Menu
▾
▴
mlton-commit — [MLton-commit] Code commits
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(56) |
Sep
(40) |
Oct
(30) |
Nov
(144) |
Dec
(23) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2006 |
Jan
(41) |
Feb
(29) |
Mar
(31) |
Apr
(39) |
May
(193) |
Jun
(45) |
Jul
(19) |
Aug
(3) |
Sep
(23) |
Oct
(83) |
Nov
(92) |
Dec
(123) |
| 2007 |
Jan
(90) |
Feb
(267) |
Mar
(120) |
Apr
(51) |
May
(40) |
Jun
(121) |
Jul
(109) |
Aug
(173) |
Sep
(77) |
Oct
(52) |
Nov
(121) |
Dec
(62) |
| 2008 |
Jan
(76) |
Feb
(53) |
Mar
(98) |
Apr
(87) |
May
(26) |
Jun
(27) |
Jul
(23) |
Aug
(136) |
Sep
(79) |
Oct
(68) |
Nov
(29) |
Dec
(14) |
| 2009 |
Jan
(7) |
Feb
(2) |
Mar
(11) |
Apr
(75) |
May
(1) |
Jun
(95) |
Jul
(19) |
Aug
(4) |
Sep
(8) |
Oct
(93) |
Nov
(43) |
Dec
(21) |
| 2010 |
Jan
(20) |
Feb
(23) |
Mar
(18) |
Apr
(6) |
May
(20) |
Jun
(23) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
(2) |
Feb
(6) |
Mar
(15) |
Apr
(5) |
May
(9) |
Jun
(14) |
Jul
(9) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(2) |
Jun
(17) |
Jul
(37) |
Aug
|
Sep
(1) |
Oct
(6) |
Nov
|
Dec
|
| 2013 |
Jan
|
Feb
|
Mar
(5) |
Apr
(2) |
May
(7) |
Jun
(11) |
Jul
(8) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
(2) |
Mar
(1) |
Apr
|
May
(1) |
Jun
(1) |
Jul
(7) |
Aug
(2) |
Sep
|
Oct
(5) |
Nov
(2) |
Dec
(4) |
| 2015 |
Jan
|
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(9) |
Jul
(1) |
Aug
|
Sep
|
Oct
(4) |
Nov
(1) |
Dec
|
| 2016 |
Jan
(2) |
Feb
(1) |
Mar
(1) |
Apr
(1) |
May
(1) |
Jun
(2) |
Jul
(1) |
Aug
|
Sep
(5) |
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
(1) |
Feb
(3) |
Mar
(3) |
Apr
(7) |
May
(2) |
Jun
(2) |
Jul
(5) |
Aug
(1) |
Sep
(2) |
Oct
(17) |
Nov
(4) |
Dec
(7) |
| 2018 |
Jan
(5) |
Feb
(14) |
Mar
(2) |
Apr
(5) |
May
(2) |
Jun
(5) |
Jul
|
Aug
(2) |
Sep
|
Oct
(3) |
Nov
(5) |
Dec
|
| 2019 |
Jan
(4) |
Feb
(2) |
Mar
(3) |
Apr
(1) |
May
(8) |
Jun
(14) |
Jul
(2) |
Aug
|
Sep
(2) |
Oct
(2) |
Nov
(15) |
Dec
(2) |
| 2020 |
Jan
(10) |
Feb
(3) |
Mar
(1) |
Apr
|
May
(9) |
Jun
(4) |
Jul
(16) |
Aug
(10) |
Sep
(4) |
Oct
(3) |
Nov
|
Dec
|
| 2021 |
Jan
(11) |
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
|
Oct
(6) |
Nov
(4) |
Dec
(4) |
| 2022 |
Jan
(4) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(6) |
Jun
(3) |
Jul
|
Aug
(1) |
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
(2) |
May
(5) |
Jun
(1) |
Jul
(4) |
Aug
(1) |
Sep
|
Oct
(1) |
Nov
(13) |
Dec
|
| 2024 |
Jan
(1) |
Feb
|
Mar
(5) |
Apr
|
May
(10) |
Jun
|
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
(1) |
Dec
(14) |
| 2025 |
Jan
(3) |
Feb
|
Mar
(1) |
Apr
|
May
(2) |
Jun
(3) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Wesley T. <we...@ml...> - 2011-07-19 04:23:36
|
ARM also expects doubles to be aligned.
Really, architectures which support 4-byte alignment are the exception here.
----------------------------------------------------------------------
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/package/debian/patches/22-fixes-20110319-to-20110719.patch
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2011-07-19 10:45:17 UTC (rev 7553)
+++ mlton/trunk/mlton/main/main.fun 2011-07-19 11:23:18 UTC (rev 7554)
@@ -186,6 +186,7 @@
case !Control.Target.arch of
Alpha => true
| AMD64 => true
+ | ARM => true
| HPPA => true
| IA64 => true
| MIPS => true
Modified: mlton/trunk/package/debian/patches/22-fixes-20110319-to-20110719.patch
===================================================================
--- mlton/trunk/package/debian/patches/22-fixes-20110319-to-20110719.patch 2011-07-19 10:45:17 UTC (rev 7553)
+++ mlton/trunk/package/debian/patches/22-fixes-20110319-to-20110719.patch 2011-07-19 11:23:18 UTC (rev 7554)
@@ -4306,8 +4306,11 @@
| SML => "sml"
| MLB => "mlb"
| Generated => "g"
-@@ -190,6 +188,7 @@
+@@ -190,8 +188,10 @@
+ case !Control.Target.arch of
+ Alpha => true
| AMD64 => true
++ | ARM => true
| HPPA => true
| IA64 => true
+ | MIPS => true
|
|
From: Wesley T. <we...@ml...> - 2011-07-19 03:45:31
|
Incremental patch
----------------------------------------------------------------------
A mlton/trunk/package/debian/patches/22-fixes-20110319-to-20110719.patch
U mlton/trunk/package/debian/patches/series
----------------------------------------------------------------------
Added: mlton/trunk/package/debian/patches/22-fixes-20110319-to-20110719.patch
===================================================================
--- mlton/trunk/package/debian/patches/22-fixes-20110319-to-20110719.patch 2011-07-19 10:37:02 UTC (rev 7552)
+++ mlton/trunk/package/debian/patches/22-fixes-20110319-to-20110719.patch 2011-07-19 10:45:17 UTC (rev 7553)
@@ -0,0 +1,100420 @@
+Index: regression/weird-word1.sml
+===================================================================
+--- regression/weird-word1.sml (revision 0)
++++ regression/weird-word1.sml (revision 7552)
+@@ -0,0 +1,26 @@
++fun fib (w: Word5.word) : Word5.word =
++ if w <= 0wx1
++ then 0wx1
++ else fib (w - 0wx1) + fib (w - 0wx2)
++
++val s =
++ case (fib 0wx5) of
++ 0wx0 => "0wx0"
++ | 0wx1 => "0wx1"
++ | 0wx2 => "0wx2"
++ | 0wx3 => "0wx3"
++ | 0wx4 => "0wx4"
++ | 0wx5 => "0wx5"
++ | 0wx6 => "0wx6"
++ | 0wx7 => "0wx7"
++ | 0wx8 => "0wx8"
++ | 0wx9 => "0wx9"
++ | 0wxA => "0wxA"
++ | 0wxB => "0wxB"
++ | 0wxC => "0wxC"
++ | 0wxD => "0wxD"
++ | 0wxE => "0wxE"
++ | 0wxF => "0wxF"
++ | _ => "zzz"
++
++val _ = print (concat [s, "\n"])
+Index: regression/weird-word2.sml
+===================================================================
+--- regression/weird-word2.sml (revision 0)
++++ regression/weird-word2.sml (revision 7552)
+@@ -0,0 +1,41 @@
++fun fib (w: Word5.word) : Word5.word =
++ if w <= 0wx1
++ then 0wx1
++ else fib (w - 0wx1) + fib (w - 0wx2)
++
++val s =
++ case (fib 0wx5) of
++ 0wx0 => "0wx0"
++ | 0wx1 => "0wx1"
++ | 0wx2 => "0wx2"
++ | 0wx3 => "0wx3"
++ | 0wx4 => "0wx4"
++ | 0wx5 => "0wx5"
++ | 0wx6 => "0wx6"
++ | 0wx7 => "0wx7"
++ | 0wx8 => "0wx8"
++ | 0wx9 => "0wx9"
++ | 0wxA => "0wxA"
++ | 0wxB => "0wxB"
++ | 0wxC => "0wxC"
++ | 0wxD => "0wxD"
++ | 0wxE => "0wxE"
++ | 0wxF => "0wxF"
++ | 0wx10 => "0wx10"
++ | 0wx11 => "0wx11"
++ | 0wx12 => "0wx12"
++ | 0wx13 => "0wx13"
++ | 0wx14 => "0wx14"
++ | 0wx15 => "0wx15"
++ | 0wx16 => "0wx16"
++ | 0wx17 => "0wx17"
++ | 0wx18 => "0wx18"
++ | 0wx19 => "0wx19"
++ | 0wx1A => "0wx1A"
++ | 0wx1B => "0wx1B"
++ | 0wx1C => "0wx1C"
++ | 0wx1D => "0wx1D"
++ | 0wx1E => "0wx1E"
++ | 0wx1F => "0wx1F"
++
++val _ = print (concat [s, "\n"])
+Index: regression/weird-word1.ok
+===================================================================
+--- regression/weird-word1.ok (revision 0)
++++ regression/weird-word1.ok (revision 7552)
+@@ -0,0 +1 @@
++0wx8
+Index: regression/weird-word2.ok
+===================================================================
+--- regression/weird-word2.ok (revision 0)
++++ regression/weird-word2.ok (revision 7552)
+@@ -0,0 +1 @@
++0wx8
+Index: mllex/lexgen.sml
+===================================================================
+--- mllex/lexgen.sml (revision 7524)
++++ mllex/lexgen.sml (revision 7552)
+@@ -1,3 +1,6 @@
++(* Modified by Matthew Fluet on 2011-06-17.
++ * Use simple file name (rather than absolute paths) in line directives in output.
++ *)
+ (* Modified by Vesa Karvonen on 2007-12-19.
+ * Create line directives in output.
+ *)
+@@ -295,7 +298,7 @@
+ val OutFile = ref ""
+ fun fmtLineDir {line, col} file =
+ String.concat ["(*#line ", Int.toString line, ".", Int.toString (col+1),
+- " \"", OS.FileSys.fullPath file, "\"*)"]
++ " \"", file, "\"*)"]
+ val sayPos =
+ fn SOME pos => say (fmtLineDir pos (!InFile))
+ | NONE => (say (fmtLineDir {line = !LexOutLine, col = 0} (!OutFile));
+@@ -1284,7 +1287,7 @@
+
+ fun lexGen(infile) =
+ let val outfile = infile ^ ".sml"
+- val () = (InFile := infile; OutFile := outfile)
++ val () = (InFile := OS.Path.file infile; OutFile := OS.Path.file outfile)
+ fun PrintLexer (ends) =
+ let val sayln = fn x => (say x; say "\n")
+ in case !ArgCode
+Index: include/bytecode.h
+===================================================================
+--- include/bytecode.h (revision 7524)
++++ include/bytecode.h (revision 7552)
+@@ -1,12 +0,0 @@
+-/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
+- * Jagannathan, and Stephen Weeks.
+- *
+- * MLton is released under a BSD-style license.
+- * See the file MLton-LICENSE for details.
+- */
+-
+-#include <stdint.h>
+-#include "ml-types.h"
+-#include "c-types.h"
+-#include "export.h"
+-#include "interpret.h"
+Index: include/bytecode-main.h
+===================================================================
+--- include/bytecode-main.h (revision 7524)
++++ include/bytecode-main.h (revision 7552)
+@@ -1,87 +0,0 @@
+-/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
+- * Jagannathan, and Stephen Weeks.
+- *
+- * MLton is released under a BSD-style license.
+- * See the file MLton-LICENSE for details.
+- */
+-
+-#ifndef _BYTECODE_MAIN_H_
+-#define _BYTECODE_MAIN_H_
+-
+-#include "common-main.h"
+-#include "interpret.h"
+-
+-#ifndef DEBUG_CODEGEN
+-#define DEBUG_CODEGEN FALSE
+-#endif
+-
+-PRIVATE extern struct Bytecode MLton_bytecode;
+-
+-static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) {
+- return *((GC_frameIndex*)(MLton_bytecode.code + ra - sizeof(GC_frameIndex)));
+-}
+-
+-#define MLtonCallFromC \
+-static void MLton_callFromC () { \
+- uintptr_t nextFun; \
+- GC_state s; \
+- \
+- if (DEBUG_CODEGEN) \
+- fprintf (stderr, "MLton_callFromC() starting\n"); \
+- s = &gcState; \
+- GC_setSavedThread (s, GC_getCurrentThread (s)); \
+- s->atomicState += 3; \
+- if (s->signalsInfo.signalIsPending) \
+- s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; \
+- /* Switch to the C Handler thread. */ \
+- GC_switchToThread (s, GC_getCallFromCHandlerThread (s), 0); \
+- nextFun = *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); \
+- MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
+- s->atomicState += 1; \
+- GC_switchToThread (s, GC_getSavedThread (s), 0); \
+- s->atomicState -= 1; \
+- if (0 == s->atomicState \
+- && s->signalsInfo.signalIsPending) \
+- s->limit = 0; \
+- if (DEBUG_CODEGEN) \
+- fprintf (stderr, "MLton_callFromC done\n"); \
+-} \
+-
+-#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
+-MLtonCallFromC \
+-PUBLIC int MLton_main (int argc, char* argv[]) { \
+- uintptr_t nextFun; \
+- Initialize (al, mg, mfs, mmc, pk, ps); \
+- if (gcState.amOriginal) { \
+- real_Init(); \
+- nextFun = ml; \
+- } else { \
+- /* Return to the saved world */ \
+- nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+- } \
+- MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
+- return 1; \
+-}
+-
+-#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, ml) \
+-MLtonCallFromC \
+-PUBLIC void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \
+- uintptr_t nextFun; \
+- Initialize (al, mg, mfs, mmc, pk, ps); \
+- if (gcState.amOriginal) { \
+- real_Init(); \
+- nextFun = ml; \
+- } else { \
+- /* Return to the saved world */ \
+- nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+- } \
+- MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
+-} \
+-PUBLIC void LIB_CLOSE(LIBNAME) () { \
+- uintptr_t nextFun; \
+- nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+- MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
+- GC_done(&gcState); \
+-}
+-
+-#endif /* #ifndef _BYTECODE_MAIN_H */
+Index: runtime/gdtoa-patch.mlton
+===================================================================
+--- runtime/gdtoa-patch.mlton (revision 7524)
++++ runtime/gdtoa-patch.mlton (revision 7552)
+@@ -1,98 +1,103 @@
+---- gdtoa/gdtoa.h.orig 2008-07-31 18:07:23.128804424 +0200
+-+++ gdtoa/gdtoa.h 2008-07-31 18:09:01.333773640 +0200
+-@@ -39,6 +39,7 @@
+- #define GDTOA_H_INCLUDED
+-
+- #include "arith.h"
+-+#include "../export.h"
+-
+- #ifndef Long
+- #define Long long
+-@@ -108,42 +109,42 @@
+- extern "C" {
+- #endif
+-
+--extern char* gdtoa__dtoa ANSI((double d, int mode, int ndigits, int *decpt,
+-+PRIVATE extern char* gdtoa__dtoa ANSI((double d, int mode, int ndigits, int *decpt,
+- int *sign, char **rve));
+--extern char* gdtoa__gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
+-+PRIVATE extern char* gdtoa__gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
+- int mode, int ndigits, int *decpt, char **rve));
+--extern void gdtoa__freedtoa ANSI((char*));
+--extern float gdtoa__strtof ANSI((CONST char *, char **));
+--extern double gdtoa__strtod ANSI((CONST char *, char **));
+--extern int gdtoa__strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
+--
+--extern char* gdtoa__g_ddfmt ANSI((char*, double*, int, unsigned));
+--extern char* gdtoa__g_dfmt ANSI((char*, double*, int, unsigned));
+--extern char* gdtoa__g_ffmt ANSI((char*, float*, int, unsigned));
+--extern char* gdtoa__g_Qfmt ANSI((char*, void*, int, unsigned));
+--extern char* gdtoa__g_xfmt ANSI((char*, void*, int, unsigned));
+--extern char* gdtoa__g_xLfmt ANSI((char*, void*, int, unsigned));
+--
+--extern int gdtoa__strtoId ANSI((CONST char*, char**, double*, double*));
+--extern int gdtoa__strtoIdd ANSI((CONST char*, char**, double*, double*));
+--extern int gdtoa__strtoIf ANSI((CONST char*, char**, float*, float*));
+--extern int gdtoa__strtoIQ ANSI((CONST char*, char**, void*, void*));
+--extern int gdtoa__strtoIx ANSI((CONST char*, char**, void*, void*));
+--extern int gdtoa__strtoIxL ANSI((CONST char*, char**, void*, void*));
+--extern int gdtoa__strtord ANSI((CONST char*, char**, int, double*));
+--extern int gdtoa__strtordd ANSI((CONST char*, char**, int, double*));
+--extern int gdtoa__strtorf ANSI((CONST char*, char**, int, float*));
+--extern int gdtoa__strtorQ ANSI((CONST char*, char**, int, void*));
+--extern int gdtoa__strtorx ANSI((CONST char*, char**, int, void*));
+--extern int gdtoa__strtorxL ANSI((CONST char*, char**, int, void*));
+-+PRIVATE extern void gdtoa__freedtoa ANSI((char*));
+-+PRIVATE extern float gdtoa__strtof ANSI((CONST char *, char **));
+-+PRIVATE extern double gdtoa__strtod ANSI((CONST char *, char **));
+-+PRIVATE extern int gdtoa__strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
+-+
+-+PRIVATE extern char* gdtoa__g_ddfmt ANSI((char*, double*, int, unsigned));
+-+PRIVATE extern char* gdtoa__g_dfmt ANSI((char*, double*, int, unsigned));
+-+PRIVATE extern char* gdtoa__g_ffmt ANSI((char*, float*, int, unsigned));
+-+PRIVATE extern char* gdtoa__g_Qfmt ANSI((char*, void*, int, unsigned));
+-+PRIVATE extern char* gdtoa__g_xfmt ANSI((char*, void*, int, unsigned));
+-+PRIVATE extern char* gdtoa__g_xLfmt ANSI((char*, void*, int, unsigned));
+-+
+-+PRIVATE extern int gdtoa__strtoId ANSI((CONST char*, char**, double*, double*));
+-+PRIVATE extern int gdtoa__strtoIdd ANSI((CONST char*, char**, double*, double*));
+-+PRIVATE extern int gdtoa__strtoIf ANSI((CONST char*, char**, float*, float*));
+-+PRIVATE extern int gdtoa__strtoIQ ANSI((CONST char*, char**, void*, void*));
+-+PRIVATE extern int gdtoa__strtoIx ANSI((CONST char*, char**, void*, void*));
+-+PRIVATE extern int gdtoa__strtoIxL ANSI((CONST char*, char**, void*, void*));
+-+PRIVATE extern int gdtoa__strtord ANSI((CONST char*, char**, int, double*));
+-+PRIVATE extern int gdtoa__strtordd ANSI((CONST char*, char**, int, double*));
+-+PRIVATE extern int gdtoa__strtorf ANSI((CONST char*, char**, int, float*));
+-+PRIVATE extern int gdtoa__strtorQ ANSI((CONST char*, char**, int, void*));
+-+PRIVATE extern int gdtoa__strtorx ANSI((CONST char*, char**, int, void*));
+-+PRIVATE extern int gdtoa__strtorxL ANSI((CONST char*, char**, int, void*));
+- #if 1
+--extern int gdtoa__strtodI ANSI((CONST char*, char**, double*));
+--extern int gdtoa__strtopd ANSI((CONST char*, char**, double*));
+--extern int gdtoa__strtopdd ANSI((CONST char*, char**, double*));
+--extern int gdtoa__strtopf ANSI((CONST char*, char**, float*));
+--extern int gdtoa__strtopQ ANSI((CONST char*, char**, void*));
+--extern int gdtoa__strtopx ANSI((CONST char*, char**, void*));
+--extern int gdtoa__strtopxL ANSI((CONST char*, char**, void*));
+-+PRIVATE extern int gdtoa__strtodI ANSI((CONST char*, char**, double*));
+-+PRIVATE extern int gdtoa__strtopd ANSI((CONST char*, char**, double*));
+-+PRIVATE extern int gdtoa__strtopdd ANSI((CONST char*, char**, double*));
+-+PRIVATE extern int gdtoa__strtopf ANSI((CONST char*, char**, float*));
+-+PRIVATE extern int gdtoa__strtopQ ANSI((CONST char*, char**, void*));
+-+PRIVATE extern int gdtoa__strtopx ANSI((CONST char*, char**, void*));
+-+PRIVATE extern int gdtoa__strtopxL ANSI((CONST char*, char**, void*));
+- #else
+- #define gdtoa__strtopd(s,se,x) gdtoa__strtord(s,se,1,x)
+- #define gdtoa__strtopdd(s,se,x) gdtoa__strtordd(s,se,1,x)
+---- gdtoa/gdtoaimp.h.orig 2008-10-04 02:33:51 +0000
+-+++ gdtoa/gdtoaimp.h 2008-10-04 02:34:41 +0000
+-@@ -503,7 +503,8 @@
+- #define g__fmt g__fmt_D2A
+- #define gethex gethex_D2A
+- #define hexdig hexdig_D2A
+--#define hexdig_init hexdig_init_D2A
+-+/* work around MinGW bug */
+-+#define hexdig_init hexdig_init_D3A
+- #define hexnan hexnan_D2A
+- #define hi0bits hi0bits_D2A
+- #define i2b i2b_D2A
++diff -P -C 2 -r gdtoa/gdtoa.h gdtoa-new/gdtoa.h
++*** gdtoa/gdtoa.h 2011-05-27 17:20:57.492026828 -0400
++--- gdtoa-new/gdtoa.h 2011-05-27 17:21:21.004032383 -0400
++***************
++*** 105,144 ****
++ #endif
++
++! extern char* gdtoa__dtoa ANSI((double d, int mode, int ndigits, int *decpt,
++ int *sign, char **rve));
++! extern char* gdtoa__gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
++ int mode, int ndigits, int *decpt, char **rve));
++! extern void gdtoa__freedtoa ANSI((char*));
++! extern float gdtoa__strtof ANSI((CONST char *, char **));
++! extern double gdtoa__strtod ANSI((CONST char *, char **));
++! extern int gdtoa__strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
++
++! extern char* gdtoa__g_ddfmt ANSI((char*, double*, int, size_t));
++! extern char* gdtoa__g_dfmt ANSI((char*, double*, int, size_t));
++! extern char* gdtoa__g_ffmt ANSI((char*, float*, int, size_t));
++! extern char* gdtoa__g_Qfmt ANSI((char*, void*, int, size_t));
++! extern char* gdtoa__g_xfmt ANSI((char*, void*, int, size_t));
++! extern char* gdtoa__g_xLfmt ANSI((char*, void*, int, size_t));
++
++! extern int gdtoa__strtoId ANSI((CONST char*, char**, double*, double*));
++! extern int gdtoa__strtoIdd ANSI((CONST char*, char**, double*, double*));
++! extern int gdtoa__strtoIf ANSI((CONST char*, char**, float*, float*));
++! extern int gdtoa__strtoIQ ANSI((CONST char*, char**, void*, void*));
++! extern int gdtoa__strtoIx ANSI((CONST char*, char**, void*, void*));
++! extern int gdtoa__strtoIxL ANSI((CONST char*, char**, void*, void*));
++! extern int gdtoa__strtord ANSI((CONST char*, char**, int, double*));
++! extern int gdtoa__strtordd ANSI((CONST char*, char**, int, double*));
++! extern int gdtoa__strtorf ANSI((CONST char*, char**, int, float*));
++! extern int gdtoa__strtorQ ANSI((CONST char*, char**, int, void*));
++! extern int gdtoa__strtorx ANSI((CONST char*, char**, int, void*));
++! extern int gdtoa__strtorxL ANSI((CONST char*, char**, int, void*));
++ #if 1
++! extern int gdtoa__strtodI ANSI((CONST char*, char**, double*));
++! extern int gdtoa__strtopd ANSI((CONST char*, char**, double*));
++! extern int gdtoa__strtopdd ANSI((CONST char*, char**, double*));
++! extern int gdtoa__strtopf ANSI((CONST char*, char**, float*));
++! extern int gdtoa__strtopQ ANSI((CONST char*, char**, void*));
++! extern int gdtoa__strtopx ANSI((CONST char*, char**, void*));
++! extern int gdtoa__strtopxL ANSI((CONST char*, char**, void*));
++ #else
++ #define gdtoa__strtopd(s,se,x) gdtoa__strtord(s,se,1,x)
++--- 105,144 ----
++ #endif
++
++! PRIVATE extern char* gdtoa__dtoa ANSI((double d, int mode, int ndigits, int *decpt,
++ int *sign, char **rve));
++! PRIVATE extern char* gdtoa__gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
++ int mode, int ndigits, int *decpt, char **rve));
++! PRIVATE extern void gdtoa__freedtoa ANSI((char*));
++! PRIVATE extern float gdtoa__strtof ANSI((CONST char *, char **));
++! PRIVATE extern double gdtoa__strtod ANSI((CONST char *, char **));
++! PRIVATE extern int gdtoa__strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
++
++! PRIVATE extern char* gdtoa__g_ddfmt ANSI((char*, double*, int, size_t));
++! PRIVATE extern char* gdtoa__g_dfmt ANSI((char*, double*, int, size_t));
++! PRIVATE extern char* gdtoa__g_ffmt ANSI((char*, float*, int, size_t));
++! PRIVATE extern char* gdtoa__g_Qfmt ANSI((char*, void*, int, size_t));
++! PRIVATE extern char* gdtoa__g_xfmt ANSI((char*, void*, int, size_t));
++! PRIVATE extern char* gdtoa__g_xLfmt ANSI((char*, void*, int, size_t));
++
++! PRIVATE extern int gdtoa__strtoId ANSI((CONST char*, char**, double*, double*));
++! PRIVATE extern int gdtoa__strtoIdd ANSI((CONST char*, char**, double*, double*));
++! PRIVATE extern int gdtoa__strtoIf ANSI((CONST char*, char**, float*, float*));
++! PRIVATE extern int gdtoa__strtoIQ ANSI((CONST char*, char**, void*, void*));
++! PRIVATE extern int gdtoa__strtoIx ANSI((CONST char*, char**, void*, void*));
++! PRIVATE extern int gdtoa__strtoIxL ANSI((CONST char*, char**, void*, void*));
++! PRIVATE extern int gdtoa__strtord ANSI((CONST char*, char**, int, double*));
++! PRIVATE extern int gdtoa__strtordd ANSI((CONST char*, char**, int, double*));
++! PRIVATE extern int gdtoa__strtorf ANSI((CONST char*, char**, int, float*));
++! PRIVATE extern int gdtoa__strtorQ ANSI((CONST char*, char**, int, void*));
++! PRIVATE extern int gdtoa__strtorx ANSI((CONST char*, char**, int, void*));
++! PRIVATE extern int gdtoa__strtorxL ANSI((CONST char*, char**, int, void*));
++ #if 1
++! PRIVATE extern int gdtoa__strtodI ANSI((CONST char*, char**, double*));
++! PRIVATE extern int gdtoa__strtopd ANSI((CONST char*, char**, double*));
++! PRIVATE extern int gdtoa__strtopdd ANSI((CONST char*, char**, double*));
++! PRIVATE extern int gdtoa__strtopf ANSI((CONST char*, char**, float*));
++! PRIVATE extern int gdtoa__strtopQ ANSI((CONST char*, char**, void*));
++! PRIVATE extern int gdtoa__strtopx ANSI((CONST char*, char**, void*));
++! PRIVATE extern int gdtoa__strtopxL ANSI((CONST char*, char**, void*));
++ #else
++ #define gdtoa__strtopd(s,se,x) gdtoa__strtord(s,se,1,x)
++diff -P -C 2 -r gdtoa/gdtoaimp.h gdtoa-new/gdtoaimp.h
++*** gdtoa/gdtoaimp.h 2011-05-27 17:20:57.493026911 -0400
++--- gdtoa-new/gdtoaimp.h 2011-05-27 17:21:21.004032383 -0400
++***************
++*** 504,508 ****
++ #define gethex gethex_D2A
++ #define hexdig hexdig_D2A
++! #define hexdig_init hexdig_init_D2A
++ #define hexnan hexnan_D2A
++ #define hi0bits(x) hi0bits_D2A((ULong)(x))
++--- 504,509 ----
++ #define gethex gethex_D2A
++ #define hexdig hexdig_D2A
++! /* work around MinGW bug */
++! #define hexdig_init hexdig_init_D3A
++ #define hexnan hexnan_D2A
++ #define hi0bits(x) hi0bits_D2A((ULong)(x))
+Index: runtime/gc/copy-thread.c
+===================================================================
+--- runtime/gc/copy-thread.c (revision 7524)
++++ runtime/gc/copy-thread.c (revision 7552)
+@@ -1,4 +1,5 @@
+-/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
++/* Copyright (C) 2011 Matthew Fluet.
++ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+@@ -35,7 +36,7 @@
+ GC_thread fromThread;
+ GC_stack fromStack;
+ GC_thread toThread;
+- GC_stack toStack;
++ GC_stack __attribute__ ((unused)) toStack;
+
+ if (DEBUG_THREADS)
+ fprintf (stderr, "GC_copyCurrentThread\n");
+@@ -57,7 +58,7 @@
+ GC_thread fromThread;
+ GC_stack fromStack;
+ GC_thread toThread;
+- GC_stack toStack;
++ GC_stack __attribute__ ((unused)) toStack;
+
+ if (DEBUG_THREADS)
+ fprintf (stderr, "GC_copyThread ("FMTPTR")\n", (uintptr_t)p);
+Index: runtime/gc/heap.c
+===================================================================
+--- runtime/gc/heap.c (revision 7524)
++++ runtime/gc/heap.c (revision 7552)
+@@ -1,4 +1,4 @@
+-/* Copyright (C) 2009-2010 Matthew Fluet.
++/* Copyright (C) 2009-2011 Matthew Fluet.
+ * Copyright (C) 2005-2008 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+@@ -41,7 +41,7 @@
+ size_t liveMapsSize, liveWithMapsSize;
+ size_t currentMapsSize, currentWithMapsSize;
+ size_t resSize, resWithMapsSize;
+- size_t syslimSize, syslimMapsSize, syslimWithMapsSize;
++ size_t syslimSize, __attribute__ ((unused)) syslimMapsSize, syslimWithMapsSize;
+ double ratio;
+
+ syslimWithMapsSize = alignDown (SIZE_MAX, s->sysvals.pageSize);
+@@ -553,12 +553,11 @@
+ */
+ void resizeHeapSecondary (GC_state s) {
+ size_t primarySize, primaryWithMapsSize;
+- size_t secondarySize, secondaryWithMapsSize;
++ size_t secondarySize;
+
+ primarySize = s->heap.size;
+ primaryWithMapsSize = s->heap.withMapsSize;
+ secondarySize = s->secondaryHeap.size;
+- secondaryWithMapsSize = s->secondaryHeap.withMapsSize;
+ if (DEBUG_RESIZING)
+ fprintf (stderr, "secondaryHeapResize\n");
+ if (0 == secondarySize)
+Index: runtime/gc/init-world.c
+===================================================================
+--- runtime/gc/init-world.c (revision 7524)
++++ runtime/gc/init-world.c (revision 7552)
+@@ -1,4 +1,5 @@
+-/* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
++/* Copyright (C) 2011 Matthew Fluet.
++ * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+@@ -51,7 +52,7 @@
+ size_t bytes;
+ bool neg;
+ __mpz_struct resmpz;
+- int ans;
++ __attribute__ ((unused)) int ans;
+
+ assert (isFrontierAligned (s, s->frontier));
+ for (i = 0; i < s->intInfInitsLength; i++) {
+Index: runtime/gc/profiling.c
+===================================================================
+--- runtime/gc/profiling.c (revision 7524)
++++ runtime/gc/profiling.c (revision 7552)
+@@ -1,4 +1,5 @@
+-/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
++/* Copyright (C) 2011 Matthew Fluet.
++ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+@@ -76,7 +77,6 @@
+
+ void enterForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex) {
+ uint32_t i;
+- GC_profileData p;
+ GC_sourceIndex sourceIndex;
+ uint32_t *sourceSeq;
+
+@@ -84,7 +84,6 @@
+ fprintf (stderr, "enterForProfiling ("FMTSSI")\n", sourceSeqIndex);
+ assert (s->profiling.stack);
+ assert (sourceSeqIndex < s->sourceMaps.sourceSeqsLength);
+- p = s->profiling.data;
+ sourceSeq = s->sourceMaps.sourceSeqs[sourceSeqIndex];
+ for (i = 1; i <= sourceSeq[0]; i++) {
+ sourceIndex = sourceSeq[i];
+@@ -123,10 +122,8 @@
+ }
+
+ void leaveSourceForProfiling (GC_state s, GC_profileMasterIndex i) {
+- GC_profileData p;
+ GC_profileStack ps;
+
+- p = s->profiling.data;
+ ps = getProfileStackInfo (s, i);
+ assert (ps->numOccurrences > 0);
+ ps->numOccurrences--;
+@@ -136,7 +133,6 @@
+
+ void leaveForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex) {
+ int32_t i;
+- GC_profileData p;
+ GC_sourceIndex sourceIndex;
+ uint32_t *sourceSeq;
+
+@@ -144,7 +140,6 @@
+ fprintf (stderr, "leaveForProfiling ("FMTSSI")\n", sourceSeqIndex);
+ assert (s->profiling.stack);
+ assert (sourceSeqIndex < s->sourceMaps.sourceSeqsLength);
+- p = s->profiling.data;
+ sourceSeq = s->sourceMaps.sourceSeqs[sourceSeqIndex];
+ for (i = sourceSeq[0]; i > 0; i--) {
+ sourceIndex = sourceSeq[i];
+Index: runtime/gc/invariant.c
+===================================================================
+--- runtime/gc/invariant.c (revision 7524)
++++ runtime/gc/invariant.c (revision 7552)
+@@ -1,4 +1,5 @@
+-/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
++/* Copyright (C) 2011 Matthew Fluet.
++ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+@@ -42,6 +43,8 @@
+
+ assert (layout->size <= s->maxFrameSize);
+ offsets = layout->offsets;
++ for (unsigned int j = 0; j < offsets[0]; ++j)
++ assert (offsets[j + 1] < layout->size);
+ }
+ }
+ /* Generational */
+Index: runtime/gdtoa-patch
+===================================================================
+--- runtime/gdtoa-patch (revision 7524)
++++ runtime/gdtoa-patch (revision 7552)
+@@ -1,918 +1,1119 @@
+-diff -u gdtoa.orig/arithchk.c gdtoa/arithchk.c
+---- gdtoa.orig/arithchk.c 1998-06-19 20:46:11 +0000
+-+++ gdtoa/arithchk.c 2008-10-04 02:01:43 +0000
+-@@ -136,7 +136,7 @@
+- return b == 0.;
+- }
+-
+--main()
+-+int main()
+- {
+- Akind *a = 0;
+- int Ldef = 0;
+-diff -u gdtoa.orig/dmisc.c gdtoa/dmisc.c
+---- gdtoa.orig/dmisc.c 1998-11-02 19:34:31 +0000
+-+++ gdtoa/dmisc.c 2008-10-04 02:01:43 +0000
+-@@ -89,9 +89,9 @@
+-
+- void
+- #ifdef KR_headers
+--freedtoa(s) char *s;
+-+gdtoa__freedtoa(s) char *s;
+- #else
+--freedtoa(char *s)
+-+gdtoa__freedtoa(char *s)
+- #endif
+- {
+- Bigint *b = (Bigint *)((int *)s - 1);
+-diff -u gdtoa.orig/dtoa.c gdtoa/dtoa.c
+---- gdtoa.orig/dtoa.c 2000-11-02 15:09:01 +0000
+-+++ gdtoa/dtoa.c 2008-10-04 02:01:43 +0000
+-@@ -80,7 +80,7 @@
+- #endif
+-
+- char *
+--dtoa
+-+gdtoa__dtoa
+- #ifdef KR_headers
+- (d, mode, ndigits, decpt, sign, rve)
+- double d; int mode, ndigits, *decpt, *sign; char **rve;
+-@@ -142,7 +142,7 @@
+-
+- #ifndef MULTIPLE_THREADS
+- if (dtoa_result) {
+-- freedtoa(dtoa_result);
+-+ gdtoa__freedtoa(dtoa_result);
+- dtoa_result = 0;
+- }
+- #endif
+-diff -u gdtoa.orig/g_Qfmt.c gdtoa/g_Qfmt.c
+---- gdtoa.orig/g_Qfmt.c 2000-11-01 15:21:10 +0000
+-+++ gdtoa/g_Qfmt.c 2008-10-04 02:01:43 +0000
+-@@ -57,9 +57,9 @@
+-
+- char*
+- #ifdef KR_headers
+--g_Qfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
+-+gdtoa__g_Qfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
+- #else
+--g_Qfmt(char *buf, void *V, int ndig, unsigned bufsize)
+-+gdtoa__g_Qfmt(char *buf, void *V, int ndig, unsigned bufsize)
+- #endif
+- {
+- static FPI fpi = { 113, 1-16383-113+1, 32766 - 16383 - 113 + 1, 1, 0 };
+-@@ -115,6 +115,6 @@
+- return 0;
+- mode = 0;
+- }
+-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+- return g__fmt(buf, s, se, decpt, sign);
+- }
+-diff -u gdtoa.orig/g__fmt.c gdtoa/g__fmt.c
+---- gdtoa.orig/g__fmt.c 2003-03-21 20:59:43 +0000
+-+++ gdtoa/g__fmt.c 2008-10-04 02:01:43 +0000
+-@@ -96,6 +96,6 @@
+- *b++ = '0';
+- *b = 0;
+- }
+-- freedtoa(s0);
+-+ gdtoa__freedtoa(s0);
+- return b;
++diff -P -C 2 -r gdtoa/dmisc.c gdtoa-new/dmisc.c
++*** gdtoa/dmisc.c 2004-04-11 23:39:50.000000000 -0400
++--- gdtoa-new/dmisc.c 2011-05-27 17:09:13.940030010 -0400
++***************
++*** 84,90 ****
++ void
++ #ifdef KR_headers
++! freedtoa(s) char *s;
++ #else
++! freedtoa(char *s)
++ #endif
++ {
++--- 84,90 ----
++ void
++ #ifdef KR_headers
++! gdtoa__freedtoa(s) char *s;
++ #else
++! gdtoa__freedtoa(char *s)
++ #endif
++ {
++diff -P -C 2 -r gdtoa/dtoa.c gdtoa-new/dtoa.c
++*** gdtoa/dtoa.c 2010-09-15 10:59:11.000000000 -0400
++--- gdtoa-new/dtoa.c 2011-05-27 17:09:13.940030010 -0400
++***************
++*** 74,78 ****
++
++ char *
++! dtoa
++ #ifdef KR_headers
++ (d0, mode, ndigits, decpt, sign, rve)
++--- 74,78 ----
++
++ char *
++! gdtoa__dtoa
++ #ifdef KR_headers
++ (d0, mode, ndigits, decpt, sign, rve)
++***************
++*** 147,151 ****
++ #ifndef MULTIPLE_THREADS
++ if (dtoa_result) {
++! freedtoa(dtoa_result);
++ dtoa_result = 0;
++ }
++--- 147,151 ----
++ #ifndef MULTIPLE_THREADS
++ if (dtoa_result) {
++! gdtoa__freedtoa(dtoa_result);
++ dtoa_result = 0;
++ }
++diff -P -C 2 -r gdtoa/g_ddfmt.c gdtoa-new/g_ddfmt.c
++*** gdtoa/g_ddfmt.c 2009-04-11 23:11:05.000000000 -0400
++--- gdtoa-new/g_ddfmt.c 2011-05-27 17:09:13.940030010 -0400
++***************
++*** 34,40 ****
++ char *
++ #ifdef KR_headers
++! g_ddfmt(buf, dd0, ndig, bufsize) char *buf; double *dd0; int ndig; size_t bufsize;
++ #else
++! g_ddfmt(char *buf, double *dd0, int ndig, size_t bufsize)
++ #endif
++ {
++--- 34,40 ----
++ char *
++ #ifdef KR_headers
++! gdtoa__g_ddfmt(buf, dd0, ndig, bufsize) char *buf; double *dd0; int ndig; size_t bufsize;
++ #else
++! gdtoa__g_ddfmt(char *buf, double *dd0, int ndig, size_t bufsize)
++ #endif
++ {
++***************
++*** 164,168 ****
++ fpi.sudden_underflow = 0;
++ i = STRTOG_Normal;
++! s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
++ b = g__fmt(buf, s, se, decpt, z->sign, bufsize);
++ Bfree(z);
++--- 164,168 ----
++ fpi.sudden_underflow = 0;
++ i = STRTOG_Normal;
++! s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
++ b = g__fmt(buf, s, se, decpt, z->sign, bufsize);
++ Bfree(z);
++diff -P -C 2 -r gdtoa/g_dfmt.c gdtoa-new/g_dfmt.c
++*** gdtoa/g_dfmt.c 2010-07-08 23:38:41.000000000 -0400
++--- gdtoa-new/g_dfmt.c 2011-05-27 17:09:13.940030010 -0400
++***************
++*** 34,40 ****
++ char*
++ #ifdef KR_headers
++! g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; size_t bufsize;
++ #else
++! g_dfmt(char *buf, double *d, int ndig, size_t bufsize)
++ #endif
++ {
++--- 34,40 ----
++ char*
++ #ifdef KR_headers
++! gdtoa__g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; size_t bufsize;
++ #else
++! gdtoa__g_dfmt(char *buf, double *d, int ndig, size_t bufsize)
++ #endif
++ {
++***************
++*** 91,95 ****
++ if (sign)
++ i = STRTOG_Normal | STRTOG_Neg;
++! s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
++ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+-diff -u gdtoa.orig/g_ddfmt.c gdtoa/g_ddfmt.c
+---- gdtoa.orig/g_ddfmt.c 1998-09-09 12:09:31 +0000
+-+++ gdtoa/g_ddfmt.c 2008-10-04 02:01:43 +0000
+-@@ -40,9 +40,9 @@
+-
+- char *
+- #ifdef KR_headers
+--g_ddfmt(buf, dd, ndig, bufsize) char *buf; double *dd; int ndig; unsigned bufsize;
+-+gdtoa__g_ddfmt(buf, dd, ndig, bufsize) char *buf; double *dd; int ndig; unsigned bufsize;
+- #else
+--g_ddfmt(char *buf, double *dd, int ndig, unsigned bufsize)
+-+gdtoa__g_ddfmt(char *buf, double *dd, int ndig, unsigned bufsize)
+- #endif
+- {
+- FPI fpi;
+-@@ -154,7 +154,7 @@
+- fpi.rounding = FPI_Round_near;
+- fpi.sudden_underflow = 0;
+- i = STRTOG_Normal;
+-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+- b = g__fmt(buf, s, se, decpt, z->sign);
+- Bfree(z);
+- return b;
+-diff -u gdtoa.orig/g_dfmt.c gdtoa/g_dfmt.c
+---- gdtoa.orig/g_dfmt.c 1998-09-09 14:18:15 +0000
+-+++ gdtoa/g_dfmt.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- char*
+- #ifdef KR_headers
+--g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; unsigned bufsize;
+-+gdtoa__g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; unsigned bufsize;
+- #else
+--g_dfmt(char *buf, double *d, int ndig, unsigned bufsize)
+-+gdtoa__g_dfmt(char *buf, double *d, int ndig, unsigned bufsize)
+- #endif
+- {
+- static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
+-@@ -90,6 +90,6 @@
+- mode = 0;
+- }
+- i = STRTOG_Normal;
+-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+- return g__fmt(buf, s, se, decpt, sign);
+- }
+-diff -u gdtoa.orig/g_ffmt.c gdtoa/g_ffmt.c
+---- gdtoa.orig/g_ffmt.c 1998-09-12 20:39:39 +0000
+-+++ gdtoa/g_ffmt.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- char*
+- #ifdef KR_headers
+--g_ffmt(buf, f, ndig, bufsize) char *buf; float *f; int ndig; unsigned bufsize;
+-+gdtoa__g_ffmt(buf, f, ndig, bufsize) char *buf; float *f; int ndig; unsigned bufsize;
+- #else
+--g_ffmt(char *buf, float *f, int ndig, unsigned bufsize)
+-+gdtoa__g_ffmt(char *buf, float *f, int ndig, unsigned bufsize)
+- #endif
+- {
+- static FPI fpi = { 24, 1-127-24+1, 254-127-24+1, 1, 0 };
+-@@ -89,6 +89,6 @@
+- mode = 0;
+- }
+- i = STRTOG_Normal;
+-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+- return g__fmt(buf, s, se, decpt, sign);
+- }
+-diff -u gdtoa.orig/g_xLfmt.c gdtoa/g_xLfmt.c
+---- gdtoa.orig/g_xLfmt.c 1998-09-09 16:35:43 +0000
+-+++ gdtoa/g_xLfmt.c 2008-10-04 02:01:43 +0000
+-@@ -55,9 +55,9 @@
+-
+- char*
+- #ifdef KR_headers
+--g_xLfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
+-+gdtoa__g_xLfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
+- #else
+--g_xLfmt(char *buf, void *V, int ndig, unsigned bufsize)
+-+gdtoa__g_xLfmt(char *buf, void *V, int ndig, unsigned bufsize)
+- #endif
+- {
+- static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, 0 };
+-@@ -109,6 +109,6 @@
+- return 0;
+- mode = 0;
+- }
+-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+- return g__fmt(buf, s, se, decpt, sign);
+- }
+-diff -u gdtoa.orig/g_xfmt.c gdtoa/g_xfmt.c
+---- gdtoa.orig/g_xfmt.c 1998-09-09 13:59:17 +0000
+-+++ gdtoa/g_xfmt.c 2008-10-04 02:01:43 +0000
+-@@ -59,9 +59,9 @@
+-
+- char*
+- #ifdef KR_headers
+--g_xfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
+-+gdtoa__g_xfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
+- #else
+--g_xfmt(char *buf, void *V, int ndig, unsigned bufsize)
+-+gdtoa__g_xfmt(char *buf, void *V, int ndig, unsigned bufsize)
+- #endif
+- {
+- static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, 0 };
+-@@ -114,6 +114,6 @@
+- return 0;
+- mode = 0;
+- }
+-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+- return g__fmt(buf, s, se, decpt, sign);
+- }
+-Only in gdtoa: gdtoa
+-diff -u gdtoa.orig/gdtoa.c gdtoa/gdtoa.c
+---- gdtoa.orig/gdtoa.c 1999-09-21 04:22:19 +0000
+-+++ gdtoa/gdtoa.c 2008-10-04 02:01:43 +0000
+-@@ -115,7 +115,7 @@
+- */
+-
+- char *
+--gdtoa
+-+gdtoa__gdtoa
+- #ifdef KR_headers
+- (fpi, be, bits, kindp, mode, ndigits, decpt, rve)
+- FPI *fpi; int be; ULong *bits;
+-@@ -168,7 +168,7 @@
+-
+- #ifndef MULTIPLE_THREADS
+- if (dtoa_result) {
+-- freedtoa(dtoa_result);
+-+ gdtoa__freedtoa(dtoa_result);
+- dtoa_result = 0;
+- }
+- #endif
+-diff -u gdtoa.orig/gdtoa.h gdtoa/gdtoa.h
+---- gdtoa.orig/gdtoa.h 2000-11-01 15:01:39 +0000
+-+++ gdtoa/gdtoa.h 2008-10-04 02:01:43 +0000
+-@@ -108,49 +108,49 @@
+- extern "C" {
+- #endif
+-
+--extern char* dtoa ANSI((double d, int mode, int ndigits, int *decpt,
+-+extern char* gdtoa__dtoa ANSI((double d, int mode, int ndigits, int *decpt,
+- int *sign, char **rve));
+--extern char* gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
+-+extern char* gdtoa__gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
+- int mode, int ndigits, int *decpt, char **rve));
+--extern void freedtoa ANSI((char*));
+--extern float strtof ANSI((CONST char *, char **));
+--extern double strtod ANSI((CONST char *, char **));
+--extern int strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
+-+extern void gdtoa__freedtoa ANSI((char*));
+-+extern float gdtoa__strtof ANSI((CONST char *, char **));
+-+extern double gdtoa__strtod ANSI((CONST char *, char **));
+-+extern int gdtoa__strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
+-
+--extern char* g_ddfmt ANSI((char*, double*, int, unsigned));
+--extern char* g_dfmt ANSI((char*, double*, int, unsigned));
+--extern char* g_ffmt ANSI((char*, float*, int, unsigned));
+--extern char* g_Qfmt ANSI((char*, void*, int, unsigned));
+--extern char* g_xfmt ANSI((char*, void*, int, unsigned));
+--extern char* g_xLfmt ANSI((char*, void*, int, unsigned));
+-+extern char* gdtoa__g_ddfmt ANSI((char*, double*, int, unsigned));
+-+extern char* gdtoa__g_dfmt ANSI((char*, double*, int, unsigned));
+-+extern char* gdtoa__g_ffmt ANSI((char*, float*, int, unsigned));
+-+extern char* gdtoa__g_Qfmt ANSI((char*, void*, int, unsigned));
+-+extern char* gdtoa__g_xfmt ANSI((char*, void*, int, unsigned));
+-+extern char* gdtoa__g_xLfmt ANSI((char*, void*, int, unsigned));
+-
+--extern int strtoId ANSI((CONST char*, char**, double*, double*));
+--extern int strtoIdd ANSI((CONST char*, char**, double*, double*));
+--extern int strtoIf ANSI((CONST char*, char**, float*, float*));
+--extern int strtoIQ ANSI((CONST char*, char**, void*, void*));
+--extern int strtoIx ANSI((CONST char*, char**, void*, void*));
+--extern int strtoIxL ANSI((CONST char*, char**, void*, void*));
+--extern int strtord ANSI((CONST char*, char**, int, double*));
+--extern int strtordd ANSI((CONST char*, char**, int, double*));
+--extern int strtorf ANSI((CONST char*, char**, int, float*));
+--extern int strtorQ ANSI((CONST char*, char**, int, void*));
+--extern int strtorx ANSI((CONST char*, char**, int, void*));
+--extern int strtorxL ANSI((CONST char*, char**, int, void*));
+-+extern int gdtoa__strtoId ANSI((CONST char*, char**, double*, double*));
+-+extern int gdtoa__strtoIdd ANSI((CONST char*, char**, double*, double*));
+-+extern int gdtoa__strtoIf ANSI((CONST char*, char**, float*, float*));
+-+extern int gdtoa__strtoIQ ANSI((CONST char*, char**, void*, void*));
+-+extern int gdtoa__strtoIx ANSI((CONST char*, char**, void*, void*));
+-+extern int gdtoa__strtoIxL ANSI((CONST char*, char**, void*, void*));
+-+extern int gdtoa__strtord ANSI((CONST char*, char**, int, double*));
+-+extern int gdtoa__strtordd ANSI((CONST char*, char**, int, double*));
+-+extern int gdtoa__strtorf ANSI((CONST char*, char**, int, float*));
+-+extern int gdtoa__strtorQ ANSI((CONST char*, char**, int, void*));
+-+extern int gdtoa__strtorx ANSI((CONST char*, char**, int, void*));
+-+extern int gdtoa__strtorxL ANSI((CONST char*, char**, int, void*));
+- #if 1
+--extern int strtodI ANSI((CONST char*, char**, double*));
+--extern int strtopd ANSI((CONST char*, char**, double*));
+--extern int strtopdd ANSI((CONST char*, char**, double*));
+--extern int strtopf ANSI((CONST char*, char**, float*));
+--extern int strtopQ ANSI((CONST char*, char**, void*));
+--extern int strtopx ANSI((CONST char*, char**, void*));
+--extern int strtopxL ANSI((CONST char*, char**, void*));
+-+extern int gdtoa__strtodI ANSI((CONST char*, char**, double*));
+-+extern int gdtoa__strtopd ANSI((CONST char*, char**, double*));
+-+extern int gdtoa__strtopdd ANSI((CONST char*, char**, double*));
+-+extern int gdtoa__strtopf ANSI((CONST char*, char**, float*));
+-+extern int gdtoa__strtopQ ANSI((CONST char*, char**, void*));
+-+extern int gdtoa__strtopx ANSI((CONST char*, char**, void*));
+-+extern int gdtoa__strtopxL ANSI((CONST char*, char**, void*));
+- #else
+--#define strtopd(s,se,x) strtord(s,se,1,x)
+--#define strtopdd(s,se,x) strtordd(s,se,1,x)
+--#define strtopf(s,se,x) strtorf(s,se,1,x)
+--#define strtopQ(s,se,x) strtorQ(s,se,1,x)
+--#define strtopx(s,se,x) strtorx(s,se,1,x)
+--#define strtopxL(s,se,x) strtorxL(s,se,1,x)
+-+#define gdtoa__strtopd(s,se,x) gdtoa__strtord(s,se,1,x)
+-+#define gdtoa__strtopdd(s,se,x) gdtoa__strtordd(s,se,1,x)
+-+#define gdtoa__strtopf(s,se,x) gdtoa__strtorf(s,se,1,x)
+-+#define gdtoa__strtopQ(s,se,x) gdtoa__strtorQ(s,se,1,x)
+-+#define gdtoa__strtopx(s,se,x) gdtoa__strtorx(s,se,1,x)
+-+#define gdtoa__strtopxL(s,se,x) gdtoa__strtorxL(s,se,1,x)
+- #endif
+-
+- #ifdef __cplusplus
+-diff -u gdtoa.orig/gdtoaimp.h gdtoa/gdtoaimp.h
+---- gdtoa.orig/gdtoaimp.h 2000-11-02 15:09:01 +0000
+-+++ gdtoa/gdtoaimp.h 2008-10-04 02:24:16 +0000
+-@@ -267,7 +267,7 @@
+- Exactly one of IEEE_8087, IEEE_MC68k, VAX, or IBM should be defined.
+- #endif
+-
+--typedef union { double d; ULong L[2]; } U;
+-+typedef union { double d; ULong L[2]; } __attribute__((__may_alias__)) U;
+-
+- #ifdef YES_ALIAS
+- #define dval(x) x
+-@@ -502,6 +502,7 @@
+- #define g__fmt g__fmt_D2A
+- #define gethex gethex_D2A
+- #define hexdig hexdig_D2A
+-+#define hexdig_init hexdig_init_D2A
+- #define hexnan hexnan_D2A
+- #define hi0bits hi0bits_D2A
+- #define i2b i2b_D2A
+-@@ -551,7 +552,7 @@
+- int *decpt, int *sign, char **rve));
+- extern char *g__fmt ANSI((char*, char*, char*, int, ULong));
+- extern int gethex ANSI((CONST char**, FPI*, Long*, Bigint**, int));
+-- extern void hexdig_init_D2A(Void);
+-+ extern void hexdig_init ANSI((Void));
+- extern int hexnan ANSI((CONST char**, FPI*, ULong*));
+- extern int hi0bits ANSI((ULong));
+- extern Bigint *i2b ANSI((int));
+-@@ -570,8 +571,8 @@
+- extern Bigint *s2b ANSI((CONST char*, int, int, ULong));
+- extern Bigint *set_ones ANSI((Bigint*, int));
+- extern char *strcp ANSI((char*, const char*));
+-- extern int strtoIg ANSI((CONST char*, char**, FPI*, Long*, Bigint**, int*));
+-- extern double strtod ANSI((const char *s00, char **se));
+-+ extern int gdtoa__strtoIg ANSI((CONST char*, char**, FPI*, Long*, Bigint**, int*));
+-+ extern double gdtoa__strtod ANSI((const char *s00, char **se));
+- extern Bigint *sum ANSI((Bigint*, Bigint*));
+- extern int trailz ANSI((Bigint*));
+- extern double ulp ANSI((double));
+-diff -u gdtoa.orig/gethex.c gdtoa/gethex.c
+---- gdtoa.orig/gethex.c 2003-03-26 20:33:08 +0000
+-+++ gdtoa/gethex.c 2008-10-04 02:24:16 +0000
+-@@ -57,7 +57,7 @@
+- #endif
+-
+- if (!hexdig['0'])
+-- hexdig_init_D2A();
+-+ hexdig_init();
+- havedig = 0;
+- s0 = *(CONST unsigned char **)sp + 2;
+- while(s0[havedig] == '0')
+-diff -u gdtoa.orig/hd_init.c gdtoa/hd_init.c
+---- gdtoa.orig/hd_init.c 2000-11-03 01:45:35 +0000
+-+++ gdtoa/hd_init.c 2008-10-04 02:24:16 +0000
+-@@ -52,7 +52,7 @@
+- }
+-
+- void
+--hexdig_init_D2A(Void)
+-+hexdig_init(Void)
+- {
+- #define USC (unsigned char *)
+- htinit(hexdig, USC "0123456789", 0x10);
+-diff -u gdtoa.orig/hexnan.c gdtoa/hexnan.c
+---- gdtoa.orig/hexnan.c 2000-11-03 01:44:38 +0000
+-+++ gdtoa/hexnan.c 2008-10-04 02:24:16 +0000
+-@@ -68,7 +68,7 @@
+- int havedig, hd0, i, nbits;
+-
+- if (!hexdig['0'])
+-- hexdig_init_D2A();
+-+ hexdig_init();
+- nbits = fpi->nbits;
+- x = x0 + (nbits >> kshift);
+- if (nbits & kmask)
+-diff -u gdtoa.orig/strtoIQ.c gdtoa/strtoIQ.c
+---- gdtoa.orig/strtoIQ.c 1998-06-22 18:49:25 +0000
+-+++ gdtoa/strtoIQ.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtoIQ(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+-+gdtoa__strtoIQ(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+- #else
+--strtoIQ(CONST char *s, char **sp, void *a, void *b)
+-+gdtoa__strtoIQ(CONST char *s, char **sp, void *a, void *b)
+- #endif
+- {
+- static FPI fpi = { 113, 1-16383-113+1, 32766-16383-113+1, 1, SI };
+-@@ -52,7 +52,7 @@
+-
+- B[0] = Balloc(2);
+- B[0]->wds = 4;
+-- k = strtoIg(s, sp, &fpi, exp, B, rv);
+-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
+- ULtoQ(L, B[0]->x, exp[0], rv[0]);
+- Bfree(B[0]);
+- if (B[1]) {
+-diff -u gdtoa.orig/strtoId.c gdtoa/strtoId.c
+---- gdtoa.orig/strtoId.c 1998-09-09 13:59:17 +0000
+-+++ gdtoa/strtoId.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtoId(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+-+gdtoa__strtoId(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+- #else
+--strtoId(CONST char *s, char **sp, double *f0, double *f1)
+-+gdtoa__strtoId(CONST char *s, char **sp, double *f0, double *f1)
+- #endif
+- {
+- static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
+-@@ -51,7 +51,7 @@
+-
+- B[0] = Balloc(1);
+- B[0]->wds = 2;
+-- k = strtoIg(s, sp, &fpi, exp, B, rv);
+-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
+- ULtod((ULong*)f0, B[0]->x, exp[0], rv[0]);
+- Bfree(B[0]);
+- if (B[1]) {
+-diff -u gdtoa.orig/strtoIdd.c gdtoa/strtoIdd.c
+---- gdtoa.orig/strtoIdd.c 1998-09-09 13:59:17 +0000
+-+++ gdtoa/strtoIdd.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtoIdd(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+-+gdtoa__strtoIdd(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+- #else
+--strtoIdd(CONST char *s, char **sp, double *f0, double *f1)
+-+gdtoa__strtoIdd(CONST char *s, char **sp, double *f0, double *f1)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -55,7 +55,7 @@
+-
+- B[0] = Balloc(2);
+- B[0]->wds = 4;
+-- k = strtoIg(s, sp, &fpi, exp, B, rv);
+-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
+- ULtodd((ULong*)f0, B[0]->x, exp[0], rv[0]);
+- Bfree(B[0]);
+- if (B[1]) {
+-diff -u gdtoa.orig/strtoIf.c gdtoa/strtoIf.c
+---- gdtoa.orig/strtoIf.c 1998-09-09 13:59:17 +0000
+-+++ gdtoa/strtoIf.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtoIf(s, sp, f0, f1) CONST char *s; char **sp; float *f0, *f1;
+-+gdtoa__strtoIf(s, sp, f0, f1) CONST char *s; char **sp; float *f0, *f1;
+- #else
+--strtoIf(CONST char *s, char **sp, float *f0, float *f1)
+-+gdtoa__strtoIf(CONST char *s, char **sp, float *f0, float *f1)
+- #endif
+- {
+- static FPI fpi = { 24, 1-127-24+1, 254-127-24+1, 1, SI };
+-@@ -51,7 +51,7 @@
+-
+- B[0] = Balloc(0);
+- B[0]->wds = 1;
+-- k = strtoIg(s, sp, &fpi, exp, B, rv);
+-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
+- ULtof((ULong*)f0, B[0]->x, exp[0], rv[0]);
+- Bfree(B[0]);
+- if (B[1]) {
+-diff -u gdtoa.orig/strtoIg.c gdtoa/strtoIg.c
+---- gdtoa.orig/strtoIg.c 1998-06-26 14:04:19 +0000
+-+++ gdtoa/strtoIg.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtoIg(s00, se, fpi, exp, B, rvp) CONST char *s00; char **se; FPI *fpi; Long *exp; Bigint **B; int *rvp;
+-+gdtoa__strtoIg(s00, se, fpi, exp, B, rvp) CONST char *s00; char **se; FPI *fpi; Long *exp; Bigint **B; int *rvp;
+- #else
+--strtoIg(CONST char *s00, char **se, FPI *fpi, Long *exp, Bigint **B, int *rvp)
+-+gdtoa__strtoIg(CONST char *s00, char **se, FPI *fpi, Long *exp, Bigint **B, int *rvp)
+- #endif
+- {
+- Bigint *b, *b1;
+-@@ -50,7 +50,7 @@
+- Long e1;
+-
+- b = *B;
+-- rv = strtodg(s00, se, fpi, exp, b->x);
+-+ rv = gdtoa__strtodg(s00, se, fpi, exp, b->x);
+- if (!(rv & STRTOG_Inexact)) {
+- B[1] = 0;
+- return *rvp = rv;
+-diff -u gdtoa.orig/strtoIx.c gdtoa/strtoIx.c
+---- gdtoa.orig/strtoIx.c 1998-09-09 13:13:22 +0000
+-+++ gdtoa/strtoIx.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtoIx(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+-+gdtoa__strtoIx(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+- #else
+--strtoIx(CONST char *s, char **sp, void *a, void *b)
+-+gdtoa__strtoIx(CONST char *s, char **sp, void *a, void *b)
+- #endif
+- {
+- static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, SI };
+-@@ -52,7 +52,7 @@
+-
+- B[0] = Balloc(1);
+- B[0]->wds = 2;
+-- k = strtoIg(s, sp, &fpi, exp, B, rv);
+-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
+- ULtox(L, B[0]->x, exp[0], rv[0]);
+- Bfree(B[0]);
+- if (B[1]) {
+-diff -u gdtoa.orig/strtoIxL.c gdtoa/strtoIxL.c
+---- gdtoa.orig/strtoIxL.c 1998-09-09 13:13:22 +0000
+-+++ gdtoa/strtoIxL.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtoIxL(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+-+gdtoa__strtoIxL(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+- #else
+--strtoIxL(CONST char *s, char **sp, void *a, void *b)
+-+gdtoa__strtoIxL(CONST char *s, char **sp, void *a, void *b)
+- #endif
+- {
+- static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, SI };
+-@@ -52,7 +52,7 @@
+-
+- B[0] = Balloc(1);
+- B[0]->wds = 2;
+-- k = strtoIg(s, sp, &fpi, exp, B, rv);
+-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
+- ULtoxL(L, B[0]->x, exp[0], rv[0]);
+- Bfree(B[0]);
+- if (B[1]) {
+-diff -u gdtoa.orig/strtod.c gdtoa/strtod.c
+---- gdtoa.orig/strtod.c 2003-03-21 21:24:01 +0000
+-+++ gdtoa/strtod.c 2008-10-04 02:01:43 +0000
+-@@ -58,7 +58,7 @@
+- #endif
+-
+- double
+--strtod
+-+gdtoa__strtod
+- #ifdef KR_headers
+- (s00, se) CONST char *s00; char **se;
+- #else
+-diff -u gdtoa.orig/strtodI.c gdtoa/strtodI.c
+---- gdtoa.orig/strtodI.c 2000-11-02 04:33:13 +0000
+-+++ gdtoa/strtodI.c 2008-10-04 02:01:43 +0000
+-@@ -56,9 +56,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
+-+gdtoa__strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
+- #else
+--strtodI(CONST char *s, char **sp, double *dd)
+-+gdtoa__strtodI(CONST char *s, char **sp, double *dd)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -75,7 +75,7 @@
+- } U;
+- U *u;
+-
+-- k = strtodg(s, sp, &fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
+- u = (U*)dd;
+- sign = k & STRTOG_Neg ? 0x80000000L : 0;
+- switch(k & STRTOG_Retmask) {
+-diff -u gdtoa.orig/strtodg.c gdtoa/strtodg.c
+---- gdtoa.orig/strtodg.c 2003-03-21 20:59:43 +0000
+-+++ gdtoa/strtodg.c 2008-10-04 02:01:43 +0000
+-@@ -316,7 +316,7 @@
+- }
+-
+- int
+--strtodg
+-+gdtoa__strtodg
+- #ifdef KR_headers
+- (s00, se, fpi, exp, bits)
+- CONST char *s00; char **se; FPI *fpi; Long *exp; ULong *bits;
+-diff -u gdtoa.orig/strtof.c gdtoa/strtof.c
+---- gdtoa.orig/strtof.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtof.c 2008-10-04 02:01:43 +0000
+-@@ -37,11 +37,11 @@
+-
+- #include "gdtoaimp.h"
+-
+-- float
+-+ float gdtoa__strtof
+- #ifdef KR_headers
+--strtof(s, sp) CONST char *s; char **sp;
+-+ (s, sp) CONST char *s; char **sp;
+- #else
+--strtof(CONST char *s, char **sp)
+-+ (CONST char *s, char **sp)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -54,7 +54,7 @@
+- int k;
+- union { ULong L[1]; float f; } u;
+-
+-- k = strtodg(s, sp, &fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
+- switch(k & STRTOG_Retmask) {
+- case STRTOG_NoNumber:
+- case STRTOG_Zero:
+-diff -u gdtoa.orig/strtopQ.c gdtoa/strtopQ.c
+---- gdtoa.orig/strtopQ.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtopQ.c 2008-10-04 02:01:43 +0000
+-@@ -57,9 +57,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtopQ(s, sp, V) CONST char *s; char **sp; void *V;
+-+gdtoa__strtopQ(s, sp, V) CONST char *s; char **sp; void *V;
+- #else
+--strtopQ(CONST char *s, char **sp, void *V)
+-+gdtoa__strtopQ(CONST char *s, char **sp, void *V)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -72,7 +72,7 @@
+- int k;
+- ULong *L = (ULong*)V;
+-
+-- k = strtodg(s, sp, &fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
+- switch(k & STRTOG_Retmask) {
+- case STRTOG_NoNumber:
+- case STRTOG_Zero:
+-diff -u gdtoa.orig/strtopd.c gdtoa/strtopd.c
+---- gdtoa.orig/strtopd.c 1998-09-12 15:30:06 +0000
+-+++ gdtoa/strtopd.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtopd(s, sp, d) char *s; char **sp; double *d;
+-+gdtoa__strtopd(s, sp, d) char *s; char **sp; double *d;
+- #else
+--strtopd(CONST char *s, char **sp, double *d)
+-+gdtoa__strtopd(CONST char *s, char **sp, double *d)
+- #endif
+- {
+- static FPI fpi0 = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
+-@@ -49,7 +49,7 @@
+- Long exp;
+- int k;
+-
+-- k = strtodg(s, sp, &fpi0, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, &fpi0, &exp, bits);
+- ULtod((ULong*)d, bits, exp, k);
+- return k;
+- }
+-diff -u gdtoa.orig/strtopdd.c gdtoa/strtopdd.c
+---- gdtoa.orig/strtopdd.c 2000-11-02 04:33:46 +0000
+-+++ gdtoa/strtopdd.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtopdd(s, sp, dd) CONST char *s; char **sp; double *dd;
+-+gdtoa__strtopdd(s, sp, dd) CONST char *s; char **sp; double *dd;
+- #else
+--strtopdd(CONST char *s, char **sp, double *dd)
+-+gdtoa__strtopdd(CONST char *s, char **sp, double *dd)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -58,7 +58,7 @@
+- } U;
+- U *u;
+-
+-- rv = strtodg(s, sp, &fpi, &exp, bits);
+-+ rv = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
+- u = (U*)dd;
+- switch(rv & STRTOG_Retmask) {
+- case STRTOG_NoNumber:
+-diff -u gdtoa.orig/strtopf.c gdtoa/strtopf.c
+---- gdtoa.orig/strtopf.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtopf.c 2008-10-04 02:01:43 +0000
+-@@ -39,9 +39,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtopf(s, sp, f) CONST char *s; char **sp; float *f;
+-+gdtoa__strtopf(s, sp, f) CONST char *s; char **sp; float *f;
+- #else
+--strtopf(CONST char *s, char **sp, float *f)
+-+gdtoa__strtopf(CONST char *s, char **sp, float *f)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -53,7 +53,7 @@
+- Long exp;
+- int k;
+-
+-- k = strtodg(s, sp, &fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
+- L = (ULong*)f;
+- switch(k & STRTOG_Retmask) {
+- case STRTOG_NoNumber:
+-diff -u gdtoa.orig/strtopx.c gdtoa/strtopx.c
+---- gdtoa.orig/strtopx.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtopx.c 2008-10-04 02:01:43 +0000
+-@@ -59,9 +59,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtopx(s, sp, V) CONST char *s; char **sp; void *V;
+-+gdtoa__strtopx(s, sp, V) CONST char *s; char **sp; void *V;
+- #else
+--strtopx(CONST char *s, char **sp, void *V)
+-+gdtoa__strtopx(CONST char *s, char **sp, void *V)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -74,7 +74,7 @@
+- int k;
+- UShort *L = (UShort*)V;
+-
+-- k = strtodg(s, sp, &fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
+- switch(k & STRTOG_Retmask) {
+- case STRTOG_NoNumber:
+- case STRTOG_Zero:
+-diff -u gdtoa.orig/strtopxL.c gdtoa/strtopxL.c
+---- gdtoa.orig/strtopxL.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtopxL.c 2008-10-04 02:01:43 +0000
+-@@ -55,9 +55,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtopxL(s, sp, V) CONST char *s; char **sp; void *V;
+-+gdtoa__strtopxL(s, sp, V) CONST char *s; char **sp; void *V;
+- #else
+--strtopxL(CONST char *s, char **sp, void *V)
+-+gdtoa__strtopxL(CONST char *s, char **sp, void *V)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -70,7 +70,7 @@
+- int k;
+- ULong *L = (ULong*)V;
+-
+-- k = strtodg(s, sp, &fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
+- switch(k & STRTOG_Retmask) {
+- case STRTOG_NoNumber:
+- case STRTOG_Zero:
+-diff -u gdtoa.orig/strtorQ.c gdtoa/strtorQ.c
+---- gdtoa.orig/strtorQ.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtorQ.c 2008-10-04 02:01:43 +0000
+-@@ -98,9 +98,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtorQ(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
+-+gdtoa__strtorQ(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
+- #else
+--strtorQ(CONST char *s, char **sp, int rounding, void *L)
+-+gdtoa__strtorQ(CONST char *s, char **sp, int rounding, void *L)
+- #endif
+- {
+- static FPI fpi0 = { 113, 1-16383-113+1, 32766-16383-113+1, 1, SI };
+-@@ -115,7 +115,7 @@
+- fpi1.rounding = rounding;
+- fpi = &fpi1;
+- }
+-- k = strtodg(s, sp, fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+- ULtoQ((ULong*)L, bits, exp, k);
+- return k;
+- }
+-diff -u gdtoa.orig/strtord.c gdtoa/strtord.c
+---- gdtoa.orig/strtord.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtord.c 2008-10-04 02:01:43 +0000
+-@@ -76,9 +76,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtord(s, sp, rounding, d) CONST char *s; char **sp; int rounding; double *d;
+-+gdtoa__strtord(s, sp, rounding, d) CONST char *s; char **sp; int rounding; double *d;
+- #else
+--strtord(CONST char *s, char **sp, int rounding, double *d)
+-+gdtoa__strtord(CONST char *s, char **sp, int rounding, double *d)
+- #endif
+- {
+- static FPI fpi0 = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
+-@@ -93,7 +93,7 @@
+- fpi1.rounding = rounding;
+- fpi = &fpi1;
+- }
+-- k = strtodg(s, sp, fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+- ULtod((ULong*)d, bits, exp, k);
+- return k;
+- }
+-diff -u gdtoa.orig/strtordd.c gdtoa/strtordd.c
+---- gdtoa.orig/strtordd.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtordd.c 2008-10-04 02:01:43 +0000
+-@@ -178,9 +178,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtordd(s, sp, rounding, dd) CONST char *s; char **sp; int rounding; double *dd;
+-+gdtoa__strtordd(s, sp, rounding, dd) CONST char *s; char **sp; int rounding; double *dd;
+- #else
+--strtordd(CONST char *s, char **sp, int rounding, double *dd)
+-+gdtoa__strtordd(CONST char *s, char **sp, int rounding, double *dd)
+- #endif
+- {
+- #ifdef Sudden_Underflow
+-@@ -199,7 +199,7 @@
+- fpi1.rounding = rounding;
+- fpi = &fpi1;
+- }
+-- k = strtodg(s, sp, fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+- ULtodd((ULong*)dd, bits, exp, k);
+- return k;
+- }
+-diff -u gdtoa.orig/strtorf.c gdtoa/strtorf.c
+---- gdtoa.orig/strtorf.c 2000-11-02 04:31:40 +0000
+-+++ gdtoa/strtorf.c 2008-10-04 02:01:43 +0000
+-@@ -72,9 +72,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtorf(s, sp, rounding, f) CONST char *s; char **sp; int rounding; float *f;
+-+gdtoa__strtorf(s, sp, rounding, f) CONST char *s; char **sp; int rounding; float *f;
+- #else
+--strtorf(CONST char *s, char **sp, int rounding, float *f)
+-+gdtoa__strtorf(CONST char *s, char **sp, int rounding, float *f)
+- #endif
+- {
+- static FPI fpi0 = { 24, 1-127-24+1, 254-127-24+1, 1, SI };
+-@@ -89,7 +89,7 @@
+- fpi1.rounding = rounding;
+- fpi = &fpi1;
+- }
+-- k = strtodg(s, sp, fpi, &exp, bits);
+-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+- ULtof((ULong*)f, bits, exp, k);
+- return k;
+- }
+-diff -u gdtoa.orig/strtorx.c gdtoa/strtorx.c
+---- gdtoa.orig/strtorx.c 2000-11-02 04:34:18 +0000
+-+++ gdtoa/strtorx.c 2008-10-04 02:01:43 +0000
+-@@ -95,9 +95,9 @@
+-
+- int
+- #ifdef KR_headers
+--strtorx(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
+-+gdtoa__strtorx(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
+- #else
+--strtorx(CONST char *s, char **sp, int rou...
[truncated message content] |
|
From: Wesley T. <we...@ml...> - 2011-07-19 03:37:05
|
armhf port
----------------------------------------------------------------------
U mlton/trunk/package/debian/changelog
U mlton/trunk/package/debian/control
U mlton/trunk/package/debian/heap-size
A mlton/trunk/package/debian/mlton-runtime-arm-linux-gnueabihf.install
----------------------------------------------------------------------
Modified: mlton/trunk/package/debian/changelog
===================================================================
--- mlton/trunk/package/debian/changelog 2011-07-19 10:16:34 UTC (rev 7551)
+++ mlton/trunk/package/debian/changelog 2011-07-19 10:37:02 UTC (rev 7552)
@@ -4,8 +4,14 @@
* Uploaded mips[el] bootstrap packages as 20100608-4
* Build-Depend on newest gcc and binutils
* Removed explicit-relocs patch
+ * Include a diffs to current release head
+ * Necessary for 8-bit aligned MIPS read/writes
+ * Increase heap-size for mips post-alignment
+ * Building armel on debian buildd instead of qemu
+ * Heap-size 1.2g on 1.5g machines
+ * Added armhf port
- -- Wesley W. Terpstra (Debian) <ter...@de...> Sun, 08 May 2011 11:56:34 +0200
+ -- Wesley W. Terpstra (Debian) <ter...@de...> Tue, 19 Jul 2011 12:29:52 +0200
mlton (20100608-4) unstable; urgency=low
Modified: mlton/trunk/package/debian/control
===================================================================
--- mlton/trunk/package/debian/control 2011-07-19 10:16:34 UTC (rev 7551)
+++ mlton/trunk/package/debian/control 2011-07-19 10:37:02 UTC (rev 7552)
@@ -62,7 +62,7 @@
This package includes non-man-page documentation.
Package: mlton-compiler
-Architecture: alpha amd64 armel hppa hurd-i386 i386 ia64 kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc s390 sparc
+Architecture: alpha amd64 armel armhf hppa hurd-i386 i386 ia64 kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc s390 sparc
Multi-Arch: foreign
Depends: ${shlibs:Depends}, ${misc:Depends}, gcc, libc6-dev, libgmp-dev, mlton-basis (= ${source:Version}), mlton-runtime-native (= ${binary:Version}) | mlton-runtime
Breaks: mlton (<< 20100608-3)
@@ -81,7 +81,7 @@
This package includes the compiler itself.
Package: mlton-tools
-Architecture: alpha amd64 armel hppa hurd-i386 i386 ia64 kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc s390 sparc
+Architecture: alpha amd64 armel armhf hppa hurd-i386 i386 ia64 kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc s390 sparc
Multi-Arch: foreign
Depends: ${shlibs:Depends}, ${misc:Depends}
Breaks: mlton (<< 20100608-3)
@@ -100,8 +100,8 @@
This package includes tools which autogenerate SML.
Package: mlton-runtime-native
-Architecture: alpha amd64 armel hppa hurd-i386 i386 ia64 kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc s390 sparc
-Depends: ${misc:Depends}, mlton-runtime-alpha-linux-gnu (= ${binary:Version}) [alpha] | mlton-runtime-x86-64-linux-gnu (= ${binary:Version}) [amd64] | mlton-runtime-arm-linux-gnueabi (= ${binary:Version}) [armel] | mlton-runtime-hppa-linux-gnu (= ${binary:Version}) [hppa] | mlton-runtime-i486-gnu (= ${binary:Version}) [hurd-i386] | mlton-runtime-i486-linux-gnu (= ${binary:Version}) [i386] | mlton-runtime-ia64-linux-gnu (= ${binary:Version}) [ia64] | mlton-runtime-i486-kfreebsd-gnu (= ${binary:Version}) [kfreebsd-i386] | mlton-runtime-x86-64-kfreebsd-gnu (= ${binary:Version}) [kfreebsd-amd64] | mlton-runtime-mips-linux-gnu (= ${binary:Version}) [mips] | mlton-runtime-mipsel-linux-gnu (= ${binary:Version}) [mipsel] | mlton-runtime-powerpc-linux-gnu (= ${binary:Version}) [powerpc] | mlton-runtime-s390-linux-gnu (= ${binary:Version}) [s390] | mlton-runtime-sparc-linux-gnu (= ${binary:Version}) [sparc]
+Architecture: alpha amd64 armel armhf hppa hurd-i386 i386 ia64 kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc s390 sparc
+Depends: ${misc:Depends}, mlton-runtime-alpha-linux-gnu (= ${binary:Version}) [alpha] | mlton-runtime-x86-64-linux-gnu (= ${binary:Version}) [amd64] | mlton-runtime-arm-linux-gnueabi (= ${binary:Version}) [armel] | mlton-runtime-arm-linux-gnueabihf (= ${binary:Version}) [armhf] | mlton-runtime-hppa-linux-gnu (= ${binary:Version}) [hppa] | mlton-runtime-i486-gnu (= ${binary:Version}) [hurd-i386] | mlton-runtime-i486-linux-gnu (= ${binary:Version}) [i386] | mlton-runtime-ia64-linux-gnu (= ${binary:Version}) [ia64] | mlton-runtime-i486-kfreebsd-gnu (= ${binary:Version}) [kfreebsd-i386] | mlton-runtime-x86-64-kfreebsd-gnu (= ${binary:Version}) [kfreebsd-amd64] | mlton-runtime-mips-linux-gnu (= ${binary:Version}) [mips] | mlton-runtime-mipsel-linux-gnu (= ${binary:Version}) [mipsel] | mlton-runtime-powerpc-linux-gnu (= ${binary:Version}) [powerpc] | mlton-runtime-s390-linux-gnu (= ${binary:Version}) [s390] | mlton-runtime-sparc-linux-gnu (= ${binary:Version}) [sparc]
Homepage: http://mlton.org/
Description: Optimizing compiler for Standard ML - native runtime libraries
MLton is a whole-program optimizing compiler
@@ -169,6 +169,24 @@
.
This package provides arm target libraries.
+Package: mlton-runtime-arm-linux-gnueabihf
+Architecture: armhf
+Multi-Arch: foreign
+Depends: ${misc:Depends}, mlton-basis (= ${source:Version})
+Provides: mlton-runtime
+Homepage: http://mlton.org/
+Description: Optimizing compiler for Standard ML - armhf runtime libraries
+ MLton is a whole-program optimizing compiler
+ for Standard ML. MLton generates standalone
+ executables with excellent runtime performance,
+ is SML 97 compliant, and has a complete basis
+ library. MLton has source-level profiling,
+ a fast C FFI, an interface to the GNU
+ multiprecision library, and lots of useful
+ libraries.
+ .
+ This package provides armhf target libraries.
+
Package: mlton-runtime-hppa-linux-gnu
Architecture: hppa
Multi-Arch: foreign
Modified: mlton/trunk/package/debian/heap-size
===================================================================
--- mlton/trunk/package/debian/heap-size 2011-07-19 10:16:34 UTC (rev 7551)
+++ mlton/trunk/package/debian/heap-size 2011-07-19 10:37:02 UTC (rev 7552)
@@ -13,7 +13,8 @@
# - 8g (goetz)
# amd64 - 1g (nautilus) UNUSABLE / black-listed
# - 2g (excelsior, brahms)
-# armel - 64g (sparta)
+# armel -1.5g (arnold, antheil, alwyn, alain)
+# -0.5g (argento, arcadelt, ancina) UNUSABLE
# hppa - 8g (paer)
# -3.5g (penalosa, peri)
# hurd-i386
@@ -41,15 +42,16 @@
if dpkg-architecture -ealpha; then result="fixed-heap 3g"; fi
if dpkg-architecture -eamd64; then result="fixed-heap 1.7g"; fi
-if dpkg-architecture -earmel; then result="max-heap 850m"; fi
+if dpkg-architecture -earmel; then result="max-heap 1.2g"; fi
+if dpkg-architecture -earmhf; then result="max-heap 1.2g"; fi
if dpkg-architecture -ehppa; then result="fixed-heap 1.5g"; fi
if dpkg-architecture -ehurd-i386; then result="fixed-heap 800m"; fi
if dpkg-architecture -ei386; then result="fixed-heap 1.5g"; fi
if dpkg-architecture -eia64; then result="fixed-heap 3g"; fi
if dpkg-architecture -ekfreebsd-amd64; then result="fixed-heap 1.7g"; fi
if dpkg-architecture -ekfreebsd-i386; then result="fixed-heap 1.5g"; fi
-if dpkg-architecture -emips; then result="fixed-heap 800m"; fi
-if dpkg-architecture -emipsel; then result="fixed-heap 800m"; fi
+if dpkg-architecture -emips; then result="fixed-heap 850m"; fi
+if dpkg-architecture -emipsel; then result="fixed-heap 850m"; fi
if dpkg-architecture -epowerpc; then result="fixed-heap 1.5g"; fi
if dpkg-architecture -es390; then result="fixed-heap 850m"; fi
if dpkg-architecture -esparc; then result="fixed-heap 1.5g"; fi
Added: mlton/trunk/package/debian/mlton-runtime-arm-linux-gnueabihf.install
===================================================================
--- mlton/trunk/package/debian/mlton-runtime-arm-linux-gnueabihf.install 2011-07-19 10:16:34 UTC (rev 7551)
+++ mlton/trunk/package/debian/mlton-runtime-arm-linux-gnueabihf.install 2011-07-19 10:37:02 UTC (rev 7552)
@@ -0,0 +1 @@
+usr/lib/mlton/targets/arm-linux-gnueabihf/*
|
|
From: Wesley T. <we...@ml...> - 2011-07-19 03:16:37
|
Doubles must be 8-byte aligned even on MIP32.
See for example: sdc1 instruction
Depending on the kernel and processor, unaligned reads/writes may be fixed up,
which explains why this problem has not appeared before now.
----------------------------------------------------------------------
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2011-07-06 08:06:48 UTC (rev 7550)
+++ mlton/trunk/mlton/main/main.fun 2011-07-19 10:16:34 UTC (rev 7551)
@@ -188,6 +188,7 @@
| AMD64 => true
| HPPA => true
| IA64 => true
+ | MIPS => true
| Sparc => true
| S390 => true
| _ => false
|
|
From: Wesley T. <we...@ml...> - 2011-07-06 01:06:50
|
binutils and gcc on mips finally work for mlton!
----------------------------------------------------------------------
U mlton/trunk/package/debian/changelog
U mlton/trunk/package/debian/control
D mlton/trunk/package/debian/patches/00-no-relocs-on-mips.patch
U mlton/trunk/package/debian/patches/series
----------------------------------------------------------------------
Modified: mlton/trunk/package/debian/changelog
===================================================================
--- mlton/trunk/package/debian/changelog 2011-06-17 15:51:43 UTC (rev 7549)
+++ mlton/trunk/package/debian/changelog 2011-07-06 08:06:48 UTC (rev 7550)
@@ -1,3 +1,12 @@
+mlton (20100608-5) unstable; urgency=low
+
+ * Newest gcc and binutils fix mips[el] jump problem
+ * Uploaded mips[el] bootstrap packages as 20100608-4
+ * Build-Depend on newest gcc and binutils
+ * Removed explicit-relocs patch
+
+ -- Wesley W. Terpstra (Debian) <ter...@de...> Sun, 08 May 2011 11:56:34 +0200
+
mlton (20100608-4) unstable; urgency=low
* Add missing install file for sparc runtime
Modified: mlton/trunk/package/debian/control
===================================================================
--- mlton/trunk/package/debian/control 2011-06-17 15:51:43 UTC (rev 7549)
+++ mlton/trunk/package/debian/control 2011-07-06 08:06:48 UTC (rev 7550)
@@ -2,7 +2,7 @@
Section: devel
Priority: optional
Maintainer: Wesley W. Terpstra (Debian) <ter...@de...>
-Build-Depends: mlton (>= 20070826), libgmp-dev, htmldoc, texlive-latex-base, procps, debhelper (>= 7.0.0), cdbs (>= 0.4.52), quilt
+Build-Depends: mlton (>= 20070826), libgmp-dev, htmldoc, texlive-latex-base, procps, debhelper (>= 7.0.0), cdbs (>= 0.4.52), quilt, binutils (>= 2.21.51.201104) [mips mipsel], gcc (>= 4:4.6.0-5) [mips mipsel]
Standards-Version: 3.9.1
Package: mlton
@@ -101,7 +101,7 @@
Package: mlton-runtime-native
Architecture: alpha amd64 armel hppa hurd-i386 i386 ia64 kfreebsd-i386 kfreebsd-amd64 mips mipsel powerpc s390 sparc
-Depends: ${misc:Depends}, mlton-runtime-alpha-linux-gnu (= ${binary:Version}) [alpha] | mlton-runtime-x86-64-linux-gnu (= ${binary:Version}) [amd64] | mlton-runtime-arm-linux-gnueabi (= ${binary:Version}) [armel] | mlton-runtime-hppa-linux-gnu (= ${binary:Version}) [hppa] | mlton-runtime-i486-gnu (= ${binary:Version}) [hurd-i386] | mlton-runtime-i486-linux-gnu (= ${binary:Version}) [i386] | mlton-runtime-ia64-linux-gnu (= ${binary:Version}) [ia64] | mlton-runtime-i486-kfreebsd-gnu (= ${binary:Version}) [kfreebsd-i386] | mlton-runtime-x86-64-kfreebsd-gnu (= ${binary:Version}) [kfreebsd-amd64] | mlton-runtime-mips-linux-gnu (= ${binary:Version}) [mips] | mlton-runtime-mips-linux-gnu (= ${binary:Version}) [mipsel] | mlton-runtime-powerpc-linux-gnu (= ${binary:Version}) [powerpc] | mlton-runtime-s390-linux-gnu (= ${binary:Version}) [s390] | mlton-runtime-sparc-linux-gnu (= ${binary:Version}) [sparc]
+Depends: ${misc:Depends}, mlton-runtime-alpha-linux-gnu (= ${binary:Version}) [alpha] | mlton-runtime-x86-64-linux-gnu (= ${binary:Version}) [amd64] | mlton-runtime-arm-linux-gnueabi (= ${binary:Version}) [armel] | mlton-runtime-hppa-linux-gnu (= ${binary:Version}) [hppa] | mlton-runtime-i486-gnu (= ${binary:Version}) [hurd-i386] | mlton-runtime-i486-linux-gnu (= ${binary:Version}) [i386] | mlton-runtime-ia64-linux-gnu (= ${binary:Version}) [ia64] | mlton-runtime-i486-kfreebsd-gnu (= ${binary:Version}) [kfreebsd-i386] | mlton-runtime-x86-64-kfreebsd-gnu (= ${binary:Version}) [kfreebsd-amd64] | mlton-runtime-mips-linux-gnu (= ${binary:Version}) [mips] | mlton-runtime-mipsel-linux-gnu (= ${binary:Version}) [mipsel] | mlton-runtime-powerpc-linux-gnu (= ${binary:Version}) [powerpc] | mlton-runtime-s390-linux-gnu (= ${binary:Version}) [s390] | mlton-runtime-sparc-linux-gnu (= ${binary:Version}) [sparc]
Homepage: http://mlton.org/
Description: Optimizing compiler for Standard ML - native runtime libraries
MLton is a whole-program optimizing compiler
Deleted: mlton/trunk/package/debian/patches/00-no-relocs-on-mips.patch
===================================================================
--- mlton/trunk/package/debian/patches/00-no-relocs-on-mips.patch 2011-06-17 15:51:43 UTC (rev 7549)
+++ mlton/trunk/package/debian/patches/00-no-relocs-on-mips.patch 2011-07-06 08:06:48 UTC (rev 7550)
@@ -1,18 +0,0 @@
-Description: Work around for broken mips(el) gcc codegen
-Author: Wesley W. Terpstra (Debian) <ter...@de...>
-Bug-Debian: http://bugs.debian.org/552314
-Bug: http://gcc.gnu.org/bugzilla/show_bug.cgi?id=44537
-Forwarded: no
-Last-Update: 2010-06-14
-
-diff -Nur -x '*.orig' -x '*~' mlton/bin/mlton-script mlton.new/bin/mlton-script
---- mlton/bin/mlton-script 2009-11-07 17:29:05.000000000 +0100
-+++ mlton.new/bin/mlton-script 2009-11-07 17:31:43.000000000 +0100
-@@ -115,6 +115,7 @@
- -target-cc-opt openbsd '-I/usr/local/include' \
- -target-cc-opt aix '-maix64' \
- -target-cc-opt ia64 "$ia64hpux -mtune=itanium2" \
-+ -target-cc-opt mips '-mno-explicit-relocs' \
- -target-cc-opt sparc '-m32 -mcpu=v8 -Wa,-xarch=v8plusa' \
- -target-cc-opt x86 \
- '-m32
Modified: mlton/trunk/package/debian/patches/series
===================================================================
--- mlton/trunk/package/debian/patches/series 2011-06-17 15:51:43 UTC (rev 7549)
+++ mlton/trunk/package/debian/patches/series 2011-07-06 08:06:48 UTC (rev 7550)
@@ -1,2 +1 @@
-00-no-relocs-on-mips.patch
11-fixes-20100608-to-20110319.patch
|
|
From: Matthew F. <fl...@ml...> - 2011-06-17 08:51:45
|
Fix type error introduced by previous commit.
----------------------------------------------------------------------
U mlton/trunk/mlyacc/src/yacc.sml
----------------------------------------------------------------------
Modified: mlton/trunk/mlyacc/src/yacc.sml
===================================================================
--- mlton/trunk/mlyacc/src/yacc.sml 2011-06-17 15:21:05 UTC (rev 7548)
+++ mlton/trunk/mlyacc/src/yacc.sml 2011-06-17 15:51:43 UTC (rev 7549)
@@ -781,7 +781,7 @@
in let val result = TextIO.openOut (spec ^ ".sml")
val sigs = TextIO.openOut (spec ^ ".sig")
val specFile = OS.Path.file spec
- val resultFile = OS.Path.file result
+ val resultFile = specFile ^ ".sml"
val line = ref 1
val col = ref 0
val pr = fn s => TextIO.output(result,s)
|
|
From: Matthew F. <fl...@ml...> - 2011-06-17 08:21:12
|
Changed line directives in ML-Lex and ML-Yacc generated code to be simple file names, rather than absolute paths.
----------------------------------------------------------------------
U mlton/trunk/mllex/lexgen.sml
U mlton/trunk/mlyacc/src/yacc.sml
----------------------------------------------------------------------
Modified: mlton/trunk/mllex/lexgen.sml
===================================================================
--- mlton/trunk/mllex/lexgen.sml 2011-06-17 15:21:02 UTC (rev 7547)
+++ mlton/trunk/mllex/lexgen.sml 2011-06-17 15:21:05 UTC (rev 7548)
@@ -1,3 +1,6 @@
+(* Modified by Matthew Fluet on 2011-06-17.
+ * Use simple file name (rather than absolute paths) in line directives in output.
+ *)
(* Modified by Vesa Karvonen on 2007-12-19.
* Create line directives in output.
*)
@@ -295,7 +298,7 @@
val OutFile = ref ""
fun fmtLineDir {line, col} file =
String.concat ["(*#line ", Int.toString line, ".", Int.toString (col+1),
- " \"", OS.FileSys.fullPath file, "\"*)"]
+ " \"", file, "\"*)"]
val sayPos =
fn SOME pos => say (fmtLineDir pos (!InFile))
| NONE => (say (fmtLineDir {line = !LexOutLine, col = 0} (!OutFile));
@@ -1284,7 +1287,7 @@
fun lexGen(infile) =
let val outfile = infile ^ ".sml"
- val () = (InFile := infile; OutFile := outfile)
+ val () = (InFile := OS.Path.file infile; OutFile := OS.Path.file outfile)
fun PrintLexer (ends) =
let val sayln = fn x => (say x; say "\n")
in case !ArgCode
Modified: mlton/trunk/mlyacc/src/yacc.sml
===================================================================
--- mlton/trunk/mlyacc/src/yacc.sml 2011-06-17 15:21:02 UTC (rev 7547)
+++ mlton/trunk/mlyacc/src/yacc.sml 2011-06-17 15:21:05 UTC (rev 7548)
@@ -1,3 +1,6 @@
+(* Modified by Matthew Fluet on 2011-06-17.
+ * Use simple file name (rather than absolute paths) in line directives in output.
+ *)
(* Modified by Vesa Karvonen on 2007-12-18.
* Create line directives in output.
*)
@@ -777,8 +780,8 @@
in let val result = TextIO.openOut (spec ^ ".sml")
val sigs = TextIO.openOut (spec ^ ".sig")
- val specPath = OS.FileSys.fullPath spec
- val resultPath = OS.FileSys.fullPath (spec ^ ".sml")
+ val specFile = OS.Path.file spec
+ val resultFile = OS.Path.file result
val line = ref 1
val col = ref 0
val pr = fn s => TextIO.output(result,s)
@@ -793,8 +796,8 @@
String.concat ["(*#line ", Int.toString line, ".",
Int.toString (col+1), " \"", path, "\"*)"]
val fmtPos =
- fn NONE => (fmtLineDir {line = !line, col = 0} resultPath) ^ "\n"
- | SOME pos => fmtLineDir pos specPath
+ fn NONE => (fmtLineDir {line = !line, col = 0} resultFile) ^ "\n"
+ | SOME pos => fmtLineDir pos specFile
val termvoid = makeUniqueId "VOID"
val ntvoid = makeUniqueId "ntVOID"
val hasType = fn s => case symbolType s
|
|
From: Matthew F. <fl...@ml...> - 2011-06-17 08:21:04
|
Interpret #line directives as relative to source file.
----------------------------------------------------------------------
U mlton/trunk/mlton/control/source.sml
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/control/source.sml
===================================================================
--- mlton/trunk/mlton/control/source.sml 2011-06-15 02:20:56 UTC (rev 7546)
+++ mlton/trunk/mlton/control/source.sml 2011-06-17 15:21:02 UTC (rev 7547)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -11,7 +12,8 @@
datatype t = T of {file: File.t ref,
lineNum: int ref,
- lineStart: int ref}
+ lineStart: int ref,
+ origDir: Dir.t}
fun getPos (T {file, lineNum, lineStart, ...}, n) =
SourcePos.make {column = n - !lineStart,
@@ -20,10 +22,18 @@
fun lineStart (s as T {lineStart, ...}) = getPos (s, !lineStart)
-fun lineDirective (T {file, lineNum, lineStart},
+fun lineDirective (T {file, lineNum, lineStart, origDir},
f,
{lineNum = n, lineStart = s}) =
- (Option.app (f, fn f => file := f)
+ (Option.app (f, fn f =>
+ let
+ val f =
+ if OS.Path.isAbsolute f
+ then f
+ else OS.Path.mkCanonical (OS.Path.concat (origDir, f))
+ in
+ file := f
+ end)
; lineNum := n
; lineStart := s)
@@ -34,7 +44,8 @@
* starts at position ~1, which will translate position 0 to
* column 1.
*)
- lineStart = ref ~1}
+ lineStart = ref ~1,
+ origDir = File.dirOf file}
fun newline (T {lineStart, lineNum, ...}, n) =
(Int.inc lineNum
|
|
From: Matthew F. <fl...@ml...> - 2011-06-14 19:21:01
|
Fixed bug in SSA/SSA2 shrinker.
Fixed bug in SSA/SSA2 shrinker that could erroneously turn a non-tail
function call with a Bug transfer as its continuation into a tail
function call. The bug was triggered by the following SSA fragment:
fun tuple_1213 (env_9399: (lambdas_9377 * lambdas_9378 * lambdas_2366 * lambdas_234),
x_108593: Region.Wrap.t_8 vector): {raises = Some (CodeGen.AMD64MLTree.an),
returns = Some ()} = L_39443 ()
...
L_39452 (env_9400: lambdas_161 ref)
sub_288 (env_9400, x_108600) NonTail {cont = L_39453,
handler = Handle L_39454}
L_39454 (x_108601: CodeGen.AMD64MLTree.an)
Leave AstCore.Exp.tuple mlton/ast/ast-core.fun 625.11
raise (x_108601)
L_39453 (x_108602: Region.Wrap.t_8)
region_7 (x_108602)
region_7 (x_306671: Region.Wrap.t_8)
L_161558 ()
L_161558 ()
Bug
...
which was transformed to:
fun tuple_1213 (env_9399: (lambdas_9377 * lambdas_9378 * lambdas_2366 * lambdas_234),
x_108593: Region.Wrap.t_8 vector): {raises = Some (CodeGen.AMD64MLTree.an),
returns = Some ()} = L_39443 ()
...
L_39452 (env_9400: lambdas_161 ref)
Leave AstCore.Exp.tuple mlton/ast/ast-core.fun 625.11
sub_288 (env_9400, x_108600) Tail
...
Note that sub_288 returns Region.Wrap.t_8, but tuple_1213 returns ();
hence the transformed program is ill-typed.
The shrinker attempts to turn a nontail call into a tail call when the
return continuation is a Bug transfer and the handler is Leaves
followed by a Raise. To enable this transformation, the shrinker only
assigns LabelMeaning.Bug to blocks where the formals match the
function return, the statements are exclusively profile statements,
and the transfer is Bug. However, the shrinker also assigned
LabelMeaning.Bug to blocks where the statements are exclusively
profile statements and the transfer is a Goto to a block assigned
LabelMeaning.Bug. Hence, in the above, LabelMeaning.Bug is assigned to
L_161558, region_7, and L_39453.
The fix is to not propagate the LabelMeaning.Bug to a block with a
Goto transfer unless the block's formals match the function return.
Thanks to Lars Bergstrom for the bug report.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/mlton/ssa/shrink.fun
U mlton/trunk/mlton/ssa/shrink2.fun
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2011-06-11 21:23:09 UTC (rev 7545)
+++ mlton/trunk/doc/changelog 2011-06-15 02:20:56 UTC (rev 7546)
@@ -1,5 +1,10 @@
Here are the changes from version 2010608 to version YYYYMMDD.
+* 2011-06-14
+ - Fixed bug in SSA/SSA2 shrinker that could erroneously turn a
+ non-tail function call with a Bug transfer as its continuation
+ into a tail function call.
+
* 2011-06-10
- Fixed bug in translation from SSA2 to RSSA with case expressions
over non-primitive-sized words.
Modified: mlton/trunk/mlton/ssa/shrink.fun
===================================================================
--- mlton/trunk/mlton/ssa/shrink.fun 2011-06-11 21:23:09 UTC (rev 7545)
+++ mlton/trunk/mlton/ssa/shrink.fun 2011-06-15 02:20:56 UTC (rev 7546)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009,2011 Matthew Fluet.
* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -460,7 +460,17 @@
Goto {canMove = canMove',
dst = m,
args = ps}
- | Bug => Bug
+ | Bug =>
+ if (case returns of
+ NONE => true
+ | SOME ts =>
+ Vector.equals
+ (ts, args, fn (t, (_, t')) =>
+ Type.equals (t, t')))
+ then Bug
+ else Goto {canMove = canMove',
+ dst = m,
+ args = ps}
| Case _ =>
Goto {canMove = canMove',
dst = m,
@@ -707,7 +717,7 @@
Transfer.layout))
val traceSimplifyCase =
Trace.trace
- ("Ssa2.Shrink2.simplifyCase",
+ ("Ssa.Shrink2.simplifyCase",
fn {canMove, cases, default, test, ...} =>
Layout.record [("canMove", List.layout Statement.layout canMove),
("cantSimplify", Layout.str "fn () => ..."),
Modified: mlton/trunk/mlton/ssa/shrink2.fun
===================================================================
--- mlton/trunk/mlton/ssa/shrink2.fun 2011-06-11 21:23:09 UTC (rev 7545)
+++ mlton/trunk/mlton/ssa/shrink2.fun 2011-06-15 02:20:56 UTC (rev 7546)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009,2011 Matthew Fluet.
* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -465,8 +465,18 @@
Goto {canMove = canMove',
dst = m,
args = ps}
- | Bug => Bug
- | Case _ =>
+ | Bug =>
+ if (case returns of
+ NONE => true
+ | SOME ts =>
+ Vector.equals
+ (ts, args, fn (t, (_, t')) =>
+ Type.equals (t, t')))
+ then Bug
+ else Goto {canMove = canMove',
+ dst = m,
+ args = ps}
+ | Case _ =>
Goto {canMove = canMove',
dst = m,
args = ps}
|
|
From: Matthew F. <fl...@ml...> - 2011-06-11 14:23:41
|
Update SML/NJ libraries to 110.73; add ML-LPT libraries.
----------------------------------------------------------------------
U mlton/trunk/Makefile
U mlton/trunk/lib/ckit-lib/ckit.patch
U mlton/trunk/lib/ckit-lib/ckit.tgz
A mlton/trunk/lib/mllpt-lib/
A mlton/trunk/lib/mllpt-lib/.ignore
A mlton/trunk/lib/mllpt-lib/Makefile
A mlton/trunk/lib/mllpt-lib/ml-lpt.patch
A mlton/trunk/lib/mllpt-lib/ml-lpt.tgz
U mlton/trunk/lib/mlrisc-lib/MLRISC.patch
U mlton/trunk/lib/mlrisc-lib/MLRISC.tgz
U mlton/trunk/lib/smlnj-lib/smlnj-lib.patch
U mlton/trunk/lib/smlnj-lib/smlnj-lib.tgz
U mlton/trunk/util/cm2mlb/cm2mlb-map
U mlton/trunk/util/cm2mlb/cm2mlb.sml
----------------------------------------------------------------------
Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile 2011-06-10 19:46:13 UTC (rev 7544)
+++ mlton/trunk/Makefile 2011-06-11 21:23:09 UTC (rev 7545)
@@ -134,13 +134,14 @@
bin/make-pdf-guide; \
fi
-LIBRARIES := ckit-lib cml mlnlffi-lib mlrisc-lib mlyacc-lib smlnj-lib
+LIBRARIES := ckit-lib cml mllpt-lib mlnlffi-lib mlrisc-lib mlyacc-lib smlnj-lib
.PHONY: libraries-no-check
libraries-no-check:
mkdir -p "$(LIB)/sml"
cd "$(LIB)/sml" && rm -rf $(LIBRARIES)
$(MAKE) -C "$(SRC)/lib/ckit-lib"
+ $(MAKE) -C "$(SRC)/lib/mllpt-lib"
$(MAKE) -C "$(SRC)/lib/mlnlffi-lib"
$(MAKE) -C "$(SRC)/lib/mlrisc-lib"
$(MAKE) -C "$(SRC)/lib/smlnj-lib"
@@ -148,6 +149,7 @@
$(CP) "$(SRC)/lib/ckit-lib/ckit/." "$(LIB)/sml/ckit-lib"
$(CP) "$(SRC)/lib/mlnlffi-lib/." "$(LIB)/sml/mlnlffi-lib"
$(CP) "$(SRC)/lib/mlrisc-lib/MLRISC/." "$(LIB)/sml/mlrisc-lib"
+ $(CP) "$(SRC)/lib/mllpt-lib/ml-lpt/lib/." "$(LIB)/sml/mllpt-lib"
$(CP) "$(SRC)/lib/mlyacc-lib/." "$(LIB)/sml/mlyacc-lib"
$(CP) "$(SRC)/lib/smlnj-lib/smlnj-lib/." "$(LIB)/sml/smlnj-lib"
find "$(LIB)/sml" -type d -name .cm | xargs rm -rf
Modified: mlton/trunk/lib/ckit-lib/ckit.patch
===================================================================
--- mlton/trunk/lib/ckit-lib/ckit.patch 2011-06-10 19:46:13 UTC (rev 7544)
+++ mlton/trunk/lib/ckit-lib/ckit.patch 2011-06-11 21:23:09 UTC (rev 7545)
@@ -1,1847 +1,1628 @@
-diff -N -C 2 -r ckit/README.mlton ckit-mlton/README.mlton
-*** ckit/README.mlton 1969-12-31 19:00:00.000000000 -0500
---- ckit-mlton/README.mlton 2010-02-18 11:59:02.000000000 -0500
-***************
-*** 0 ****
---- 1,14 ----
-+ The following changes were made to the ckit Library, in addition to
-+ deriving the {{{.mlb}}} file from the {{{.cm}}} files:
-+ * {{{parser/parse-tree-sig.sml}}} (modified): Rewrote use of (sequential) {{{withtype}}} in signature.
-+ * {{{parser/parse-tree.sml}}} (modified): Rewrote use of (sequential) {{{withtype}}}.
-+ * {{{parser/grammar/c.lex.sml}}} (modified): Rewrote use of vector literal.
-+ * {{{ast/ast-sig.sml}}} (modified): Rewrote use of {{{withtype}}} in signature.
-+ * {{{ast/pp/pp-lib.sml}}} (modified): Rewrote use of ''or-patterns''.
-+ * {{{ast/pp/pp-ast-ext-sig.sml}}} (modified): Rewrote use of {{{signature}}} in {{{local}}}.
-+ * {{{ast/pp/pp-ast-adornment-sig.sml}}} (modified): Rewrote use of {{{signature}}} in {{{local}}}.
-+ * {{{ast/type-util-sig.sml}}} (modified): Rewrote use of {{{signature}}} in {{{local}}}.
-+ * {{{ast/type-util.sml}}} (modified): Rewrote use of ''or-patterns''.
-+ * {{{ast/sizeof.sml}}} (modified): Rewrote use of ''or-patterns''.
-+ * {{{ast/initializer-normalizer.sml}}} (modified): Rewrote use of ''or-patterns''.
-+ * {{{ast/build-ast.sml}}} (modified): Rewrote use of ''or-patterns''.
-diff -N -C 2 -r ckit/ckit-lib.mlb ckit-mlton/ckit-lib.mlb
-*** ckit/ckit-lib.mlb 1969-12-31 19:00:00.000000000 -0500
---- ckit-mlton/ckit-lib.mlb 2009-03-27 18:24:18.000000000 -0400
-***************
-*** 0 ****
---- 1 ----
-+ src/ckit-lib.mlb
-diff -N -C 2 -r ckit/src/ast/ast-sig.sml ckit-mlton/src/ast/ast-sig.sml
-*** ckit/src/ast/ast-sig.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/ast-sig.sml 2009-03-27 18:28:04.000000000 -0400
-***************
-*** 68,72 ****
- = TypeDecl of {shadow: {strct:bool} option, tid:tid}
- (* placeholder to indicate where typedefs/enums/structs should be printed *)
-! | VarDecl of id * initExpression option
-
-
---- 68,77 ----
- = TypeDecl of {shadow: {strct:bool} option, tid:tid}
- (* placeholder to indicate where typedefs/enums/structs should be printed *)
-! | VarDecl of
-! (* id *) {name: Symbol.symbol, uid: Pid.uid,
-! location: SourceMap.location, ctype: ctype,
-! stClass: storageClass, status: declStatus,
-! global: bool, kind: idKind} *
-! initExpression option
-
-
-***************
-*** 107,112 ****
- | Comma of expression * expression
- | Sub of expression * expression
-! | Member of expression * member
-! | Arrow of expression * member
- | Deref of expression
- | AddrOf of expression
---- 112,125 ----
- | Comma of expression * expression
- | Sub of expression * expression
-! | Member of
-! expression *
-! (* member *) {name: Symbol.symbol, uid : Pid.uid,
-! location : SourceMap.location,
-! ctype: ctype, kind: memberKind}
-! | Arrow of
-! expression *
-! (* member *) {name: Symbol.symbol, uid : Pid.uid,
-! location : SourceMap.location,
-! ctype: ctype, kind: memberKind}
- | Deref of expression
- | AddrOf of expression
-***************
-*** 114,119 ****
- | Unop of unop * expression
- | Cast of ctype * expression
-! | Id of id
-! | EnumId of member * LargeInt.int
- | SizeOf of ctype (* not used in compiler mode; sizeof expr becomes sizeof (typeof expr) *)
- | ExprExt of (expression, statement, binop, unop) AstExt.expressionExt
---- 127,140 ----
- | Unop of unop * expression
- | Cast of ctype * expression
-! | Id of
-! (* id *) {name: Symbol.symbol, uid: Pid.uid,
-! location: SourceMap.location, ctype: ctype,
-! stClass: storageClass, status: declStatus,
-! global: bool, kind: idKind}
-! | EnumId of
-! (* member *) {name: Symbol.symbol, uid : Pid.uid,
-! location : SourceMap.location,
-! ctype: ctype, kind: memberKind} *
-! LargeInt.int
- | SizeOf of ctype (* not used in compiler mode; sizeof expr becomes sizeof (typeof expr) *)
- | ExprExt of (expression, statement, binop, unop) AstExt.expressionExt
-***************
-*** 132,136 ****
- | Array of (LargeInt.int * expression) option * ctype
- | Pointer of ctype
-! | Function of ctype * (ctype * id option) list
- | StructRef of tid (* reference to a tid bound by a struct decl *)
- | UnionRef of tid (* reference to a tid bound by a union decl *)
---- 153,163 ----
- | Array of (LargeInt.int * expression) option * ctype
- | Pointer of ctype
-! | Function of
-! ctype *
-! (ctype *
-! (* id *) {name: Symbol.symbol, uid: Pid.uid,
-! location: SourceMap.location, ctype: ctype,
-! stClass: storageClass, status: declStatus,
-! global: bool, kind: idKind} option) list
- | StructRef of tid (* reference to a tid bound by a struct decl *)
- | UnionRef of tid (* reference to a tid bound by a union decl *)
-***************
-*** 152,156 ****
- | ENUMmem of LargeInt.int
-
-! withtype member =
- {name: Symbol.symbol, (* the name of the member *)
- uid : Pid.uid, (* unique identifier *)
---- 179,183 ----
- | ENUMmem of LargeInt.int
-
-! type member =
- {name: Symbol.symbol, (* the name of the member *)
- uid : Pid.uid, (* unique identifier *)
-diff -N -C 2 -r ckit/src/ast/build-ast.sml ckit-mlton/src/ast/build-ast.sml
-*** ckit/src/ast/build-ast.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/build-ast.sml 2009-03-27 18:28:04.000000000 -0400
-***************
-*** 291,295 ****
- | _ => false
-
-! fun isPartialTy(Ast.StructRef tid | Ast.UnionRef tid) = isPartial tid
- | isPartialTy _ = false
-
---- 291,296 ----
- | _ => false
-
-! fun isPartialTy(Ast.StructRef tid) = isPartial tid
-! | isPartialTy(Ast.UnionRef tid) = isPartial tid
- | isPartialTy _ = false
-
-***************
-*** 444,448 ****
- of Ast.Member(Ast.EXPR (expr'', aid, _), _) =>
- isLval (expr'', lookAid aid)
-! | (Ast.Id _ | Ast.Sub _ | Ast.Arrow _ | Ast.Deref _) => true
- | _ => false
-
---- 445,452 ----
- of Ast.Member(Ast.EXPR (expr'', aid, _), _) =>
- isLval (expr'', lookAid aid)
-! | Ast.Id _ => true
-! | Ast.Sub _ => true
-! | Ast.Arrow _ => true
-! | Ast.Deref _ => true
- | _ => false
-
-***************
-*** 603,607 ****
-
-
-! fun TCInitializer(ctype as (Ast.TypeRef _ | Ast.Qual _), expr) =
- TCInitializer(getCoreType ctype, expr) (* the following TCInitializer cases expect coretypes *)
- | TCInitializer (Ast.Array(opt, ctype), Ast.Aggregate exprs) =
---- 607,613 ----
-
-
-! fun TCInitializer(ctype as Ast.TypeRef _, expr) =
-! TCInitializer(getCoreType ctype, expr) (* the following TCInitializer cases expect coretypes *)
-! | TCInitializer(ctype as Ast.Qual _, expr) =
- TCInitializer(getCoreType ctype, expr) (* the following TCInitializer cases expect coretypes *)
- | TCInitializer (Ast.Array(opt, ctype), Ast.Aggregate exprs) =
-***************
-*** 651,655 ****
- | NONE => bug "TCInitializer: lookTid failed"
- | _ => error "TCInitializer: ill-formed UnionRef type")
-! | TCInitializer (ty as (Ast.StructRef _ | Ast.UnionRef _), Ast.Simple(Ast.EXPR(coreExp, aid, _))) =
- if isAssignableTys {lhsTy=ty, rhsTy=lookAid aid, rhsExprOpt=SOME coreExp}
- then ()
---- 657,665 ----
- | NONE => bug "TCInitializer: lookTid failed"
- | _ => error "TCInitializer: ill-formed UnionRef type")
-! | TCInitializer (ty as Ast.StructRef _, Ast.Simple(Ast.EXPR(coreExp, aid, _))) =
-! if isAssignableTys {lhsTy=ty, rhsTy=lookAid aid, rhsExprOpt=SOME coreExp}
-! then ()
-! else error "type of initializer is incompatible with type of lval"
-! | TCInitializer (ty as Ast.UnionRef _, Ast.Simple(Ast.EXPR(coreExp, aid, _))) =
- if isAssignableTys {lhsTy=ty, rhsTy=lookAid aid, rhsExprOpt=SOME coreExp}
- then ()
-***************
-*** 805,809 ****
- *)
- (* Note: should really reduce constants arith exprs to simple constants *)
-! fun constCheck(Ast.EXPR((Ast.StringConst _ | Ast.IntConst _ | Ast.RealConst _),_,_)) = true
- | constCheck(Ast.EXPR(Ast.QuestionColon(e1, e2, e3), _, _))
- = constCheck e1 andalso constCheck e2 andalso constCheck e3
---- 815,821 ----
- *)
- (* Note: should really reduce constants arith exprs to simple constants *)
-! fun constCheck(Ast.EXPR(Ast.StringConst _,_,_)) = true
-! | constCheck(Ast.EXPR(Ast.IntConst _,_,_)) = true
-! | constCheck(Ast.EXPR(Ast.RealConst _,_,_)) = true
- | constCheck(Ast.EXPR(Ast.QuestionColon(e1, e2, e3), _, _))
- = constCheck e1 andalso constCheck e2 andalso constCheck e3
-***************
-*** 2372,2376 ****
- of PT.Signed =>
- (case !kind
-! of SOME (Ast.FLOAT | Ast.DOUBLE | Ast.LONGDOUBLE) =>
- error "illegal combination of signed with float/double/long double"
- | _ => ();
---- 2384,2392 ----
- of PT.Signed =>
- (case !kind
-! of SOME Ast.FLOAT =>
-! error "illegal combination of signed with float/double/long double"
-! | SOME Ast.DOUBLE =>
-! error "illegal combination of signed with float/double/long double"
-! | SOME Ast.LONGDOUBLE =>
- error "illegal combination of signed with float/double/long double"
- | _ => ();
-***************
-*** 2380,2384 ****
- | PT.Unsigned =>
- (case !kind
-! of SOME (Ast.FLOAT | Ast.DOUBLE | Ast.LONGDOUBLE) =>
- error "illegal combination of unsigned with float/double/long double"
- | _ => ();
---- 2396,2404 ----
- | PT.Unsigned =>
- (case !kind
-! of SOME Ast.FLOAT =>
-! error "illegal combination of unsigned with float/double/long double"
-! | SOME Ast.DOUBLE =>
-! error "illegal combination of unsigned with float/double/long double"
-! | SOME Ast.LONGDOUBLE =>
- error "illegal combination of unsigned with float/double/long double"
- | _ => ();
-***************
-*** 2395,2399 ****
- | PT.Short =>
- (case !kind
-! of (NONE | SOME Ast.INT) => (kind := SOME Ast.SHORT)
- | SOME ct =>
- error (case ct
---- 2415,2420 ----
- | PT.Short =>
- (case !kind
-! of NONE => (kind := SOME Ast.SHORT)
-! | SOME Ast.INT => (kind := SOME Ast.SHORT)
- | SOME ct =>
- error (case ct
-***************
-*** 2403,2407 ****
- (case !kind
- of NONE => (kind := SOME Ast.INT)
-! | SOME (Ast.SHORT | Ast.LONG | Ast.LONGLONG) => ()
- | SOME ct =>
- error (case ct
---- 2424,2430 ----
- (case !kind
- of NONE => (kind := SOME Ast.INT)
-! | SOME Ast.SHORT => ()
-! | SOME Ast.LONG => ()
-! | SOME Ast.LONGLONG => ()
- | SOME ct =>
- error (case ct
-***************
-*** 2688,2692 ****
- of SOME(TAG{ctype=ty,location=loc',...}) =>
- (case ty
-! of (Ast.UnionRef tid | Ast.StructRef tid) =>
- if isPartial tid
- then SOME{tid=tid, alreadyDefined=false}
---- 2711,2725 ----
- of SOME(TAG{ctype=ty,location=loc',...}) =>
- (case ty
-! of Ast.UnionRef tid =>
-! if isPartial tid
-! then SOME{tid=tid, alreadyDefined=false}
-! else if repeated_declarations_ok
-! then SOME{tid=tid, alreadyDefined=true}
-! else (error("Redeclaration of type tag `"
-! ^ tagname
-! ^ "'; previous declaration at "
-! ^ SM.locToString loc');
-! NONE)
-! | Ast.StructRef tid =>
- if isPartial tid
- then SOME{tid=tid, alreadyDefined=false}
-diff -N -C 2 -r ckit/src/ast/initializer-normalizer.sml ckit-mlton/src/ast/initializer-normalizer.sml
-*** ckit/src/ast/initializer-normalizer.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/initializer-normalizer.sml 2009-03-27 18:28:04.000000000 -0400
-***************
-*** 157,161 ****
- | SOME _ => fail "Incomplete type for union ref"
- | NONE => fail "Inconsistent table for union ref")
-! | (Ast.Numeric _ | Ast.Pointer _ | Ast.Function _ | Ast.EnumRef _) =>
- feed (scalarNorm ctype, inits)
- | Ast.Void => fail "Incomplete type: void"
---- 157,167 ----
- | SOME _ => fail "Incomplete type for union ref"
- | NONE => fail "Inconsistent table for union ref")
-! | Ast.Numeric _ =>
-! feed (scalarNorm ctype, inits)
-! | Ast.Pointer _ =>
-! feed (scalarNorm ctype, inits)
-! | Ast.Function _ =>
-! feed (scalarNorm ctype, inits)
-! | Ast.EnumRef _ =>
- feed (scalarNorm ctype, inits)
- | Ast.Void => fail "Incomplete type: void"
-diff -N -C 2 -r ckit/src/ast/pp/pp-ast-adornment-sig.sml ckit-mlton/src/ast/pp/pp-ast-adornment-sig.sml
-*** ckit/src/ast/pp/pp-ast-adornment-sig.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/pp/pp-ast-adornment-sig.sml 2009-03-27 18:29:56.000000000 -0400
-***************
-*** 1,9 ****
- (* Copyright (c) 1998 by Lucent Technologies *)
-
-! local
- type 'a pp = Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
-
- type ('aidinfo,'a,'b) adornment_pp = ('aidinfo -> 'a) -> 'aidinfo -> 'b
-! in
- signature PPASTADORNMENT = sig
- type aidinfo
---- 1,9 ----
- (* Copyright (c) 1998 by Lucent Technologies *)
-
-! (* local *)
- type 'a pp = Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
-
- type ('aidinfo,'a,'b) adornment_pp = ('aidinfo -> 'a) -> 'aidinfo -> 'b
-! (* in *)
- signature PPASTADORNMENT = sig
- type aidinfo
-***************
-*** 12,14 ****
- val ppExternalDeclAdornment: (aidinfo,Ast.coreExternalDecl pp,Ast.externalDecl pp) adornment_pp
- end
-! end
---- 12,14 ----
- val ppExternalDeclAdornment: (aidinfo,Ast.coreExternalDecl pp,Ast.externalDecl pp) adornment_pp
- end
-! (* end *)
-diff -N -C 2 -r ckit/src/ast/pp/pp-ast-ext-sig.sml ckit-mlton/src/ast/pp/pp-ast-ext-sig.sml
-*** ckit/src/ast/pp/pp-ast-ext-sig.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/pp/pp-ast-ext-sig.sml 2009-03-27 18:29:56.000000000 -0400
-***************
-*** 1,5 ****
- (* Copyright (c) 1998 by Lucent Technologies *)
-
-! local
- type 'a pp = Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
- type ('a, 'aidinfo) ppExt =
---- 1,5 ----
- (* Copyright (c) 1998 by Lucent Technologies *)
-
-! (* local *)
- type 'a pp = Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
- type ('a, 'aidinfo) ppExt =
-***************
-*** 8,12 ****
- -> 'aidinfo
- -> Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
-! in
-
- signature PPASTEXT = sig
---- 8,12 ----
- -> 'aidinfo
- -> Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
-! (* in *)
-
- signature PPASTEXT = sig
-***************
-*** 25,27 ****
- end
-
-! end
---- 25,27 ----
- end
-
-! (* end *)
-diff -N -C 2 -r ckit/src/ast/pp/pp-lib.sml ckit-mlton/src/ast/pp/pp-lib.sml
-*** ckit/src/ast/pp/pp-lib.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/pp/pp-lib.sml 2009-03-27 18:29:56.000000000 -0400
-***************
-*** 116,120 ****
- fun ppId pps ({name,uid,kind,stClass,global,...}: Ast.id) =
- case (stClass,global)
-! of ((Ast.EXTERN,_) | (_, true)) => (* globals *)
- if !suppressPidGlobalUnderscores then ppSymbol' pps name
- else ppSymbol pps (name,uid)
---- 116,123 ----
- fun ppId pps ({name,uid,kind,stClass,global,...}: Ast.id) =
- case (stClass,global)
-! of (Ast.EXTERN,_) => (* globals *)
-! if !suppressPidGlobalUnderscores then ppSymbol' pps name
-! else ppSymbol pps (name,uid)
-! | (_, true) => (* globals *)
- if !suppressPidGlobalUnderscores then ppSymbol' pps name
- else ppSymbol pps (name,uid)
-diff -N -C 2 -r ckit/src/ast/sizeof.sml ckit-mlton/src/ast/sizeof.sml
-*** ckit/src/ast/sizeof.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/sizeof.sml 2009-03-27 18:28:04.000000000 -0400
-***************
-*** 322,326 ****
- case ty
- of Ast.TypeRef tid => processTid sizesErrWarnBug tidtab tid
-! | (Ast.StructRef tid | Ast.UnionRef tid) =>
- processTid sizesErrWarnBug tidtab tid
- | Ast.EnumRef _ =>
---- 322,328 ----
- case ty
- of Ast.TypeRef tid => processTid sizesErrWarnBug tidtab tid
-! | Ast.StructRef tid =>
-! processTid sizesErrWarnBug tidtab tid
-! | Ast.UnionRef tid =>
- processTid sizesErrWarnBug tidtab tid
- | Ast.EnumRef _ =>
-diff -N -C 2 -r ckit/src/ast/type-util-sig.sml ckit-mlton/src/ast/type-util-sig.sml
-*** ckit/src/ast/type-util-sig.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/type-util-sig.sml 2009-03-27 18:28:04.000000000 -0400
-***************
-*** 1,9 ****
- (* Copyright (c) 1998 by Lucent Technologies *)
-
-! local
- type 'a type_util = Tables.tidtab -> Ast.ctype -> 'a
- type 'a type_mem_util = Tables.tidtab -> Ast.ctype * Ast.member -> 'a
- type 'a type_type_util = Tables.tidtab -> Ast.ctype * Ast.ctype -> 'a
-! in
-
- signature TYPE_UTIL =
---- 1,9 ----
- (* Copyright (c) 1998 by Lucent Technologies *)
-
-! (* local *)
- type 'a type_util = Tables.tidtab -> Ast.ctype -> 'a
- type 'a type_mem_util = Tables.tidtab -> Ast.ctype * Ast.member -> 'a
- type 'a type_type_util = Tables.tidtab -> Ast.ctype * Ast.ctype -> 'a
-! (* in *)
-
- signature TYPE_UTIL =
-***************
-*** 146,148 ****
- end (* signature TYPE_UTIL *)
-
-! end (* local *)
---- 146,148 ----
- end (* signature TYPE_UTIL *)
-
-! (* end (* local *) *)
-diff -N -C 2 -r ckit/src/ast/type-util.sml ckit-mlton/src/ast/type-util.sml
-*** ckit/src/ast/type-util.sml 2010-02-03 11:40:52.000000000 -0500
---- ckit-mlton/src/ast/type-util.sml 2009-03-27 18:28:04.000000000 -0400
-***************
-*** 283,287 ****
- case reduceTypedef tidtab ty
- of Ast.Qual (_,ty) => isStructOrUnion tidtab ty
-! | (Ast.StructRef tid | Ast.UnionRef tid) => SOME tid
- | _ => NONE
-
---- 283,288 ----
- case reduceTypedef tidtab ty
- of Ast.Qual (_,ty) => isStructOrUnion tidtab ty
-! | Ast.StructRef tid => SOME tid
-! | Ast.UnionRef tid => SOME tid
- | _ => NONE
-
-***************
-*** 554,558 ****
- (SOME ct, eml) => (SOME(Pointer ct), eml)
- | (NONE, eml) => (NONE, eml))
-! | ((StructRef tid1, StructRef tid2) | (UnionRef tid1, UnionRef tid2)) =>
- if Tid.equal (tid1, tid2) then (SOME ty1, nil) else (NONE, nil)
- | _ => (NONE, nil)
---- 555,561 ----
- (SOME ct, eml) => (SOME(Pointer ct), eml)
- | (NONE, eml) => (NONE, eml))
-! | (StructRef tid1, StructRef tid2) =>
-! if Tid.equal (tid1, tid2) then (SOME ty1, nil) else (NONE, nil)
-! | (UnionRef tid1, UnionRef tid2) =>
- if Tid.equal (tid1, tid2) then (SOME ty1, nil) else (NONE, nil)
- | _ => (NONE, nil)
-***************
-*** 652,657 ****
- (case (usualUnaryCnv tidtab ty1, exp1Zero, usualUnaryCnv tidtab ty2, exp2Zero) of
- (Ast.Numeric _, _, Ast.Numeric _, _) => usualBinaryCnv tidtab (ty1, ty2) (* get common type *)
-! | ((Ast.StructRef tid1, _, Ast.StructRef tid2, _) |
-! (Ast.UnionRef tid1, _, Ast.UnionRef tid2, _)) =>
- if Tid.equal (tid1, tid2) then SOME ty1
- else NONE
---- 655,662 ----
- (case (usualUnaryCnv tidtab ty1, exp1Zero, usualUnaryCnv tidtab ty2, exp2Zero) of
- (Ast.Numeric _, _, Ast.Numeric _, _) => usualBinaryCnv tidtab (ty1, ty2) (* get common type *)
-! | (Ast.StructRef tid1, _, Ast.StructRef tid2, _) =>
-! if Tid.equal (tid1, tid2) then SOME ty1
-! else NONE
-! | (Ast.UnionRef tid1, _, Ast.UnionRef tid2, _) =>
- if Tid.equal (tid1, tid2) then SOME ty1
- else NONE
-***************
-*** 746,752 ****
- * is a function of no args *)
- *)
-! | ((_, nil, _) | (_, _, nil)) => ( ["Type Warning: function call has too few args"]
-! , nil
-! )
- | (nil, argl, _) => (["Type Warning: function call has too many args"]
- , List.map (functionArgConv tidtab) argl
---- 751,760 ----
- * is a function of no args *)
- *)
-! | (_, nil, _) => (["Type Warning: function call has too few args"]
-! , nil
-! )
-! | (_, _, nil) => (["Type Warning: function call has too few args"]
-! , nil
-! )
- | (nil, argl, _) => (["Type Warning: function call has too many args"]
- , List.map (functionArgConv tidtab) argl
-diff -N -C 2 -r ckit/src/ckit-lib.mlb ckit-mlton/src/ckit-lib.mlb
-*** ckit/src/ckit-lib.mlb 1969-12-31 19:00:00.000000000 -0500
---- ckit-mlton/src/ckit-lib.mlb 2010-04-02 16:08:40.000000000 -0400
-***************
-*** 0 ****
---- 1,888 ----
-+
-+ ann
-+ "nonexhaustiveMatch warn" "redundantMatch warn"
-+ "sequenceNonUnit ignore"
-+ "warnUnused false" "forceUsed"
-+ in
-+
-+ local
-+ basis l4 =
-+ bas
-+ (* $/basis.cm ====> *) $(SML_LIB)/basis/basis.mlb
-+ end
-+ basis l24 =
-+ bas
-+ (* $/smlnj-lib.cm ====> *) $(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb
-+ end
-+ basis l71 =
-+ bas
-+ (* $/pp-lib.cm ====> *) $(SML_LIB)/smlnj-lib/PP/pp-lib.mlb
-+ end
-+ basis l96 =
-+ bas
-+ (* $/ml-yacc-lib.cm ====> *) $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
-+ end
-+ in
-+ local
-+ $(SML_LIB)/basis/pervasive.mlb
-+ local
-+ open l4
-+ in
-+ structure gs_0 = TextIO
+diff --git a/README.mlton b/README.mlton
+new file mode 100644
+index 0000000..1a82db7
+--- /dev/null
++++ b/README.mlton
+@@ -0,0 +1,14 @@
++The following changes were made to the ckit Library, in addition to
++deriving the {{{.mlb}}} file from the {{{.cm}}} files:
++ * {{{ast/ast-sig.sml}}} (modified): Rewrote use of {{{withtype}}} in signature.
++ * {{{ast/build-ast.sml}}} (modified): Rewrote use of ''or-patterns''.
++ * {{{ast/initializer-normalizer.sml}}} (modified): Rewrote use of ''or-patterns''.
++ * {{{ast/pp/pp-ast-adornment-sig.sml}}} (modified): Rewrote use of {{{signature}}} in {{{local}}}.
++ * {{{ast/pp/pp-ast-ext-sig.sml}}} (modified): Rewrote use of {{{signature}}} in {{{local}}}.
++ * {{{ast/pp/pp-lib.sml}}} (modified): Rewrote use of ''or-patterns''.
++ * {{{ast/sizeof.sml}}} (modified): Rewrote use of ''or-patterns''.
++ * {{{ast/type-util-sig.sml}}} (modified): Rewrote use of {{{signature}}} in {{{local}}}.
++ * {{{ast/type-util.sml}}} (modified): Rewrote use of ''or-patterns''.
++ * {{{parser/grammar/c.lex.sml}}} (modified): Rewrote use of vector literal.
++ * {{{parser/parse-tree-sig.sml}}} (modified): Rewrote use of (sequential) {{{withtype}}} in signature.
++ * {{{parser/parse-tree.sml}}} (modified): Rewrote use of (sequential) {{{withtype}}}.
+diff --git a/ckit-lib.mlb b/ckit-lib.mlb
+new file mode 100644
+index 0000000..abc601f
+--- /dev/null
++++ b/ckit-lib.mlb
+@@ -0,0 +1 @@
++src/ckit-lib.mlb
+diff --git a/src/ast/ast-sig.sml b/src/ast/ast-sig.sml
+index 29f5eb2..367fb5a 100644
+--- a/src/ast/ast-sig.sml
++++ b/src/ast/ast-sig.sml
+@@ -67,7 +67,12 @@ sig
+ datatype declaration
+ = TypeDecl of {shadow: {strct:bool} option, tid:tid}
+ (* placeholder to indicate where typedefs/enums/structs should be printed *)
+- | VarDecl of id * initExpression option
++ | VarDecl of
++ (* id *) {name: Symbol.symbol, uid: Pid.uid,
++ location: SourceMap.location, ctype: ctype,
++ stClass: storageClass, status: declStatus,
++ global: bool, kind: idKind} *
++ initExpression option
+
+
+ (* STATEMENTS *)
+@@ -106,15 +111,31 @@ sig
+ | Assign of expression * expression
+ | Comma of expression * expression
+ | Sub of expression * expression
+- | Member of expression * member
+- | Arrow of expression * member
++ | Member of
++ expression *
++ (* member *) {name: Symbol.symbol, uid : Pid.uid,
++ location : SourceMap.location,
++ ctype: ctype, kind: memberKind}
++ | Arrow of
++ expression *
++ (* member *) {name: Symbol.symbol, uid : Pid.uid,
++ location : SourceMap.location,
++ ctype: ctype, kind: memberKind}
+ | Deref of expression
+ | AddrOf of expression
+ | Binop of binop * expression * expression
+ | Unop of unop * expression
+ | Cast of ctype * expression
+- | Id of id
+- | EnumId of member * LargeInt.int
++ | Id of
++ (* id *) {name: Symbol.symbol, uid: Pid.uid,
++ location: SourceMap.location, ctype: ctype,
++ stClass: storageClass, status: declStatus,
++ global: bool, kind: idKind}
++ | EnumId of
++ (* member *) {name: Symbol.symbol, uid : Pid.uid,
++ location : SourceMap.location,
++ ctype: ctype, kind: memberKind} *
++ LargeInt.int
+ | SizeOf of ctype (* not used in compiler mode; sizeof expr becomes sizeof (typeof expr) *)
+ | ExprExt of (expression, statement, binop, unop) AstExt.expressionExt
+ | ErrorExpr
+@@ -131,7 +152,13 @@ sig
+ * signednessTag
+ | Array of (LargeInt.int * expression) option * ctype
+ | Pointer of ctype
+- | Function of ctype * (ctype * id option) list
++ | Function of
++ ctype *
++ (ctype *
++ (* id *) {name: Symbol.symbol, uid: Pid.uid,
++ location: SourceMap.location, ctype: ctype,
++ stClass: storageClass, status: declStatus,
++ global: bool, kind: idKind} option) list
+ | StructRef of tid (* reference to a tid bound by a struct decl *)
+ | UnionRef of tid (* reference to a tid bound by a union decl *)
+ | EnumRef of tid (* reference to a tid bound by a enumeration decl *)
+@@ -151,7 +178,7 @@ sig
+ | UNIONmem
+ | ENUMmem of LargeInt.int
+
+- withtype member =
++ type member =
+ {name: Symbol.symbol, (* the name of the member *)
+ uid : Pid.uid, (* unique identifier *)
+ location : SourceMap.location,
+diff --git a/src/ast/build-ast.sml b/src/ast/build-ast.sml
+index 9e8e7c7..65e32bf 100644
+--- a/src/ast/build-ast.sml
++++ b/src/ast/build-ast.sml
+@@ -290,7 +290,8 @@ let
+ of SOME{ntype=NONE,...} => true
+ | _ => false
+
+- fun isPartialTy(Ast.StructRef tid | Ast.UnionRef tid) = isPartial tid
++ fun isPartialTy(Ast.StructRef tid) = isPartial tid
++ | isPartialTy(Ast.UnionRef tid) = isPartial tid
+ | isPartialTy _ = false
+
+
+@@ -443,7 +444,10 @@ let
+ case expr
+ of Ast.Member(Ast.EXPR (expr'', aid, _), _) =>
+ isLval (expr'', lookAid aid)
+- | (Ast.Id _ | Ast.Sub _ | Ast.Arrow _ | Ast.Deref _) => true
++ | Ast.Id _ => true
++ | Ast.Sub _ => true
++ | Ast.Arrow _ => true
++ | Ast.Deref _ => true
+ | _ => false
+
+ fun checkAssignableLval (expr, ty, s) =
+@@ -602,7 +606,9 @@ let
+ NB 2: if type is array then *do* generate errors when initializer is simple *)
+
+
+- fun TCInitializer(ctype as (Ast.TypeRef _ | Ast.Qual _), expr) =
++ fun TCInitializer(ctype as Ast.TypeRef _, expr) =
++ TCInitializer(getCoreType ctype, expr) (* the following TCInitializer cases expect coretypes *)
++ | TCInitializer(ctype as Ast.Qual _, expr) =
+ TCInitializer(getCoreType ctype, expr) (* the following TCInitializer cases expect coretypes *)
+ | TCInitializer (Ast.Array(opt, ctype), Ast.Aggregate exprs) =
+ (case (opt, LargeInt.fromInt(List.length exprs))
+@@ -650,7 +656,11 @@ let
+ error "empty union"
+ | NONE => bug "TCInitializer: lookTid failed"
+ | _ => error "TCInitializer: ill-formed UnionRef type")
+- | TCInitializer (ty as (Ast.StructRef _ | Ast.UnionRef _), Ast.Simple(Ast.EXPR(coreExp, aid, _))) =
++ | TCInitializer (ty as Ast.StructRef _, Ast.Simple(Ast.EXPR(coreExp, aid, _))) =
++ if isAssignableTys {lhsTy=ty, rhsTy=lookAid aid, rhsExprOpt=SOME coreExp}
++ then ()
++ else error "type of initializer is incompatible with type of lval"
++ | TCInitializer (ty as Ast.UnionRef _, Ast.Simple(Ast.EXPR(coreExp, aid, _))) =
+ if isAssignableTys {lhsTy=ty, rhsTy=lookAid aid, rhsExprOpt=SOME coreExp}
+ then ()
+ else error "type of initializer is incompatible with type of lval"
+@@ -804,7 +814,9 @@ let
+ b) the object has static storage duration
+ *)
+ (* Note: should really reduce constants arith exprs to simple constants *)
+- fun constCheck(Ast.EXPR((Ast.StringConst _ | Ast.IntConst _ | Ast.RealConst _),_,_)) = true
++ fun constCheck(Ast.EXPR(Ast.StringConst _,_,_)) = true
++ | constCheck(Ast.EXPR(Ast.IntConst _,_,_)) = true
++ | constCheck(Ast.EXPR(Ast.RealConst _,_,_)) = true
+ | constCheck(Ast.EXPR(Ast.QuestionColon(e1, e2, e3), _, _))
+ = constCheck e1 andalso constCheck e2 andalso constCheck e3
+ | constCheck(Ast.EXPR(Ast.Binop(_, e1, e2), _, _))
+@@ -2371,7 +2383,11 @@ end old code ******)
+ (case spec
+ of PT.Signed =>
+ (case !kind
+- of SOME (Ast.FLOAT | Ast.DOUBLE | Ast.LONGDOUBLE) =>
++ of SOME Ast.FLOAT =>
++ error "illegal combination of signed with float/double/long double"
++ | SOME Ast.DOUBLE =>
++ error "illegal combination of signed with float/double/long double"
++ | SOME Ast.LONGDOUBLE =>
+ error "illegal combination of signed with float/double/long double"
+ | _ => ();
+ case !signed
+@@ -2379,7 +2395,11 @@ end old code ******)
+ | SOME _ => error "Multiple signed/unsigned")
+ | PT.Unsigned =>
+ (case !kind
+- of SOME (Ast.FLOAT | Ast.DOUBLE | Ast.LONGDOUBLE) =>
++ of SOME Ast.FLOAT =>
++ error "illegal combination of unsigned with float/double/long double"
++ | SOME Ast.DOUBLE =>
++ error "illegal combination of unsigned with float/double/long double"
++ | SOME Ast.LONGDOUBLE =>
+ error "illegal combination of unsigned with float/double/long double"
+ | _ => ();
+ case !signed
+@@ -2394,7 +2414,8 @@ end old code ******)
+ | _ => "illegal use of char specifier"))
+ | PT.Short =>
+ (case !kind
+- of (NONE | SOME Ast.INT) => (kind := SOME Ast.SHORT)
++ of NONE => (kind := SOME Ast.SHORT)
++ | SOME Ast.INT => (kind := SOME Ast.SHORT)
+ | SOME ct =>
+ error (case ct
+ of Ast.SHORT => "duplicate short specifier"
+@@ -2402,7 +2423,9 @@ end old code ******)
+ | PT.Int =>
+ (case !kind
+ of NONE => (kind := SOME Ast.INT)
+- | SOME (Ast.SHORT | Ast.LONG | Ast.LONGLONG) => ()
++ | SOME Ast.SHORT => ()
++ | SOME Ast.LONG => ()
++ | SOME Ast.LONGLONG => ()
+ | SOME ct =>
+ error (case ct
+ of Ast.INT => "duplicate int specifier"
+@@ -2687,7 +2710,17 @@ end old code ******)
+ (case lookLocalScope sym
+ of SOME(TAG{ctype=ty,location=loc',...}) =>
+ (case ty
+- of (Ast.UnionRef tid | Ast.StructRef tid) =>
++ of Ast.UnionRef tid =>
++ if isPartial tid
++ then SOME{tid=tid, alreadyDefined=false}
++ else if repeated_declarations_ok
++ then SOME{tid=tid, alreadyDefined=true}
++ else (error("Redeclaration of type tag `"
++ ^ tagname
++ ^ "'; previous declaration at "
++ ^ SM.locToString loc');
++ NONE)
++ | Ast.StructRef tid =>
+ if isPartial tid
+ then SOME{tid=tid, alreadyDefined=false}
+ else if repeated_declarations_ok
+diff --git a/src/ast/initializer-normalizer.sml b/src/ast/initializer-normalizer.sml
+index 5ea8dbc..2e7a563 100644
+--- a/src/ast/initializer-normalizer.sml
++++ b/src/ast/initializer-normalizer.sml
+@@ -156,7 +156,13 @@ let
+ feed (unionNorm (ctype, fields), inits)
+ | SOME _ => fail "Incomplete type for union ref"
+ | NONE => fail "Inconsistent table for union ref")
+- | (Ast.Numeric _ | Ast.Pointer _ | Ast.Function _ | Ast.EnumRef _) =>
++ | Ast.Numeric _ =>
++ feed (scalarNorm ctype, inits)
++ | Ast.Pointer _ =>
++ feed (scalarNorm ctype, inits)
++ | Ast.Function _ =>
++ feed (scalarNorm ctype, inits)
++ | Ast.EnumRef _ =>
+ feed (scalarNorm ctype, inits)
+ | Ast.Void => fail "Incomplete type: void"
+ | Ast.Ellipses => fail "Cannot initialize ellipses"
+diff --git a/src/ast/pp/pp-ast-adornment-sig.sml b/src/ast/pp/pp-ast-adornment-sig.sml
+index a7b937b..ab6e0a9 100644
+--- a/src/ast/pp/pp-ast-adornment-sig.sml
++++ b/src/ast/pp/pp-ast-adornment-sig.sml
+@@ -1,14 +1,14 @@
+ (* Copyright (c) 1998 by Lucent Technologies *)
+
+-local
++(* local *)
+ type 'a pp = Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
+
+ type ('aidinfo,'a,'b) adornment_pp = ('aidinfo -> 'a) -> 'aidinfo -> 'b
+-in
++(* in *)
+ signature PPASTADORNMENT = sig
+ type aidinfo
+ val ppExpressionAdornment: (aidinfo,Ast.coreExpression pp,Ast.expression pp) adornment_pp
+ val ppStatementAdornment : (aidinfo,Ast.coreStatement pp,Ast.statement pp) adornment_pp
+ val ppExternalDeclAdornment: (aidinfo,Ast.coreExternalDecl pp,Ast.externalDecl pp) adornment_pp
+ end
+-end
++(* end *)
+diff --git a/src/ast/pp/pp-ast-ext-sig.sml b/src/ast/pp/pp-ast-ext-sig.sml
+index 4169fc7..c7291ab 100644
+--- a/src/ast/pp/pp-ast-ext-sig.sml
++++ b/src/ast/pp/pp-ast-ext-sig.sml
+@@ -1,13 +1,13 @@
+ (* Copyright (c) 1998 by Lucent Technologies *)
+
+-local
++(* local *)
+ type 'a pp = Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
+ type ('a, 'aidinfo) ppExt =
+ (('aidinfo -> Ast.expression pp) * ('aidinfo -> Ast.statement pp) *
+ ('aidinfo -> Ast.binop pp) * ('aidinfo -> Ast.unop pp))
+ -> 'aidinfo
+ -> Tables.tidtab -> OldPrettyPrint.ppstream -> 'a -> unit
+-in
++(* in *)
+
+ signature PPASTEXT = sig
+ type aidinfo
+@@ -24,4 +24,4 @@ signature PPASTEXT = sig
+ aidinfo) ppExt
+ end
+
+-end
++(* end *)
+diff --git a/src/ast/pp/pp-lib.sml b/src/ast/pp/pp-lib.sml
+index f6386d3..70f8504 100644
+--- a/src/ast/pp/pp-lib.sml
++++ b/src/ast/pp/pp-lib.sml
+@@ -115,7 +115,10 @@ structure PPLib = struct
+
+ fun ppId pps ({name,uid,kind,stClass,global,...}: Ast.id) =
+ case (stClass,global)
+- of ((Ast.EXTERN,_) | (_, true)) => (* globals *)
++ of (Ast.EXTERN,_) => (* globals *)
++ if !suppressPidGlobalUnderscores then ppSymbol' pps name
++ else ppSymbol pps (name,uid)
++ | (_, true) => (* globals *)
+ if !suppressPidGlobalUnderscores then ppSymbol' pps name
+ else ppSymbol pps (name,uid)
+ | _ => ppSymbol pps (name,uid)
+diff --git a/src/ast/sizeof.sml b/src/ast/sizeof.sml
+index 02705c2..aebd826 100644
+--- a/src/ast/sizeof.sml
++++ b/src/ast/sizeof.sml
+@@ -321,7 +321,9 @@ struct
+ and process (sizesErrWarnBug as {sizes, err, warn, bug}) tidtab ty =
+ case ty
+ of Ast.TypeRef tid => processTid sizesErrWarnBug tidtab tid
+- | (Ast.StructRef tid | Ast.UnionRef tid) =>
++ | Ast.StructRef tid =>
++ processTid sizesErrWarnBug tidtab tid
++ | Ast.UnionRef tid =>
+ processTid sizesErrWarnBug tidtab tid
+ | Ast.EnumRef _ =>
+ let val {bits,align} = #int sizes
+diff --git a/src/ast/type-util-sig.sml b/src/ast/type-util-sig.sml
+index b03260b..a262146 100644
+--- a/src/ast/type-util-sig.sml
++++ b/src/ast/type-util-sig.sml
+@@ -1,10 +1,10 @@
+ (* Copyright (c) 1998 by Lucent Technologies *)
+
+-local
++(* local *)
+ type 'a type_util = Tables.tidtab -> Ast.ctype -> 'a
+ type 'a type_mem_util = Tables.tidtab -> Ast.ctype * Ast.member -> 'a
+ type 'a type_type_util = Tables.tidtab -> Ast.ctype * Ast.ctype -> 'a
+-in
++(* in *)
+
+ signature TYPE_UTIL =
+ sig
+@@ -145,4 +145,4 @@ sig
+
+ end (* signature TYPE_UTIL *)
+
+-end (* local *)
++(* end (* local *) *)
+diff --git a/src/ast/type-util.sml b/src/ast/type-util.sml
+index 8dc30d3..851cfe8 100644
+--- a/src/ast/type-util.sml
++++ b/src/ast/type-util.sml
+@@ -282,7 +282,8 @@ struct
+ fun isStructOrUnion tidtab ty =
+ case reduceTypedef tidtab ty
+ of Ast.Qual (_,ty) => isStructOrUnion tidtab ty
+- | (Ast.StructRef tid | Ast.UnionRef tid) => SOME tid
++ | Ast.StructRef tid => SOME tid
++ | Ast.UnionRef tid => SOME tid
+ | _ => NONE
+
+ fun isEnum tidtab (ty,member as {uid,kind=Ast.ENUMmem _,...}: Ast.member) =
+@@ -553,7 +554,9 @@ struct
+ | (Pointer ct1, Pointer ct2) => (case compose (ct1, ct2) of
+ (SOME ct, eml) => (SOME(Pointer ct), eml)
+ | (NONE, eml) => (NONE, eml))
+- | ((StructRef tid1, StructRef tid2) | (UnionRef tid1, UnionRef tid2)) =>
++ | (StructRef tid1, StructRef tid2) =>
++ if Tid.equal (tid1, tid2) then (SOME ty1, nil) else (NONE, nil)
++ | (UnionRef tid1, UnionRef tid2) =>
+ if Tid.equal (tid1, tid2) then (SOME ty1, nil) else (NONE, nil)
+ | _ => (NONE, nil)
+ end
+@@ -651,8 +654,10 @@ struct
+ fun conditionalExp tidtab {ty1, exp1Zero, ty2, exp2Zero} = (* for Eq and Neq *)
+ (case (usualUnaryCnv tidtab ty1, exp1Zero, usualUnaryCnv tidtab ty2, exp2Zero) of
+ (Ast.Numeric _, _, Ast.Numeric _, _) => usualBinaryCnv tidtab (ty1, ty2) (* get common type *)
+- | ((Ast.StructRef tid1, _, Ast.StructRef tid2, _) |
+- (Ast.UnionRef tid1, _, Ast.UnionRef tid2, _)) =>
++ | (Ast.StructRef tid1, _, Ast.StructRef tid2, _) =>
++ if Tid.equal (tid1, tid2) then SOME ty1
++ else NONE
++ | (Ast.UnionRef tid1, _, Ast.UnionRef tid2, _) =>
+ if Tid.equal (tid1, tid2) then SOME ty1
+ else NONE
+ | (Ast.Void, _, Ast.Void, _) => SOME ty1
+@@ -745,9 +750,12 @@ struct
+ | ([Ast.Void], nil) => (nil, nil) (* bugfix 15/jun/99: a function with a single void argument
+ * is a function of no args *)
+ *)
+- | ((_, nil, _) | (_, _, nil)) => ( ["Type Warning: function call has too few args"]
+- , nil
+- )
++ | (_, nil, _) => (["Type Warning: function call has too few args"]
++ , nil
++ )
++ | (_, _, nil) => (["Type Warning: function call has too few args"]
++ , nil
++ )
+ | (nil, argl, _) => (["Type Warning: function call has too many args"]
+ , List.map (functionArgConv tidtab) argl
+ )
+diff --git a/src/ckit-lib.mlb b/src/ckit-lib.mlb
+new file mode 100644
+index 0000000..70a2919
+--- /dev/null
++++ b/src/ckit-lib.mlb
+@@ -0,0 +1,888 @@
++
++ann
++ "nonexhaustiveMatch warn" "redundantMatch warn"
++ "sequenceNonUnit ignore"
++ "warnUnused false" "forceUsed"
++in
++
++local
++ basis l4 =
++ bas
++ (* $/basis.cm ====> *) $(SML_LIB)/basis/basis.mlb
+ end
-+ local
-+ variants/type-check-control-sig.sml
-+ in
-+ signature gs_1 = TYPECHECKCONTROL
++ basis l24 =
++ bas
++ (* $/smlnj-lib.cm ====> *) $(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb
+ end
-+ local
-+ variants/parse-control-sig.sml
-+ in
-+ signature gs_2 = PARSECONTROL
++ basis l71 =
++ bas
++ (* $/pp-lib.cm ====> *) $(SML_LIB)/smlnj-lib/PP/pp-lib.mlb
+ end
-+ local
-+ signature PARSECONTROL = gs_2
-+ signature TYPECHECKCONTROL = gs_1
-+ variants/config-sig.sml
-+ in
-+ signature gs_3 = CONFIG
++ basis l96 =
++ bas
++ (* $/ml-yacc-lib.cm ====> *) $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
+ end
-+ local
-+ signature CONFIG = gs_3
-+ signature PARSECONTROL = gs_2
-+ signature TYPECHECKCONTROL = gs_1
-+ structure TextIO = gs_0
-+ variants/ansic/config.sml
-+ in
-+ structure gs_4 = Config
-+ end
-+ local
-+ open l24
-+ in
-+ functor gs_5 = HashTableFn
-+ end
-+ local
-+ ast/uidtabimp-sig.sml
-+ in
-+ signature gs_6 = UIDTABIMP
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_7 = Word
-+ end
-+ local
-+ structure Word = gs_7
-+ ast/uid-sig.sml
-+ in
-+ signature gs_8 = UID
-+ end
-+ local
-+ functor HashTableFn = gs_5
-+ signature UID = gs_8
-+ signature UIDTABIMP = gs_6
-+ ast/uidtabimp-fn.sml
-+ in
-+ functor gs_9 = UidtabImpFn
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_10 = Int
-+ end
-+ local
-+ structure Int = gs_10
-+ signature UID = gs_8
-+ structure Word = gs_7
-+ ast/uid-fn.sml
-+ in
-+ functor gs_11 = UidFn
-+ end
-+ local
-+ signature UID = gs_8
-+ functor UidFn = gs_11
-+ ast/aid.sml
-+ in
-+ structure gs_12 = Aid
-+ end
-+ local
-+ structure Aid = gs_12
-+ functor UidtabImpFn = gs_9
-+ ast/aidtab.sml
-+ in
-+ structure gs_13 = Aidtab
-+ end
-+ local
-+ open l24
-+ in
-+ structure gs_14 = Format
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_15 = String
-+ end
-+ local
-+ parser/util/sourcemap-sig.sml
-+ in
-+ signature gs_16 = SOURCE_MAP
-+ end
-+ local
-+ structure Config = gs_4
-+ structure Format = gs_14
-+ structure Int = gs_10
-+ signature SOURCE_MAP = gs_16
-+ structure String = gs_15
-+ parser/util/sourcemap.sml
-+ in
-+ structure gs_17 = SourceMap
-+ end
-+ local
-+ open l71
-+ in
-+ functor gs_18 = PPStreamFn
-+ end
-+ local
-+ open l71
-+ in
-+ structure gs_19 = StringToken
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_20 = StringCvt
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_21 = List
-+ end
-+ local
-+ structure List = gs_21
-+ functor PPStreamFn = gs_18
-+ structure String = gs_15
-+ structure StringCvt = gs_20
-+ structure StringToken = gs_19
-+ parser/util/old-pp.sml
-+ in
-+ signature gs_22 = OLD_PRETTYPRINT
-+ structure gs_23 = OldPrettyPrint
-+ end
-+ local
-+ structure Format = gs_14
-+ signature OLD_PRETTYPRINT = gs_22
-+ structure OldPrettyPrint = gs_23
-+ structure SourceMap = gs_17
-+ structure TextIO = gs_0
-+ parser/util/error-sig.sml
-+ in
-+ signature gs_24 = ERROR
-+ end
-+ local
-+ signature ERROR = gs_24
-+ structure Format = gs_14
-+ signature OLD_PRETTYPRINT = gs_22
-+ structure OldPrettyPrint = gs_23
-+ structure SourceMap = gs_17
-+ structure TextIO = gs_0
-+ parser/util/error.sml
-+ in
-+ structure gs_25 = Error
-+ end
-+ local
-+ open l96
-+ in
-+ functor gs_26 = Join
-+ functor gs_27 = JoinWithArg
-+ end
-+ local
-+ open l96
-+ in
-+ structure gs_28 = LrParser
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_29 = LargeInt
-+ end
-+ local
-+ parser/extensions/c/parse-tree-ext.sml
-+ in
-+ structure gs_30 = ParseTreeExt
-+ end
-+ local
-+ structure LargeInt = gs_29
-+ structure ParseTreeExt = gs_30
-+ structure SourceMap = gs_17
-+ parser/parse-tree-sig.sml
-+ in
-+ signature gs_31 = PARSETREE
-+ end
-+ local
-+ structure LargeInt = gs_29
-+ signature PARSETREE = gs_31
-+ structure ParseTreeExt = gs_30
-+ structure SourceMap = gs_17
-+ parser/parse-tree.sml
-+ in
-+ structure gs_32 = ParseTree
-+ end
-+ local
-+ structure Error = gs_25
-+ structure ParseTree = gs_32
-+ parser/parser-sig.sml
-+ in
-+ signature gs_33 = PARSER
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_34 = IO
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_35 = TextPrimIO
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_36 = IntInf
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_37 = CharVector
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_38 = Vector
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_39 = Real
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_40 = Char
-+ end
-+ local
-+ open l24
-+ in
-+ structure gs_41 = AtomTable
-+ end
-+ local
-+ open l24
-+ in
-+ structure gs_42 = Atom
-+ end
-+ local
-+ structure Atom = gs_42
-+ structure AtomTable = gs_41
-+ structure Config = gs_4
-+ parser/grammar/tdefs.sml
-+ in
-+ signature gs_43 = TYPEDEFS
-+ structure gs_44 = TypeDefs
-+ end
-+ local
-+ open l96
-+ in
-+ signature gs_45 = ARG_LEXER
-+ signature gs_46 = ARG_PARSER
-+ signature gs_47 = LEXER
-+ signature gs_48 = LR_PARSER
-+ signature gs_49 = LR_TABLE
-+ signature gs_50 = PARSER
-+ signature gs_51 = PARSER_DATA
-+ signature gs_52 = STREAM
-+ signature gs_53 = TOKEN
-+ end
-+ local
-+ signature ARG_LEXER = gs_45
-+ signature ARG_PARSER = gs_46
-+ signature LEXER = gs_47
-+ signature LR_PARSER = gs_48
-+ signature LR_TABLE = gs_49
-+ structure LargeInt = gs_29
-+ signature PARSER = gs_50
-+ signature PARSER_DATA = gs_51
-+ signature STREAM = gs_52
-+ signature TOKEN = gs_53
-+ parser/grammar/c.grm.sig
-+ in
-+ signature gs_54 = C_LRVALS
-+ signature gs_55 = C_TOKENS
-+ end
-+ local
-+ structure Atom = gs_42
-+ structure AtomTable = gs_41
-+ signature C_LRVALS = gs_54
-+ signature C_TOKENS = gs_55
-+ structure Config = gs_4
-+ signature TYPEDEFS = gs_43
-+ structure TypeDefs = gs_44
-+ parser/grammar/tokentable.sml
-+ in
-+ signature gs_56 = TOKENTABLE
-+ functor gs_57 = TokenTable
-+ end
-+ local
-+ signature C_LRVALS = gs_54
-+ signature C_TOKENS = gs_55
-+ structure Char = gs_40
-+ structure CharVector = gs_37
-+ structure IO = gs_34
-+ structure Int = gs_10
-+ structure IntInf = gs_36
-+ structure LargeInt = gs_29
-+ structure Real = gs_39
-+ structure SourceMap = gs_17
-+ structure String = gs_15
-+ structure StringCvt = gs_20
-+ signature TOKENTABLE = gs_56
-+ structure TextIO = gs_0
-+ structure TextPrimIO = gs_35
-+ functor TokenTable = gs_57
-+ structure Vector = gs_38
-+ parser/grammar/c.lex.sml
-+ in
-+ functor gs_58 = CLexFun
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_59 = Array
-+ end
-+ local
-+ signature ARG_LEXER = gs_45
-+ signature ARG_PARSER = gs_46
-+ structure Array = gs_59
-+ signature C_LRVALS = gs_54
-+ signature C_TOKENS = gs_55
-+ structure Char = gs_40
-+ structure Error = gs_25
-+ signature LEXER = gs_47
-+ signature LR_PARSER = gs_48
-+ signature LR_TABLE = gs_49
-+ structure LargeInt = gs_29
-+ structure List = gs_21
-+ signature PARSER = gs_50
-+ signature PARSER_DATA = gs_51
-+ structure ParseTree = gs_32
-+ signature STREAM = gs_52
-+ structure SourceMap = gs_17
-+ structure String = gs_15
-+ signature TOKEN = gs_53
-+ signature TYPEDEFS = gs_43
-+ structure TypeDefs = gs_44
-+ parser/grammar/c.grm.sml
-+ in
-+ functor gs_60 = LrValsFun
-+ end
-+ local
-+ functor CLexFun = gs_58
-+ structure Error = gs_25
-+ functor Join = gs_26
-+ functor JoinWithArg = gs_27
-+ structure LrParser = gs_28
-+ functor LrValsFun = gs_60
-+ signature PARSER = gs_33
-+ structure SourceMap = gs_17
-+ signature TOKENTABLE = gs_56
-+ signature TYPEDEFS = gs_43
-+ structure TextIO = gs_0
-+ functor TokenTable = gs_57
-+ structure TypeDefs = gs_44
-+ parser/parser.sml
-+ in
-+ structure gs_61 = Parser
-+ end
-+ local
-+ open l24
-+ in
-+ structure gs_62 = HashString
-+ end
-+ local
-+ signature UID = gs_8
-+ functor UidFn = gs_11
-+ ast/tid.sml
-+ in
-+ structure gs_63 = Tid
-+ end
-+ local
-+ structure Tid = gs_63
-+ ast/symbol-sig.sml
-+ in
-+ signature gs_64 = SYMBOL
-+ end
-+ local
-+ structure HashString = gs_62
-+ structure Int = gs_10
-+ signature SYMBOL = gs_64
-+ structure String = gs_15
-+ structure Tid = gs_63
-+ structure Word = gs_7
-+ ast/symbol.sml
-+ in
-+ structure gs_65 = Symbol
-+ end
-+ local
-+ signature UID = gs_8
-+ functor UidFn = gs_11
-+ ast/pid.sml
-+ in
-+ structure gs_66 = Pid
-+ end
-+ local
-+ ast/extensions/c/ast-ext.sml
-+ in
-+ structure gs_67 = AstExt
-+ end
-+ local
-+ structure Aid = gs_12
-+ structure AstExt = gs_67
-+ structure LargeInt = gs_29
-+ structure Pid = gs_66
-+ structure SourceMap = gs_17
-+ structure Symbol = gs_65
-+ structure Tid = gs_63
-+ ast/ast-sig.sml
-+ in
-+ signature gs_68 = AST
-+ end
-+ local
-+ signature AST = gs_68
-+ structure Aid = gs_12
-+ structure AstExt = gs_67
-+ structure LargeInt = gs_29
-+ structure Pid = gs_66
-+ structure SourceMap = gs_17
-+ structure Symbol = gs_65
-+ structure Tid = gs_63
-+ ast/ast.sml
-+ in
-+ structure gs_69 = Ast
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure LargeInt = gs_29
-+ structure Pid = gs_66
-+ structure SourceMap = gs_17
-+ structure Symbol = gs_65
-+ structure Tid = gs_63
-+ ast/bindings.sml
-+ in
-+ structure gs_70 = Bindings
-+ end
-+ local
-+ open l24
-+ in
-+ functor gs_71 = BinaryMapFn
-+ end
-+ local
-+ open l24
-+ in
-+ signature gs_72 = ORD_MAP
-+ end
-+ local
-+ structure Tid = gs_63
-+ functor UidtabImpFn = gs_9
-+ ast/tidtab.sml
-+ in
-+ structure gs_73 = Tidtab
-+ end
-+ local
-+ structure Aidtab = gs_13
-+ structure Ast = gs_69
-+ structure Bindings = gs_70
-+ structure Tidtab = gs_73
-+ ast/tables.sml
-+ in
-+ structure gs_74 = Tables
-+ end
-+ local
-+ structure Aid = gs_12
-+ structure Ast = gs_69
-+ structure Bindings = gs_70
-+ structure Error = gs_25
-+ structure LargeInt = gs_29
-+ signature ORD_MAP = gs_72
-+ structure SourceMap = gs_17
-+ structure Symbol = gs_65
-+ structure Tables = gs_74
-+ structure Tid = gs_63
-+ ast/state-sig.sml
-+ in
-+ signature gs_75 = STATE
-+ end
-+ local
-+ structure Aid = gs_12
-+ structure Aidtab = gs_13
-+ structure Ast = gs_69
-+ functor BinaryMapFn = gs_71
-+ structure Bindings = gs_70
-+ structure Error = gs_25
-+ structure LargeInt = gs_29
-+ structure List = gs_21
-+ structure Pid = gs_66
-+ signature STATE = gs_75
-+ structure SourceMap = gs_17
-+ structure Symbol = gs_65
-+ structure Tables = gs_74
-+ structure Tid = gs_63
-+ structure Tidtab = gs_73
-+ ast/state.sml
-+ in
-+ structure gs_76 = State
-+ end
-+ local
-+ ast/sizes-sig.sml
-+ in
-+ signature gs_77 = SIZES
-+ end
-+ local
-+ signature SIZES = gs_77
-+ ast/sizes.sml
-+ in
-+ structure gs_78 = Sizes
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure Bindings = gs_70
-+ structure Sizes = gs_78
-+ structure State = gs_76
-+ structure Tables = gs_74
-+ structure TextIO = gs_0
-+ structure Tidtab = gs_73
-+ ast/parse-to-ast-sig.sml
-+ in
-+ signature gs_79 = PARSE_TO_AST
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_80 = ListPair
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_81 = Option
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure Bindings = gs_70
-+ structure Error = gs_25
-+ structure ParseTree = gs_32
-+ structure Sizes = gs_78
-+ structure State = gs_76
-+ structure Tables = gs_74
-+ structure Tidtab = gs_73
-+ ast/build-ast-sig.sml
-+ in
-+ signature gs_82 = BUILD_AST
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure ParseTree = gs_32
-+ structure ParseTreeExt = gs_30
-+ structure State = gs_76
-+ ast/cnv-ext-sig.sml
-+ in
-+ signature gs_83 = CNVEXT
-+ end
-+ local
-+ structure Ast = gs_69
-+ signature CNVEXT = gs_83
-+ structure ParseTree = gs_32
-+ structure ParseTreeExt = gs_30
-+ structure State = gs_76
-+ ast/extensions/c/cnv-ext.sml
-+ in
-+ structure gs_84 = CnvExt
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure Bindings = gs_70
-+ structure Pid = gs_66
-+ structure Symbol = gs_65
-+ ast/simplify-assign-ops.sml
-+ in
-+ structure gs_85 = SimplifyAssignOps
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure Bindings = gs_70
-+ signature OLD_PRETTYPRINT = gs_22
-+ structure OldPrettyPrint = gs_23
-+ structure Tables = gs_74
-+ structure Tid = gs_63
-+ ast/pp/pp-ast-sig.sml
-+ in
-+ signature gs_86 = PP_AST
-+ end
-+ local
-+ open l4
-+ in
-+ structure gs_87 = Int32
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure Int = gs_10
-+ structure Int32 = gs_87
-+ structure LargeInt = gs_29
-+ signature OLD_PRETTYPRINT = gs_22
-+ structure OldPrettyPrint = gs_23
-+ structure Pid = gs_66
-+ structure Real = gs_39
-+ structure String = gs_15
-+ structure Symbol = gs_65
-+ structure Tables = gs_74
-+ structure TextIO = gs_0
-+ structure Tid = gs_63
-+ structure Tidtab = gs_73
-+ ast/pp/pp-lib.sml
-+ in
-+ structure gs_88 = PPLib
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure AstExt = gs_67
-+ signature OLD_PRETTYPRINT = gs_22
-+ structure OldPrettyPrint = gs_23
-+ structure Tables = gs_74
-+ ast/pp/pp-ast-ext-sig.sml
-+ in
-+ signature gs_89 = PPASTEXT
-+ end
-+ local
-+ signature PPASTEXT = gs_89
-+ ast/extensions/c/pp-ast-ext-fn.sml
-+ in
-+ functor gs_90 = PPAstExtFn
-+ end
-+ local
-+ structure Ast = gs_69
-+ signature OLD_PRETTYPRINT = gs_22
-+ structure OldPrettyPrint = gs_23
-+ structure Tables = gs_74
-+ ast/pp/pp-ast-adornment-sig.sml
-+ in
-+ signature gs_91 = PPASTADORNMENT
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure Bindings = gs_70
-+ structure Int = gs_10
-+ structure LargeInt = gs_29
-+ structure List = gs_21
-+ signature OLD_PRETTYPRINT = gs_22
-+ structure OldPrettyPrint = gs_23
-+ structure Option = gs_81
-+ signature PPASTADORNMENT = gs_91
-+ functor PPAstExtFn = gs_90
-+ structure PPLib = gs_88
-+ signature PP_AST = gs_86
-+ structure Pid = gs_66
-+ structure SourceMap = gs_17
-+ structure Tid = gs_63
-+ structure Tidtab = gs_73
-+ ast/pp/pp-ast-fn.sml
-+ in
-+ functor gs_92 = PPAstFn
-+ end
-+ local
-+ structure Ast = gs_69
-+ signature PPASTADORNMENT = gs_91
-+ functor PPAstFn = gs_92
-+ ast/pp/pp-ast.sml
-+ in
-+ structure gs_93 = PPAst
-+ end
-+ local
-+ structure Ast = gs_69
-+ ast/ctype-eq.sml
-+ in
-+ structure gs_94 = CTypeEq
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure Sizes = gs_78
-+ structure Tables = gs_74
-+ ast/sizeof-sig.sml
-+ in
-+ signature gs_95 = SIZEOF
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure LargeInt = gs_29
-+ structure Tables = gs_74
-+ ast/type-util-sig.sml
-+ in
-+ signature gs_96 = TYPE_UTIL
-+ end
-+ local
-+ structure Ast = gs_69
-+ structure Bindings = gs_70
-+ structure Config = gs_4
-+ structure Int = gs_10
-+ structure List = gs_21
-+ structure PPAst = gs_93
-+ structure PPLib = gs_88
-+ structure Pid = gs_66
-+ structure Symbol = gs_65
-+ signature TYPE_UTIL = gs_96
-+ structure Tables = gs_74
-+ structure Tid = gs_63
-+ structure Tidtab = gs_73
-+ ast/type-util.sml
-+ in
-+ structure gs_97 = TypeUtil
-+ end
-+ local
-+ structure Ast = gs_69
-+ functor BinaryMapFn = gs_71
-+ structure Bindings = gs_70
-+ structure Config = gs_4
-+ structure Int = gs_10
-+ structure LargeInt = gs_29
-+ structure List = gs_21
-+ structure Pid = gs_66
-+ signature SIZEOF = gs_95
-+ structure Sizes = gs_78
-+ structure Tables = gs_74
-+ structure TextIO = gs_0
-+ structure Tid = gs_63
-+ structure Tidtab = gs_73
-+ structure TypeUtil = gs_97
-+ ast/sizeof.sml
-+ in
-+ structure gs_98 = Sizeof
-+ end
-+ local
-+ structure ParseTree = gs_32
-+ structure Real = gs_39
-+ structure Tid = gs_63
-+ ast/anonymous-structs.sml
-+ in
-+ structure gs_99 = AnonymousStructs
-+ structure gs_100 = TyEq
-+ end
-+...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2011-06-10 12:46:15
|
Fixed bug in translation from SSA2 to RSSA with case expressions over non-primitive-sized words.
Word constants in a case expression should be rounded up to
primitive-sized words during the SSA to RSSA conversion.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/mlton/backend/ssa-to-rssa.fun
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2011-06-10 19:46:10 UTC (rev 7543)
+++ mlton/trunk/doc/changelog 2011-06-10 19:46:13 UTC (rev 7544)
@@ -1,6 +1,8 @@
Here are the changes from version 2010608 to version YYYYMMDD.
* 2011-06-10
+ - Fixed bug in translation from SSA2 to RSSA with case expressions
+ over non-primitive-sized words.
- Fixed bug in SSA/SSA2 type checking of case expressions over
words.
Modified: mlton/trunk/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/trunk/mlton/backend/ssa-to-rssa.fun 2011-06-10 19:46:10 UTC (rev 7543)
+++ mlton/trunk/mlton/backend/ssa-to-rssa.fun 2011-06-10 19:46:13 UTC (rev 7544)
@@ -599,12 +599,18 @@
src = Operand.word (WordX.one cardElemSize)}]
end
+fun convertWordSize (ws: WordSize.t): WordSize.t =
+ WordSize.roundUpToPrim ws
+
+fun convertWordX (w: WordX.t): WordX.t =
+ WordX.resize (w, convertWordSize (WordX.size w))
+
fun convertConst (c: Const.t): Const.t =
let
datatype z = datatype Const.t
in
case c of
- Word w => Word (WordX.resize (w, WordSize.roundUpToPrim (WordX.size w)))
+ Word w => Word (convertWordX w)
| _ => c
end
@@ -688,16 +694,21 @@
(ss, t)
end
| _ => Error.bug "SsaToRssa.translateCase: strange type"))
- | S.Cases.Word (s, cs) =>
- ([],
- Switch
- (Switch.T
- {cases = (QuickSort.sortVector
- (cs, fn ((w, _), (w', _)) =>
- WordX.le (w, w', {signed = false}))),
- default = default,
- size = s,
- test = varOp test}))
+ | S.Cases.Word (s, cases) =>
+ let
+ val cases =
+ QuickSort.sortVector
+ (Vector.map (cases, fn (w, l) => (convertWordX w, l)),
+ fn ((w, _), (w', _)) => WordX.le (w, w', {signed = false}))
+ in
+ ([],
+ Switch
+ (Switch.T
+ {cases = cases,
+ default = default,
+ size = convertWordSize s,
+ test = varOp test}))
+ end
fun eta (l: Label.t, kind: Kind.t): Label.t =
let
val {args, ...} = labelInfo l
|
|
From: Matthew F. <fl...@ml...> - 2011-06-10 12:46:11
|
Unify SSA/SSA2 type checking of case expressions over words and cons.
Previously, checking for exhaustiveness and redundancy of a case
exprssion over cons used a boolean array of length equal to the number
of cons in the datatype of the test. This had a latent "bug" in that
an ill-typed program might have a con from a different datatype in a
case expression; this con might have an index larger than the number
of cons in the datatype of the test, which would trigger an unhelpful
Subscript exception. Verifying that the cons are appropriate for the
datatype of the test is handled by analyze, which runs after
checkScopes (which performs the exhaustiveness and redundancy checks).
----------------------------------------------------------------------
U mlton/trunk/mlton/ssa/type-check.fun
U mlton/trunk/mlton/ssa/type-check2.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/ssa/type-check.fun
===================================================================
--- mlton/trunk/mlton/ssa/type-check.fun 2011-06-10 19:46:06 UTC (rev 7542)
+++ mlton/trunk/mlton/ssa/type-check.fun 2011-06-10 19:46:10 UTC (rev 7543)
@@ -48,7 +48,7 @@
end
val (bindTycon, getTycon, getTycon', _) = make' (Tycon.layout, Tycon.plist)
- val (bindCon, getCon, getCon', _) = make' (Con.layout, Con.plist)
+ val (bindCon, getCon, _) = make (Con.layout, Con.plist)
val (bindVar, getVar, getVar', unbindVar) = make' (Var.layout, Var.plist)
fun getVars xs = Vector.foreach (xs, getVar)
val (bindLabel, getLabel, unbindLabel) = make (Label.layout, Label.plist)
@@ -108,16 +108,19 @@
| Call {func, args, ...} => (getFunc func; getVars args)
| Case {test, cases, default, ...} =>
let
- fun doitWord (ws, cases) =
+ fun doit (cases: ('a * 'b) vector,
+ equals: 'a * 'a -> bool,
+ hash: 'a -> word,
+ numExhaustiveCases: IntInf.t) =
let
- val table = HashSet.new {hash = WordX.hash}
+ val table = HashSet.new {hash = hash}
val _ =
Vector.foreach
(cases, fn (x, _) =>
let
val _ =
HashSet.insertIfNew
- (table, WordX.hash x, fn y => WordX.equals (x, y),
+ (table, hash x, fn y => equals (x, y),
fn () => x,
fn _ => Error.bug "Ssa.TypeCheck.loopTransfer: redundant branch in case")
in
@@ -125,37 +128,23 @@
end)
val numCases = Int.toIntInf (Vector.length cases)
in
- case (IntInf.equals (numCases, WordSize.cardinality ws), isSome default) of
+ case (IntInf.equals (numCases, numExhaustiveCases), isSome default) of
(true, true) =>
Error.bug "Ssa.TypeCheck.loopTransfer: exhaustive case has default"
| (false, false) =>
Error.bug "Ssa.TypeCheck.loopTransfer: non-exhaustive case has no default"
| _ => ()
end
+ fun doitWord (ws, cases) =
+ doit (cases, WordX.equals, WordX.hash, WordSize.cardinality ws)
fun doitCon cases =
let
- val numCons =
+ val numExhaustiveCases =
case Type.dest (getVar' test) of
- Type.Datatype t => getTycon' t
+ Type.Datatype t => Int.toIntInf (getTycon' t)
| _ => Error.bug "Ssa.TypeCheck.loopTransfer: case test is not a datatype"
- val cons = Array.array (numCons, false)
- val _ =
- Vector.foreach
- (cases, fn (con, _) =>
- let
- val i = getCon' con
- in
- if Array.sub (cons, i)
- then Error.bug "Ssa.TypeCheck.loopTransfer: redundant branch in case"
- else Array.update (cons, i, true)
- end)
in
- case (Array.forall (cons, fn b => b), isSome default) of
- (true, true) =>
- Error.bug "Ssa.TypeCheck.loopTransfer: exhaustive case has default"
- | (false, false) =>
- Error.bug "Ssa.TypeCheck.loopTransfer: non-exhaustive case has no default"
- | _ => ()
+ doit (cases, Con.equals, Con.hash, numExhaustiveCases)
end
val _ = getVar test
val _ =
@@ -212,11 +201,11 @@
val _ = Vector.foreach
(datatypes, fn Datatype.T {tycon, cons} =>
(bindTycon (tycon, Vector.length cons)
- ; Vector.foreachi (cons, fn (i, {con, ...}) =>
- bindCon (con, i))))
+ ; Vector.foreach (cons, fn {con, ...} =>
+ bindCon con)))
val _ = Vector.foreach
(datatypes, fn Datatype.T {cons, ...} =>
- Vector.foreach (cons, fn {args, ...} =>
+ Vector.foreach (cons, fn {args, ...} =>
Vector.foreach (args, loopType)))
val _ = Vector.foreach (globals, loopStatement)
val _ = List.foreach (functions, bindFunc o Function.name)
Modified: mlton/trunk/mlton/ssa/type-check2.fun
===================================================================
--- mlton/trunk/mlton/ssa/type-check2.fun 2011-06-10 19:46:06 UTC (rev 7542)
+++ mlton/trunk/mlton/ssa/type-check2.fun 2011-06-10 19:46:10 UTC (rev 7543)
@@ -49,7 +49,7 @@
end
val (bindTycon, getTycon, getTycon', _) = make' (Tycon.layout, Tycon.plist)
- val (bindCon, getCon, getCon', _) = make' (Con.layout, Con.plist)
+ val (bindCon, getCon, _) = make (Con.layout, Con.plist)
val (bindVar, getVar, getVar', unbindVar) = make' (Var.layout, Var.plist)
fun getVars xs = Vector.foreach (xs, getVar)
val (bindFunc, getFunc, _) = make (Func.layout, Func.plist)
@@ -132,57 +132,43 @@
| Call {func, args, ...} => (getFunc func; getVars args)
| Case {test, cases, default, ...} =>
let
- fun doitWord (ws, cases) =
+ fun doit (cases: ('a * 'b) vector,
+ equals: 'a * 'a -> bool,
+ hash: 'a -> word,
+ numExhaustiveCases: IntInf.t) =
let
- val table = HashSet.new {hash = WordX.hash}
+ val table = HashSet.new {hash = hash}
val _ =
Vector.foreach
(cases, fn (x, _) =>
let
val _ =
HashSet.insertIfNew
- (table, WordX.hash x, fn y => WordX.equals (x, y),
+ (table, hash x, fn y => equals (x, y),
fn () => x,
- fn _ => Error.bug "Ssa2.TypeCheck.loopTransfer: redundant branch in case")
+ fn _ => Error.bug "Ssa.TypeCheck.loopTransfer: redundant branch in case")
in
()
end)
val numCases = Int.toIntInf (Vector.length cases)
in
- case (IntInf.equals (numCases, WordSize.cardinality ws), isSome default) of
+ case (IntInf.equals (numCases, numExhaustiveCases), isSome default) of
(true, true) =>
- Error.bug "Ssa2.TypeCheck.loopTransfer: exhaustive case has default"
+ Error.bug "Ssa.TypeCheck.loopTransfer: exhaustive case has default"
| (false, false) =>
- Error.bug "Ssa2.TypeCheck.loopTransfer: non-exhaustive case has no default"
+ Error.bug "Ssa.TypeCheck.loopTransfer: non-exhaustive case has no default"
| _ => ()
end
+ fun doitWord (ws, cases) =
+ doit (cases, WordX.equals, WordX.hash, WordSize.cardinality ws)
fun doitCon cases =
let
- val numCons =
+ val numExhaustiveCases =
case Type.dest (getVar' test) of
- Type.Datatype t => getTycon' t
- | _ => Error.bug (concat
- ["Ssa2.TypeCheck2.loopTransfer: case test ",
- Var.toString test,
- " is not a datatype"])
- val cons = Array.array (numCons, false)
- val _ =
- Vector.foreach
- (cases, fn (con, _) =>
- let
- val i = getCon' con
- in
- if Array.sub (cons, i)
- then Error.bug "Ssa2.TypeCheck2.loopTransfer: redundant branch in case"
- else Array.update (cons, i, true)
- end)
+ Type.Datatype t => Int.toIntInf (getTycon' t)
+ | _ => Error.bug "Ssa.TypeCheck.loopTransfer: case test is not a datatype"
in
- case (Array.forall (cons, fn b => b), isSome default) of
- (true, true) =>
- Error.bug "Ssa2.TypeCheck2.loopTransfer: exhaustive case has default"
- | (false, false) =>
- Error.bug "Ssa2.TypeCheck2.loopTransfer: non-exhaustive case has no default"
- | _ => ()
+ doit (cases, Con.equals, Con.hash, numExhaustiveCases)
end
val _ = getVar test
val _ =
@@ -239,11 +225,11 @@
val _ = Vector.foreach
(datatypes, fn Datatype.T {tycon, cons} =>
(bindTycon (tycon, Vector.length cons)
- ; Vector.foreachi (cons, fn (i, {con, ...}) =>
- bindCon (con, i))))
+ ; Vector.foreach (cons, fn {con, ...} =>
+ bindCon con)))
val _ = Vector.foreach
(datatypes, fn Datatype.T {cons, ...} =>
- Vector.foreach (cons, fn {args, ...} =>
+ Vector.foreach (cons, fn {args, ...} =>
Prod.foreach (args, loopType)))
val _ = Vector.foreach (globals, loopStatement)
val _ = List.foreach (functions, bindFunc o Function.name)
|
|
From: Matthew F. <fl...@ml...> - 2011-06-10 12:46:08
|
Fixed bug in SSA/SSA2 type checking of case expressions over words.
Allow an SSA/SSA2 case expression over words to be exhaustive without
a default.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/mlton/ssa/type-check.fun
U mlton/trunk/mlton/ssa/type-check2.fun
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2011-06-10 19:46:02 UTC (rev 7541)
+++ mlton/trunk/doc/changelog 2011-06-10 19:46:06 UTC (rev 7542)
@@ -1,5 +1,9 @@
Here are the changes from version 2010608 to version YYYYMMDD.
+* 2011-06-10
+ - Fixed bug in SSA/SSA2 type checking of case expressions over
+ words.
+
* 2011-06-04
- Remove bytecode codegen.
- Remove support for .cm files as input.
Modified: mlton/trunk/mlton/ssa/type-check.fun
===================================================================
--- mlton/trunk/mlton/ssa/type-check.fun 2011-06-10 19:46:02 UTC (rev 7541)
+++ mlton/trunk/mlton/ssa/type-check.fun 2011-06-10 19:46:06 UTC (rev 7542)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009,2011 Matthew Fluet.
* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -108,27 +108,29 @@
| Call {func, args, ...} => (getFunc func; getVars args)
| Case {test, cases, default, ...} =>
let
- fun doit (cases: ('a * 'b) vector,
- equals: 'a * 'a -> bool,
- toWord: 'a -> word): unit =
+ fun doitWord (ws, cases) =
let
- val table = HashSet.new {hash = toWord}
+ val table = HashSet.new {hash = WordX.hash}
val _ =
Vector.foreach
(cases, fn (x, _) =>
let
- val _ =
+ val _ =
HashSet.insertIfNew
- (table, toWord x, fn y => equals (x, y),
- fn () => x,
+ (table, WordX.hash x, fn y => WordX.equals (x, y),
+ fn () => x,
fn _ => Error.bug "Ssa.TypeCheck.loopTransfer: redundant branch in case")
in
()
end)
+ val numCases = Int.toIntInf (Vector.length cases)
in
- if isSome default
- then ()
- else Error.bug "Ssa.TypeCheck.loopTransfer: case has no default"
+ case (IntInf.equals (numCases, WordSize.cardinality ws), isSome default) of
+ (true, true) =>
+ Error.bug "Ssa.TypeCheck.loopTransfer: exhaustive case has default"
+ | (false, false) =>
+ Error.bug "Ssa.TypeCheck.loopTransfer: non-exhaustive case has no default"
+ | _ => ()
end
fun doitCon cases =
let
@@ -159,8 +161,7 @@
val _ =
case cases of
Cases.Con cs => doitCon cs
- | Cases.Word (_, cs) =>
- doit (cs, WordX.equals, Word.fromIntInf o WordX.toIntInf)
+ | Cases.Word (ws, cs) => doitWord (ws, cs)
in
()
end
Modified: mlton/trunk/mlton/ssa/type-check2.fun
===================================================================
--- mlton/trunk/mlton/ssa/type-check2.fun 2011-06-10 19:46:02 UTC (rev 7541)
+++ mlton/trunk/mlton/ssa/type-check2.fun 2011-06-10 19:46:06 UTC (rev 7542)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009,2011 Matthew Fluet.
* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -132,27 +132,29 @@
| Call {func, args, ...} => (getFunc func; getVars args)
| Case {test, cases, default, ...} =>
let
- fun doit (cases: ('a * 'b) vector,
- equals: 'a * 'a -> bool,
- toWord: 'a -> word): unit =
+ fun doitWord (ws, cases) =
let
- val table = HashSet.new {hash = toWord}
+ val table = HashSet.new {hash = WordX.hash}
val _ =
Vector.foreach
(cases, fn (x, _) =>
let
- val _ =
+ val _ =
HashSet.insertIfNew
- (table, toWord x, fn y => equals (x, y),
- fn () => x,
- fn _ => Error.bug "Ssa2.TypeCheck2.loopTransfer: redundant branch in case")
+ (table, WordX.hash x, fn y => WordX.equals (x, y),
+ fn () => x,
+ fn _ => Error.bug "Ssa2.TypeCheck.loopTransfer: redundant branch in case")
in
()
end)
+ val numCases = Int.toIntInf (Vector.length cases)
in
- if isSome default
- then ()
- else Error.bug "Ssa2.TypeCheck2.loopTransfer: case has no default"
+ case (IntInf.equals (numCases, WordSize.cardinality ws), isSome default) of
+ (true, true) =>
+ Error.bug "Ssa2.TypeCheck.loopTransfer: exhaustive case has default"
+ | (false, false) =>
+ Error.bug "Ssa2.TypeCheck.loopTransfer: non-exhaustive case has no default"
+ | _ => ()
end
fun doitCon cases =
let
@@ -186,8 +188,7 @@
val _ =
case cases of
Cases.Con cs => doitCon cs
- | Cases.Word (_, cs) =>
- doit (cs, WordX.equals, Word.fromIntInf o WordX.toIntInf)
+ | Cases.Word (ws, cs) => doitWord (ws, cs)
in
()
end
|
|
From: Matthew F. <fl...@ml...> - 2011-06-10 12:46:05
|
Check sizes of word constants in case expressions in SSA and SSA2 ILs.
----------------------------------------------------------------------
U mlton/trunk/mlton/ssa/analyze.fun
U mlton/trunk/mlton/ssa/analyze2.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/ssa/analyze.fun
===================================================================
--- mlton/trunk/mlton/ssa/analyze.fun 2011-06-10 19:45:59 UTC (rev 7540)
+++ mlton/trunk/mlton/ssa/analyze.fun 2011-06-10 19:46:02 UTC (rev 7541)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -126,23 +127,34 @@
end
| Case {test, cases, default, ...} =>
- let val test = value test
+ let
+ val test = value test
fun ensureNullary j =
if 0 = Vector.length (labelValues j)
then ()
else Error.bug (concat ["Analyze.loopTransfer: Case:",
Label.toString j,
" must be nullary"])
- fun doit (s, cs, filter: 'a * 'b -> unit) =
- (filter (test, s)
- ; Vector.foreach (cs, fn (_, j) => ensureNullary j))
+ fun ensureSize (w, s) =
+ if WordSize.equals (s, WordX.size w)
+ then ()
+ else Error.bug (concat ["Analyze.loopTransfer: Case:",
+ WordX.toString w,
+ " must be size ",
+ WordSize.toString s])
+ fun doitWord (s, cs) =
+ (ignore (filterWord (test, s))
+ ; Vector.foreach (cs, fn (w, j) =>
+ (ensureSize (w, s)
+ ; ensureNullary j)))
+ fun doitCon cs =
+ Vector.foreach (cs, fn (c, j) =>
+ filter (test, c, labelValues j))
datatype z = datatype Cases.t
val _ =
case cases of
- Con cases =>
- Vector.foreach (cases, fn (c, j) =>
- filter (test, c, labelValues j))
- | Word (s, cs) => doit (s, cs, filterWord)
+ Con cs => doitCon cs
+ | Word (s, cs) => doitWord (s, cs)
val _ = Option.app (default, ensureNullary)
in ()
end
Modified: mlton/trunk/mlton/ssa/analyze2.fun
===================================================================
--- mlton/trunk/mlton/ssa/analyze2.fun 2011-06-10 19:45:59 UTC (rev 7540)
+++ mlton/trunk/mlton/ssa/analyze2.fun 2011-06-10 19:46:02 UTC (rev 7541)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -123,35 +124,46 @@
end
| Case {test, cases, default, ...} =>
- let val test = value test
+ let
+ val test = value test
+ fun ensureSize (w, s) =
+ if WordSize.equals (s, WordX.size w)
+ then ()
+ else Error.bug (concat ["Analyze.loopTransfer: Case:",
+ WordX.toString w,
+ " must be size ",
+ WordSize.toString s])
fun ensureNullary j =
if 0 = Vector.length (labelValues j)
then ()
else Error.bug (concat ["Analyze2.loopTransfer: Case:",
Label.toString j,
" must be nullary"])
- fun doit (s, cs, filter: 'a * 'b -> unit) =
- (filter (test, s)
- ; Vector.foreach (cs, fn (_, j) => ensureNullary j))
+ fun doitWord (s, cs) =
+ (ignore (filterWord (test, s))
+ ; Vector.foreach (cs, fn (w, j) =>
+ (ensureSize (w, s)
+ ; ensureNullary j)))
+ fun doitCon cs =
+ Vector.foreach
+ (cs, fn (c, j) =>
+ let
+ val v = labelValues j
+ val variant =
+ case Vector.length v of
+ 0 => NONE
+ | 1 => SOME (Vector.sub (v, 0))
+ | _ => Error.bug "Analyze2.loopTransfer: Case:conApp with >1 arg"
+ in
+ filter {con = c,
+ test = test,
+ variant = variant}
+ end)
datatype z = datatype Cases.t
val _ =
case cases of
- Con cases =>
- Vector.foreach
- (cases, fn (c, j) =>
- let
- val v = labelValues j
- val variant =
- case Vector.length v of
- 0 => NONE
- | 1 => SOME (Vector.sub (v, 0))
- | _ => Error.bug "Analyze2.loopTransfer: Case:conApp with >1 arg"
- in
- filter {con = c,
- test = test,
- variant = variant}
- end)
- | Word (s, cs) => doit (s, cs, filterWord)
+ Con cs => doitCon cs
+ | Word (s, cs) => doitWord (s, cs)
val _ = Option.app (default, ensureNullary)
in ()
end
|
|
From: Matthew F. <fl...@ml...> - 2011-06-10 12:46:00
|
Regression tests with case expressions over weird-sized words.
These regression tests demonstrate bugs with the handling of case
expressions over weird-sized words.
The weird-word1.sml regression test includes a case expression that
enumerates 16 (of the 32) elements of Word5.word. This test triggers
errors in the codegens and also an internal type error in the RSSA IL
program. The root cause is that the constants in a case expression
over weird-sized words are not rounded up to primitive-sized words in
the SSA to RSSA conversion.
[mtf@fenrir regression]$ mlton -codegen native weird-word1.sml
WordX.mod
[mtf@fenrir regression]$ mlton -codegen c weird-word1.sml
WordSize.prim
[mtf@fenrir regression]$ mlton -type-check true weird-word1.sml
invalid transfer: switch {test = x_0,
default = Some L_0,
cases = ((0x0, L_16),
(0x1, L_15),
(0x2, L_14),
(0x3, L_13),
(0x4, L_12),
(0x5, L_11),
(0x6, L_10),
(0x7, L_9),
(0x8, L_8),
(0x9, L_7),
(0xA, L_6),
(0xB, L_5),
(0xC, L_4),
(0xD, L_3),
(0xE, L_2),
(0xF, L_1))}
invalid block: L_17 (x_0: [Word5, Bits3]) Jump =
switch {test = x_0,
default = Some L_0,
cases = ((0x0, L_16),
(0x1, L_15),
(0x2, L_14),
(0x3, L_13),
(0x4, L_12),
(0x5, L_11),
(0x6, L_10),
(0x7, L_9),
(0x8, L_8),
(0x9, L_7),
(0xA, L_6),
(0xB, L_5),
(0xC, L_4),
(0xD, L_3),
(0xE, L_2),
(0xF, L_1))}
Rssa.typeCheck
The weird-word2.sml regression test includes a case expression that
enumerates 32 (of the 32) elements of Word5.word. This test triggers
internal type errors in the SSA and SSA2 IL programs. The root cause
is that the SSA and SSA2 type checkers demand a default case for all
case expressions over words.
[mtf@fenrir regression]$ mlton weird-word2.sml
Ssa.TypeCheck.loopTransfer: case has no default
[mtf@fenrir regression]$ mlton -type-check true weird-word2.sml
Ssa.TypeCheck.loopTransfer: case has no default
----------------------------------------------------------------------
A mlton/trunk/regression/weird-word1.ok
A mlton/trunk/regression/weird-word1.sml
A mlton/trunk/regression/weird-word2.ok
A mlton/trunk/regression/weird-word2.sml
----------------------------------------------------------------------
Added: mlton/trunk/regression/weird-word1.ok
===================================================================
--- mlton/trunk/regression/weird-word1.ok 2011-06-10 19:45:57 UTC (rev 7539)
+++ mlton/trunk/regression/weird-word1.ok 2011-06-10 19:45:59 UTC (rev 7540)
@@ -0,0 +1 @@
+0wx8
Added: mlton/trunk/regression/weird-word1.sml
===================================================================
--- mlton/trunk/regression/weird-word1.sml 2011-06-10 19:45:57 UTC (rev 7539)
+++ mlton/trunk/regression/weird-word1.sml 2011-06-10 19:45:59 UTC (rev 7540)
@@ -0,0 +1,26 @@
+fun fib (w: Word5.word) : Word5.word =
+ if w <= 0wx1
+ then 0wx1
+ else fib (w - 0wx1) + fib (w - 0wx2)
+
+val s =
+ case (fib 0wx5) of
+ 0wx0 => "0wx0"
+ | 0wx1 => "0wx1"
+ | 0wx2 => "0wx2"
+ | 0wx3 => "0wx3"
+ | 0wx4 => "0wx4"
+ | 0wx5 => "0wx5"
+ | 0wx6 => "0wx6"
+ | 0wx7 => "0wx7"
+ | 0wx8 => "0wx8"
+ | 0wx9 => "0wx9"
+ | 0wxA => "0wxA"
+ | 0wxB => "0wxB"
+ | 0wxC => "0wxC"
+ | 0wxD => "0wxD"
+ | 0wxE => "0wxE"
+ | 0wxF => "0wxF"
+ | _ => "zzz"
+
+val _ = print (concat [s, "\n"])
Added: mlton/trunk/regression/weird-word2.ok
===================================================================
--- mlton/trunk/regression/weird-word2.ok 2011-06-10 19:45:57 UTC (rev 7539)
+++ mlton/trunk/regression/weird-word2.ok 2011-06-10 19:45:59 UTC (rev 7540)
@@ -0,0 +1 @@
+0wx8
Added: mlton/trunk/regression/weird-word2.sml
===================================================================
--- mlton/trunk/regression/weird-word2.sml 2011-06-10 19:45:57 UTC (rev 7539)
+++ mlton/trunk/regression/weird-word2.sml 2011-06-10 19:45:59 UTC (rev 7540)
@@ -0,0 +1,41 @@
+fun fib (w: Word5.word) : Word5.word =
+ if w <= 0wx1
+ then 0wx1
+ else fib (w - 0wx1) + fib (w - 0wx2)
+
+val s =
+ case (fib 0wx5) of
+ 0wx0 => "0wx0"
+ | 0wx1 => "0wx1"
+ | 0wx2 => "0wx2"
+ | 0wx3 => "0wx3"
+ | 0wx4 => "0wx4"
+ | 0wx5 => "0wx5"
+ | 0wx6 => "0wx6"
+ | 0wx7 => "0wx7"
+ | 0wx8 => "0wx8"
+ | 0wx9 => "0wx9"
+ | 0wxA => "0wxA"
+ | 0wxB => "0wxB"
+ | 0wxC => "0wxC"
+ | 0wxD => "0wxD"
+ | 0wxE => "0wxE"
+ | 0wxF => "0wxF"
+ | 0wx10 => "0wx10"
+ | 0wx11 => "0wx11"
+ | 0wx12 => "0wx12"
+ | 0wx13 => "0wx13"
+ | 0wx14 => "0wx14"
+ | 0wx15 => "0wx15"
+ | 0wx16 => "0wx16"
+ | 0wx17 => "0wx17"
+ | 0wx18 => "0wx18"
+ | 0wx19 => "0wx19"
+ | 0wx1A => "0wx1A"
+ | 0wx1B => "0wx1B"
+ | 0wx1C => "0wx1C"
+ | 0wx1D => "0wx1D"
+ | 0wx1E => "0wx1E"
+ | 0wx1F => "0wx1F"
+
+val _ = print (concat [s, "\n"])
|
|
From: Matthew F. <fl...@ml...> - 2011-06-10 12:45:58
|
Force gdtoa/README to be up-to-date. ---------------------------------------------------------------------- U mlton/trunk/runtime/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/runtime/Makefile =================================================================== --- mlton/trunk/runtime/Makefile 2011-06-04 14:34:36 UTC (rev 7538) +++ mlton/trunk/runtime/Makefile 2011-06-10 19:45:57 UTC (rev 7539) @@ -270,6 +270,7 @@ patch -s -p0 <gdtoa-patch patch -s -p0 <gdtoa-patch.internal patch -s -p0 <gdtoa-patch.mlton + @touch $@ $(GDTOACFILES): gdtoa/README @touch $@ |
|
From: Matthew F. <fl...@ml...> - 2011-06-04 07:34:48
|
Upgrade gdtoa.tgz
----------------------------------------------------------------------
U mlton/trunk/runtime/Makefile
U mlton/trunk/runtime/gdtoa-patch
U mlton/trunk/runtime/gdtoa-patch.internal
U mlton/trunk/runtime/gdtoa-patch.mlton
U mlton/trunk/runtime/gdtoa.tgz
----------------------------------------------------------------------
Modified: mlton/trunk/runtime/Makefile
===================================================================
--- mlton/trunk/runtime/Makefile 2011-06-04 14:34:05 UTC (rev 7537)
+++ mlton/trunk/runtime/Makefile 2011-06-04 14:34:36 UTC (rev 7538)
@@ -265,26 +265,38 @@
all: $(ALL)
-gdtoa/arithchk.c: gdtoa.tgz gdtoa-patch gdtoa-patch.internal gdtoa-patch.mlton
+gdtoa/README: gdtoa.tgz gdtoa-patch gdtoa-patch.internal gdtoa-patch.mlton
gzip -dc gdtoa.tgz | tar xf -
patch -s -p0 <gdtoa-patch
patch -s -p0 <gdtoa-patch.internal
patch -s -p0 <gdtoa-patch.mlton
-$(GDTOACFILES): gdtoa/arithchk.c
+$(GDTOACFILES): gdtoa/README
@touch $@
+gdtoa/arithchk.c: gdtoa/README
+ @touch $@
+
gdtoa/arithchk.out: gdtoa/arithchk.c
cd gdtoa && $(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -w -O1 -o arithchk.out arithchk.c
gdtoa/arith.h: gdtoa/arithchk.out
cd gdtoa && ./arithchk.out >arith.h
-gdtoa/%-pic.o: gdtoa/%.c gdtoa/arith.h
+gdtoa/qnan.c: gdtoa/README
+ @touch $@
+
+gdtoa/qnan.out: gdtoa/arith.h gdtoa/qnan.c
+ cd gdtoa && $(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -w -O1 -o qnan.out qnan.c
+
+gdtoa/gd_qnan.h: gdtoa/qnan.out
+ cd gdtoa && ./qnan.out >gd_qnan.h
+
+gdtoa/%-pic.o: gdtoa/%.c gdtoa/arith.h gdtoa/gd_qnan.h
$(CC) $(PICCFLAGS) $(PICWARNCFLAGS) -w -DINFNAN_CHECK -c -o $@ $<
-gdtoa/%-gdb.o: gdtoa/%.c gdtoa/arith.h
+gdtoa/%-gdb.o: gdtoa/%.c gdtoa/arith.h gdtoa/gd_qnan.h
$(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -w -DINFNAN_CHECK -c -o $@ $<
-gdtoa/%.o: gdtoa/%.c gdtoa/arith.h
+gdtoa/%.o: gdtoa/%.c gdtoa/arith.h gdtoa/gd_qnan.h
$(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -w -DINFNAN_CHECK -c -o $@ $<
libgdtoa.a: $(GDTOA_OBJS)
Modified: mlton/trunk/runtime/gdtoa-patch
===================================================================
--- mlton/trunk/runtime/gdtoa-patch 2011-06-04 14:34:05 UTC (rev 7537)
+++ mlton/trunk/runtime/gdtoa-patch 2011-06-04 14:34:36 UTC (rev 7538)
@@ -1,918 +1,1119 @@
-diff -u gdtoa.orig/arithchk.c gdtoa/arithchk.c
---- gdtoa.orig/arithchk.c 1998-06-19 20:46:11 +0000
-+++ gdtoa/arithchk.c 2008-10-04 02:01:43 +0000
-@@ -136,7 +136,7 @@
- return b == 0.;
- }
-
--main()
-+int main()
- {
- Akind *a = 0;
- int Ldef = 0;
-diff -u gdtoa.orig/dmisc.c gdtoa/dmisc.c
---- gdtoa.orig/dmisc.c 1998-11-02 19:34:31 +0000
-+++ gdtoa/dmisc.c 2008-10-04 02:01:43 +0000
-@@ -89,9 +89,9 @@
-
- void
- #ifdef KR_headers
--freedtoa(s) char *s;
-+gdtoa__freedtoa(s) char *s;
- #else
--freedtoa(char *s)
-+gdtoa__freedtoa(char *s)
- #endif
- {
- Bigint *b = (Bigint *)((int *)s - 1);
-diff -u gdtoa.orig/dtoa.c gdtoa/dtoa.c
---- gdtoa.orig/dtoa.c 2000-11-02 15:09:01 +0000
-+++ gdtoa/dtoa.c 2008-10-04 02:01:43 +0000
-@@ -80,7 +80,7 @@
- #endif
-
- char *
--dtoa
-+gdtoa__dtoa
- #ifdef KR_headers
- (d, mode, ndigits, decpt, sign, rve)
- double d; int mode, ndigits, *decpt, *sign; char **rve;
-@@ -142,7 +142,7 @@
-
- #ifndef MULTIPLE_THREADS
- if (dtoa_result) {
-- freedtoa(dtoa_result);
-+ gdtoa__freedtoa(dtoa_result);
- dtoa_result = 0;
- }
- #endif
-diff -u gdtoa.orig/g_Qfmt.c gdtoa/g_Qfmt.c
---- gdtoa.orig/g_Qfmt.c 2000-11-01 15:21:10 +0000
-+++ gdtoa/g_Qfmt.c 2008-10-04 02:01:43 +0000
-@@ -57,9 +57,9 @@
-
- char*
- #ifdef KR_headers
--g_Qfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
-+gdtoa__g_Qfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
- #else
--g_Qfmt(char *buf, void *V, int ndig, unsigned bufsize)
-+gdtoa__g_Qfmt(char *buf, void *V, int ndig, unsigned bufsize)
- #endif
- {
- static FPI fpi = { 113, 1-16383-113+1, 32766 - 16383 - 113 + 1, 1, 0 };
-@@ -115,6 +115,6 @@
- return 0;
- mode = 0;
- }
-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
- return g__fmt(buf, s, se, decpt, sign);
- }
-diff -u gdtoa.orig/g__fmt.c gdtoa/g__fmt.c
---- gdtoa.orig/g__fmt.c 2003-03-21 20:59:43 +0000
-+++ gdtoa/g__fmt.c 2008-10-04 02:01:43 +0000
-@@ -96,6 +96,6 @@
- *b++ = '0';
- *b = 0;
- }
-- freedtoa(s0);
-+ gdtoa__freedtoa(s0);
- return b;
+diff -P -C 2 -r gdtoa/dmisc.c gdtoa-new/dmisc.c
+*** gdtoa/dmisc.c 2004-04-11 23:39:50.000000000 -0400
+--- gdtoa-new/dmisc.c 2011-05-27 17:09:13.940030010 -0400
+***************
+*** 84,90 ****
+ void
+ #ifdef KR_headers
+! freedtoa(s) char *s;
+ #else
+! freedtoa(char *s)
+ #endif
+ {
+--- 84,90 ----
+ void
+ #ifdef KR_headers
+! gdtoa__freedtoa(s) char *s;
+ #else
+! gdtoa__freedtoa(char *s)
+ #endif
+ {
+diff -P -C 2 -r gdtoa/dtoa.c gdtoa-new/dtoa.c
+*** gdtoa/dtoa.c 2010-09-15 10:59:11.000000000 -0400
+--- gdtoa-new/dtoa.c 2011-05-27 17:09:13.940030010 -0400
+***************
+*** 74,78 ****
+
+ char *
+! dtoa
+ #ifdef KR_headers
+ (d0, mode, ndigits, decpt, sign, rve)
+--- 74,78 ----
+
+ char *
+! gdtoa__dtoa
+ #ifdef KR_headers
+ (d0, mode, ndigits, decpt, sign, rve)
+***************
+*** 147,151 ****
+ #ifndef MULTIPLE_THREADS
+ if (dtoa_result) {
+! freedtoa(dtoa_result);
+ dtoa_result = 0;
+ }
+--- 147,151 ----
+ #ifndef MULTIPLE_THREADS
+ if (dtoa_result) {
+! gdtoa__freedtoa(dtoa_result);
+ dtoa_result = 0;
+ }
+diff -P -C 2 -r gdtoa/g_ddfmt.c gdtoa-new/g_ddfmt.c
+*** gdtoa/g_ddfmt.c 2009-04-11 23:11:05.000000000 -0400
+--- gdtoa-new/g_ddfmt.c 2011-05-27 17:09:13.940030010 -0400
+***************
+*** 34,40 ****
+ char *
+ #ifdef KR_headers
+! g_ddfmt(buf, dd0, ndig, bufsize) char *buf; double *dd0; int ndig; size_t bufsize;
+ #else
+! g_ddfmt(char *buf, double *dd0, int ndig, size_t bufsize)
+ #endif
+ {
+--- 34,40 ----
+ char *
+ #ifdef KR_headers
+! gdtoa__g_ddfmt(buf, dd0, ndig, bufsize) char *buf; double *dd0; int ndig; size_t bufsize;
+ #else
+! gdtoa__g_ddfmt(char *buf, double *dd0, int ndig, size_t bufsize)
+ #endif
+ {
+***************
+*** 164,168 ****
+ fpi.sudden_underflow = 0;
+ i = STRTOG_Normal;
+! s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ b = g__fmt(buf, s, se, decpt, z->sign, bufsize);
+ Bfree(z);
+--- 164,168 ----
+ fpi.sudden_underflow = 0;
+ i = STRTOG_Normal;
+! s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ b = g__fmt(buf, s, se, decpt, z->sign, bufsize);
+ Bfree(z);
+diff -P -C 2 -r gdtoa/g_dfmt.c gdtoa-new/g_dfmt.c
+*** gdtoa/g_dfmt.c 2010-07-08 23:38:41.000000000 -0400
+--- gdtoa-new/g_dfmt.c 2011-05-27 17:09:13.940030010 -0400
+***************
+*** 34,40 ****
+ char*
+ #ifdef KR_headers
+! g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; size_t bufsize;
+ #else
+! g_dfmt(char *buf, double *d, int ndig, size_t bufsize)
+ #endif
+ {
+--- 34,40 ----
+ char*
+ #ifdef KR_headers
+! gdtoa__g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; size_t bufsize;
+ #else
+! gdtoa__g_dfmt(char *buf, double *d, int ndig, size_t bufsize)
+ #endif
+ {
+***************
+*** 91,95 ****
+ if (sign)
+ i = STRTOG_Normal | STRTOG_Neg;
+! s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
}
-diff -u gdtoa.orig/g_ddfmt.c gdtoa/g_ddfmt.c
---- gdtoa.orig/g_ddfmt.c 1998-09-09 12:09:31 +0000
-+++ gdtoa/g_ddfmt.c 2008-10-04 02:01:43 +0000
-@@ -40,9 +40,9 @@
-
- char *
- #ifdef KR_headers
--g_ddfmt(buf, dd, ndig, bufsize) char *buf; double *dd; int ndig; unsigned bufsize;
-+gdtoa__g_ddfmt(buf, dd, ndig, bufsize) char *buf; double *dd; int ndig; unsigned bufsize;
- #else
--g_ddfmt(char *buf, double *dd, int ndig, unsigned bufsize)
-+gdtoa__g_ddfmt(char *buf, double *dd, int ndig, unsigned bufsize)
- #endif
- {
- FPI fpi;
-@@ -154,7 +154,7 @@
- fpi.rounding = FPI_Round_near;
- fpi.sudden_underflow = 0;
- i = STRTOG_Normal;
-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
- b = g__fmt(buf, s, se, decpt, z->sign);
- Bfree(z);
- return b;
-diff -u gdtoa.orig/g_dfmt.c gdtoa/g_dfmt.c
---- gdtoa.orig/g_dfmt.c 1998-09-09 14:18:15 +0000
-+++ gdtoa/g_dfmt.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- char*
- #ifdef KR_headers
--g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; unsigned bufsize;
-+gdtoa__g_dfmt(buf, d, ndig, bufsize) char *buf; double *d; int ndig; unsigned bufsize;
- #else
--g_dfmt(char *buf, double *d, int ndig, unsigned bufsize)
-+gdtoa__g_dfmt(char *buf, double *d, int ndig, unsigned bufsize)
- #endif
- {
- static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
-@@ -90,6 +90,6 @@
- mode = 0;
- }
- i = STRTOG_Normal;
-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
- return g__fmt(buf, s, se, decpt, sign);
- }
-diff -u gdtoa.orig/g_ffmt.c gdtoa/g_ffmt.c
---- gdtoa.orig/g_ffmt.c 1998-09-12 20:39:39 +0000
-+++ gdtoa/g_ffmt.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- char*
- #ifdef KR_headers
--g_ffmt(buf, f, ndig, bufsize) char *buf; float *f; int ndig; unsigned bufsize;
-+gdtoa__g_ffmt(buf, f, ndig, bufsize) char *buf; float *f; int ndig; unsigned bufsize;
- #else
--g_ffmt(char *buf, float *f, int ndig, unsigned bufsize)
-+gdtoa__g_ffmt(char *buf, float *f, int ndig, unsigned bufsize)
- #endif
- {
- static FPI fpi = { 24, 1-127-24+1, 254-127-24+1, 1, 0 };
-@@ -89,6 +89,6 @@
- mode = 0;
- }
- i = STRTOG_Normal;
-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
- return g__fmt(buf, s, se, decpt, sign);
- }
-diff -u gdtoa.orig/g_xLfmt.c gdtoa/g_xLfmt.c
---- gdtoa.orig/g_xLfmt.c 1998-09-09 16:35:43 +0000
-+++ gdtoa/g_xLfmt.c 2008-10-04 02:01:43 +0000
-@@ -55,9 +55,9 @@
-
- char*
- #ifdef KR_headers
--g_xLfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
-+gdtoa__g_xLfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
- #else
--g_xLfmt(char *buf, void *V, int ndig, unsigned bufsize)
-+gdtoa__g_xLfmt(char *buf, void *V, int ndig, unsigned bufsize)
- #endif
- {
- static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, 0 };
-@@ -109,6 +109,6 @@
- return 0;
- mode = 0;
- }
-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
- return g__fmt(buf, s, se, decpt, sign);
- }
-diff -u gdtoa.orig/g_xfmt.c gdtoa/g_xfmt.c
---- gdtoa.orig/g_xfmt.c 1998-09-09 13:59:17 +0000
-+++ gdtoa/g_xfmt.c 2008-10-04 02:01:43 +0000
-@@ -59,9 +59,9 @@
-
- char*
- #ifdef KR_headers
--g_xfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
-+gdtoa__g_xfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; unsigned bufsize;
- #else
--g_xfmt(char *buf, void *V, int ndig, unsigned bufsize)
-+gdtoa__g_xfmt(char *buf, void *V, int ndig, unsigned bufsize)
- #endif
- {
- static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, 0 };
-@@ -114,6 +114,6 @@
- return 0;
- mode = 0;
- }
-- s = gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
-+ s = gdtoa__gdtoa(&fpi, ex, bits, &i, mode, ndig, &decpt, &se);
- return g__fmt(buf, s, se, decpt, sign);
- }
-Only in gdtoa: gdtoa
-diff -u gdtoa.orig/gdtoa.c gdtoa/gdtoa.c
---- gdtoa.orig/gdtoa.c 1999-09-21 04:22:19 +0000
-+++ gdtoa/gdtoa.c 2008-10-04 02:01:43 +0000
-@@ -115,7 +115,7 @@
- */
-
- char *
--gdtoa
-+gdtoa__gdtoa
- #ifdef KR_headers
- (fpi, be, bits, kindp, mode, ndigits, decpt, rve)
- FPI *fpi; int be; ULong *bits;
-@@ -168,7 +168,7 @@
-
- #ifndef MULTIPLE_THREADS
- if (dtoa_result) {
-- freedtoa(dtoa_result);
-+ gdtoa__freedtoa(dtoa_result);
- dtoa_result = 0;
- }
- #endif
-diff -u gdtoa.orig/gdtoa.h gdtoa/gdtoa.h
---- gdtoa.orig/gdtoa.h 2000-11-01 15:01:39 +0000
-+++ gdtoa/gdtoa.h 2008-10-04 02:01:43 +0000
-@@ -108,49 +108,49 @@
- extern "C" {
- #endif
-
--extern char* dtoa ANSI((double d, int mode, int ndigits, int *decpt,
-+extern char* gdtoa__dtoa ANSI((double d, int mode, int ndigits, int *decpt,
- int *sign, char **rve));
--extern char* gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
-+extern char* gdtoa__gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
- int mode, int ndigits, int *decpt, char **rve));
--extern void freedtoa ANSI((char*));
--extern float strtof ANSI((CONST char *, char **));
--extern double strtod ANSI((CONST char *, char **));
--extern int strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
-+extern void gdtoa__freedtoa ANSI((char*));
-+extern float gdtoa__strtof ANSI((CONST char *, char **));
-+extern double gdtoa__strtod ANSI((CONST char *, char **));
-+extern int gdtoa__strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
-
--extern char* g_ddfmt ANSI((char*, double*, int, unsigned));
--extern char* g_dfmt ANSI((char*, double*, int, unsigned));
--extern char* g_ffmt ANSI((char*, float*, int, unsigned));
--extern char* g_Qfmt ANSI((char*, void*, int, unsigned));
--extern char* g_xfmt ANSI((char*, void*, int, unsigned));
--extern char* g_xLfmt ANSI((char*, void*, int, unsigned));
-+extern char* gdtoa__g_ddfmt ANSI((char*, double*, int, unsigned));
-+extern char* gdtoa__g_dfmt ANSI((char*, double*, int, unsigned));
-+extern char* gdtoa__g_ffmt ANSI((char*, float*, int, unsigned));
-+extern char* gdtoa__g_Qfmt ANSI((char*, void*, int, unsigned));
-+extern char* gdtoa__g_xfmt ANSI((char*, void*, int, unsigned));
-+extern char* gdtoa__g_xLfmt ANSI((char*, void*, int, unsigned));
-
--extern int strtoId ANSI((CONST char*, char**, double*, double*));
--extern int strtoIdd ANSI((CONST char*, char**, double*, double*));
--extern int strtoIf ANSI((CONST char*, char**, float*, float*));
--extern int strtoIQ ANSI((CONST char*, char**, void*, void*));
--extern int strtoIx ANSI((CONST char*, char**, void*, void*));
--extern int strtoIxL ANSI((CONST char*, char**, void*, void*));
--extern int strtord ANSI((CONST char*, char**, int, double*));
--extern int strtordd ANSI((CONST char*, char**, int, double*));
--extern int strtorf ANSI((CONST char*, char**, int, float*));
--extern int strtorQ ANSI((CONST char*, char**, int, void*));
--extern int strtorx ANSI((CONST char*, char**, int, void*));
--extern int strtorxL ANSI((CONST char*, char**, int, void*));
-+extern int gdtoa__strtoId ANSI((CONST char*, char**, double*, double*));
-+extern int gdtoa__strtoIdd ANSI((CONST char*, char**, double*, double*));
-+extern int gdtoa__strtoIf ANSI((CONST char*, char**, float*, float*));
-+extern int gdtoa__strtoIQ ANSI((CONST char*, char**, void*, void*));
-+extern int gdtoa__strtoIx ANSI((CONST char*, char**, void*, void*));
-+extern int gdtoa__strtoIxL ANSI((CONST char*, char**, void*, void*));
-+extern int gdtoa__strtord ANSI((CONST char*, char**, int, double*));
-+extern int gdtoa__strtordd ANSI((CONST char*, char**, int, double*));
-+extern int gdtoa__strtorf ANSI((CONST char*, char**, int, float*));
-+extern int gdtoa__strtorQ ANSI((CONST char*, char**, int, void*));
-+extern int gdtoa__strtorx ANSI((CONST char*, char**, int, void*));
-+extern int gdtoa__strtorxL ANSI((CONST char*, char**, int, void*));
- #if 1
--extern int strtodI ANSI((CONST char*, char**, double*));
--extern int strtopd ANSI((CONST char*, char**, double*));
--extern int strtopdd ANSI((CONST char*, char**, double*));
--extern int strtopf ANSI((CONST char*, char**, float*));
--extern int strtopQ ANSI((CONST char*, char**, void*));
--extern int strtopx ANSI((CONST char*, char**, void*));
--extern int strtopxL ANSI((CONST char*, char**, void*));
-+extern int gdtoa__strtodI ANSI((CONST char*, char**, double*));
-+extern int gdtoa__strtopd ANSI((CONST char*, char**, double*));
-+extern int gdtoa__strtopdd ANSI((CONST char*, char**, double*));
-+extern int gdtoa__strtopf ANSI((CONST char*, char**, float*));
-+extern int gdtoa__strtopQ ANSI((CONST char*, char**, void*));
-+extern int gdtoa__strtopx ANSI((CONST char*, char**, void*));
-+extern int gdtoa__strtopxL ANSI((CONST char*, char**, void*));
- #else
--#define strtopd(s,se,x) strtord(s,se,1,x)
--#define strtopdd(s,se,x) strtordd(s,se,1,x)
--#define strtopf(s,se,x) strtorf(s,se,1,x)
--#define strtopQ(s,se,x) strtorQ(s,se,1,x)
--#define strtopx(s,se,x) strtorx(s,se,1,x)
--#define strtopxL(s,se,x) strtorxL(s,se,1,x)
-+#define gdtoa__strtopd(s,se,x) gdtoa__strtord(s,se,1,x)
-+#define gdtoa__strtopdd(s,se,x) gdtoa__strtordd(s,se,1,x)
-+#define gdtoa__strtopf(s,se,x) gdtoa__strtorf(s,se,1,x)
-+#define gdtoa__strtopQ(s,se,x) gdtoa__strtorQ(s,se,1,x)
-+#define gdtoa__strtopx(s,se,x) gdtoa__strtorx(s,se,1,x)
-+#define gdtoa__strtopxL(s,se,x) gdtoa__strtorxL(s,se,1,x)
- #endif
-
- #ifdef __cplusplus
-diff -u gdtoa.orig/gdtoaimp.h gdtoa/gdtoaimp.h
---- gdtoa.orig/gdtoaimp.h 2000-11-02 15:09:01 +0000
-+++ gdtoa/gdtoaimp.h 2008-10-04 02:24:16 +0000
-@@ -267,7 +267,7 @@
- Exactly one of IEEE_8087, IEEE_MC68k, VAX, or IBM should be defined.
- #endif
-
--typedef union { double d; ULong L[2]; } U;
-+typedef union { double d; ULong L[2]; } __attribute__((__may_alias__)) U;
-
- #ifdef YES_ALIAS
- #define dval(x) x
-@@ -502,6 +502,7 @@
- #define g__fmt g__fmt_D2A
- #define gethex gethex_D2A
- #define hexdig hexdig_D2A
-+#define hexdig_init hexdig_init_D2A
- #define hexnan hexnan_D2A
- #define hi0bits hi0bits_D2A
- #define i2b i2b_D2A
-@@ -551,7 +552,7 @@
- int *decpt, int *sign, char **rve));
- extern char *g__fmt ANSI((char*, char*, char*, int, ULong));
- extern int gethex ANSI((CONST char**, FPI*, Long*, Bigint**, int));
-- extern void hexdig_init_D2A(Void);
-+ extern void hexdig_init ANSI((Void));
- extern int hexnan ANSI((CONST char**, FPI*, ULong*));
- extern int hi0bits ANSI((ULong));
- extern Bigint *i2b ANSI((int));
-@@ -570,8 +571,8 @@
- extern Bigint *s2b ANSI((CONST char*, int, int, ULong));
- extern Bigint *set_ones ANSI((Bigint*, int));
- extern char *strcp ANSI((char*, const char*));
-- extern int strtoIg ANSI((CONST char*, char**, FPI*, Long*, Bigint**, int*));
-- extern double strtod ANSI((const char *s00, char **se));
-+ extern int gdtoa__strtoIg ANSI((CONST char*, char**, FPI*, Long*, Bigint**, int*));
-+ extern double gdtoa__strtod ANSI((const char *s00, char **se));
- extern Bigint *sum ANSI((Bigint*, Bigint*));
- extern int trailz ANSI((Bigint*));
- extern double ulp ANSI((double));
-diff -u gdtoa.orig/gethex.c gdtoa/gethex.c
---- gdtoa.orig/gethex.c 2003-03-26 20:33:08 +0000
-+++ gdtoa/gethex.c 2008-10-04 02:24:16 +0000
-@@ -57,7 +57,7 @@
- #endif
-
- if (!hexdig['0'])
-- hexdig_init_D2A();
-+ hexdig_init();
- havedig = 0;
- s0 = *(CONST unsigned char **)sp + 2;
- while(s0[havedig] == '0')
-diff -u gdtoa.orig/hd_init.c gdtoa/hd_init.c
---- gdtoa.orig/hd_init.c 2000-11-03 01:45:35 +0000
-+++ gdtoa/hd_init.c 2008-10-04 02:24:16 +0000
-@@ -52,7 +52,7 @@
- }
-
- void
--hexdig_init_D2A(Void)
-+hexdig_init(Void)
- {
- #define USC (unsigned char *)
- htinit(hexdig, USC "0123456789", 0x10);
-diff -u gdtoa.orig/hexnan.c gdtoa/hexnan.c
---- gdtoa.orig/hexnan.c 2000-11-03 01:44:38 +0000
-+++ gdtoa/hexnan.c 2008-10-04 02:24:16 +0000
-@@ -68,7 +68,7 @@
- int havedig, hd0, i, nbits;
-
- if (!hexdig['0'])
-- hexdig_init_D2A();
-+ hexdig_init();
- nbits = fpi->nbits;
- x = x0 + (nbits >> kshift);
- if (nbits & kmask)
-diff -u gdtoa.orig/strtoIQ.c gdtoa/strtoIQ.c
---- gdtoa.orig/strtoIQ.c 1998-06-22 18:49:25 +0000
-+++ gdtoa/strtoIQ.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtoIQ(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
-+gdtoa__strtoIQ(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
- #else
--strtoIQ(CONST char *s, char **sp, void *a, void *b)
-+gdtoa__strtoIQ(CONST char *s, char **sp, void *a, void *b)
- #endif
- {
- static FPI fpi = { 113, 1-16383-113+1, 32766-16383-113+1, 1, SI };
-@@ -52,7 +52,7 @@
-
- B[0] = Balloc(2);
- B[0]->wds = 4;
-- k = strtoIg(s, sp, &fpi, exp, B, rv);
-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
- ULtoQ(L, B[0]->x, exp[0], rv[0]);
- Bfree(B[0]);
- if (B[1]) {
-diff -u gdtoa.orig/strtoId.c gdtoa/strtoId.c
---- gdtoa.orig/strtoId.c 1998-09-09 13:59:17 +0000
-+++ gdtoa/strtoId.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtoId(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
-+gdtoa__strtoId(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
- #else
--strtoId(CONST char *s, char **sp, double *f0, double *f1)
-+gdtoa__strtoId(CONST char *s, char **sp, double *f0, double *f1)
- #endif
- {
- static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
-@@ -51,7 +51,7 @@
-
- B[0] = Balloc(1);
- B[0]->wds = 2;
-- k = strtoIg(s, sp, &fpi, exp, B, rv);
-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
- ULtod((ULong*)f0, B[0]->x, exp[0], rv[0]);
- Bfree(B[0]);
- if (B[1]) {
-diff -u gdtoa.orig/strtoIdd.c gdtoa/strtoIdd.c
---- gdtoa.orig/strtoIdd.c 1998-09-09 13:59:17 +0000
-+++ gdtoa/strtoIdd.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtoIdd(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
-+gdtoa__strtoIdd(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
- #else
--strtoIdd(CONST char *s, char **sp, double *f0, double *f1)
-+gdtoa__strtoIdd(CONST char *s, char **sp, double *f0, double *f1)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -55,7 +55,7 @@
-
- B[0] = Balloc(2);
- B[0]->wds = 4;
-- k = strtoIg(s, sp, &fpi, exp, B, rv);
-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
- ULtodd((ULong*)f0, B[0]->x, exp[0], rv[0]);
- Bfree(B[0]);
- if (B[1]) {
-diff -u gdtoa.orig/strtoIf.c gdtoa/strtoIf.c
---- gdtoa.orig/strtoIf.c 1998-09-09 13:59:17 +0000
-+++ gdtoa/strtoIf.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtoIf(s, sp, f0, f1) CONST char *s; char **sp; float *f0, *f1;
-+gdtoa__strtoIf(s, sp, f0, f1) CONST char *s; char **sp; float *f0, *f1;
- #else
--strtoIf(CONST char *s, char **sp, float *f0, float *f1)
-+gdtoa__strtoIf(CONST char *s, char **sp, float *f0, float *f1)
- #endif
- {
- static FPI fpi = { 24, 1-127-24+1, 254-127-24+1, 1, SI };
-@@ -51,7 +51,7 @@
-
- B[0] = Balloc(0);
- B[0]->wds = 1;
-- k = strtoIg(s, sp, &fpi, exp, B, rv);
-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
- ULtof((ULong*)f0, B[0]->x, exp[0], rv[0]);
- Bfree(B[0]);
- if (B[1]) {
-diff -u gdtoa.orig/strtoIg.c gdtoa/strtoIg.c
---- gdtoa.orig/strtoIg.c 1998-06-26 14:04:19 +0000
-+++ gdtoa/strtoIg.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtoIg(s00, se, fpi, exp, B, rvp) CONST char *s00; char **se; FPI *fpi; Long *exp; Bigint **B; int *rvp;
-+gdtoa__strtoIg(s00, se, fpi, exp, B, rvp) CONST char *s00; char **se; FPI *fpi; Long *exp; Bigint **B; int *rvp;
- #else
--strtoIg(CONST char *s00, char **se, FPI *fpi, Long *exp, Bigint **B, int *rvp)
-+gdtoa__strtoIg(CONST char *s00, char **se, FPI *fpi, Long *exp, Bigint **B, int *rvp)
- #endif
- {
- Bigint *b, *b1;
-@@ -50,7 +50,7 @@
- Long e1;
-
- b = *B;
-- rv = strtodg(s00, se, fpi, exp, b->x);
-+ rv = gdtoa__strtodg(s00, se, fpi, exp, b->x);
- if (!(rv & STRTOG_Inexact)) {
- B[1] = 0;
- return *rvp = rv;
-diff -u gdtoa.orig/strtoIx.c gdtoa/strtoIx.c
---- gdtoa.orig/strtoIx.c 1998-09-09 13:13:22 +0000
-+++ gdtoa/strtoIx.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtoIx(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
-+gdtoa__strtoIx(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
- #else
--strtoIx(CONST char *s, char **sp, void *a, void *b)
-+gdtoa__strtoIx(CONST char *s, char **sp, void *a, void *b)
- #endif
- {
- static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, SI };
-@@ -52,7 +52,7 @@
-
- B[0] = Balloc(1);
- B[0]->wds = 2;
-- k = strtoIg(s, sp, &fpi, exp, B, rv);
-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
- ULtox(L, B[0]->x, exp[0], rv[0]);
- Bfree(B[0]);
- if (B[1]) {
-diff -u gdtoa.orig/strtoIxL.c gdtoa/strtoIxL.c
---- gdtoa.orig/strtoIxL.c 1998-09-09 13:13:22 +0000
-+++ gdtoa/strtoIxL.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtoIxL(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
-+gdtoa__strtoIxL(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
- #else
--strtoIxL(CONST char *s, char **sp, void *a, void *b)
-+gdtoa__strtoIxL(CONST char *s, char **sp, void *a, void *b)
- #endif
- {
- static FPI fpi = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, SI };
-@@ -52,7 +52,7 @@
-
- B[0] = Balloc(1);
- B[0]->wds = 2;
-- k = strtoIg(s, sp, &fpi, exp, B, rv);
-+ k = gdtoa__strtoIg(s, sp, &fpi, exp, B, rv);
- ULtoxL(L, B[0]->x, exp[0], rv[0]);
- Bfree(B[0]);
- if (B[1]) {
-diff -u gdtoa.orig/strtod.c gdtoa/strtod.c
---- gdtoa.orig/strtod.c 2003-03-21 21:24:01 +0000
-+++ gdtoa/strtod.c 2008-10-04 02:01:43 +0000
-@@ -58,7 +58,7 @@
- #endif
-
- double
--strtod
-+gdtoa__strtod
- #ifdef KR_headers
- (s00, se) CONST char *s00; char **se;
- #else
-diff -u gdtoa.orig/strtodI.c gdtoa/strtodI.c
---- gdtoa.orig/strtodI.c 2000-11-02 04:33:13 +0000
-+++ gdtoa/strtodI.c 2008-10-04 02:01:43 +0000
-@@ -56,9 +56,9 @@
-
- int
- #ifdef KR_headers
--strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
-+gdtoa__strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
- #else
--strtodI(CONST char *s, char **sp, double *dd)
-+gdtoa__strtodI(CONST char *s, char **sp, double *dd)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -75,7 +75,7 @@
- } U;
- U *u;
-
-- k = strtodg(s, sp, &fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
- u = (U*)dd;
- sign = k & STRTOG_Neg ? 0x80000000L : 0;
- switch(k & STRTOG_Retmask) {
-diff -u gdtoa.orig/strtodg.c gdtoa/strtodg.c
---- gdtoa.orig/strtodg.c 2003-03-21 20:59:43 +0000
-+++ gdtoa/strtodg.c 2008-10-04 02:01:43 +0000
-@@ -316,7 +316,7 @@
- }
-
- int
--strtodg
-+gdtoa__strtodg
- #ifdef KR_headers
- (s00, se, fpi, exp, bits)
- CONST char *s00; char **se; FPI *fpi; Long *exp; ULong *bits;
-diff -u gdtoa.orig/strtof.c gdtoa/strtof.c
---- gdtoa.orig/strtof.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtof.c 2008-10-04 02:01:43 +0000
-@@ -37,11 +37,11 @@
-
- #include "gdtoaimp.h"
-
-- float
-+ float gdtoa__strtof
- #ifdef KR_headers
--strtof(s, sp) CONST char *s; char **sp;
-+ (s, sp) CONST char *s; char **sp;
- #else
--strtof(CONST char *s, char **sp)
-+ (CONST char *s, char **sp)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -54,7 +54,7 @@
- int k;
- union { ULong L[1]; float f; } u;
-
-- k = strtodg(s, sp, &fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
- switch(k & STRTOG_Retmask) {
- case STRTOG_NoNumber:
- case STRTOG_Zero:
-diff -u gdtoa.orig/strtopQ.c gdtoa/strtopQ.c
---- gdtoa.orig/strtopQ.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtopQ.c 2008-10-04 02:01:43 +0000
-@@ -57,9 +57,9 @@
-
- int
- #ifdef KR_headers
--strtopQ(s, sp, V) CONST char *s; char **sp; void *V;
-+gdtoa__strtopQ(s, sp, V) CONST char *s; char **sp; void *V;
- #else
--strtopQ(CONST char *s, char **sp, void *V)
-+gdtoa__strtopQ(CONST char *s, char **sp, void *V)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -72,7 +72,7 @@
- int k;
- ULong *L = (ULong*)V;
-
-- k = strtodg(s, sp, &fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
- switch(k & STRTOG_Retmask) {
- case STRTOG_NoNumber:
- case STRTOG_Zero:
-diff -u gdtoa.orig/strtopd.c gdtoa/strtopd.c
---- gdtoa.orig/strtopd.c 1998-09-12 15:30:06 +0000
-+++ gdtoa/strtopd.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtopd(s, sp, d) char *s; char **sp; double *d;
-+gdtoa__strtopd(s, sp, d) char *s; char **sp; double *d;
- #else
--strtopd(CONST char *s, char **sp, double *d)
-+gdtoa__strtopd(CONST char *s, char **sp, double *d)
- #endif
- {
- static FPI fpi0 = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
-@@ -49,7 +49,7 @@
- Long exp;
- int k;
-
-- k = strtodg(s, sp, &fpi0, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, &fpi0, &exp, bits);
- ULtod((ULong*)d, bits, exp, k);
- return k;
- }
-diff -u gdtoa.orig/strtopdd.c gdtoa/strtopdd.c
---- gdtoa.orig/strtopdd.c 2000-11-02 04:33:46 +0000
-+++ gdtoa/strtopdd.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtopdd(s, sp, dd) CONST char *s; char **sp; double *dd;
-+gdtoa__strtopdd(s, sp, dd) CONST char *s; char **sp; double *dd;
- #else
--strtopdd(CONST char *s, char **sp, double *dd)
-+gdtoa__strtopdd(CONST char *s, char **sp, double *dd)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -58,7 +58,7 @@
- } U;
- U *u;
-
-- rv = strtodg(s, sp, &fpi, &exp, bits);
-+ rv = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
- u = (U*)dd;
- switch(rv & STRTOG_Retmask) {
- case STRTOG_NoNumber:
-diff -u gdtoa.orig/strtopf.c gdtoa/strtopf.c
---- gdtoa.orig/strtopf.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtopf.c 2008-10-04 02:01:43 +0000
-@@ -39,9 +39,9 @@
-
- int
- #ifdef KR_headers
--strtopf(s, sp, f) CONST char *s; char **sp; float *f;
-+gdtoa__strtopf(s, sp, f) CONST char *s; char **sp; float *f;
- #else
--strtopf(CONST char *s, char **sp, float *f)
-+gdtoa__strtopf(CONST char *s, char **sp, float *f)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -53,7 +53,7 @@
- Long exp;
- int k;
-
-- k = strtodg(s, sp, &fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
- L = (ULong*)f;
- switch(k & STRTOG_Retmask) {
- case STRTOG_NoNumber:
-diff -u gdtoa.orig/strtopx.c gdtoa/strtopx.c
---- gdtoa.orig/strtopx.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtopx.c 2008-10-04 02:01:43 +0000
-@@ -59,9 +59,9 @@
-
- int
- #ifdef KR_headers
--strtopx(s, sp, V) CONST char *s; char **sp; void *V;
-+gdtoa__strtopx(s, sp, V) CONST char *s; char **sp; void *V;
- #else
--strtopx(CONST char *s, char **sp, void *V)
-+gdtoa__strtopx(CONST char *s, char **sp, void *V)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -74,7 +74,7 @@
- int k;
- UShort *L = (UShort*)V;
-
-- k = strtodg(s, sp, &fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
- switch(k & STRTOG_Retmask) {
- case STRTOG_NoNumber:
- case STRTOG_Zero:
-diff -u gdtoa.orig/strtopxL.c gdtoa/strtopxL.c
---- gdtoa.orig/strtopxL.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtopxL.c 2008-10-04 02:01:43 +0000
-@@ -55,9 +55,9 @@
-
- int
- #ifdef KR_headers
--strtopxL(s, sp, V) CONST char *s; char **sp; void *V;
-+gdtoa__strtopxL(s, sp, V) CONST char *s; char **sp; void *V;
- #else
--strtopxL(CONST char *s, char **sp, void *V)
-+gdtoa__strtopxL(CONST char *s, char **sp, void *V)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -70,7 +70,7 @@
- int k;
- ULong *L = (ULong*)V;
-
-- k = strtodg(s, sp, &fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
- switch(k & STRTOG_Retmask) {
- case STRTOG_NoNumber:
- case STRTOG_Zero:
-diff -u gdtoa.orig/strtorQ.c gdtoa/strtorQ.c
---- gdtoa.orig/strtorQ.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtorQ.c 2008-10-04 02:01:43 +0000
-@@ -98,9 +98,9 @@
-
- int
- #ifdef KR_headers
--strtorQ(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
-+gdtoa__strtorQ(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
- #else
--strtorQ(CONST char *s, char **sp, int rounding, void *L)
-+gdtoa__strtorQ(CONST char *s, char **sp, int rounding, void *L)
- #endif
- {
- static FPI fpi0 = { 113, 1-16383-113+1, 32766-16383-113+1, 1, SI };
-@@ -115,7 +115,7 @@
- fpi1.rounding = rounding;
- fpi = &fpi1;
- }
-- k = strtodg(s, sp, fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
- ULtoQ((ULong*)L, bits, exp, k);
- return k;
- }
-diff -u gdtoa.orig/strtord.c gdtoa/strtord.c
---- gdtoa.orig/strtord.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtord.c 2008-10-04 02:01:43 +0000
-@@ -76,9 +76,9 @@
-
- int
- #ifdef KR_headers
--strtord(s, sp, rounding, d) CONST char *s; char **sp; int rounding; double *d;
-+gdtoa__strtord(s, sp, rounding, d) CONST char *s; char **sp; int rounding; double *d;
- #else
--strtord(CONST char *s, char **sp, int rounding, double *d)
-+gdtoa__strtord(CONST char *s, char **sp, int rounding, double *d)
- #endif
- {
- static FPI fpi0 = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
-@@ -93,7 +93,7 @@
- fpi1.rounding = rounding;
- fpi = &fpi1;
- }
-- k = strtodg(s, sp, fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
- ULtod((ULong*)d, bits, exp, k);
- return k;
- }
-diff -u gdtoa.orig/strtordd.c gdtoa/strtordd.c
---- gdtoa.orig/strtordd.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtordd.c 2008-10-04 02:01:43 +0000
-@@ -178,9 +178,9 @@
-
- int
- #ifdef KR_headers
--strtordd(s, sp, rounding, dd) CONST char *s; char **sp; int rounding; double *dd;
-+gdtoa__strtordd(s, sp, rounding, dd) CONST char *s; char **sp; int rounding; double *dd;
- #else
--strtordd(CONST char *s, char **sp, int rounding, double *dd)
-+gdtoa__strtordd(CONST char *s, char **sp, int rounding, double *dd)
- #endif
- {
- #ifdef Sudden_Underflow
-@@ -199,7 +199,7 @@
- fpi1.rounding = rounding;
- fpi = &fpi1;
- }
-- k = strtodg(s, sp, fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
- ULtodd((ULong*)dd, bits, exp, k);
- return k;
- }
-diff -u gdtoa.orig/strtorf.c gdtoa/strtorf.c
---- gdtoa.orig/strtorf.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtorf.c 2008-10-04 02:01:43 +0000
-@@ -72,9 +72,9 @@
-
- int
- #ifdef KR_headers
--strtorf(s, sp, rounding, f) CONST char *s; char **sp; int rounding; float *f;
-+gdtoa__strtorf(s, sp, rounding, f) CONST char *s; char **sp; int rounding; float *f;
- #else
--strtorf(CONST char *s, char **sp, int rounding, float *f)
-+gdtoa__strtorf(CONST char *s, char **sp, int rounding, float *f)
- #endif
- {
- static FPI fpi0 = { 24, 1-127-24+1, 254-127-24+1, 1, SI };
-@@ -89,7 +89,7 @@
- fpi1.rounding = rounding;
- fpi = &fpi1;
- }
-- k = strtodg(s, sp, fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
- ULtof((ULong*)f, bits, exp, k);
- return k;
- }
-diff -u gdtoa.orig/strtorx.c gdtoa/strtorx.c
---- gdtoa.orig/strtorx.c 2000-11-02 04:34:18 +0000
-+++ gdtoa/strtorx.c 2008-10-04 02:01:43 +0000
-@@ -95,9 +95,9 @@
-
- int
- #ifdef KR_headers
--strtorx(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
-+gdtoa__strtorx(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
- #else
--strtorx(CONST char *s, char **sp, int rounding, void *L)
-+gdtoa__strtorx(CONST char *s, char **sp, int rounding, void *L)
- #endif
- {
- static FPI fpi0 = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, SI };
-@@ -112,7 +112,7 @@
- fpi1.rounding = rounding;
- fpi = &fpi1;
- }
-- k = strtodg(s, sp, fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
- ULtox((UShort*)L, bits, exp, k);
- return k;
- }
-diff -u gdtoa.orig/strtorxL.c gdtoa/strtorxL.c
---- gdtoa.orig/strtorxL.c 2000-11-02 04:31:40 +0000
-+++ gdtoa/strtorxL.c 2008-10-04 02:01:43 +0000
-@@ -89,9 +89,9 @@
-
- int
- #ifdef KR_headers
--strtorxL(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
-+gdtoa__strtorxL(s, sp, rounding, L) CONST char *s; char **sp; int rounding; void *L;
- #else
--strtorxL(CONST char *s, char **sp, int rounding, void *L)
-+gdtoa__strtorxL(CONST char *s, char **sp, int rounding, void *L)
- #endif
- {
- static FPI fpi0 = { 64, 1-16383-64+1, 32766 - 16383 - 64 + 1, 1, SI };
-@@ -106,7 +106,7 @@
- fpi1.rounding = rounding;
- fpi = &fpi1;
- }
-- k = strtodg(s, sp, fpi, &exp, bits);
-+ k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
- ULtoxL((ULong*)L, bits, exp, k);
- return k;
- }
-Common subdirectories: gdtoa.orig/test and gdtoa/test
+--- 91,95 ----
+ if (sign)
+ i = STRTOG_Normal | STRTOG_Neg;
+! s = gdtoa__gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+diff -P -C 2 -r gdtoa/gdtoa.c gdtoa-new/gdtoa.c
+*** gdtoa/gdtoa.c 2011-03-04 23:26:27.000000000 -0500
+--- gdtoa-new/gdtoa.c 2011-05-27 17:09:13.941030075 -0400
+***************
+*** 110,114 ****
+
+ char *
+! gdtoa
+ #ifdef KR_headers
+ (fpi, be, bits, kindp, mode, ndigits, decpt, rve)
+--- 110,114 ----
+
+ char *
+! gdtoa__gdtoa
+ #ifdef KR_headers
+ (fpi, be, bits, kindp, mode, ndigits, decpt, rve)
+***************
+*** 165,169 ****
+ #ifndef MULTIPLE_THREADS
+ if (dtoa_result) {
+! freedtoa(dtoa_result);
+ dtoa_result = 0;
+ }
+--- 165,169 ----
+ #ifndef MULTIPLE_THREADS
+ if (dtoa_result) {
+! gdtoa__freedtoa(dtoa_result);
+ dtoa_result = 0;
+ }
+diff -P -C 2 -r gdtoa/gdtoa.h gdtoa-new/gdtoa.h
+*** gdtoa/gdtoa.h 2011-03-04 13:54:26.000000000 -0500
+--- gdtoa-new/gdtoa.h 2011-05-27 17:18:00.996031868 -0400
+***************
+*** 104,150 ****
+ #endif
+
+! extern char* dtoa ANSI((double d, int mode, int ndigits, int *decpt,
+ int *sign, char **rve));
+! extern char* gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
+ int mode, int ndigits, int *decpt, char **rve));
+! extern void freedtoa ANSI((char*));
+! extern float strtof ANSI((CONST char *, char **));
+! extern double strtod ANSI((CONST char *, char **));
+! extern int strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
+
+! extern char* g_ddfmt ANSI((char*, double*, int, size_t));
+! extern char* g_dfmt ANSI((char*, double*, int, size_t));
+! extern char* g_ffmt ANSI((char*, float*, int, size_t));
+! extern char* g_Qfmt ANSI((char*, void*, int, size_t));
+! extern char* g_xfmt ANSI((char*, void*, int, size_t));
+! extern char* g_xLfmt ANSI((char*, void*, int, size_t));
+
+! extern int strtoId ANSI((CONST char*, char**, double*, double*));
+! extern int strtoIdd ANSI((CONST char*, char**, double*, double*));
+! extern int strtoIf ANSI((CONST char*, char**, float*, float*));
+! extern int strtoIQ ANSI((CONST char*, char**, void*, void*));
+! extern int strtoIx ANSI((CONST char*, char**, void*, void*));
+! extern int strtoIxL ANSI((CONST char*, char**, void*, void*));
+! extern int strtord ANSI((CONST char*, char**, int, double*));
+! extern int strtordd ANSI((CONST char*, char**, int, double*));
+! extern int strtorf ANSI((CONST char*, char**, int, float*));
+! extern int strtorQ ANSI((CONST char*, char**, int, void*));
+! extern int strtorx ANSI((CONST char*, char**, int, void*));
+! extern int strtorxL ANSI((CONST char*, char**, int, void*));
+ #if 1
+! extern int strtodI ANSI((CONST char*, char**, double*));
+! extern int strtopd ANSI((CONST char*, char**, double*));
+! extern int strtopdd ANSI((CONST char*, char**, double*));
+! extern int strtopf ANSI((CONST char*, char**, float*));
+! extern int strtopQ ANSI((CONST char*, char**, void*));
+! extern int strtopx ANSI((CONST char*, char**, void*));
+! extern int strtopxL ANSI((CONST char*, char**, void*));
+ #else
+! #define strtopd(s,se,x) strtord(s,se,1,x)
+! #define strtopdd(s,se,x) strtordd(s,se,1,x)
+! #define strtopf(s,se,x) strtorf(s,se,1,x)
+! #define strtopQ(s,se,x) strtorQ(s,se,1,x)
+! #define strtopx(s,se,x) strtorx(s,se,1,x)
+! #define strtopxL(s,se,x) strtorxL(s,se,1,x)
+ #endif
+
+--- 104,150 ----
+ #endif
+
+! extern char* gdtoa__dtoa ANSI((double d, int mode, int ndigits, int *decpt,
+ int *sign, char **rve));
+! extern char* gdtoa__gdtoa ANSI((FPI *fpi, int be, ULong *bits, int *kindp,
+ int mode, int ndigits, int *decpt, char **rve));
+! extern void gdtoa__freedtoa ANSI((char*));
+! extern float gdtoa__strtof ANSI((CONST char *, char **));
+! extern double gdtoa__strtod ANSI((CONST char *, char **));
+! extern int gdtoa__strtodg ANSI((CONST char*, char**, FPI*, Long*, ULong*));
+
+! extern char* gdtoa__g_ddfmt ANSI((char*, double*, int, size_t));
+! extern char* gdtoa__g_dfmt ANSI((char*, double*, int, size_t));
+! extern char* gdtoa__g_ffmt ANSI((char*, float*, int, size_t));
+! extern char* gdtoa__g_Qfmt ANSI((char*, void*, int, size_t));
+! extern char* gdtoa__g_xfmt ANSI((char*, void*, int, size_t));
+! extern char* gdtoa__g_xLfmt ANSI((char*, void*, int, size_t));
+
+! extern int gdtoa__strtoId ANSI((CONST char*, char**, double*, double*));
+! extern int gdtoa__strtoIdd ANSI((CONST char*, char**, double*, double*));
+! extern int gdtoa__strtoIf ANSI((CONST char*, char**, float*, float*));
+! extern int gdtoa__strtoIQ ANSI((CONST char*, char**, void*, void*));
+! extern int gdtoa__strtoIx ANSI((CONST char*, char**, void*, void*));
+! extern int gdtoa__strtoIxL ANSI((CONST char*, char**, void*, void*));
+! extern int gdtoa__strtord ANSI((CONST char*, char**, int, double*));
+! extern int gdtoa__strtordd ANSI((CONST char*, char**, int, double*));
+! extern int gdtoa__strtorf ANSI((CONST char*, char**, int, float*));
+! extern int gdtoa__strtorQ ANSI((CONST char*, char**, int, void*));
+! extern int gdtoa__strtorx ANSI((CONST char*, char**, int, void*));
+! extern int gdtoa__strtorxL ANSI((CONST char*, char**, int, void*));
+ #if 1
+! extern int gdtoa__strtodI ANSI((CONST char*, char**, double*));
+! extern int gdtoa__strtopd ANSI((CONST char*, char**, double*));
+! extern int gdtoa__strtopdd ANSI((CONST char*, char**, double*));
+! extern int gdtoa__strtopf ANSI((CONST char*, char**, float*));
+! extern int gdtoa__strtopQ ANSI((CONST char*, char**, void*));
+! extern int gdtoa__strtopx ANSI((CONST char*, char**, void*));
+! extern int gdtoa__strtopxL ANSI((CONST char*, char**, void*));
+ #else
+! #define gdtoa__strtopd(s,se,x) gdtoa__strtord(s,se,1,x)
+! #define gdtoa__strtopdd(s,se,x) gdtoa__strtordd(s,se,1,x)
+! #define gdtoa__strtopf(s,se,x) gdtoa__strtorf(s,se,1,x)
+! #define gdtoa__strtopQ(s,se,x) gdtoa__strtorQ(s,se,1,x)
+! #define gdtoa__strtopx(s,se,x) gdtoa__strtorx(s,se,1,x)
+! #define gdtoa__strtopxL(s,se,x) gdtoa__strtorxL(s,se,1,x)
+ #endif
+
+diff -P -C 2 -r gdtoa/gdtoaimp.h gdtoa-new/gdtoaimp.h
+*** gdtoa/gdtoaimp.h 2011-03-21 17:02:29.000000000 -0400
+--- gdtoa-new/gdtoaimp.h 2011-05-27 17:18:00.996031868 -0400
+***************
+*** 275,279 ****
+ #endif
+
+! typedef union { double d; ULong L[2]; } U;
+
+ #ifdef IEEE_8087
+--- 275,279 ----
+ #endif
+
+! typedef union { double d; ULong L[2]; } __attribute__((__may_alias__)) U;
+
+ #ifdef IEEE_8087
+***************
+*** 504,507 ****
+--- 504,508 ----
+ #define gethex gethex_D2A
+ #define hexdig hexdig_D2A
++ #define hexdig_init hexdig_init_D2A
+ #define hexnan hexnan_D2A
+ #define hi0bits(x) hi0bits_D2A((ULong)(x))
+***************
+*** 523,526 ****
+--- 524,528 ----
+ #define strcp strcp_D2A
+ #define strtoIg strtoIg_D2A
++ #define strtod strtod_D2A
+ #define sum sum_D2A
+ #define tens tens_D2A
+***************
+*** 553,557 ****
+ extern char *g__fmt ANSI((char*, char*, char*, int, ULong, size_t));
+ extern int gethex ANSI((CONST char**, FPI*, Long*, Bigint**, int));
+! extern void hexdig_init_D2A(Void);
+ extern int hexnan ANSI((CONST char**, FPI*, ULong*));
+ extern int hi0bits_D2A ANSI((ULong));
+--- 555,559 ----
+ extern char *g__fmt ANSI((char*, char*, char*, int, ULong, size_t));
+ extern int gethex ANSI((CONST char**, FPI*, Long*, Bigint**, int));
+! extern void hexdig_init ANSI((Void));
+ extern int hexnan ANSI((CONST char**, FPI*, ULong*));
+ extern int hi0bits_D2A ANSI((ULong));
+diff -P -C 2 -r gdtoa/gethex.c gdtoa-new/gethex.c
+*** gdtoa/gethex.c 2009-03-16 00:37:50.000000000 -0400
+--- gdtoa-new/gethex.c 2011-05-27 17:09:13.941030075 -0400
+***************
+*** 68,72 ****
+
+ if (!hexdig['0'])
+! hexdig_init_D2A();
+ *bp = 0;
+ havedig = 0;
+--- 68,72 ----
+
+ if (!hexdig['0'])
+! hexdig_init();
+ *bp = 0;
+ havedig = 0;
+diff -P -C 2 -r gdtoa/g_ffmt.c gdtoa-new/g_ffmt.c
+*** gdtoa/g_ffmt.c 2008-09-09 00:44:56.000000000 -0400
+--- gdtoa-new/g_ffmt.c 2011-05-27 17:09:13.941030074 -0400
+***************
+*** 34,40 ****
+ char*
+ #ifdef KR_headers
+! g_ffmt(buf, f, ndig, bufsize) char *buf; float *f; int ndig; size_t bufsize;
+ #else
+! g_ffmt(char *buf, float *f, int ndig, size_t bufsize)
+ #endif
+ {
+--- 34,40 ----
+ char*
+ #ifdef KR_headers
+! gdtoa__g_ffmt(buf, f, ndig, bufsize) char *buf; float *f; int ndig; size_t bufsize;
+ #else
+! gdtoa__g_ffmt(char *buf, float *f, int ndig, size_t bufsize)
+ #endif
+ {
+***************
+*** 89,93 ****
+ }
+ i = STRTOG_Normal;
+! s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+--- 89,93 ----
+ }
+ i = STRTOG_Normal;
+! s = gdtoa__gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+diff -P -C 2 -r gdtoa/g__fmt.c gdtoa-new/g__fmt.c
+*** gdtoa/g__fmt.c 2009-02-21 11:53:53.000000000 -0500
+--- gdtoa-new/g__fmt.c 2011-05-27 17:09:13.940030010 -0400
+***************
+*** 143,147 ****
+ }
+ ret:
+! freedtoa(s0);
+ return b;
+ }
+--- 143,147 ----
+ }
+ ret:
+! gdtoa__freedtoa(s0);
+ return b;
+ }
+diff -P -C 2 -r gdtoa/g_Qfmt.c gdtoa-new/g_Qfmt.c
+*** gdtoa/g_Qfmt.c 2008-09-09 00:44:56.000000000 -0400
+--- gdtoa-new/g_Qfmt.c 2011-05-27 17:09:13.940030010 -0400
+***************
+*** 52,58 ****
+ char*
+ #ifdef KR_headers
+! g_Qfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+ #else
+! g_Qfmt(char *buf, void *V, int ndig, size_t bufsize)
+ #endif
+ {
+--- 52,58 ----
+ char*
+ #ifdef KR_headers
+! gdtoa__g_Qfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+ #else
+! gdtoa__g_Qfmt(char *buf, void *V, int ndig, size_t bufsize)
+ #endif
+ {
+***************
+*** 115,119 ****
+ mode = 0;
+ }
+! s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+--- 115,119 ----
+ mode = 0;
+ }
+! s = gdtoa__gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+diff -P -C 2 -r gdtoa/g_xfmt.c gdtoa-new/g_xfmt.c
+*** gdtoa/g_xfmt.c 2008-09-09 00:44:56.000000000 -0400
+--- gdtoa-new/g_xfmt.c 2011-05-27 17:09:13.941030075 -0400
+***************
+*** 54,60 ****
+ char*
+ #ifdef KR_headers
+! g_xfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+ #else
+! g_xfmt(char *buf, void *V, int ndig, size_t bufsize)
+ #endif
+ {
+--- 54,60 ----
+ char*
+ #ifdef KR_headers
+! gdtoa__g_xfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+ #else
+! gdtoa__g_xfmt(char *buf, void *V, int ndig, size_t bufsize)
+ #endif
+ {
+***************
+*** 115,119 ****
+ mode = 0;
+ }
+! s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+--- 115,119 ----
+ mode = 0;
+ }
+! s = gdtoa__gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+diff -P -C 2 -r gdtoa/g_xLfmt.c gdtoa-new/g_xLfmt.c
+*** gdtoa/g_xLfmt.c 2008-09-09 00:44:56.000000000 -0400
+--- gdtoa-new/g_xLfmt.c 2011-05-27 17:09:13.941030074 -0400
+***************
+*** 50,56 ****
+ char*
+ #ifdef KR_headers
+! g_xLfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+ #else
+! g_xLfmt(char *buf, void *V, int ndig, size_t bufsize)
+ #endif
+ {
+--- 50,56 ----
+ char*
+ #ifdef KR_headers
+! gdtoa__g_xLfmt(buf, V, ndig, bufsize) char *buf; char *V; int ndig; size_t bufsize;
+ #else
+! gdtoa__g_xLfmt(char *buf, void *V, int ndig, size_t bufsize)
+ #endif
+ {
+***************
+*** 109,113 ****
+ mode = 0;
+ }
+! s = gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+--- 109,113 ----
+ mode = 0;
+ }
+! s = gdtoa__gdtoa(fpi, ex, bits, &i, mode, ndig, &decpt, &se);
+ return g__fmt(buf, s, se, decpt, sign, bufsize);
+ }
+diff -P -C 2 -r gdtoa/hd_init.c gdtoa-new/hd_init.c
+*** gdtoa/hd_init.c 2004-04-11 23:39:50.000000000 -0400
+--- gdtoa-new/hd_init.c 2011-05-27 17:09:13.941030075 -0400
+***************
+*** 47,51 ****
+
+ void
+! hexdig_init_D2A(Void)
+ {
+ #define USC (unsigned char *)
+--- 47,51 ----
+
+ void
+! hexdig_init(Void)
+ {
+ #define USC (unsigned char *)
+diff -P -C 2 -r gdtoa/hexnan.c gdtoa-new/hexnan.c
+*** gdtoa/hexnan.c 2009-03-16 00:39:17.000000000 -0400
+--- gdtoa-new/hexnan.c 2011-05-27 17:09:13.942030138 -0400
+***************
+*** 63,67 ****
+
+ if (!hexdig['0'])
+! hexdig_init_D2A();
+ nbits = fpi->nbits;
+ x = x0 + (nbits >> kshift);
+--- 63,67 ----
+
+ if (!hexdig['0'])
+! hexdig_init();
+ nbits = fpi->nbits;
+ x = x0 + (nbits >> kshift);
+diff -P -C 2 -r gdtoa/strtod.c gdtoa-new/strtod.c
+*** gdtoa/strtod.c 2011-03-04 13:15:00.000000000 -0500
+--- gdtoa-new/strtod.c 2011-05-27 17:09:13.944030259 -0400
+***************
+*** 81,85 ****
+
+ double
+! strtod
+ #ifdef KR_headers
+ (s00, se) CONST char *s00; char **se;
+--- 81,85 ----
+
+ double
+! gdtoa__strtod
+ #ifdef KR_headers
+ (s00, se) CONST char *s00; char **se;
+diff -P -C 2 -r gdtoa/strtodg.c gdtoa-new/strtodg.c
+*** gdtoa/strtodg.c 2009-04-11 23:11:05.000000000 -0400
+--- gdtoa-new/strtodg.c 2011-05-27 17:09:13.944030259 -0400
+***************
+*** 314,318 ****
+
+ int
+! strtodg
+ #ifdef KR_headers
+ (s00, se, fpi, exp, bits)
+--- 314,318 ----
+
+ int
+! gdtoa__strtodg
+ #ifdef KR_headers
+ (s00, se, fpi, exp, bits)
+diff -P -C 2 -r gdtoa/strtodI.c gdtoa-new/strtodI.c
+*** gdtoa/strtodI.c 2009-10-21 19:49:32.000000000 -0400
+--- gdtoa-new/strtodI.c 2011-05-27 17:09:13.944030259 -0400
+***************
+*** 51,57 ****
+ int
+ #ifdef KR_headers
+! strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
+ #else
+! strtodI(CONST char *s, char **sp, double *dd)
+ #endif
+ {
+--- 51,57 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtodI(s, sp, dd) CONST char *s; char **sp; double *dd;
+ #else
+! gdtoa__strtodI(CONST char *s, char **sp, double *dd)
+ #endif
+ {
+***************
+*** 62,66 ****
+ U *u;
+
+! k = strtodg(s, sp, &fpi, &exp, bits);
+ u = (U*)dd;
+ sign = k & STRTOG_Neg ? 0x80000000L : 0;
+--- 62,66 ----
+ U *u;
+
+! k = gdtoa__strtodg(s, sp, &fpi, &exp, bits);
+ u = (U*)dd;
+ sign = k & STRTOG_Neg ? 0x80000000L : 0;
+diff -P -C 2 -r gdtoa/strtof.c gdtoa-new/strtof.c
+*** gdtoa/strtof.c 2009-03-16 00:57:44.000000000 -0400
+--- gdtoa-new/strtof.c 2011-05-27 17:09:13.944030259 -0400
+***************
+*** 32,40 ****
+ #include "gdtoaimp.h"
+
+! float
+ #ifdef KR_headers
+! strtof(s, sp) CONST char *s; char **sp;
+ #else
+! strtof(CONST char *s, char **sp)
+ #endif
+ {
+--- 32,40 ----
+ #include "gdtoaimp.h"
+
+! float gdtoa__strtof
+ #ifdef KR_headers
+! (s, sp) CONST char *s; char **sp;
+ #else
+! (CONST char *s, char **sp)
+ #endif
+ {
+***************
+*** 50,54 ****
+ #endif
+
+! k = strtodg(s, sp, fpi, &exp, bits);
+ switch(k & STRTOG_Retmask) {
+ case STRTOG_NoNumber:
+--- 50,54 ----
+ #endif
+
+! k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+ switch(k & STRTOG_Retmask) {
+ case STRTOG_NoNumber:
+diff -P -C 2 -r gdtoa/strtoId.c gdtoa-new/strtoId.c
+*** gdtoa/strtoId.c 2004-04-11 23:39:50.000000000 -0400
+--- gdtoa-new/strtoId.c 2011-05-27 17:09:13.943030200 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtoId(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+ #else
+! strtoId(CONST char *s, char **sp, double *f0, double *f1)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtoId(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+ #else
+! gdtoa__strtoId(CONST char *s, char **sp, double *f0, double *f1)
+ #endif
+ {
+diff -P -C 2 -r gdtoa/strtoIdd.c gdtoa-new/strtoIdd.c
+*** gdtoa/strtoIdd.c 2004-04-11 23:39:50.000000000 -0400
+--- gdtoa-new/strtoIdd.c 2011-05-27 17:09:13.943030200 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtoIdd(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+ #else
+! strtoIdd(CONST char *s, char **sp, double *f0, double *f1)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtoIdd(s, sp, f0, f1) CONST char *s; char **sp; double *f0, *f1;
+ #else
+! gdtoa__strtoIdd(CONST char *s, char **sp, double *f0, double *f1)
+ #endif
+ {
+diff -P -C 2 -r gdtoa/strtoIf.c gdtoa-new/strtoIf.c
+*** gdtoa/strtoIf.c 2004-04-11 23:39:50.000000000 -0400
+--- gdtoa-new/strtoIf.c 2011-05-27 17:09:13.943030200 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtoIf(s, sp, f0, f1) CONST char *s; char **sp; float *f0, *f1;
+ #else
+! strtoIf(CONST char *s, char **sp, float *f0, float *f1)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtoIf(s, sp, f0, f1) CONST char *s; char **sp; float *f0, *f1;
+ #else
+! gdtoa__strtoIf(CONST char *s, char **sp, float *f0, float *f1)
+ #endif
+ {
+diff -P -C 2 -r gdtoa/strtoIg.c gdtoa-new/strtoIg.c
+*** gdtoa/strtoIg.c 2009-03-16 00:55:05.000000000 -0400
+--- gdtoa-new/strtoIg.c 2011-05-27 17:09:13.943030200 -0400
+***************
+*** 45,49 ****
+
+ b = *B;
+! rv = strtodg(s00, se, fpi, exp, b->x);
+ if (!(rv & STRTOG_Inexact)) {
+ B[1] = 0;
+--- 45,49 ----
+
+ b = *B;
+! rv = gdtoa__strtodg(s00, se, fpi, exp, b->x);
+ if (!(rv & STRTOG_Inexact)) {
+ B[1] = 0;
+diff -P -C 2 -r gdtoa/strtoIQ.c gdtoa-new/strtoIQ.c
+*** gdtoa/strtoIQ.c 2004-04-11 23:39:50.000000000 -0400
+--- gdtoa-new/strtoIQ.c 2011-05-27 17:09:13.943030200 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtoIQ(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+ #else
+! strtoIQ(CONST char *s, char **sp, void *a, void *b)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtoIQ(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+ #else
+! gdtoa__strtoIQ(CONST char *s, char **sp, void *a, void *b)
+ #endif
+ {
+diff -P -C 2 -r gdtoa/strtoIx.c gdtoa-new/strtoIx.c
+*** gdtoa/strtoIx.c 2004-04-11 23:39:50.000000000 -0400
+--- gdtoa-new/strtoIx.c 2011-05-27 17:09:13.943030200 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtoIx(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+ #else
+! strtoIx(CONST char *s, char **sp, void *a, void *b)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtoIx(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+ #else
+! gdtoa__strtoIx(CONST char *s, char **sp, void *a, void *b)
+ #endif
+ {
+diff -P -C 2 -r gdtoa/strtoIxL.c gdtoa-new/strtoIxL.c
+*** gdtoa/strtoIxL.c 2004-04-11 23:39:50.000000000 -0400
+--- gdtoa-new/strtoIxL.c 2011-05-27 17:09:13.943030200 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtoIxL(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+ #else
+! strtoIxL(CONST char *s, char **sp, void *a, void *b)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtoIxL(s, sp, a, b) CONST char *s; char **sp; void *a; void *b;
+ #else
+! gdtoa__strtoIxL(CONST char *s, char **sp, void *a, void *b)
+ #endif
+ {
+diff -P -C 2 -r gdtoa/strtopd.c gdtoa-new/strtopd.c
+*** gdtoa/strtopd.c 2008-09-09 00:44:56.000000000 -0400
+--- gdtoa-new/strtopd.c 2011-05-27 17:09:13.945030317 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtopd(s, sp, d) char *s; char **sp; double *d;
+ #else
+! strtopd(CONST char *s, char **sp, double *d)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtopd(s, sp, d) char *s; char **sp; double *d;
+ #else
+! gdtoa__strtopd(CONST char *s, char **sp, double *d)
+ #endif
+ {
+***************
+*** 49,53 ****
+ #endif
+
+! k = strtodg(s, sp, fpi, &exp, bits);
+ ULtod((ULong*)d, bits, exp, k);
+ return k;
+--- 49,53 ----
+ #endif
+
+! k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+ ULtod((ULong*)d, bits, exp, k);
+ return k;
+diff -P -C 2 -r gdtoa/strtopdd.c gdtoa-new/strtopdd.c
+*** gdtoa/strtopdd.c 2009-03-16 01:32:44.000000000 -0400
+--- gdtoa-new/strtopdd.c 2011-05-27 17:09:13.945030317 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtopdd(s, sp, dd) CONST char *s; char **sp; double *dd;
+ #else
+! strtopdd(CONST char *s, char **sp, double *dd)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtopdd(s, sp, dd) CONST char *s; char **sp; double *dd;
+ #else
+! gdtoa__strtopdd(CONST char *s, char **sp, double *dd)
+ #endif
+ {
+***************
+*** 58,62 ****
+ #endif
+
+! rv = strtodg(s, sp, fpi, &exp, bits);
+ u = (U*)dd;
+ switch(rv & STRTOG_Retmask) {
+--- 58,62 ----
+ #endif
+
+! rv = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+ u = (U*)dd;
+ switch(rv & STRTOG_Retmask) {
+diff -P -C 2 -r gdtoa/strtopf.c gdtoa-new/strtopf.c
+*** gdtoa/strtopf.c 2009-03-16 01:30:33.000000000 -0400
+--- gdtoa-new/strtopf.c 2011-05-27 17:09:13.945030317 -0400
+***************
+*** 34,40 ****
+ int
+ #ifdef KR_headers
+! strtopf(s, sp, f) CONST char *s; char **sp; float *f;
+ #else
+! strtopf(CONST char *s, char **sp, float *f)
+ #endif
+ {
+--- 34,40 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtopf(s, sp, f) CONST char *s; char **sp; float *f;
+ #else
+! gdtoa__strtopf(CONST char *s, char **sp, float *f)
+ #endif
+ {
+***************
+*** 49,53 ****
+ #endif
+
+! k = strtodg(s, sp, fpi, &exp, bits);
+ L = (ULong*)f;
+ switch(k & STRTOG_Retmask) {
+--- 49,53 ----
+ #endif
+
+! k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+ L = (ULong*)f;
+ switch(k & STRTOG_Retmask) {
+diff -P -C 2 -r gdtoa/strtopQ.c gdtoa-new/strtopQ.c
+*** gdtoa/strtopQ.c 2008-09-09 00:44:56.000000000 -0400
+--- gdtoa-new/strtopQ.c 2011-05-27 17:09:13.945030317 -0400
+***************
+*** 52,58 ****
+ int
+ #ifdef KR_headers
+! strtopQ(s, sp, V) CONST char *s; char **sp; void *V;
+ #else
+! strtopQ(CONST char *s, char **sp, void *V)
+ #endif
+ {
+--- 52,58 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtopQ(s, sp, V) CONST char *s; char **sp; void *V;
+ #else
+! gdtoa__strtopQ(CONST char *s, char **sp, void *V)
+ #endif
+ {
+***************
+*** 68,72 ****
+ #endif
+
+! k = strtodg(s, sp, fpi, &exp, bits);
+ switch(k & STRTOG_Retmask) {
+ case STRTOG_NoNumber:
+--- 68,72 ----
+ #endif
+
+! k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+ switch(k & STRTOG_Retmask) {
+ case STRTOG_NoNumber:
+diff -P -C 2 -r gdtoa/strtopx.c gdtoa-new/strtopx.c
+*** gdtoa/strtopx.c 2009-04-20 01:38:02.000000000 -0400
+--- gdtoa-new/strtopx.c 2011-05-27 17:09:13.945030317 -0400
+***************
+*** 54,60 ****
+ int
+ #ifdef KR_headers
+! strtopx(s, sp, V) CONST char *s; char **sp; void *V;
+ #else
+! strtopx(CONST char *s, char **sp, void *V)
+ #endif
+ {
+--- 54,60 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtopx(s, sp, V) CONST char *s; char **sp; void *V;
+ #else
+! gdtoa__strtopx(CONST char *s, char **sp, void *V)
+ #endif
+ {
+***************
+*** 70,74 ****
+ #endif
+
+! k = strtodg(s, sp, fpi, &exp, bits);
+ switch(k & STRTOG_Retmask) {
+ case STRTOG_NoNumber:
+--- 70,74 ----
+ #endif
+
+! k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+ switch(k & STRTOG_Retmask) {
+ case STRTOG_NoNumber:
+diff -P -C 2 -r gdtoa/strtopxL.c gdtoa-new/strtopxL.c
+*** gdtoa/strtopxL.c 2009-04-20 01:38:02.000000000 -0400
+--- gdtoa-new/strtopxL.c 2011-05-27 17:09:13.945030317 -0400
+***************
+*** 50,56 ****
+ int
+ #ifdef KR_headers
+! strtopxL(s, sp, V) CONST char *s; char **sp; void *V;
+ #else
+! strtopxL(CONST char *s, char **sp, void *V)
+ #endif
+ {
+--- 50,56 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtopxL(s, sp, V) CONST char *s; char **sp; void *V;
+ #else
+! gdtoa__strtopxL(CONST char *s, char **sp, void *V)
+ #endif
+ {
+***************
+*** 66,70 ****
+ #endif
+
+! k = strtodg(s, sp, fpi, &exp, bits);
+ switch(k & STRTOG_Retmask) {
+ case STRTOG_NoNumber:
+--- 66,70 ----
+ #endif
+
+! k = gdtoa__strtodg(s, sp, fpi, &exp, bits);
+ switch(k & STRTOG_Retmask) {
+ case STRTOG_NoNumber:
+diff -P -C 2 -r gdtoa/strtord.c gdtoa-new/strtord.c
+*** gdtoa/strtord.c 2005-01-12 01:47:38.000000000 -0500
+--- gdtoa-new/strtord.c 2011-05-27 17:09:13.946030372 -0400
+***************
+*** 71,77 ****
+ int
+ #ifdef KR_headers
+! strtord(s, sp, rounding, d) CONST char *s; char **sp; int rounding; double *d;
+ #else
+! strtord(CONST char *s, char **sp, int rounding, double *d)
+ #endif
+ {
+--- 71,77 ----
+ int
+ #ifdef KR_headers
+! gdtoa__strtord(s, sp, rounding, d) CONST char *s; char **sp; int rounding; double...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2011-06-04 07:34:31
|
Remove bytecode codegen.
----------------------------------------------------------------------
U mlton/trunk/Makefile
U mlton/trunk/basis-library/primitive/prim-mlton.sml
U mlton/trunk/basis-library/real/real.sml
U mlton/trunk/doc/changelog
D mlton/trunk/include/bytecode-main.h
D mlton/trunk/include/bytecode.h
D mlton/trunk/mlton/codegen/bytecode/bytecode.fun
D mlton/trunk/mlton/codegen/bytecode/bytecode.sig
D mlton/trunk/mlton/codegen/bytecode/sources.cm
D mlton/trunk/mlton/codegen/bytecode/sources.mlb
U mlton/trunk/mlton/codegen/sources.cm
U mlton/trunk/mlton/codegen/sources.mlb
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/main/compile.fun
U mlton/trunk/mlton/main/lookup-constant.fun
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/runtime/Makefile
D mlton/trunk/runtime/bytecode/.ignore
D mlton/trunk/runtime/bytecode/Makefile
D mlton/trunk/runtime/bytecode/interpret.c
D mlton/trunk/runtime/bytecode/interpret.h
D mlton/trunk/runtime/bytecode/opcode.h
D mlton/trunk/runtime/bytecode/print-opcodes.c
----------------------------------------------------------------------
Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/Makefile 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,4 @@
-## Copyright (C) 2009 Matthew Fluet.
+## Copyright (C) 2009,2011 Matthew Fluet.
# Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
# Jagannathan, and Stephen Weeks.
# Copyright (C) 1997-2000 NEC Research Institute.
@@ -205,20 +205,12 @@
echo "$(TARGET_ARCH)" > "$(LIB)/targets/$(TARGET)/arch"
$(CP) runtime/gen/basis-ffi.sml \
basis-library/primitive/basis-ffi.sml
-ifeq ($(OMIT_BYTECODE), yes)
-else
- $(CP) runtime/bytecode/opcodes "$(LIB)/"
-endif
$(CP) runtime/*.h "$(INC)/"
mv "$(INC)/c-types.h" "$(LIB)/targets/$(TARGET)/include"
for d in basis basis/Real basis/Word gc platform util; do \
mkdir -p "$(INC)/$$d"; \
$(CP) runtime/$$d/*.h "$(INC)/$$d"; \
done
-ifeq ($(OMIT_BYTECODE), yes)
-else
- $(CP) runtime/bytecode/interpret.h "$(INC)"
-endif
for x in "$(LIB)/targets/$(TARGET)"/*.a; do $(RANLIB) "$$x"; done
.PHONY: script
Modified: mlton/trunk/basis-library/primitive/prim-mlton.sml
===================================================================
--- mlton/trunk/basis-library/primitive/prim-mlton.sml 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/basis-library/primitive/prim-mlton.sml 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2010 Matthew Fluet.
+(* Copyright (C) 2010-2011 Matthew Fluet.
* Copyright (C) 1999-2009 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -62,17 +62,15 @@
structure Codegen =
struct
- datatype t = Bytecode | C | x86 | amd64
+ datatype t = amd64 | C | x86
val codegen =
case _build_const "MLton_Codegen_codegen": Int32.int; of
- 0 => Bytecode
- | 1 => C
- | 2 => x86
- | 3 => amd64
+ 0 => C
+ | 1 => x86
+ | 2 => amd64
| _ => raise Primitive.Exn.Fail8 "MLton_Codegen_codegen"
- val isBytecode = codegen = Bytecode
val isC = codegen = C
val isX86 = codegen = x86
val isAmd64 = codegen = amd64
Modified: mlton/trunk/basis-library/real/real.sml
===================================================================
--- mlton/trunk/basis-library/real/real.sml 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/basis-library/real/real.sml 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,5 @@
-(* Copyright (C) 2003-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 2003-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
@@ -20,16 +21,9 @@
local
open Prim
- val isBytecode = MLton.Codegen.isBytecode
in
- val *+ =
- if isBytecode
- then fn (r1, r2, r3) => r1 * r2 + r3
- else *+
- val *- =
- if isBytecode
- then fn (r1, r2, r3) => r1 * r2 - r3
- else *-
+ val op *+ = op *+
+ val op *- = op *-
val op * = op *
val op + = op +
val op - = op -
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/doc/changelog 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,6 +1,7 @@
Here are the changes from version 2010608 to version YYYYMMDD.
* 2011-06-04
+ - Remove bytecode codegen.
- Remove support for .cm files as input.
* 2011-05-03
Deleted: mlton/trunk/include/bytecode-main.h
===================================================================
--- mlton/trunk/include/bytecode-main.h 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/include/bytecode-main.h 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,87 +0,0 @@
-/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- */
-
-#ifndef _BYTECODE_MAIN_H_
-#define _BYTECODE_MAIN_H_
-
-#include "common-main.h"
-#include "interpret.h"
-
-#ifndef DEBUG_CODEGEN
-#define DEBUG_CODEGEN FALSE
-#endif
-
-PRIVATE extern struct Bytecode MLton_bytecode;
-
-static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) {
- return *((GC_frameIndex*)(MLton_bytecode.code + ra - sizeof(GC_frameIndex)));
-}
-
-#define MLtonCallFromC \
-static void MLton_callFromC () { \
- uintptr_t nextFun; \
- GC_state s; \
- \
- if (DEBUG_CODEGEN) \
- fprintf (stderr, "MLton_callFromC() starting\n"); \
- s = &gcState; \
- GC_setSavedThread (s, GC_getCurrentThread (s)); \
- s->atomicState += 3; \
- if (s->signalsInfo.signalIsPending) \
- s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; \
- /* Switch to the C Handler thread. */ \
- GC_switchToThread (s, GC_getCallFromCHandlerThread (s), 0); \
- nextFun = *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); \
- MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
- s->atomicState += 1; \
- GC_switchToThread (s, GC_getSavedThread (s), 0); \
- s->atomicState -= 1; \
- if (0 == s->atomicState \
- && s->signalsInfo.signalIsPending) \
- s->limit = 0; \
- if (DEBUG_CODEGEN) \
- fprintf (stderr, "MLton_callFromC done\n"); \
-} \
-
-#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
-MLtonCallFromC \
-PUBLIC int MLton_main (int argc, char* argv[]) { \
- uintptr_t nextFun; \
- Initialize (al, mg, mfs, mmc, pk, ps); \
- if (gcState.amOriginal) { \
- real_Init(); \
- nextFun = ml; \
- } else { \
- /* Return to the saved world */ \
- nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
- } \
- MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
- return 1; \
-}
-
-#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, ml) \
-MLtonCallFromC \
-PUBLIC void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \
- uintptr_t nextFun; \
- Initialize (al, mg, mfs, mmc, pk, ps); \
- if (gcState.amOriginal) { \
- real_Init(); \
- nextFun = ml; \
- } else { \
- /* Return to the saved world */ \
- nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
- } \
- MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
-} \
-PUBLIC void LIB_CLOSE(LIBNAME) () { \
- uintptr_t nextFun; \
- nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
- MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
- GC_done(&gcState); \
-}
-
-#endif /* #ifndef _BYTECODE_MAIN_H */
Deleted: mlton/trunk/include/bytecode.h
===================================================================
--- mlton/trunk/include/bytecode.h 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/include/bytecode.h 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,12 +0,0 @@
-/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- */
-
-#include <stdint.h>
-#include "ml-types.h"
-#include "c-types.h"
-#include "export.h"
-#include "interpret.h"
Deleted: mlton/trunk/mlton/codegen/bytecode/bytecode.fun
===================================================================
--- mlton/trunk/mlton/codegen/bytecode/bytecode.fun 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/codegen/bytecode/bytecode.fun 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,893 +0,0 @@
-(* Copyright (C) 2009 Matthew Fluet.
- * Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-functor Bytecode (S: BYTECODE_STRUCTS): BYTECODE =
-struct
-
-open S
-
-local
- open Machine
-in
- structure Block = Block
- structure CFunction = CFunction
- structure Chunk = Chunk
- structure CType = CType
- structure FrameInfo = FrameInfo
- structure Global = Global
- structure Kind = Kind
- structure Label = Label
- structure Live = Live
- structure Operand = Operand
- structure Prim = Prim
- structure Program = Program
- structure Register = Register
- structure Runtime = Runtime
- structure Scale = Scale
- structure StackOffset = StackOffset
- structure Statement = Statement
- structure Switch = Switch
- structure Transfer = Transfer
- structure Type = Type
- structure WordSize = WordSize
- structure WordX = WordX
-end
-
-structure Target = CFunction.Target
-
-fun implementsPrim p =
- let
- datatype z = datatype Prim.Name.t
- in
- case Prim.name p of
- CPointer_add => true
- | CPointer_diff => true
- | CPointer_equal => true
- | CPointer_fromWord => true
- | CPointer_lt => true
- | CPointer_sub => true
- | CPointer_toWord => true
- | FFI_Symbol _ => true
- | Real_Math_acos _ => true
- | Real_Math_asin _ => true
- | Real_Math_atan _ => true
- | Real_Math_atan2 _ => true
- | Real_Math_cos _ => true
- | Real_Math_exp _ => true
- | Real_Math_ln _ => true
- | Real_Math_log10 _ => true
- | Real_Math_sin _ => true
- | Real_Math_sqrt _ => true
- | Real_Math_tan _ => true
- | Real_abs _ => true
- | Real_add _ => true
- | Real_castToWord _ => true
- | Real_div _ => true
- | Real_equal _ => true
- | Real_ldexp _ => false
- | Real_le _ => true
- | Real_lt _ => true
- | Real_mul _ => true
- | Real_muladd _ => false
- | Real_mulsub _ => false
- | Real_neg _ => true
- | Real_qequal _ => false
- | Real_rndToReal _ => true
- | Real_rndToWord _ => true
- | Real_round _ => true
- | Real_sub _ => true
- | Word_add _ => true
- | Word_addCheck _ => true
- | Word_andb _ => true
- | Word_castToReal _ => true
- | Word_equal _ => true
- | Word_extdToWord _ => true
- | Word_lshift _ => true
- | Word_lt _ => true
- | Word_mul _ => true
- | Word_mulCheck _ => true
- | Word_neg _ => true
- | Word_negCheck _ => true
- | Word_notb _ => true
- | Word_orb _ => true
- | Word_quot _ => true
- | Word_rem _ => true
- | Word_rndToReal _ => true
- | Word_rol _ => true
- | Word_ror _ => true
- | Word_rshift _ => true
- | Word_sub _ => true
- | Word_subCheck _ => true
- | Word_xorb _ => true
- | _ => false
- end
-
-structure Opcode = IntInf
-
-structure CType =
- struct
- open CType
-
- val memo: (t -> 'a) -> t -> 'a =
- fn f =>
- let
- val m =
- CType.memo (fn t =>
- case t of
- CType.CPointer => NONE
- | CType.Objptr => NONE
- | _ => SOME (f t))
- in
- fn t =>
- valOf (case t of
- CType.CPointer => m (CType.csize ())
- | CType.Objptr => m (CType.csize ())
- | _ => m t)
- end
-
- val noSigned =
- memo (fn t =>
- case t of
- Int8 => Word8
- | Int16 => Word16
- | Int32 => Word32
- | Int64 => Word64
- | _ => t)
-
- val toStringOrig = toString
- val toString = memo toString
- end
-
-structure LoadStore =
- struct
- datatype t = Load | Store
-
- val toString =
- fn Load => "load"
- | Store => "store"
-
- val layout = Layout.str o toString
- end
-
-fun output {program as Program.T {chunks, main, ...}, outputC} =
- let
- datatype z = datatype LoadStore.t
- datatype z = datatype Statement.t
- datatype z = datatype Transfer.t
- (* Build a table of the opcodes. *)
- val table = HashSet.new {hash = #hash}
- val _ =
- File.withIn
- (concat [!Control.libDir, "/opcodes"], fn ins =>
- In.foldLines
- (ins, 0, fn (l, i) =>
- case String.tokens (l, Char.isSpace) of
- [name] =>
- let
- val hash = String.hash name
- val _ =
- HashSet.insertIfNew
- (table, hash,
- fn {name = name', ...} => name = name',
- fn () => {hash = hash,
- opcode = Int.toIntInf i,
- name = name},
- fn _ => Error.bug
- (concat ["Bytecode.output: duplicate opcode: ",
- name]))
- in
- i + 1
- end
- | _ => Error.bug "Bytecode.output: strange opcode file"))
- val opcode: string -> Opcode.t =
- fn name =>
- #opcode (HashSet.lookupOrInsert
- (table, String.hash name,
- fn {name = name', ...} => name = name',
- fn () => Error.bug
- (concat ["Bytecode.output: missing opcode: ",
- name])))
- val callCounter = Counter.new 0
- val callCs = ref []
- fun callC {function: string,
- prototype}: string =
- let
- val (args, result) = prototype
- val c = Counter.new 0
- fun temp () = concat ["t", Int.toString (Counter.next c)]
- fun cast (cty, src) =
- concat ["(", cty, ")(", src, ")"]
- val args =
- Vector.map
- (args, fn cty =>
- let
- val mty = CType.noSigned cty
- val (declarePop,mtemp) =
- let
- val mty = CType.toString mty
- val mtemp = temp ()
- in
- (concat ["\t", mty, " ", mtemp,
- " = PopReg (", mty, ");\n"],
- mtemp)
- end
- val (declareCast, ctemp) =
- if mty = cty
- then ("", mtemp)
- else let
- val cty = CType.toString cty
- val ctemp = temp ()
- in
- (concat ["\t", cty, " ", ctemp, " = ",
- cast (cty, mtemp), ";\n"],
- ctemp)
- end
- in
- {declare = concat [declarePop, declareCast],
- temp = ctemp}
- end)
- val call =
- concat [function,
- " (",
- (concat o List.separate)
- (Vector.toListMap (args, #temp), ", "),
- ");\n"]
- val result =
- case result of
- NONE => concat ["\t", call]
- | SOME cty =>
- let
- val mty = CType.noSigned cty
- in
- if mty = cty
- then concat
- ["\tPushReg (", CType.toString cty, ") = ",
- call]
- else let
- val cty = CType.toString cty
- val ctemp = temp ()
- val mty = CType.toString mty
- in
- concat
- ["\t", cty, " ", ctemp, " = ", call,
- "\tPushReg (", mty, ") = ",
- cast (mty, ctemp), ";\n"]
- end
- end
- in
- concat
- ["{\n",
- concat (Vector.toListMap (args, #declare)),
- "\tassertRegsEmpty ();\n",
- result,
- "\t}\n"]
- end
- local
- val calls = HashSet.new {hash = #hash}
- in
- val () =
- (* Visit each direct C Call in the program. *)
- List.foreach
- (chunks, fn Chunk.T {blocks, ...} =>
- Vector.foreach
- (blocks, fn Block.T {statements, transfer, ...} =>
- (Vector.foreach
- (statements, fn s =>
- case s of
- PrimApp {dst, prim, ...} =>
- (case Prim.name prim of
- Prim.Name.FFI_Symbol {name, ...} =>
- Option.app
- (dst, fn _ =>
- let
- val hash = String.hash name
- in
- ignore
- (HashSet.lookupOrInsert
- (calls, hash,
- fn {name = n, symbol, ...} =>
- n = name andalso symbol,
- fn () =>
- let
- val index = Counter.next callCounter
- val display =
- let
- val ptr =
- CType.toString CType.CPointer
- in
- concat
- ["PushReg (",ptr,") = ",
- "((",ptr,")(&",name,"));\n"]
- end
- val () =
- List.push
- (callCs, {display = display,
- index = index})
- in
- {hash = hash,
- index = index,
- name = name,
- symbol = true}
- end))
- end)
- | _ => ())
- | _ => ())
- ; (case transfer of
- CCall {func, ...} =>
- let
- val CFunction.T {prototype, target, ...} = func
- datatype z = datatype Target.t
- in
- case target of
- Direct "Thread_returnToC" => ()
- | Direct name =>
- let
- val hash = String.hash name
- in
- ignore
- (HashSet.lookupOrInsert
- (calls, hash,
- fn {name = n, symbol, ...} =>
- n = name andalso (not symbol),
- fn () =>
- let
- val index = Counter.next callCounter
- val display =
- callC {function = name,
- prototype = prototype}
- val () =
- List.push
- (callCs, {display = display,
- index = index})
- in
- {hash = hash,
- index = index,
- name = name,
- symbol = false}
- end))
- end
- | Indirect => ()
- end
- | _ => ()))))
- fun directIndex (name: string) =
- #index (HashSet.lookupOrInsert
- (calls, String.hash name,
- fn {name = n, symbol, ...} =>
- n = name andalso (not symbol),
- fn () => Error.bug "Bytecode.output.directIndex"))
- fun ffiSymbolIndex (name: string) =
- #index (HashSet.lookupOrInsert
- (calls, String.hash name,
- fn {name = n, symbol, ...} =>
- n = name andalso symbol,
- fn () => Error.bug "Bytecode.output.ffiSymbolIndex"))
- end
- fun indirectIndex (f: 'a CFunction.t): int =
- let
- val index = Counter.next callCounter
- val function =
- concat ["(", "*(", CFunction.cPointerType f, " fptr)) "]
- val display =
- concat ["{\n\t", CType.toStringOrig (CType.csize ()),
- " fptr = PopReg (", CType.toStringOrig (CType.csize ()),
- ");\n\t",
- callC {function = function,
- prototype = CFunction.prototype f},
- "\t}\n"]
- val () =
- List.push (callCs, {display = display,
- index = index})
- in
- index
- end
- val callC = opcode "CallC"
- val jumpOnOverflow = opcode "JumpOnOverflow"
- val raisee = opcode "Raise"
- val returnOp = opcode "Return"
- val returnToC = opcode "Thread_returnToC"
- datatype z = datatype WordSize.prim
- val switch: WordSize.t -> Opcode.t =
- let
- val s8 = opcode "Switch8"
- val s16 = opcode "Switch16"
- val s32 = opcode "Switch32"
- val s64 = opcode "Switch64"
- in
- fn w =>
- case WordSize.prim w of
- W8 => s8
- | W16 => s16
- | W32 => s32
- | W64 => s64
- end
- local
- fun make (name, distinguishPointers: bool)
- (ls: LoadStore.t, cty: CType.t): Opcode.t =
- opcode
- (concat [if distinguishPointers
- then CType.toStringOrig cty
- else CType.toString cty,
- "_", LoadStore.toString ls, name])
- in
- val arrayOffset = make ("ArrayOffset", false)
- val contents = make ("Contents", false)
- val global = make ("Global", true)
- val offsetOp = make ("Offset", false)
- val register = make ("Register", true)
- val stackOffset = make ("StackOffset", false)
- val wordOpcode = make ("Word", false)
- end
- val branchIfZero = opcode "BranchIfZero"
- fun gpnr ls = opcode (concat [LoadStore.toString ls, "GPNR"])
- local
- fun make name (ls: LoadStore.t): Opcode.t =
- opcode (concat [LoadStore.toString ls, name])
- in
- val frontier = make "Frontier"
- val gcState = make "GCState"
- val stackTop = make "StackTop"
- end
- val code: Word8.t list ref = ref []
- val offset = ref 0
- val emitByte: Word8.t -> unit =
- fn w =>
- (List.push (code, w)
- ; Int.inc offset)
- local
- fun make (bits: int, {signed}): IntInf.t -> unit =
- let
- val bits = Bits.fromInt bits
- in
- fn i =>
- if not (WordSize.isInRange (WordSize.fromBits bits, i,
- {signed = signed}))
- then Error.bug (concat ["Bytecode.output: emitWord",
- Bits.toString bits,
- " failed on ",
- IntInf.toString i])
- else
- let
- fun loop (j, i) =
- if 0 = j
- then ()
- else
- let
- val (q, r) = IntInf.quotRem (i, 0x100)
- val () = emitByte (Word8.fromIntInf r)
- in
- loop (j - 1, q)
- end
- in
- loop (Bytes.toInt (Bits.toBytes bits),
- IntInf.mod (i, IntInf.<< (1, Bits.toWord bits)))
- end
- end
- in
- val emitWord8 = make (8, {signed = false})
- val emitWord16 = make (16, {signed = false})
- val emitWordS16 = make (16, {signed = true})
- val emitWord32 = make (32, {signed = false})
- val emitWord64 = make (64, {signed = false})
- end
- val emitWordX: WordX.t -> unit =
- fn w =>
- (case WordSize.prim (WordX.size w) of
- W8 => emitWord8
- | W16 => emitWord16
- | W32 => emitWord32
- | W64 => emitWord64) (WordX.toIntInf w)
- val emitOpcode = emitWord16
- val emitPrim: 'a Prim.t -> unit =
- fn p => emitOpcode (opcode (Prim.toString p))
- fun emitCallC (index: int): unit =
- (emitOpcode callC
- ; emitWord16 (Int.toIntInf index))
- val {get = labelInfo: Label.t -> {block: Block.t,
- emitted: bool ref,
- occurrenceOffsets: int list ref,
- offset: int option ref},
- set = setLabelInfo, ...} =
- Property.getSetOnce (Label.plist,
- Property.initRaise ("info", Label.layout))
- val needToEmit: Label.t list ref = ref []
- val emitLabel: Label.t -> unit =
- fn l =>
- let
- val {emitted, occurrenceOffsets, ...} = labelInfo l
- val () = List.push (occurrenceOffsets, !offset)
- val () = if !emitted then () else List.push (needToEmit, l)
- in
- emitWordX (WordX.zero (WordSize.cpointer ()))
- end
- val emitLabel =
- Trace.trace ("Bytecode.emitLabel", Label.layout, Unit.layout) emitLabel
- fun loadStoreStackOffset (offset, cty, ls) =
- (emitOpcode (stackOffset (ls, cty))
- ; emitWord16 (Bytes.toIntInf offset))
- val rec emitLoadOperand = fn z => emitOperand (z, Load)
- and emitOperand: Operand.t * LoadStore.t -> unit =
- fn (z, ls) =>
- let
- val cty = Type.toCType (Operand.ty z)
- datatype z = datatype Operand.t
- in
- case z of
- ArrayOffset {base, index, offset, scale, ...} =>
- (emitLoadOperand base
- ; emitLoadOperand index
- ; emitOpcode (arrayOffset (ls, cty))
- ; emitWord16 (Bytes.toIntInf offset)
- ; emitWord8 (Int.toIntInf (Scale.toInt scale)))
- | Cast (z, _) => emitOperand (z, ls)
- | Contents {oper, ...} =>
- (emitLoadOperand oper
- ; emitOpcode (contents (ls, cty)))
- | Frontier => emitOpcode (frontier ls)
- | GCState => emitOpcode (gcState ls)
- | Global g =>
- (if Global.isRoot g
- then emitOpcode (global (ls, cty))
- else emitOpcode (gpnr ls)
- ; emitWord16 (Int.toIntInf (Global.index g)))
- | Label l =>
- (emitOpcode (wordOpcode (ls, cty))
- ; emitLabel l)
- | Null => (emitOpcode (wordOpcode (ls, cty))
- ; emitWordX (WordX.zero (WordSize.cpointer ())))
- | Offset {base, offset = off, ...} =>
- (emitLoadOperand base
- ; emitOpcode (offsetOp (ls, cty))
- ; emitWordS16 (Bytes.toIntInf off))
- | Real _ => Error.bug "Bytecode.emitOperand: Real"
- | Register r =>
- (emitOpcode (register (ls, cty))
- ; emitWord16 (Int.toIntInf (Register.index r)))
- | StackOffset (StackOffset.T {offset, ...}) =>
- loadStoreStackOffset (offset, cty, ls)
- | StackTop => emitOpcode (stackTop ls)
- | Word w =>
- case ls of
- Load => (emitOpcode (wordOpcode (ls, cty)); emitWordX w)
- | Store => Error.bug "Bytecode.emitOperand: Word, Store"
- end
- val emitLoadOperand =
- Trace.trace
- ("Bytecode.emitLoadOperand", Operand.layout, Unit.layout)
- emitLoadOperand
- val emitOperand =
- Trace.trace2
- ("Bytecode.emitOperand", Operand.layout, LoadStore.layout, Unit.layout)
- emitOperand
- fun emitStoreOperand z = emitOperand (z, Store)
- fun move {dst, src} =
- (emitLoadOperand src
- ; emitStoreOperand dst)
- fun emitArgs args = Vector.foreach (Vector.rev args, emitLoadOperand)
- fun primApp {args, dst, prim} =
- case Prim.name prim of
- Prim.Name.FFI_Symbol {name, ...} =>
- Option.app
- (dst, fn dst =>
- (emitCallC (ffiSymbolIndex name)
- ; emitStoreOperand dst))
- | _ =>
- (emitArgs args
- ; emitPrim prim
- ; Option.app (dst, emitStoreOperand))
- val emitStatement: Statement.t -> unit =
- fn s =>
- case s of
- Move z => move z
- | Noop => ()
- | PrimApp z => primApp z
- | ProfileLabel _ => Error.bug "Bytecode.output.emitStatement: profileLabel"
- val emitStatement =
- Trace.trace ("Bytecode.emitStatement", Statement.layout, Unit.layout)
- emitStatement
- val gotoOp = opcode "Goto"
- val pointerSize = WordSize.cpointer ()
- val flushStackTopOp = opcode "FlushStackTop"
- val amTimeProfiling =
- !Control.profile = Control.ProfileTimeField
- orelse !Control.profile = Control.ProfileTimeLabel
- fun shiftStackTop (size: Bytes.t) =
- (primApp {args = (Vector.new2
- (Operand.StackTop,
- Operand.Word (WordX.fromIntInf
- (Bytes.toIntInf size,
- pointerSize)))),
- dst = SOME Operand.StackTop,
- prim = Prim.wordAdd pointerSize}
- ; if amTimeProfiling
- then emitOpcode flushStackTopOp
- else ())
- fun push (label: Label.t, size: Bytes.t): unit =
- (move {dst = (Operand.StackOffset
- (StackOffset.T
- {offset = Bytes.- (size, Runtime.labelSize ()),
- ty = Type.label label})),
- src = Operand.Label label}
- ; shiftStackTop size)
- fun pop (size: Bytes.t) = shiftStackTop (Bytes.~ size)
- val () =
- List.foreach
- (chunks, fn Chunk.T {blocks, ...} =>
- Vector.foreach
- (blocks, fn block =>
- setLabelInfo (Block.label block,
- {block = block,
- emitted = ref false,
- occurrenceOffsets = ref [],
- offset = ref NONE})))
- val traceEmitTransfer =
- Trace.trace ("Bytecode.emitTransfer", Transfer.layout, Unit.layout)
- fun emitBlock (Block.T {kind, label, statements, transfer, ...}): unit =
- let
- val () =
- Option.app
- (Kind.frameInfoOpt kind,
- fn FrameInfo.T {frameLayoutsIndex} =>
- ((* This load will never be used. We just have it there
- * so the disassembler doesn't get confused when it
- * sees the frameLayoutsIndex.
- *)
- emitOpcode (wordOpcode (Load, CType.Word32))
- ; emitWord32 (Int.toIntInf frameLayoutsIndex)))
- val () = #offset (labelInfo label) := SOME (!offset)
- fun popFrame () =
- Option.app (Kind.frameInfoOpt kind, fn fi =>
- pop (Program.frameSize (program, fi)))
- val () =
- case kind of
- Kind.CReturn {dst, func, ...} =>
- (case #2 (CFunction.prototype func) of
- NONE => popFrame ()
- | SOME cty =>
- case dst of
- NONE =>
- (* Even if there is no dst, we still need to
- * pop the value returned by the C function.
- * We write it to a bogus location in the
- * callee's frame before popping back to the
- * caller.
- * We mediated between the signed/unsigned treatment
- * in the stub.
- *)
- (loadStoreStackOffset
- (Bytes.zero, CType.noSigned cty, Store)
- ; popFrame ())
- | SOME z =>
- (popFrame ()
- ; emitStoreOperand (Live.toOperand z)))
- | _ => popFrame ()
- val () =
- (Vector.foreach (statements, emitStatement)
- ; emitTransfer transfer)
- in
- ()
- end
- and goto (l: Label.t): unit =
- let
- val {block as Block.T {kind, ...}, emitted, ...} = labelInfo l
- in
- if !emitted orelse isSome (Kind.frameInfoOpt kind)
- then (emitOpcode gotoOp; emitLabel l)
- else (emitted := true; emitBlock block)
- end
- and emitTransfer arg: unit =
- traceEmitTransfer
- (fn (t: Transfer.t) =>
- let
- datatype z = datatype Transfer.t
- in
- case t of
- Arith {args, dst, overflow, prim, success} =>
- (emitArgs args
- ; emitPrim prim
- ; emitStoreOperand dst
- ; emitOpcode jumpOnOverflow
- ; emitLabel overflow
- ; goto success)
- | CCall {args, frameInfo, func, return} =>
- let
- val () = emitArgs args
- val CFunction.T {maySwitchThreads, target, ...} =
- func
- val () =
- Option.app
- (frameInfo, fn frameInfo =>
- push (valOf return,
- Program.frameSize (program, frameInfo)))
- datatype z = datatype Target.t
- val () =
- case target of
- Direct "Thread_returnToC" => emitOpcode returnToC
- | Direct name => emitCallC (directIndex name)
- | Indirect => emitCallC (indirectIndex func)
- val () =
- if maySwitchThreads
- then emitOpcode returnOp
- else Option.app (return, goto)
- in
- ()
- end
- | Call {label, return, ...} =>
- (Option.app (return, fn {return, size, ...} =>
- push (return, size))
- ; goto label)
- | Goto l => goto l
- | Raise => emitOpcode raisee
- | Return => emitOpcode returnOp
- | Switch (Switch.T {cases, default, size, test}) =>
- let
- val () = emitLoadOperand test
- fun bool (a: Label.t, b: Label.t) =
- (emitOpcode branchIfZero
- ; emitLabel b
- ; goto a)
- fun normal () =
- let
- val numCases =
- Vector.length cases
- + (if isSome default then 1 else 0)
- - 1
- val () =
- (emitOpcode (switch size)
- ; emitWord16 (Int.toIntInf numCases))
- fun emitCases cases =
- Vector.foreach (cases, fn (w, l) =>
- (emitWordX w; emitLabel l))
- in
- case default of
- NONE =>
- (emitCases (Vector.dropSuffix (cases, 1))
- ; goto (#2 (Vector.last cases)))
- | SOME l =>
- (emitCases cases; goto l)
- end
- in
- if 2 = Vector.length cases
- andalso Option.isNone default
- andalso WordSize.equals (size, WordSize.bool)
- then
- let
- val (c0, l0) = Vector.sub (cases, 0)
- val (c1, l1) = Vector.sub (cases, 1)
- val i0 = WordX.toIntInf c0
- val i1 = WordX.toIntInf c1
- in
- if i0 = 0 andalso i1 = 1
- then bool (l1, l0)
- else if i0 = 1 andalso i1 = 0
- then bool (l0, l1)
- else normal ()
- end
- else normal ()
- end
- end) arg
- fun loop () =
- case !needToEmit of
- [] => ()
- | l :: ls =>
- let
- val () = needToEmit := ls
- val {block, emitted, ...} = labelInfo l
- val () =
- if !emitted
- then ()
- else (emitted := true; emitBlock block)
- in
- loop ()
- end
- val () = List.push (needToEmit, #label main)
- val () = loop ()
- (* Discard unreachable blocks *)
- val chunks =
- List.map
- (chunks, fn Chunk.T {blocks, chunkLabel, regMax} =>
- let
- val blocks =
- Vector.keepAll
- (blocks, fn Block.T {label, ...} =>
- ! (#emitted (labelInfo label)))
- in
- Chunk.T {blocks = blocks,
- chunkLabel = chunkLabel,
- regMax = regMax}
- end)
- fun labelOffset l = valOf (! (#offset (labelInfo l)))
- val code = Array.fromListRev (!code)
- (* Backpatch all label references. *)
- val () =
- List.foreach
- (chunks, fn Chunk.T {blocks, ...} =>
- Vector.foreach
- (blocks, fn Block.T {label, ...} =>
- let
- val {occurrenceOffsets = r, offset, ...} = labelInfo label
- val offset = valOf (!offset)
- fun loop (i, address) =
- if 0 = address
- then ()
- else (Array.update (code, i,
- Word8.fromInt (Int.rem (address, 0x100)))
- ; loop (i + 1, Int.quot (address, 0x100)))
- in
- List.foreach (!r, fn occ => loop (occ, offset))
- end))
- val {done, file = _, print} = outputC ()
- val print =
- Trace.trace ("Bytecode.print", String.layout, Unit.layout) print
- val () =
- CCodegen.outputDeclarations
- {additionalMainArgs = [Int.toString (labelOffset (#label main))],
- includes = ["bytecode-main.h"],
- print = print,
- program = program,
- rest = fn () => ()}
- val () = done ()
- val {done, print, ...} = outputC ()
- fun declareCallC () =
- (print "PRIVATE void MLton_callC (int i) {\n"
- ; print "switch (i) {\n"
- ; List.foreach (!callCs, fn {display, index} =>
- (print (concat ["case ", Int.toString index, ":\n\t"])
- ; print display
- ; print "break;\n"))
- ; print "}}\n")
- val () =
- (print "#include \"bytecode.h\"\n\n"
- ; List.foreach (chunks, fn c =>
- CCodegen.declareFFI (c, {print = print}))
- ; print "\n"
- ; declareCallC ()
- ; print "\n")
- val word8ArrayToString: Word8.t array -> string =
- fn a => String.tabulate (Array.length a, fn i =>
- Char.fromWord8 (Array.sub (a, i)))
- val {labels, offsets, ...} =
- List.fold
- (chunks, {labels = [], offset = 0, offsets = []},
- fn (Chunk.T {blocks, ...}, ac) =>
- Vector.fold
- (blocks, ac, fn (Block.T {label, ...}, {labels, offset, offsets}) =>
- let
- val offsets = {code = labelOffset label, name = offset} :: offsets
- val label = Label.toString label
- in
- {labels = label :: labels,
- offset = offset + String.size label + 1,
- offsets = offsets}
- end))
- val labels =
- concat (List.fold (labels, [], fn (l, ac) => l :: "\000" :: ac))
- val offsets = rev offsets
- fun printString s =
- (print "\t\""; print (String.escapeC s); print "\",\n")
- fun printInt i = print (concat ["\t", Int.toString i, ",\n"])
- val () =
- (print "static struct NameOffsets nameOffsets [] = {\n"
- ; List.foreach (offsets, fn {code, name} =>
- print (concat ["\t{ ",
- Int.toString code, ", ",
- Int.toString name,
- " },\n"]))
- ; print "};\n"
- ; print "PRIVATE struct Bytecode MLton_bytecode = {\n"
- ; printString labels
- ; printString (word8ArrayToString code)
- ; printInt (Array.length code)
- ; print "\tnameOffsets,\n"
- ; printInt (List.length offsets)
- ; print "};\n")
- val () = done ()
- in
- ()
- end
-
-end
Deleted: mlton/trunk/mlton/codegen/bytecode/bytecode.sig
===================================================================
--- mlton/trunk/mlton/codegen/bytecode/bytecode.sig 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/codegen/bytecode/bytecode.sig 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,24 +0,0 @@
-(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-signature BYTECODE_STRUCTS =
- sig
- structure CCodegen: C_CODEGEN
- structure Machine: MACHINE
- sharing Machine = CCodegen.Machine
- end
-
-signature BYTECODE =
- sig
- include BYTECODE_STRUCTS
-
- val implementsPrim: 'a Machine.Prim.t -> bool
- val output: {program: Machine.Program.t,
- outputC: unit -> {file: File.t,
- print: string -> unit,
- done: unit -> unit}} -> unit
- end
Deleted: mlton/trunk/mlton/codegen/bytecode/sources.cm
===================================================================
--- mlton/trunk/mlton/codegen/bytecode/sources.cm 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/codegen/bytecode/sources.cm 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,15 +0,0 @@
-(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-Group is
-
-../../../lib/mlton/sources.cm
-../../backend/sources.cm
-../../control/sources.cm
-../c-codegen/sources.cm
-bytecode.sig
-bytecode.fun
Deleted: mlton/trunk/mlton/codegen/bytecode/sources.mlb
===================================================================
--- mlton/trunk/mlton/codegen/bytecode/sources.mlb 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/codegen/bytecode/sources.mlb 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,18 +0,0 @@
-(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-local
- ../../../lib/mlton/sources.mlb
- ../../backend/sources.mlb
- ../../control/sources.mlb
- ../c-codegen/sources.mlb
-
- bytecode.sig
- bytecode.fun
-in
- functor Bytecode
- end
Modified: mlton/trunk/mlton/codegen/sources.cm
===================================================================
--- mlton/trunk/mlton/codegen/sources.cm 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/codegen/sources.cm 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -9,13 +10,11 @@
Group
functor amd64Codegen
-functor Bytecode
functor CCodegen
functor x86Codegen
is
amd64-codegen/sources.cm
-bytecode/sources.cm
c-codegen/sources.cm
x86-codegen/sources.cm
Modified: mlton/trunk/mlton/codegen/sources.mlb
===================================================================
--- mlton/trunk/mlton/codegen/sources.mlb 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/codegen/sources.mlb 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -9,11 +10,9 @@
local
amd64-codegen/sources.mlb
c-codegen/sources.mlb
- bytecode/sources.mlb
x86-codegen/sources.mlb
in
functor amd64Codegen
- functor Bytecode
functor CCodegen
functor x86Codegen
end
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/control/control-flags.sig 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009-2010 Matthew Fluet.
+(* Copyright (C) 2009-2011 Matthew Fluet.
* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -37,8 +37,7 @@
structure Codegen:
sig
datatype t =
- Bytecode
- | CCodegen
+ CCodegen
| x86Codegen
| amd64Codegen
val all: t list
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/control/control-flags.sml 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009-2010 Matthew Fluet.
+(* Copyright (C) 2009-2011 Matthew Fluet.
* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -63,18 +63,16 @@
structure Codegen =
struct
datatype t =
- amd64Codegen
- | Bytecode
- | CCodegen
+ CCodegen
| x86Codegen
+ | amd64Codegen
- val all = [x86Codegen,amd64Codegen,CCodegen,Bytecode]
+ val all = [x86Codegen,amd64Codegen,CCodegen]
val toString: t -> string =
- fn amd64Codegen => "amd64"
- | Bytecode => "bytecode"
- | CCodegen => "c"
+ fn CCodegen => "c"
| x86Codegen => "x86"
+ | amd64Codegen => "amd64"
end
datatype codegen = datatype Codegen.t
Modified: mlton/trunk/mlton/main/compile.fun
===================================================================
--- mlton/trunk/mlton/main/compile.fun 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/main/compile.fun 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -111,8 +112,6 @@
fun funcToLabel f = f)
structure CCodegen = CCodegen (structure Ffi = Ffi
structure Machine = Machine)
-structure Bytecode = Bytecode (structure CCodegen = CCodegen
- structure Machine = Machine)
structure x86Codegen = x86Codegen (structure CCodegen = CCodegen
structure Machine = Machine)
structure amd64Codegen = amd64Codegen (structure CCodegen = CCodegen
@@ -682,8 +681,7 @@
end
val codegenImplementsPrim =
case !Control.codegen of
- Control.Bytecode => Bytecode.implementsPrim
- | Control.CCodegen => CCodegen.implementsPrim
+ Control.CCodegen => CCodegen.implementsPrim
| Control.x86Codegen => x86Codegen.implementsPrim
| Control.amd64Codegen => amd64Codegen.implementsPrim
val machine =
@@ -725,11 +723,7 @@
; Machine.Label.printNameAlphaNumeric := true)
val () =
case !Control.codegen of
- Control.Bytecode =>
- Control.trace (Control.Top, "bytecode gen")
- Bytecode.output {program = machine,
- outputC = outputC}
- | Control.CCodegen =>
+ Control.CCodegen =>
(clearNames ()
; (Control.trace (Control.Top, "C code gen")
CCodegen.output {program = machine,
Modified: mlton/trunk/mlton/main/lookup-constant.fun
===================================================================
--- mlton/trunk/mlton/main/lookup-constant.fun 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/main/lookup-constant.fun 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2010 Matthew Fluet.
+(* Copyright (C) 2010-2011 Matthew Fluet.
* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -29,10 +29,9 @@
Align4 => 4
| Align8 => 8)),
("MLton_Codegen_codegen", fn () => int (case !codegen of
- Bytecode => 0
- | CCodegen => 1
- | x86Codegen => 2
- | amd64Codegen => 3)),
+ CCodegen => 0
+ | x86Codegen => 1
+ | amd64Codegen => 2)),
("MLton_FFI_numExports", fn () => int (Ffi.numExports ())),
("MLton_Platform_Format", fn () => case !format of
Archive => "archive"
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/mlton/main/main.fun 2011-06-04 14:34:05 UTC (rev 7537)
@@ -290,7 +290,6 @@
case cg of
Native => if hasNativeCodegen () then SOME "native" else NONE
| Explicit cg => if hasCodegen cg
- andalso cg <> Bytecode
then SOME (Control.Codegen.toString cg)
else NONE),
"|"),
@@ -1028,14 +1027,6 @@
MLton.Platform.Arch.toString targetArch,
" target"])
else ()
- val _ =
- if !codegen = Bytecode
- andalso !Control.warnDeprecated
- then
- Out.output
- (Out.error,
- "Warning: bytecode codegen is deprecated. Use native or C codegen.\n")
- else ()
val () =
Control.labelsHaveExtra_ := (case targetOS of
Cygwin => true
@@ -1047,7 +1038,6 @@
(case !explicitChunk of
NONE => (case !codegen of
amd64Codegen => ChunkPerFunc
- | Bytecode => OneChunk
| CCodegen => Coalesce {limit = 4096}
| x86Codegen => ChunkPerFunc
)
@@ -1075,10 +1065,6 @@
andalso not (warnMatch)
andalso not (!keepDefUse))
val _ =
- if !codegen = Bytecode andalso !profile = ProfileTimeLabel
- then usage (concat ["bytecode codegen doesn't support -profile time-label\n"])
- else ()
- val _ =
case targetOS of
Darwin => ()
| FreeBSD => ()
Modified: mlton/trunk/runtime/Makefile
===================================================================
--- mlton/trunk/runtime/Makefile 2011-06-04 14:33:53 UTC (rev 7536)
+++ mlton/trunk/runtime/Makefile 2011-06-04 14:34:05 UTC (rev 7537)
@@ -1,4 +1,4 @@
-## Copyright (C) 2010 Matthew Fluet.
+## Copyright (C) 2010-2011 Matthew Fluet.
# Copyright (C) 1999-2009 Henry Cejtin, Matthew Fluet, Suresh
# Jagannathan, and Stephen Weeks.
# Copyright (C) 1997-2000 NEC Research Institute.
@@ -220,9 +220,6 @@
GCCFILES := \
$(shell find gc -type f | grep '\.c$$')
-BYTECODEHFILES := \
- $(shell find bytecode -type f | grep '\.h$$')
-
BASISHFILES := \
ml-types.h \
c-types.h \
@@ -250,12 +247,6 @@
platform/$(TARGET_OS).o \
gc.o
-OMIT_BYTECODE := no
-ifeq ($(OMIT_BYTECODE), yes)
-else
- OBJS += bytecode/interpret.o
-endif
-
ifeq ($(COMPILE_FAST), yes)
OBJS += basis.o
else
@@ -270,10 +261,6 @@
ALL := libgdtoa.a libgdtoa-gdb.a libgdtoa-pic.a \
libmlton.a libmlton-gdb.a libmlton-pic.a
ALL += gen/c-types.sml gen/basis-ffi.sml gen/sizes
-ifeq ($(OMIT_BYTECODE), yes)
-else
- ALL += bytecode/opcodes
-endif
all: $(ALL)
@@ -356,21 +343,6 @@
gc.o: gc.c $(GCCFILES) $(HFILES)
$(CC) $(OPTCFLAGS) $(GCOPTCFLAGS) $(OPTWARNCFLAGS) -c -o $@ $<
-## Needs -Wno-float-equal for Real<N>_equal, included via "c-chunk.h".
-bytecode/interpret-pic.o: bytecode/interpret.c $(HFILES) $(BYTECODEHFILES)
- $(CC) -I../include $(PICCFLAGS) $(GCPICCFLAGS) $(PICWARNCFLAGS) -Wno-float-equal -c -o $@ $<
-bytecode/interpret-gdb.o: bytecode/interpret.c $(HFILES) $(BYTECODEHFILES)
- $(CC) -I../include $(DEBUGCFLAGS) $(GCDEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-float-equal -c -o $@ $<
-bytecode/interpret.o: bytecode/interpret.c $(HFILES) $(BYTECODEHFILES...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2011-06-04 07:34:01
|
Remove support for .cm files as input.
The ML Basis system provides much better infrastructure for
"programming in the very large" than the (very) limited support for
CM. The cm2mlb tool (available in the source distribution) can be
used to convert CM projects to MLB projects, preserving the CM scoping
of module identifiers.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
D mlton/trunk/mlton/cm/cm.sig
D mlton/trunk/mlton/cm/cm.sml
D mlton/trunk/mlton/cm/lexer.sig
D mlton/trunk/mlton/cm/lexer.sml
D mlton/trunk/mlton/cm/parse.sig
D mlton/trunk/mlton/cm/parse.sml
D mlton/trunk/mlton/cm/sources.cm
D mlton/trunk/mlton/cm/sources.mlb
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/mlton/main/sources.cm
U mlton/trunk/mlton/main/sources.mlb
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/doc/changelog 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,5 +1,8 @@
Here are the changes from version 2010608 to version YYYYMMDD.
+* 2011-06-04
+ - Remove support for .cm files as input.
+
* 2011-05-03
- Fixed a bug with the treatment of as-patterns, which should not
allow the redefinition of constructor status.
Deleted: mlton/trunk/mlton/cm/cm.sig
===================================================================
--- mlton/trunk/mlton/cm/cm.sig 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/cm/cm.sig 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,15 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-signature CM =
- sig
- (* cmfile can be relative or absolute.
- * The resulting list of files will have the same path as cmfile.
- *)
- val cm: {cmfile: File.t} -> File.t list
- end
Deleted: mlton/trunk/mlton/cm/cm.sml
===================================================================
--- mlton/trunk/mlton/cm/cm.sml 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/cm/cm.sml 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,101 +0,0 @@
-(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure CM: CM =
-struct
-
-val maxAliasNesting: int = 32
-
-fun cm {cmfile: File.t} =
- let
- val files = ref []
- (* The files in seen are absolute. *)
- val seen = String.memoize (fn _ => ref false)
- fun loop (cmfile: File.t,
- nesting: int,
- relativize: Dir.t option): unit =
- let
- val relativize =
- case relativize of
- NONE => NONE
- | _ => if OS.Path.isAbsolute cmfile
- then NONE
- else relativize
- val {dir, file} = OS.Path.splitDirFile cmfile
- in
- Dir.inDir
- (if dir = "" then "." else dir, fn () =>
- let
- val cwd = Dir.current ()
- fun abs f = OS.Path.mkAbsolute {path = f, relativeTo = cwd}
- fun finalize f =
- case relativize of
- NONE => abs f
- | SOME d =>
- OS.Path.mkRelative {path = f,
- relativeTo = d}
- fun region () =
- let
- val sourcePos =
- SourcePos.make {column = 0,
- file = finalize cmfile,
- line = 0}
- in
- Region.make {left = sourcePos, right = sourcePos}
- end
- fun fail msg =
- Control.error (region (), Layout.str msg, Layout.empty)
- datatype z = datatype Parse.result
- in
- case Parse.parse {cmfile = file} of
- Alias f =>
- if nesting > maxAliasNesting
- then fail "alias nesting too deep."
- else loop (f, nesting + 1, relativize)
- | Bad s => fail (concat ["bad CM file: ", s])
- | Members members =>
- List.foreach
- (members, fn m =>
- let
- val m' = abs m
- val seen = seen m'
- in
- if !seen
- then ()
- else let
- val _ = seen := true
- fun sml () =
- List.push (files, finalize m')
- in
- Control.checkFile
- (m,
- {fail = fail,
- name = m,
- ok = fn () =>
- case File.suffix m of
- SOME "cm" =>
- loop (m, 0, relativize)
- | SOME "sml" => sml ()
- | SOME "sig" => sml ()
- | SOME "fun" => sml ()
- | SOME "ML" => sml ()
- | _ =>
- fail (concat ["MLton can't process ",
- m])})
- end
- end)
- end)
- end
- val d = Dir.current ()
- val _ = loop (cmfile, 0, SOME d)
- val files = rev (!files)
- in
- files
- end
-
-end
Deleted: mlton/trunk/mlton/cm/lexer.sig
===================================================================
--- mlton/trunk/mlton/cm/lexer.sig 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/cm/lexer.sig 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,57 +0,0 @@
-(* Based on the file entity/lexer.sig in the SML/NJ CM sources. *)
-
-(*
- * entity/lexer.sig: lexical analysis of description files
- *
- * Copyright (c) 1995 by AT&T Bell Laboratories
- *
- * author: Matthias Blume (bl...@cs...)
- *)
-signature CM_LEXER = sig
-
- exception LexicalError of string * string
- exception SyntaxError of string * string
- exception UserError of string * string
-
- datatype keyword =
- K_GROUP | K_LIBRARY | K_ALIAS | K_IS
- | K_SIGNATURE | K_STRUCTURE | K_FUNSIG | K_FUNCTOR
- | K_IF | K_ELIF | K_ELSE | K_ENDIF | K_DEFINED
- | K_ERROR
-
- datatype lconn = L_AND | L_OR | L_NOT
-
- datatype arith = A_PLUS | A_MINUS | A_TIMES | A_DIV | A_MOD
-
- datatype compare = C_LT | C_LE | C_GT | C_GE | C_EQ | C_NE
-
- datatype token =
- T_COLON
- | T_HASH
- | T_KEYWORD of keyword
- | T_SYMBOL of string
- | T_STRING of string
- | T_NUMBER of int
- | T_LPAREN
- | T_RPAREN
- | T_ARITH of arith
- | T_LCONN of lconn
- | T_COMPARE of compare
- | T_NL
- | T_EOF
-
- type mode
-
- val NORMAL: mode
- val MEMBERS: mode
-
- val lexer: {
- strdef: string -> bool,
- sigdef: string -> bool,
- fctdef: string -> bool,
- fsigdef: string -> bool,
- symval: string -> int option
- } ->
- string * In.t -> mode -> token
-
-end
Deleted: mlton/trunk/mlton/cm/lexer.sml
===================================================================
--- mlton/trunk/mlton/cm/lexer.sml 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/cm/lexer.sml 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,539 +0,0 @@
-(* Based on the file entity/lexer.sml in the SML/NJ CM sources. *)
-
-(*
- * entity/lexer.sml: lexical analysis of description files
- *
- * Copyright (c) 1995 by AT&T Bell Laboratories
- *
- * author: Matthias Blume (bl...@cs...)
- *)
-structure CMLexer: CM_LEXER = struct
-
- exception LexicalError of string * string
- exception UserError of string * string
- exception SyntaxError of string * string
- exception LexerBug
-
- datatype keyword =
- K_GROUP | K_LIBRARY | K_ALIAS | K_IS
- | K_SIGNATURE | K_STRUCTURE | K_FUNSIG | K_FUNCTOR
- | K_IF | K_ELIF | K_ELSE | K_ENDIF | K_DEFINED
- | K_ERROR
-
- datatype lconn = L_AND | L_OR | L_NOT
-
- datatype arith = A_PLUS | A_MINUS | A_TIMES | A_DIV | A_MOD
-
- datatype compare = C_LT | C_LE | C_GT | C_GE | C_EQ | C_NE
-
- datatype token =
- T_COLON
- | T_HASH
- | T_KEYWORD of keyword
- | T_SYMBOL of string
- | T_STRING of string
- | T_NUMBER of int
- | T_LPAREN
- | T_RPAREN
- | T_ARITH of arith
- | T_LCONN of lconn
- | T_COMPARE of compare
- | T_NL
- | T_EOF
-
- datatype mode = NORMAL | PREPROC | MEMBERS | ERRORMSG
-
- fun lexer { strdef, sigdef, fctdef, fsigdef, symval } (fname, stream) = let
-
- fun lexerr s = raise LexicalError (fname, s)
- fun synerr s = raise SyntaxError (fname, s)
- fun usererr s = raise UserError (fname, s)
-
- val lookahead: char list ref = ref []
-
- fun getc () =
- case !lookahead of
- [] => let
- val new = String.explode (In.input stream)
- in
- case new of
- [] => NONE
- | h :: t => (lookahead := t; SOME h)
- end
- | h :: t => (lookahead := t; SOME h)
-
- fun ungetc c = (lookahead := (c :: (!lookahead)))
-
- fun skip_white mode = let
-
- fun skip_scheme_comment () =
- case getc () of
- NONE => ()
- | SOME #"\n" => (ungetc #"\n")
- | _ => skip_scheme_comment ()
-
- fun skip_ml_comment () = let
- fun incomplete () = lexerr "incomplete ML-style comment"
- in
- case getc () of
- SOME #"*" =>
- (case getc () of
- SOME #")" => ()
- | NONE => incomplete ()
- | SOME c => (ungetc c; skip_ml_comment ()))
- | SOME #"(" =>
- (case getc () of
- SOME #"*" =>
- (skip_ml_comment (); skip_ml_comment ())
- | NONE => incomplete ()
- | SOME c => (ungetc c; skip_ml_comment ()))
- (*| SOME #";" => (skip_scheme_comment (); skip_ml_comment ())*)
- | NONE => incomplete ()
- | SOME _ => skip_ml_comment ()
- end
-
- fun skip () = let
- fun done () = ()
- fun preproc_nl thunk =
- (if mode = PREPROC orelse mode = ERRORMSG then
- ungetc #"\n"
- else thunk ())
- in
- case getc () of
- NONE => ()
- | SOME #";" => (skip_scheme_comment (); skip ())
- | SOME #"\n" =>
- (case getc () of
- NONE => preproc_nl done
- | SOME #"#" => (ungetc #"#"; preproc_nl done)
- | SOME c => (ungetc c; preproc_nl skip))
- | SOME #"(" =>
- (case getc () of
- NONE => ungetc #"("
- | SOME #"*" => (skip_ml_comment (); skip ())
- | SOME c => (ungetc c; ungetc #"("))
- | SOME c =>
- if Char.isSpace c then skip () else ungetc c
- end
- in
- skip
- end
-
- fun rawlex mode = let
-
- val skip = skip_white mode
-
- fun getc_nonwhite () = (skip (); getc ())
-
- fun getnum c = let
- fun loop (n, c) = let
- val n = 10 * n + Char.ord c - Char.ord #"0"
- in
- case getc () of
- NONE => n
- | SOME c => if Char.isDigit c then loop (n, c)
- else (ungetc c; n)
- end
- in
- loop (0, c) handle Overflow => lexerr "arithmetic overflow"
- end
-
- fun expect (c, t) =
- if getc () = SOME c then t
- else lexerr (concat ["expecting ", String.implode [c]])
-
- fun ifnext (c, ty, tn) =
- case getc () of
- NONE => tn
- | SOME c1 =>
- if c = c1 then ty else (ungetc c1; tn)
-
- fun getsym (c, delim) = let
- fun loop (accu, c) = let
- val accu = c :: accu
- in
- case getc () of
- NONE => String.implode (rev accu)
- | SOME c =>
- if Char.isSpace c orelse String.contains(delim, c)
- then (ungetc c; String.implode (rev accu))
- else loop (accu, c)
- end
- in
- loop ([], c)
- end
-
- fun getline c = let
- fun loop accu =
- case getc () of
- NONE => String.implode (rev accu)
- | SOME #"\n" => String.implode (rev accu)
- | SOME c => loop (c :: accu)
- in
- loop [c]
- end
-
- val preproc_delim = "():;#+-*/%&!|><="
- val non_preproc_delim = "():;#"
-
- fun preproc_sym "if" = T_KEYWORD K_IF
- | preproc_sym "elif" = T_KEYWORD K_ELIF
- | preproc_sym "else" = T_KEYWORD K_ELSE
- | preproc_sym "endif" = T_KEYWORD K_ENDIF
- | preproc_sym "defined" = T_KEYWORD K_DEFINED
- | preproc_sym "structure" = T_KEYWORD K_STRUCTURE
- | preproc_sym "signature" = T_KEYWORD K_SIGNATURE
- | preproc_sym "functor" = T_KEYWORD K_FUNCTOR
- | preproc_sym "funsig" = T_KEYWORD K_FUNSIG
- | preproc_sym "error" = T_KEYWORD K_ERROR
- | preproc_sym s = T_SYMBOL s
-
- fun normal_sym "group" = T_KEYWORD K_GROUP
- | normal_sym "Group" = T_KEYWORD K_GROUP
- | normal_sym "GROUP" = T_KEYWORD K_GROUP
- | normal_sym "library" = T_KEYWORD K_LIBRARY
- | normal_sym "Library" = T_KEYWORD K_LIBRARY
- | normal_sym "LIBRARY" = T_KEYWORD K_LIBRARY
- | normal_sym "alias" = T_KEYWORD K_ALIAS
- | normal_sym "Alias" = T_KEYWORD K_ALIAS
- | normal_sym "ALIAS" = T_KEYWORD K_ALIAS
- | normal_sym "is" = T_KEYWORD K_IS
- | normal_sym "IS" = T_KEYWORD K_IS
- | normal_sym "structure" = T_KEYWORD K_STRUCTURE
- | normal_sym "signature" = T_KEYWORD K_SIGNATURE
- | normal_sym "functor" = T_KEYWORD K_FUNCTOR
- | normal_sym "funsig" = T_KEYWORD K_FUNSIG
- | normal_sym s = T_SYMBOL s
-
- fun string () = let
- fun collect l =
- case getc () of
- NONE => lexerr "missing string delimiter"
- | SOME #"\"" =>
- (case getc () of
- SOME #"\"" => collect (#"\"" :: l)
- | SOME c => (ungetc c; String.implode (rev l))
- | NONE => String.implode (rev l))
- | SOME c => collect (c :: l)
- in
- collect []
- end
-
- in
- if mode = ERRORMSG then
- T_SYMBOL (case getc_nonwhite () of
- NONE => "error"
- | SOME #"\n" => "error"
- | SOME c => getline c)
- else
- case getc_nonwhite () of
- NONE => T_EOF
- | SOME #":" => T_COLON
- | SOME #"\n" => T_NL
- | SOME #"#" => T_HASH
- | SOME #"\"" =>
- (case mode of
- NORMAL => T_STRING (string ())
- | MEMBERS => T_STRING (string ())
- | _ =>
- synerr "quoted string in wrong context")
- | SOME c =>
- if mode = PREPROC then
- case c of
- #"(" => T_LPAREN
- | #")" => T_RPAREN
- | #"+" => T_ARITH A_PLUS
- | #"-" => T_ARITH A_MINUS
- | #"*" => T_ARITH A_TIMES
- | #"/" => T_ARITH A_DIV
- | #"%" => T_ARITH A_MOD
- | #"&" => expect (#"&", T_LCONN L_AND)
- | #"|" => expect (#"|", T_LCONN L_OR)
- | #"!" =>
- ifnext (#"=", T_COMPARE C_NE, T_LCONN L_NOT)
- | #">" =>
- ifnext (#"=", T_COMPARE C_GE, T_COMPARE C_GT)
- | #"<" =>
- ifnext (#"=", T_COMPARE C_LE, T_COMPARE C_LT)
- | #"=" => expect (#"=", T_COMPARE C_EQ)
- | _ =>
- if Char.isDigit c then
- T_NUMBER (getnum c)
- else if Char.isAlpha c then
- preproc_sym (getsym (c, preproc_delim))
- else
- synerr "illegal preprocessor line"
- else let
- val s = getsym (c, non_preproc_delim)
- in
- if mode = NORMAL then
- normal_sym s
- else
- T_SYMBOL s
- end
- end
-
- val lex = let
-
- val lookahead: token list ref = ref []
-
- fun gett () =
- case !lookahead of
- [] => rawlex PREPROC
- | (h :: t) => (lookahead := t; h)
-
- fun ungett t = lookahead := (t :: (!lookahead))
-
- fun leftrec (f, tokf) = let
- fun loop accu = let
- val nt = gett ()
- in
- case tokf nt of
- NONE => (ungett nt; accu)
- | SOME c => loop (c (accu, f ()))
- end
- in
- loop (f ())
- end
-
- fun nonassoc (f, tokf) = let
- val lhs = f ()
- val nt = gett ()
- in
- case tokf nt of
- NONE => (ungett nt; lhs)
- | SOME c => c (lhs, f ())
- end
-
- fun expect (t, m) =
- if gett () = t then () else synerr (concat ["missing ", m])
-
- fun intbool f (x: unit -> int, y: unit -> int) =
- fn () => if f (x (), y ()) then 1 else 0
-
- fun orf (x, y) =
- fn () => if (x () <> 0) orelse (y () <> 0) then 1 else 0
- fun andf (x, y) =
- fn () => if (x () <> 0) andalso (y () <> 0) then 1 else 0
- fun notf x = fn () => if x () <> 0 then 0 else 1
- val eqf = intbool (op =)
- val nef = intbool (op <>)
- val gtf = intbool (op >)
- val gef = intbool (op >=)
- val ltf = intbool (op <)
- val lef = intbool (op <=)
-
- fun binaryf binop (x: unit -> int, y: unit -> int) =
- fn () => (binop (x (), y ()))
- fun unaryf uop (x: unit -> int) =
- fn () => uop (x ())
-
- val plusf = binaryf (op +)
- val minusf = binaryf (op -)
- val timesf = binaryf (op * )
- val divf = binaryf (op div)
- val modf = binaryf (op mod)
- val negatef = unaryf ~
-
- fun expression () = disjunction ()
-
- and disjunction () = let
- fun tokf (T_LCONN L_OR) = SOME orf
- | tokf _ = NONE
- in
- leftrec (conjunction, tokf)
- end
-
- and conjunction () = let
- fun tokf (T_LCONN L_AND) = SOME andf
- | tokf _ = NONE
- in
- leftrec (equivalence, tokf)
- end
-
- and equivalence () = let
- fun tokf (T_COMPARE C_EQ) = SOME eqf
- | tokf (T_COMPARE C_NE) = SOME nef
- | tokf _ = NONE
- in
- nonassoc (comparison, tokf)
- end
-
- and comparison () = let
- fun tokf (T_COMPARE C_GT) = SOME gtf
- | tokf (T_COMPARE C_GE) = SOME gef
- | tokf (T_COMPARE C_LT) = SOME ltf
- | tokf (T_COMPARE C_LE) = SOME lef
- | tokf _ = NONE
- in
- nonassoc (sum, tokf)
- end
-
- and sum () = let
- fun tokf (T_ARITH A_PLUS) = SOME plusf
- | tokf (T_ARITH A_MINUS) = SOME minusf
- | tokf _ = NONE
- in
- leftrec (product, tokf)
- end
-
- and product () = let
- fun tokf (T_ARITH A_TIMES) = SOME timesf
- | tokf (T_ARITH A_DIV) = SOME divf
- | tokf (T_ARITH A_MOD) = SOME modf
- | tokf _ = NONE
- in
- leftrec (unary, tokf)
- end
-
- and unary () =
- case gett () of
- T_LCONN L_NOT => notf (unary ())
- | T_ARITH A_MINUS => negatef (unary ())
- | nt => (ungett nt; primary ())
-
- and primary () =
- case gett () of
- T_LPAREN =>
- expression ()
- before expect (T_RPAREN, "right parenthesis")
- | T_NUMBER n => (fn () => n)
- | T_SYMBOL s =>
- (fn () =>
- (case symval s of
- NONE => synerr (concat ["undefined symbol: ", s])
- | SOME v => v))
- | T_KEYWORD K_DEFINED => let
- val _ = expect (T_LPAREN, "left parenthesis")
- in
- case gett () of
- T_KEYWORD k => let
- val look =
- case k of
- K_STRUCTURE => strdef
- | K_SIGNATURE => sigdef
- | K_FUNCTOR => fctdef
- | K_FUNSIG => fsigdef
- | _ => synerr "unexpected keyword"
- in
- case gett () of
- T_SYMBOL s =>
- (expect (T_RPAREN,
- "right parenthesis");
- fn () => if look s then 1 else 0)
- | _ => synerr "missing symbol"
- end
- | T_SYMBOL s =>
- (expect (T_RPAREN, "right parenthesis");
- fn () => (case symval s of
- NONE => 0
- | SOME _ => 1))
- | _ => synerr "illegal `defined' construct"
- end
- | _ => synerr "unexpected token"
-
- datatype localstate =
- T_C | T | E_C | E
-
- datatype cmd =
- IF of unit -> int
- | ELIF of unit -> int
- | ELSE
- | ENDIF
-
- type state = localstate * bool
-
- fun iscopying s =
- case s of
- [] => true
- | (_, copying) :: _ => copying
-
- fun transform (IF c, s) =
- if iscopying s andalso c () <> 0 then
- (T_C, true) :: s
- else
- (T, false) :: s
- | transform (ELIF _, (T_C, _) :: s) = (T_C, false) :: s
- | transform (ELIF c, (T, _) :: s) =
- if iscopying s andalso c () <> 0 then
- (T_C, true) :: s
- else
- (T, false) :: s
- | transform (ELIF _, _) = synerr "unexpected #elif"
- | transform (ELSE, (T_C, _) :: s) = (E, false) :: s
- | transform (ELSE, (T, _) :: s) = (E_C, iscopying s) :: s
- | transform (ELSE, _) = synerr "unexpected #else"
- | transform (ENDIF, []) = synerr "unexpected #endif"
- | transform (ENDIF, _ :: s) = s
-
- val state: state list ref = ref []
-
- fun checklook () =
- case !lookahead of
- [] => ()
- | _ => raise LexerBug
-
- fun condition () = let
- val e = expression ()
- in
- fn () =>
- (e ()
- handle Overflow => synerr "arithmetic overflow in condition"
- | Div => synerr "divide by zero in condition")
- end
-
- fun nexttoken mode =
- case rawlex mode of
- T_HASH =>
- (case rawlex PREPROC of
- T_KEYWORD K_IF => let
- val c = condition ()
- val _ = expect (T_NL, "line break (#if)")
- val _ = checklook ()
- in
- state := transform (IF c, !state);
- nexttoken mode
- end
- | T_KEYWORD K_ELSE =>
- (expect (T_NL, "line break (#else)");
- checklook ();
- state := transform (ELSE, !state);
- nexttoken mode)
- | T_KEYWORD K_ELIF => let
- val c = condition ()
- val _ = expect (T_NL, "line break (#elif)")
- val _ = checklook ()
- in
- state := transform (ELIF c, !state);
- nexttoken mode
- end
- | T_KEYWORD K_ENDIF =>
- (expect (T_NL, "line break (#endif)");
- checklook ();
- state := transform (ENDIF, !state);
- nexttoken mode)
- | T_KEYWORD K_ERROR => let
- val msg =
- case rawlex ERRORMSG of
- T_SYMBOL msg => msg
- | _ => raise LexerBug
- in
- if iscopying (!state) then
- usererr msg
- else
- (checklook (); nexttoken mode)
- end
- | _ => synerr "illegal preprocessor line")
- | T_EOF =>
- if (!state) = [] then T_EOF
- else synerr "missing #endif"
- | t => if iscopying (!state) then t else nexttoken mode
-
- in
- nexttoken
- end
-
- in
- lex
- end
-end
Deleted: mlton/trunk/mlton/cm/parse.sig
===================================================================
--- mlton/trunk/mlton/cm/parse.sig 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/cm/parse.sig 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,22 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-signature PARSE =
- sig
- datatype result =
- Alias of File.t
- | Bad of string (* error message *)
- | Members of File.t list
-
- (* Pre: cmfile must not contain any path, i.e. it must be in the
- * current directory.
- * The resulting members are either absolute or relative to the current
- * directory.
- *)
- val parse: {cmfile: string} -> result
- end
Deleted: mlton/trunk/mlton/cm/parse.sml
===================================================================
--- mlton/trunk/mlton/cm/parse.sml 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/cm/parse.sml 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,130 +0,0 @@
-(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-(* Based on the file entity/description.sml in the SML/NJ CM sources. *)
-
-(*
- * entity/description.sml: Entity description file parser.
- *
- * Copyright (c) 1995 by AT&T Bell Laboratories
- *
- * author: Matthias Blume (bl...@cs...)
- *)
-structure Parse: PARSE =
-struct
-
-val fail = Process.fail
-
-structure Lexer = CMLexer
-
-datatype result =
- Alias of File.t
- | Bad of string
- | Members of File.t list
-
-(* The main read function for CM entities. *)
-fun parse {cmfile: string} =
- Exn.withEscape
- (fn escape =>
- let
- fun bad m = (ignore (escape (Bad m)); raise Fail "impossible")
- in
- File.withIn
- (cmfile, fn ins =>
- let
- fun no _ = false
- val lex =
- Lexer.lexer {strdef = no,
- sigdef = no,
- fctdef = no,
- fsigdef = no,
- symval = fn _ => NONE}
- (cmfile, ins)
- val lex =
- fn m =>
- lex m
- handle Lexer.LexicalError (_, s) => bad s
- | Lexer.SyntaxError (_, s) => bad s
- | Lexer.UserError (_, s) => bad s
- val lookahead: Lexer.token list ref = ref []
- fun normal () =
- case !lookahead of
- [] => lex Lexer.NORMAL
- | h :: t => (lookahead := t; h)
- fun member () =
- case !lookahead of
- [] => lex Lexer.MEMBERS
- | h :: t => (lookahead := t; h)
- fun unget t = lookahead := (t :: (!lookahead))
- fun readExport () =
- let
- fun name () =
- (case normal () of
- Lexer.T_SYMBOL _ => ()
- | Lexer.T_STRING _ => ()
- | _ => bad "missing exported name"
- ; SOME ())
- in case normal () of
- Lexer.T_KEYWORD Lexer.K_SIGNATURE => name ()
- | Lexer.T_KEYWORD Lexer.K_STRUCTURE => name ()
- | Lexer.T_KEYWORD Lexer.K_FUNCTOR => name ()
- | Lexer.T_KEYWORD Lexer.K_FUNSIG => name ()
- | x => (unget x; NONE)
- end
- fun readList readItem =
- let
- fun loop ac =
- case readItem () of
- NONE => rev ac
- | SOME i => loop (i :: ac)
- in loop []
- end
- fun getFileName () =
- case member () of
- Lexer.T_SYMBOL name => SOME name
- | Lexer.T_STRING name => SOME name
- | t => (unget t; NONE)
- fun readMember () =
- case getFileName () of
- NONE => NONE
- | SOME f =>
- (case member () of
- Lexer.T_COLON =>
- (case member () of
- Lexer.T_SYMBOL _ => ()
- | Lexer.T_STRING _ => ()
- | _ => bad "missing class name")
- | t => unget t
- ; SOME f)
- fun readMembers () =
- case normal () of
- Lexer.T_KEYWORD Lexer.K_IS =>
- (if !lookahead <> [] then fail "Bug in parser" else ()
- ; readList readMember)
- | _ => bad "missing keyword 'is'"
- fun parseAlias () =
- case getFileName () of
- NONE => bad "alias name missing"
- | SOME f => let val _ = In.close ins
- in Alias f
- end
- fun parseGroup () =
- let
- val _ = readList readExport
- val members = readMembers ()
- val _ = In.close ins
- in Members members
- end
- in case normal () of
- Lexer.T_KEYWORD Lexer.K_GROUP => parseGroup ()
- | Lexer.T_KEYWORD Lexer.K_LIBRARY => parseGroup ()
- | Lexer.T_KEYWORD Lexer.K_ALIAS => parseAlias ()
- | _ => bad "expected 'group' or 'library'"
- end)
- end)
-
-end
Deleted: mlton/trunk/mlton/cm/sources.cm
===================================================================
--- mlton/trunk/mlton/cm/sources.cm 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/cm/sources.cm 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,22 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-Group
-
-structure CM
-
-is
-
-../../lib/mlton/sources.cm
-../control/sources.cm
-lexer.sig
-lexer.sml
-parse.sig
-parse.sml
-cm.sig
-cm.sml
Deleted: mlton/trunk/mlton/cm/sources.mlb
===================================================================
--- mlton/trunk/mlton/cm/sources.mlb 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/cm/sources.mlb 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,21 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-local
- ../../lib/mlton/sources.mlb
- ../control/sources.mlb
-
- lexer.sig
- lexer.sml
- parse.sig
- parse.sml
- cm.sig
- cm.sml
-in
- structure CM
-end
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/main/main.fun 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2010 Matthew Fluet.
+(* Copyright (C) 2010-2011 Matthew Fluet.
* Copyright (C) 1999-2009 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -16,11 +16,10 @@
structure Place =
struct
- datatype t = CM | Files | Generated | MLB | O | OUT | SML | TypeCheck
+ datatype t = Files | Generated | MLB | O | OUT | SML | TypeCheck
val toInt: t -> int =
- fn CM => 1
- | MLB => 1
+ fn MLB => 1
| SML => 1
| Files => 2
| TypeCheck => 4
@@ -29,8 +28,7 @@
| OUT => 7
val toString =
- fn CM => "cm"
- | Files => "files"
+ fn Files => "files"
| SML => "sml"
| MLB => "mlb"
| Generated => "g"
@@ -828,7 +826,7 @@
end
val mainUsage =
- "mlton [option ...] file.{c|cm|mlb|o|sml} [file.{c|o|s|S} ...]"
+ "mlton [option ...] file.{c|mlb|o|sml} [file.{c|o|s|S} ...]"
val {parse, usage} =
Popt.makeUsage {mainUsage = mainUsage,
@@ -1151,7 +1149,6 @@
datatype z = datatype Place.t
in
loop [(".mlb", MLB, false),
- (".cm", CM, false),
(".sml", SML, false),
(".c", Generated, true),
(".o", O, true)]
@@ -1455,23 +1452,9 @@
mkCompileSrc {listFiles = Compile.sourceFilesMLB,
elaborate = Compile.elaborateMLB,
compile = Compile.compileMLB}
- fun compileCM (file: File.t) =
- let
- val _ =
- if !Control.warnDeprecated
- then
- Out.output
- (Out.error,
- "Warning: .cm input files are deprecated. Use .mlb input files.\n")
- else ()
- val files = CM.cm {cmfile = file}
- in
- compileSML files
- end
fun compile () =
case start of
- Place.CM => compileCM input
- | Place.SML => compileSML [input]
+ Place.SML => compileSML [input]
| Place.MLB => compileMLB input
| Place.Generated => compileCSO (input :: csoFiles)
| Place.O => compileCSO (input :: csoFiles)
Modified: mlton/trunk/mlton/main/sources.cm
===================================================================
--- mlton/trunk/mlton/main/sources.cm 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/main/sources.cm 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009,2011 Matthew Fluet.
* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -18,7 +18,6 @@
../atoms/sources.cm
../backend/sources.cm
../closure-convert/sources.cm
-../cm/sources.cm
../codegen/sources.cm
../control/sources.cm
../core-ml/sources.cm
Modified: mlton/trunk/mlton/main/sources.mlb
===================================================================
--- mlton/trunk/mlton/main/sources.mlb 2011-05-27 15:00:21 UTC (rev 7535)
+++ mlton/trunk/mlton/main/sources.mlb 2011-06-04 14:33:53 UTC (rev 7536)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009,2011 Matthew Fluet.
* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -13,7 +13,6 @@
../atoms/sources.mlb
../backend/sources.mlb
../closure-convert/sources.mlb
- ../cm/sources.mlb
../codegen/sources.mlb
../control/sources.mlb
../core-ml/sources.mlb
|
|
From: Matthew F. <fl...@ml...> - 2011-05-27 08:00:34
|
Unused but set variables detected by gcc 4.6.
In gcc 4.6, -Wall implies -Wunused and -Wunused implies
-Wunused-but-set-variable. Eliminate this unused variable warning by
restoring the invariant check that uses the variable.
----------------------------------------------------------------------
U mlton/trunk/runtime/gc/invariant.c
----------------------------------------------------------------------
Modified: mlton/trunk/runtime/gc/invariant.c
===================================================================
--- mlton/trunk/runtime/gc/invariant.c 2011-05-27 15:00:11 UTC (rev 7534)
+++ mlton/trunk/runtime/gc/invariant.c 2011-05-27 15:00:21 UTC (rev 7535)
@@ -1,4 +1,5 @@
-/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -42,6 +43,8 @@
assert (layout->size <= s->maxFrameSize);
offsets = layout->offsets;
+ for (unsigned int j = 0; j < offsets[0]; ++j)
+ assert (offsets[j + 1] < layout->size);
}
}
/* Generational */
|
|
From: Matthew F. <fl...@ml...> - 2011-05-27 08:00:19
|
Unused but set variables detected by gcc 4.6.
In gcc 4.6, -Wall implies -Wunused and -Wunused implies
-Wunused-but-set-variable. Eliminate truly unused variables and use
__attribute__ ((unused)) on variables only used in assertions.
----------------------------------------------------------------------
U mlton/trunk/runtime/basis/Posix/Signal.c
U mlton/trunk/runtime/basis/Real/gdtoa.c
U mlton/trunk/runtime/basis/Real/strto.c
U mlton/trunk/runtime/gc/copy-thread.c
U mlton/trunk/runtime/gc/heap.c
U mlton/trunk/runtime/gc/init-world.c
U mlton/trunk/runtime/gc/profiling.c
----------------------------------------------------------------------
Modified: mlton/trunk/runtime/basis/Posix/Signal.c
===================================================================
--- mlton/trunk/runtime/basis/Posix/Signal.c 2011-05-24 02:34:31 UTC (rev 7533)
+++ mlton/trunk/runtime/basis/Posix/Signal.c 2011-05-27 15:00:11 UTC (rev 7534)
@@ -104,7 +104,7 @@
}
void Posix_Signal_sigsuspend (void) {
- int res;
+ int __attribute__ ((unused)) res;
res = sigsuspend (&Posix_Signal_sigset);
assert (-1 == res);
Modified: mlton/trunk/runtime/basis/Real/gdtoa.c
===================================================================
--- mlton/trunk/runtime/basis/Real/gdtoa.c 2011-05-24 02:34:31 UTC (rev 7533)
+++ mlton/trunk/runtime/basis/Real/gdtoa.c 2011-05-27 15:00:11 UTC (rev 7534)
@@ -14,10 +14,8 @@
int i;
ULong L[1];
char *result;
- ULong sign;
memcpy(L, &f, sizeof(Real32_t));
- sign = L[0] & 0x80000000L;
bits[0] = L[0] & 0x7fffff;
if (0 != (ex = (L[0] >> 23) & 0xff))
bits[0] |= 0x800000;
@@ -40,7 +38,6 @@
int i;
ULong L[2];
char *result;
- ULong sign;
int x0, x1;
if (isBigEndian()) {
@@ -51,7 +48,6 @@
x1 = 0;
}
memcpy(L, &d, sizeof(Real64_t));
- sign = L[x0] & 0x80000000L;
bits[0] = L[x1];
bits[1] = L[x0] & 0xfffff;
if (0 != (ex = (L[x0] >> 20) & 0x7ff))
Modified: mlton/trunk/runtime/basis/Real/strto.c
===================================================================
--- mlton/trunk/runtime/basis/Real/strto.c 2011-05-24 02:34:31 UTC (rev 7533)
+++ mlton/trunk/runtime/basis/Real/strto.c 2011-05-27 15:00:11 UTC (rev 7534)
@@ -4,9 +4,8 @@
Real32_t Real32_strto (NullString8_t s, C_Int_t rounding) {
char *endptr;
Real32_t res;
- int ret;
- ret = gdtoa__strtorf ((const char*)s, &endptr, (int)rounding, &res);
+ gdtoa__strtorf ((const char*)s, &endptr, (int)rounding, &res);
assert (NULL != endptr);
return res;
}
@@ -14,9 +13,8 @@
Real64_t Real64_strto (NullString8_t s, C_Int_t rounding) {
char *endptr;
Real64_t res;
- int ret;
- ret = gdtoa__strtord ((const char*)s, &endptr, (int)rounding, &res);
+ gdtoa__strtord ((const char*)s, &endptr, (int)rounding, &res);
assert (NULL != endptr);
return res;
}
Modified: mlton/trunk/runtime/gc/copy-thread.c
===================================================================
--- mlton/trunk/runtime/gc/copy-thread.c 2011-05-24 02:34:31 UTC (rev 7533)
+++ mlton/trunk/runtime/gc/copy-thread.c 2011-05-27 15:00:11 UTC (rev 7534)
@@ -1,4 +1,5 @@
-/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -35,7 +36,7 @@
GC_thread fromThread;
GC_stack fromStack;
GC_thread toThread;
- GC_stack toStack;
+ GC_stack __attribute__ ((unused)) toStack;
if (DEBUG_THREADS)
fprintf (stderr, "GC_copyCurrentThread\n");
@@ -57,7 +58,7 @@
GC_thread fromThread;
GC_stack fromStack;
GC_thread toThread;
- GC_stack toStack;
+ GC_stack __attribute__ ((unused)) toStack;
if (DEBUG_THREADS)
fprintf (stderr, "GC_copyThread ("FMTPTR")\n", (uintptr_t)p);
Modified: mlton/trunk/runtime/gc/heap.c
===================================================================
--- mlton/trunk/runtime/gc/heap.c 2011-05-24 02:34:31 UTC (rev 7533)
+++ mlton/trunk/runtime/gc/heap.c 2011-05-27 15:00:11 UTC (rev 7534)
@@ -1,4 +1,4 @@
-/* Copyright (C) 2009-2010 Matthew Fluet.
+/* Copyright (C) 2009-2011 Matthew Fluet.
* Copyright (C) 2005-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
@@ -41,7 +41,7 @@
size_t liveMapsSize, liveWithMapsSize;
size_t currentMapsSize, currentWithMapsSize;
size_t resSize, resWithMapsSize;
- size_t syslimSize, syslimMapsSize, syslimWithMapsSize;
+ size_t syslimSize, __attribute__ ((unused)) syslimMapsSize, syslimWithMapsSize;
double ratio;
syslimWithMapsSize = alignDown (SIZE_MAX, s->sysvals.pageSize);
@@ -553,12 +553,11 @@
*/
void resizeHeapSecondary (GC_state s) {
size_t primarySize, primaryWithMapsSize;
- size_t secondarySize, secondaryWithMapsSize;
+ size_t secondarySize;
primarySize = s->heap.size;
primaryWithMapsSize = s->heap.withMapsSize;
secondarySize = s->secondaryHeap.size;
- secondaryWithMapsSize = s->secondaryHeap.withMapsSize;
if (DEBUG_RESIZING)
fprintf (stderr, "secondaryHeapResize\n");
if (0 == secondarySize)
Modified: mlton/trunk/runtime/gc/init-world.c
===================================================================
--- mlton/trunk/runtime/gc/init-world.c 2011-05-24 02:34:31 UTC (rev 7533)
+++ mlton/trunk/runtime/gc/init-world.c 2011-05-27 15:00:11 UTC (rev 7534)
@@ -1,4 +1,5 @@
-/* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -51,7 +52,7 @@
size_t bytes;
bool neg;
__mpz_struct resmpz;
- int ans;
+ __attribute__ ((unused)) int ans;
assert (isFrontierAligned (s, s->frontier));
for (i = 0; i < s->intInfInitsLength; i++) {
Modified: mlton/trunk/runtime/gc/profiling.c
===================================================================
--- mlton/trunk/runtime/gc/profiling.c 2011-05-24 02:34:31 UTC (rev 7533)
+++ mlton/trunk/runtime/gc/profiling.c 2011-05-27 15:00:11 UTC (rev 7534)
@@ -1,4 +1,5 @@
-/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -76,7 +77,6 @@
void enterForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex) {
uint32_t i;
- GC_profileData p;
GC_sourceIndex sourceIndex;
uint32_t *sourceSeq;
@@ -84,7 +84,6 @@
fprintf (stderr, "enterForProfiling ("FMTSSI")\n", sourceSeqIndex);
assert (s->profiling.stack);
assert (sourceSeqIndex < s->sourceMaps.sourceSeqsLength);
- p = s->profiling.data;
sourceSeq = s->sourceMaps.sourceSeqs[sourceSeqIndex];
for (i = 1; i <= sourceSeq[0]; i++) {
sourceIndex = sourceSeq[i];
@@ -123,10 +122,8 @@
}
void leaveSourceForProfiling (GC_state s, GC_profileMasterIndex i) {
- GC_profileData p;
GC_profileStack ps;
- p = s->profiling.data;
ps = getProfileStackInfo (s, i);
assert (ps->numOccurrences > 0);
ps->numOccurrences--;
@@ -136,7 +133,6 @@
void leaveForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex) {
int32_t i;
- GC_profileData p;
GC_sourceIndex sourceIndex;
uint32_t *sourceSeq;
@@ -144,7 +140,6 @@
fprintf (stderr, "leaveForProfiling ("FMTSSI")\n", sourceSeqIndex);
assert (s->profiling.stack);
assert (sourceSeqIndex < s->sourceMaps.sourceSeqsLength);
- p = s->profiling.data;
sourceSeq = s->sourceMaps.sourceSeqs[sourceSeqIndex];
for (i = sourceSeq[0]; i > 0; i--) {
sourceIndex = sourceSeq[i];
|
|
From: Matthew F. <fl...@ml...> - 2011-05-23 19:34:32
|
Tweaks to Pygments SML lexer.
----------------------------------------------------------------------
U mlton/trunk/ide/pygments/sml_lexer/__init__.py
----------------------------------------------------------------------
Modified: mlton/trunk/ide/pygments/sml_lexer/__init__.py
===================================================================
--- mlton/trunk/ide/pygments/sml_lexer/__init__.py 2011-05-23 22:34:35 UTC (rev 7532)
+++ mlton/trunk/ide/pygments/sml_lexer/__init__.py 2011-05-24 02:34:31 UTC (rev 7533)
@@ -5,7 +5,7 @@
import re
-from pygments.lexer import RegexLexer, bygroups, include
+from pygments.lexer import RegexLexer, bygroups
from pygments.token import *
@@ -45,10 +45,10 @@
## Modules
]
- alphanumid_re = r'[a-zA-Z][a-zA-Z0-9_\']*'
- symbolicid_re = r'[!%&$#+\-/:<=>?@\\~`^|*]+'
- long_id_re = r'((%s\.)*)((%s)|(%s))' % (alphanumid_re, alphanumid_re, symbolicid_re)
- primed_alphanumid_re = r'\'[a-zA-Z0-9_\']*'
+ alphanumid_re = r"[a-zA-Z][a-zA-Z0-9_']*"
+ symbolicid_re = r"[!%&$#+\-/:<=>?@\\~`^|*]+"
+ long_id_re = r"((%s\.)*)((%s)|(%s))" % (alphanumid_re, alphanumid_re, symbolicid_re)
+ primed_alphanumid_re = r"'[a-zA-Z0-9_']*"
def long_id_callback(self, match):
strids = match.group(1)
@@ -90,10 +90,6 @@
(r'\s+', Whitespace),
(r'\(\*', Comment.Multiline, 'comment'),
- (long_id_re, long_id_callback),
- (r'(%s)' % '|'.join([re.escape(z) for z in nonid_reserved]), Punctuation),
- (primed_alphanumid_re, Name),
-
(r'~?[0-9]+\.[0-9]+((e|E)~?[0-9]+)?', Number.Float),
(r'~?[0-9]+(e|E)~?[0-9]+', Number.Float),
(r'0wx[0-9a-fA-F]+', Number.Hex),
@@ -102,8 +98,12 @@
(r'~?[0-9]+', Number.Integer),
(r'"', String, 'string'),
- (r'(#)(")', bygroups(Text, String), 'string'),
+ (r'(#)(")', bygroups(Punctuation, String), 'string'),
+ (long_id_re, long_id_callback),
+ (r'(%s)' % '|'.join([re.escape(z) for z in nonid_reserved]), Punctuation),
+ (primed_alphanumid_re, Name),
+
(r'.', Error, 'error')
],
'error': [
|
|
From: Matthew F. <fl...@ml...> - 2011-05-23 15:34:36
|
Standard ML Lexer for Pygments. ---------------------------------------------------------------------- A mlton/trunk/ide/pygments/ A mlton/trunk/ide/pygments/.ignore A mlton/trunk/ide/pygments/setup.py A mlton/trunk/ide/pygments/sml_lexer/ A mlton/trunk/ide/pygments/sml_lexer/.ignore A mlton/trunk/ide/pygments/sml_lexer/__init__.py ---------------------------------------------------------------------- Property changes on: mlton/trunk/ide/pygments ___________________________________________________________________ Name: svn:ignore + build dist sml_lexer.egg-info Added: mlton/trunk/ide/pygments/.ignore =================================================================== --- mlton/trunk/ide/pygments/.ignore 2011-05-16 21:05:48 UTC (rev 7531) +++ mlton/trunk/ide/pygments/.ignore 2011-05-23 22:34:35 UTC (rev 7532) @@ -0,0 +1,3 @@ +build +dist +sml_lexer.egg-info Added: mlton/trunk/ide/pygments/setup.py =================================================================== --- mlton/trunk/ide/pygments/setup.py 2011-05-16 21:05:48 UTC (rev 7531) +++ mlton/trunk/ide/pygments/setup.py 2011-05-23 22:34:35 UTC (rev 7532) @@ -0,0 +1,19 @@ +# -*- coding: utf-8 -*- +""" +Standard ML Lexer for Pygments +""" +from setuptools import setup + +setup( + name='sml_lexer', + version='1.0', + author='Matthew Fluet', + author_email='Mat...@gm...', + url='http://www.mlton.org/Pygments', + description=__doc__, + packages=['sml_lexer'], + entry_points=''' + [pygments.lexers] + StandardMLLexer = sml_lexer:StandardMLLexer + ''' +) Property changes on: mlton/trunk/ide/pygments/sml_lexer ___________________________________________________________________ Name: svn:ignore + __init__.pyc Added: mlton/trunk/ide/pygments/sml_lexer/.ignore =================================================================== --- mlton/trunk/ide/pygments/sml_lexer/.ignore 2011-05-16 21:05:48 UTC (rev 7531) +++ mlton/trunk/ide/pygments/sml_lexer/.ignore 2011-05-23 22:34:35 UTC (rev 7532) @@ -0,0 +1 @@ +__init__.pyc Added: mlton/trunk/ide/pygments/sml_lexer/__init__.py =================================================================== --- mlton/trunk/ide/pygments/sml_lexer/__init__.py 2011-05-16 21:05:48 UTC (rev 7531) +++ mlton/trunk/ide/pygments/sml_lexer/__init__.py 2011-05-23 22:34:35 UTC (rev 7532) @@ -0,0 +1,129 @@ +# -*- coding: utf-8 -*- +""" +Standard ML Lexer for Pygments. +""" + +import re + +from pygments.lexer import RegexLexer, bygroups, include +from pygments.token import * + + +__all__ = ['StandardMLLexer'] + + +class StandardMLLexer(RegexLexer): + """ + A Standard ML lexer. + """ + name = 'Standard ML' + aliases = ['sml'] + filenames = ['*.sml','*.sig','*.fun','*.ML'] + mimetypes = ['text/x-standardml', 'application/x-standardml'] + + flags = re.DOTALL | re.MULTILINE + + alphanumid_reserved = [ + ## Core + 'abstype', 'and', 'andalso', 'as', 'case', 'do', 'datatype', 'else', + 'end', 'exception', 'fn', 'fun', 'handle', 'if', 'in', 'infix', + 'infixr', 'let', 'local', 'nonfix', 'of', 'op', 'open', 'orelse', + 'raise', 'rec', 'then', 'type', 'val', 'with', 'withtype', 'while', + ## Modules + 'eqtype', 'functor', 'include', 'sharing', 'sig', + 'signature', 'struct', 'structure', 'where' + ] + symbolicid_reserved = [ + ## Core + ':', '|', '=', '=>', '->', '#', + ## Modules + ':>' + ] + nonid_reserved = [ + ## Core + '(', ')', '[', ']', '{', '}', ',', ';', '...', '_' + ## Modules + ] + + alphanumid_re = r'[a-zA-Z][a-zA-Z0-9_\']*' + symbolicid_re = r'[!%&$#+\-/:<=>?@\\~`^|*]+' + long_id_re = r'((%s\.)*)((%s)|(%s))' % (alphanumid_re, alphanumid_re, symbolicid_re) + primed_alphanumid_re = r'\'[a-zA-Z0-9_\']*' + + def long_id_callback(self, match): + strids = match.group(1) + pos = 0 + for m in re.finditer(r'(%s)(\.)' % self.alphanumid_re, strids) : + strid = m.group(1) + if strid in self.alphanumid_reserved : + token = Error + else : + token = Name + yield pos, token, strid + pos += len(strid) + dot = m.group(2) + yield pos, Punctuation, dot + pos += len(dot) + nqid = match.group(3) + if strids == "" : + if nqid in self.alphanumid_reserved : + token = Keyword + elif nqid in self.symbolicid_reserved : + token = Punctuation + else : + token = Name + else : + if nqid in self.alphanumid_reserved : + token = Error + elif nqid in self.symbolicid_reserved : + token = Error + else : + token = Name + yield pos, token, nqid + pos += len(nqid) + + printable_re = r'[^\x00-\x1F"\\\x7F]' + escape_re = r'\\("|\\|a|b|t|n|v|f|r|^[@-_]|[0-9]{3}|u[0-9a-fA-F]{4}|U[0-9a-fA-F]{8})' + + tokens = { + 'root': [ + (r'\s+', Whitespace), + (r'\(\*', Comment.Multiline, 'comment'), + + (long_id_re, long_id_callback), + (r'(%s)' % '|'.join([re.escape(z) for z in nonid_reserved]), Punctuation), + (primed_alphanumid_re, Name), + + (r'~?[0-9]+\.[0-9]+((e|E)~?[0-9]+)?', Number.Float), + (r'~?[0-9]+(e|E)~?[0-9]+', Number.Float), + (r'0wx[0-9a-fA-F]+', Number.Hex), + (r'~?0x[0-9a-fA-F]+', Number.Hex), + (r'0w[0-9]+', Number.Integer), + (r'~?[0-9]+', Number.Integer), + + (r'"', String, 'string'), + (r'(#)(")', bygroups(Text, String), 'string'), + + (r'.', Error, 'error') + ], + 'error': [ + (r'.', Error) + ], + 'comment': [ + (r'\(\*', Comment.Multiline, '#push'), + (r'\*\)', Comment.Multiline, '#pop'), + (r'.', Comment.Multiline), + ], + 'string': [ + (printable_re, String), + (escape_re, String.Escape), + (r'\\\s', String, 'gap'), + (r'"', String, '#pop'), + (r'.', Error), + ], + 'gap': [ + (r'\s+', String), + (r'\\', String, '#pop'), + (r'.', Error), + ], + } |
|
From: Matthew F. <fl...@ml...> - 2011-05-16 14:05:50
|
Properly handle strings with formatting gaps.
----------------------------------------------------------------------
U mlton/trunk/ide/enscript/sml_all.st
U mlton/trunk/ide/enscript/sml_simple.st
----------------------------------------------------------------------
Modified: mlton/trunk/ide/enscript/sml_all.st
===================================================================
--- mlton/trunk/ide/enscript/sml_all.st 2011-05-03 20:30:24 UTC (rev 7530)
+++ mlton/trunk/ide/enscript/sml_all.st 2011-05-16 21:05:48 UTC (rev 7531)
@@ -88,6 +88,11 @@
*/
state sml_string
{
+ /\\\\(\s|\n)/ {
+ language_print ($0);
+ call (sml_string_gap);
+ }
+
/\\\\./ {
language_print ($0);
}
@@ -102,6 +107,22 @@
}
}
+state sml_string_gap
+{
+ /(\s|\n)/ {
+ language_print ($0);
+ }
+
+ /\\\\/ {
+ language_print ($0);
+ return;
+ }
+
+ LANGUAGE_SPECIALS {
+ language_print ($0);
+ }
+}
+
/*
* Nested comments
*/
Modified: mlton/trunk/ide/enscript/sml_simple.st
===================================================================
--- mlton/trunk/ide/enscript/sml_simple.st 2011-05-03 20:30:24 UTC (rev 7530)
+++ mlton/trunk/ide/enscript/sml_simple.st 2011-05-16 21:05:48 UTC (rev 7531)
@@ -77,6 +77,11 @@
*/
state sml_string extends Highlight
{
+ /\\\\(\s|\n)/ {
+ language_print ($0);
+ call (sml_string_gap);
+ }
+
/\\\\./ {
language_print ($0);
}
@@ -87,6 +92,18 @@
}
}
+state sml_string_gap extends Highlight
+{
+ /(\s|\n)/ {
+ language_print ($0);
+ }
+
+ /\\\\/ {
+ language_print ($0);
+ return;
+ }
+}
+
/*
* Nested comments
*/
|
|
From: Matthew F. <fl...@ml...> - 2011-05-03 13:30:27
|
Fixed a bug with the treatment of as-patterns.
An as-pattern should not allow the redefinition of an identifier's
constructor status.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/mlton/elaborate/elaborate-core.fun
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2011-05-03 20:30:21 UTC (rev 7529)
+++ mlton/trunk/doc/changelog 2011-05-03 20:30:24 UTC (rev 7530)
@@ -1,5 +1,9 @@
Here are the changes from version 2010608 to version YYYYMMDD.
+* 2011-05-03
+ - Fixed a bug with the treatment of as-patterns, which should not
+ allow the redefinition of constructor status.
+
* 2011-02-18
- Fixed bug with treatment of nan in common subexpression
elimination SSA optimization.
Modified: mlton/trunk/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-core.fun 2011-05-03 20:30:21 UTC (rev 7529)
+++ mlton/trunk/mlton/elaborate/elaborate-core.fun 2011-05-03 20:30:24 UTC (rev 7530)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009-2010 Matthew Fluet.
+(* Copyright (C) 2009-2011 Matthew Fluet.
* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
@@ -556,7 +556,21 @@
case constraint of
NONE => Type.new ()
| SOME t => elaborateType (t, Lookup.fromEnv E)
- val x = bindToType (x, t)
+ val xc = Avid.toCon (Avid.fromVar x)
+ val x =
+ case Env.peekLongcon (E, Ast.Longcon.short xc) of
+ NONE => bindToType (x, t)
+ | SOME _ =>
+ let
+ val _ =
+ Control.error
+ (region,
+ seq [str "constructor can not be redefined by as: ",
+ Avar.layout x],
+ seq [str "in: ", lay ()])
+ in
+ Var.fromAst x
+ end
val pat' = loop pat
val _ =
unifyPatternConstraint (Cpat.ty pat',
|
