libgfortran:

2003-09-07  XiaoQiang Zhang (zhangapache@yahoo.com>

	* libgfortran.h (xtoa, itoa): Parameter modified.
	* io/io.h (namelist_info): Declaration to support namelist I/O
	(st_parameter): Add namelist related component
        (ionml, empty_internal_buffer, st_set_nml_var_int,
	st_set_nml_var_float, st_set_nml_var_char, st_set_nml_var_complex,
	st_set_nml_var_log): Declaration
        (set_integer, set_integer): Parameter changed
	* io/format.c (free_nodes): Fix annoying bug of lefting "deallocated"
	 fnodes
	(parse_format_list): Fix bug about FMT_SLASH
	* io/list_read.c (push_char): Totally clear old saved_string, zeroize
	newly allocated saved_string
	(next_char): Add detection of End_Of_Line support
	(convert_integer): Now can process 64 bits interger
	(read_real): Bug fixed
	(init_at_eol, find_nml_node, match_namelist_name): Add new functions
	(match_namelist_name): New implemention
	* io/lock.c (ionml): New global variable
	(library_end): Free memory in ionml
	* io/open.c (st_open): Variable initializtion
	* io/read.c (max_value): 64 bits interger support
	(convert_precsion_real): New procedure to replace "strtod" with more
	 features
	(read_f, read_radix): Input bug fix
	* io/transfer.c: (sf_seen_eor): New static variable
	(read_sf): Zeroize base buffer; fix bugs: single read statement can
	not get input in mutli line when read from stdin
	(formatted_transfer): Fix bug of FMT_O, FMT_B, FMT_Z for INTEGER type
	 request
	(data_transfer_init): Clear internal buffer for Internel File I/O.
	Internal File now worked. Detect some error condition for namelist.
	Some minor bug fix
	(next_record_w): Internal file and Namelist I/O support.
	(st_set_nml_var, st_set_nml_var_float, st_set_nml_var_char,
	st_set_nml_var_complex, st_set_nml_var_log): Implemention.
	* io/unit.c (implicit_unit): Deletion
	(get_unit): Now cannot open a unit implicitly.
	* io/unix.c (mmap_alloc): Fix fatal error in calculating the length of
	mapped buffer.
	(mem_alloc_r_at): Internal file I/O support added
	(empty_internal_buffer): New function
	* io/write.c (extract_int): Support 64 bits interger processing
	(output_float): Varibale initialization
	(write_float): Infinite real number detection.
	(write_int): 64 bits integer I/O support
	(write_decimal): New function to output decimal number
	(otoa, btoa): Better implemention and 64 bits interger support
	(namelist_write): New function
	* runtime/error.c (itoa, xtoa): Better implemention and 64 bits
	interger support

gfortran:
2003-09-07  XiaoQiang Zhang  (zhangapache@yahoo.com>

	* trans-const.c (gfc_conv_mpz_to_tree): Fix bug, parameter for
	build_int_2 changed from (high, low) to (low, high)
	* trans-io.c (ioparm_namelist_name, ioparm_namelist_name_len,
	ioparm_namelist_read_mode, iocall_set_nml_val_int,
	iocall_set_nml_val_float, iocall_set_nml_val_char,
	iocall_set_nml_val_complex, iocall_set_nml_val_log): New declaration
	(gfc_build_io_library_fndecls): Add variable initialization
	(gfc_new_nml_name_expr, get_new_var_expr): New function
	(build_dt): Add namelist support
	* io.c (value): New variable
	(check_format): Support FMT_H now


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/tree-ssa-20020619-branch@71174 138bc75d-0d04-0410-961f-82ee72b054a4

13 files changed, 752 insertions, 147 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index b47faeb098c..3a4d20b5613 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,56 @@
+2003-09-07  XiaoQiang Zhang (zhangapache@yahoo.com>
+
+	* libgfortran.h (xtoa, itoa): Parameter modified.
+	* io/io.h (namelist_info): Declaration to support namelist I/O
+	(st_parameter): Add namelist related component
+        (ionml, empty_internal_buffer, st_set_nml_var_int, 
+	st_set_nml_var_float, st_set_nml_var_char, st_set_nml_var_complex,
+	st_set_nml_var_log): Declaration
+        (set_integer, set_integer): Parameter changed
+	* io/format.c (free_nodes): Fix annoying bug of lefting "deallocated"
+	 fnodes
+	(parse_format_list): Fix bug about FMT_SLASH
+	* io/list_read.c (push_char): Totally clear old saved_string, zeroize
+	newly allocated saved_string
+	(next_char): Add detection of End_Of_Line support
+	(convert_integer): Now can process 64 bits interger
+	(read_real): Bug fixed
+	(init_at_eol, find_nml_node, match_namelist_name): Add new functions 
+	(match_namelist_name): New implemention
+	* io/lock.c (ionml): New global variable
+	(library_end): Free memory in ionml
+	* io/open.c (st_open): Variable initializtion
+	* io/read.c (max_value): 64 bits interger support
+	(convert_precsion_real): New procedure to replace "strtod" with more
+	 features
+	(read_f, read_radix): Input bug fix
+	* io/transfer.c: (sf_seen_eor): New static variable
+	(read_sf): Zeroize base buffer; fix bugs: single read statement can 
+	not get input in mutli line when read from stdin
+	(formatted_transfer): Fix bug of FMT_O, FMT_B, FMT_Z for INTEGER type
+	 request
+	(data_transfer_init): Clear internal buffer for Internel File I/O. 
+	Internal File now worked. Detect some error condition for namelist.
+	Some minor bug fix
+	(next_record_w): Internal file and Namelist I/O support.
+	(st_set_nml_var, st_set_nml_var_float, st_set_nml_var_char,
+	st_set_nml_var_complex, st_set_nml_var_log): Implemention.
+	* io/unit.c (implicit_unit): Deletion
+	(get_unit): Now cannot open a unit implicitly.
+	* io/unix.c (mmap_alloc): Fix fatal error in calculating the length of
+	mapped buffer.
+	(mem_alloc_r_at): Internal file I/O support added
+	(empty_internal_buffer): New function
+	* io/write.c (extract_int): Support 64 bits interger processing
+	(output_float): Varibale initialization
+	(write_float): Infinite real number detection.
+	(write_int): 64 bits integer I/O support
+	(write_decimal): New function to output decimal number
+	(otoa, btoa): Better implemention and 64 bits interger support
+	(namelist_write): New function
+	* runtime/error.c (itoa, xtoa): Better implemention and 64 bits 
+	interger support
+
 2003-08-15  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
 
 	* libgfortran.h (os_error, runtime_error,internal_error, sys_exit,
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index aceec5e82cb..c69a4b16bd3 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -151,6 +151,7 @@ free_fnodes (void)
     free_fnode (&array[0]);
 
   avail = array;
+  memset(array, 0, sizeof(avail[0]) * FARRAY_SIZE);
 }
 
 
@@ -502,7 +503,7 @@ format_item:
 
       t = format_lex ();
       if (t == FMT_F || t == FMT_EN || t == FMT_ES || t == FMT_D
-	  || t == FMT_G)
+	  || t == FMT_G || t == FMT_E)
 	{
 	  repeat = 1;
 	  goto data_desc;
@@ -557,6 +558,7 @@ format_item:
 
     case FMT_SLASH:
       get_fnode (&head, &tail, FMT_SLASH);
+      tail->repeat = 1;
       tail->u.r = 1;
       goto optional_comma;
 
@@ -1110,7 +1112,7 @@ static void dump_format1 (fnode * f);
 
 /* dump_format0()-- Dump a single format node */
 
-static void
+void
 dump_format0 (fnode * f)
 {
   char *p;
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index feb738bd24f..2aa1feffad6 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -66,6 +66,34 @@ stream;
 #define sseek(s, pos) ((s)->seek)(s, pos)
 #define struncate(s) ((s)->truncate)(s)
 
+/* Namelist represent object */
+/*
+   Namelist Records
+       &groupname  object=value [,object=value].../
+     or
+       &groupname  object=value [,object=value]...&groupname
+
+  Even more complex, during the execution of a program containing a
+  namelist READ statement, you can specify a question mark character(?)
+  or a question mark character preceded by an equal sign(=?) to get
+  the information of the namelist group. By '?', the name of variables
+  in the namelist will be displayed, by '=?', the name and value of
+  variables will be displayed.
+
+  All these requirements need a new data structure to record all info
+  about the namelist.
+*/
+
+typedef struct namelist_type
+{
+  char * var_name;
+  void * mem_pos;
+  int  value_acquired;
+  int len;
+  bt type;
+  struct namelist_type * next;
+}
+namelist_info;
 
 /* Options for the OPEN statement.  */
 
@@ -189,6 +217,10 @@ typedef struct
   char *readwrite;
   int readwrite_len;
 
+/* namelist related data */
+  char * namelist_name;
+  int namelist_name_len;
+  int namelist_read_mode;
 }
 st_parameter;
 
@@ -197,6 +229,8 @@ st_parameter;
 #define ioparm prefix(ioparm)
 extern st_parameter ioparm;
 
+#define ionml prefix(ionml)
+extern namelist_info * ionml;
 
 typedef struct
 {
@@ -417,6 +451,10 @@ offset_t file_position (stream *);
 #define is_seekable prefix(is_seekable)
 int is_seekable (stream *);
 
+#define empty_internal_buffer prefix(empty_internal_buffer)
+void empty_internal_buffer(stream *);
+
+
 /* unit.c */
 
 #define insert_unit prefix(insert_unix)
@@ -490,13 +528,28 @@ void transfer_complex (void *, int);
 #define next_record prefix(next_record)
 void next_record (int);
 
+#define st_set_nml_var_int prefix(st_set_nml_var_int)
+void st_set_nml_var_int (void * , char * , int , int );
+
+#define st_set_nml_var_float prefix(st_set_nml_var_float)
+void st_set_nml_var_float (void * , char * , int , int );
+
+#define st_set_nml_var_char prefix(st_set_nml_var_char)
+void st_set_nml_var_char (void * , char * , int , int );
+
+#define st_set_nml_var_complex prefix(st_set_nml_var_complex)
+void st_set_nml_var_complex (void * , char * , int , int );
+
+#define st_set_nml_var_log prefix(st_set_nml_var_log)
+void st_set_nml_var_log (void * , char * , int , int );
+
 /* read.c */
 
 #define set_integer prefix(set_integer)
-void set_integer (void *, int, int);
+void set_integer (void *, int64_t, int);
 
 #define max_value prefix(max_value)
-unsigned max_value (int, int);
+uint64_t max_value (int, int);
 
 #define convert_real prefix(convert_real)
 int convert_real (void *, const char *, int);
@@ -519,7 +572,7 @@ void read_radix (fnode *, char *, int, int);
 #define read_decimal prefix(read_decimal)
 void read_decimal (fnode *, char *, int);
 
-/* lread.c */
+/* list_read.c */
 
 #define list_formatted_read prefix(list_formatted_read)
 void list_formatted_read (bt, void *, int);
@@ -527,6 +580,15 @@ void list_formatted_read (bt, void *, int);
 #define finish_list_read prefix(finish_list_read)
 void finish_list_read (void);
 
+#define init_at_eol prefix(init_at_eol)
+void init_at_eol();
+
+#define namelist_read prefix(namelist_read)
+void namelist_read();
+
+#define namelist_write prefix(namelist_write)
+void namelist_write();
+
 /* write.c */
 
 #define write_a prefix(write_a)
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 3063bf42318..50fe7e40cf8 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -82,6 +82,7 @@ push_char (char c)
   if (saved_string == NULL)
     {
       saved_string = scratch;
+      memset (saved_string,0,SCRATCH_SIZE);
       saved_length = SCRATCH_SIZE;
       saved_used = 0;
     }
@@ -91,6 +92,8 @@ push_char (char c)
       saved_length = 2 * saved_length;
       new = get_mem (2 * saved_length);
 
+      memset (new,0,2 * saved_length);
+
       memcpy (new, saved_string, saved_used);
       if (saved_string != scratch)
 	free_mem (saved_string);
@@ -126,6 +129,7 @@ next_char (void)
 
   if (last_char != '\0')
     {
+      at_eol = 0;
       c = last_char;
       last_char = '\0';
       goto done;
@@ -296,7 +300,8 @@ static int
 convert_integer (int length, int negative)
 {
   char c, *buffer, message[100];
-  int m, v, max, max10;
+  int m;
+  int64_t v, max, max10;
 
   buffer = saved_string;
   v = 0;
@@ -501,7 +506,7 @@ read_logical (int length)
 
   unget_char (c);
   eat_separator ();
-
+  free_saved ();
   set_integer ((int *) value, v, length);
 
   return;
@@ -636,8 +641,12 @@ done:
 
   push_char ('\0');
   if (convert_integer (length, negative))
-    return;
+    {
+       free_saved ();
+       return;
+    }
 
+  free_saved ();
   saved_type = BT_INTEGER;
 }
 
@@ -773,6 +782,7 @@ done:
     {
       unget_char (c);
       eat_separator ();
+      free_saved ();
       saved_type = BT_CHARACTER;
     }
   else
@@ -949,6 +959,7 @@ read_complex (int length)
   unget_char (c);
   eat_separator ();
 
+  free_saved ();
   saved_type = BT_COMPLEX;
   return;
 
@@ -978,6 +989,7 @@ read_real (int length)
       break;
 
     case '.':
+      push_char (c);
       seen_dp = 1;
       break;
 
@@ -1031,7 +1043,8 @@ read_real (int length)
 	  goto got_repeat;
 
 	CASE_SEPARATORS:
-	  unget_char (c);	/* Real number that is just a digit-string */
+          if (c != '\n')
+            unget_char (c);        /* Real number that is just a digit-string */
 	  goto done;
 
 	default:
@@ -1156,6 +1169,7 @@ done:
   if (convert_real (value, saved_string, length))
     return;
 
+  free_saved ();
   saved_type = BT_REAL;
   return;
 
@@ -1311,6 +1325,11 @@ set_value:
     free_saved ();
 }
 
+void
+init_at_eol()
+{
+  at_eol = 0;
+}
 
 /* finish_list_read()-- Finish a list read */
 
@@ -1322,7 +1341,11 @@ finish_list_read (void)
   free_saved ();
 
   if (at_eol)
-    return;
+    {
+      at_eol = 0;
+      return;
+    }
+
 
   do
     {
@@ -1331,6 +1354,46 @@ finish_list_read (void)
   while (c != '\n');
 }
 
+namelist_info *
+find_nml_node (char * var_name)
+{
+   namelist_info * t = ionml;
+   while (t != NULL)
+     {
+       if (strcmp (var_name,t->var_name) == 0)
+         {
+           t->value_acquired = 1;
+           return t;
+         }
+       t = t->next;
+     }
+  return NULL;
+}
+
+void
+match_namelist_name (char *name, int len)
+{
+  int name_len;
+  char c;
+  char * namelist_name = name;
+
+  name_len = 0;
+  /* Match the name of the namelist */
+
+  if (tolower (next_char ()) != tolower (namelist_name[name_len++]))
+    {
+    wrong_name:
+      generate_error (ERROR_READ_VALUE, "Wrong namelist name found");
+      return;
+    }
+
+  while (name_len < len)
+    {
+      c = next_char ();
+      if (tolower (c) != tolower (namelist_name[name_len++]))
+        goto wrong_name;
+    }
+}
 
 
 /********************************************************************
@@ -1343,7 +1406,11 @@ finish_list_read (void)
 void
 namelist_read (void)
 {
-  char c, *namelist_name;
+  char c;
+  int name_matched, next_name ;
+  namelist_info * nl;
+  int len, m;
+  void * p;
 
   namelist_mode = 1;
 
@@ -1359,10 +1426,9 @@ restart:
     {
     case ' ':
       goto restart;
-
     case '!':
       do
-	c = next_char ();
+        c = next_char ();
       while (c != '\n');
 
       goto restart;
@@ -1376,22 +1442,87 @@ restart:
     }
 
   /* Match the name of the namelist */
-
-  if (tolower (next_char ()) != tolower (*namelist_name++))
-    {
-    wrong_name:
-      generate_error (ERROR_READ_VALUE, "Wrong namelist name found");
-      return;
-    }
-
-  while (*namelist_name)
-    {
-      if (tolower (c) != tolower (*namelist_name))
-	goto wrong_name;
-    }
+  match_namelist_name(ioparm.namelist_name, ioparm.namelist_name_len);
 
   /* Ready to read namelist elements */
-
-
-
+  for (;;)
+    {
+      c = next_char ();
+      switch (c)
+        {
+        case '&':
+          match_namelist_name("end",3);
+          return;
+        case '\\':
+          return;
+        case ' ':
+        case '\n':
+        case '\t':
+          break;
+        case ',':
+          next_name = 1;
+          break;
+
+        case '=':
+          name_matched = 1;
+          nl = find_nml_node (saved_string);
+          if (nl == NULL)
+            internal_error ("Can not found a valid namelist var!");
+          free_saved();
+
+          len = nl->len;
+          p = nl->mem_pos;
+          switch (nl->type)
+            {
+            case BT_INTEGER:
+              read_integer (len);
+              break;
+            case BT_LOGICAL:
+              read_logical (len);
+              break;
+            case BT_CHARACTER:
+              read_character (len);
+              break;
+            case BT_REAL:
+              read_real (len);
+              break;
+            case BT_COMPLEX:
+              read_complex (len);
+              break;
+            default:
+              internal_error ("Bad type for namelist read");
+            }
+
+           switch (saved_type)
+            {
+            case BT_COMPLEX:
+              len = 2 * len;
+              /* Fall through */
+
+            case BT_INTEGER:
+            case BT_REAL:
+            case BT_LOGICAL:
+              memcpy (p, value, len);
+              break;
+
+            case BT_CHARACTER:
+              m = (len < saved_used) ? len : saved_used;
+              memcpy (p, saved_string, m);
+
+              if (m < len)
+                memset (((char *) p) + m, ' ', len - m);
+              break;
+
+            case BT_NULL:
+              break;
+            }
+
+          break;
+
+        default :
+          push_char(c);
+          break;
+        }
+   }
 }
+
diff --git a/libgfortran/io/lock.c b/libgfortran/io/lock.c
index f26a7f9a628..1d3f06912e0 100644
--- a/libgfortran/io/lock.c
+++ b/libgfortran/io/lock.c
@@ -25,6 +25,7 @@ Boston, MA 02111-1307, USA.  */
 #include "io.h"
 
 st_parameter ioparm;
+namelist_info * ionml;
 global_t g;
 
 
@@ -58,12 +59,25 @@ void
 library_end (void)
 {
   int t;
+  namelist_info * t1, *t2;
 
   g.in_library = 0;
   filename = NULL;
   line = 0;
 
   t = ioparm.library_return;
+  if (ionml != NULL)
+    {
+      t1 = ionml;
+      while (t1 != NULL)
+       {
+         t2 = t1;
+         t1 = t1->next;
+         free_mem (t2);
+       }
+    }
+  
+  ionml = NULL;
   memset (&ioparm, '\0', sizeof (ioparm));
   ioparm.library_return = t;
 }
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 0e05380b1d2..e0daa25575f 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -465,8 +465,8 @@ void
 st_open (void)
 {
   unit_flags flags;
-  unit_t *u;
-
+  unit_t *u = NULL;
+ 
   library_start ();
 
   /* Decode options */
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 325502f56ac..1c21e8a58b1 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -34,11 +34,14 @@ Boston, MA 02111-1307, USA.  */
  * actually place the value into memory.  */
 
 void
-set_integer (void *dest, int value, int length)
+set_integer (void *dest, int64_t value, int length)
 {
 
   switch (length)
     {
+    case 8:
+      *((int64_t *) dest) = value;
+      break;
     case 4:
       *((int32_t *) dest) = value;
       break;
@@ -57,13 +60,16 @@ set_integer (void *dest, int value, int length)
 /* max_value()-- Given a length (kind), return the maximum signed or
  * unsigned value */
 
-unsigned
+uint64_t
 max_value (int length, int signed_flag)
 {
-  unsigned value;
+  uint64_t value;
 
   switch (length)
     {
+    case 8:
+      value = signed_flag ? 0x7fffffffffffffff : 0xffffffffffffffff;
+      break;
     case 4:
       value = signed_flag ? 0x7fffffff : 0xffffffff;
       break;
@@ -115,6 +121,113 @@ convert_real (void *dest, const char *buffer, int length)
   return 0;
 }
 
+int
+convert_precsion_real (void *dest, int sign,
+                       char *buffer, int length, int exponent)
+{
+  int w, new_dp_pos, i, slen, k, dp;
+  char * p, c;
+  double fval;
+  float tf;
+
+  fval =0.0;
+  tf = 0.0;
+  dp = 0;
+  new_dp_pos = 0;
+
+  slen = strlen (buffer);
+  w = slen;
+  p = buffer;
+
+/*  for (i = w - 1; i > 0; i --)
+    {
+       if (buffer[i] == '0' || buffer[i] == 0)
+         buffer[i] = 0;
+       else
+         break;
+    }
+*/
+  for (i = 0; i < w; i++)
+    {
+       if (buffer[i] == '.')
+         break;
+    }
+
+  new_dp_pos = i;
+  new_dp_pos += exponent;
+
+  while (w > 0)
+    {
+      c = *p;
+      switch (c)
+        {
+        case '0':
+        case '1':
+        case '2':
+        case '3':
+        case '4':
+        case '5':
+        case '6':
+        case '7':
+        case '8':
+        case '9':
+          fval = fval * 10.0 + c - '0';
+          p++;
+          w--;
+          break;
+
+        case '.':
+          dp = 1;
+          p++;
+          w--;
+          break;
+
+       default:
+          p++;
+          w--;
+          break;
+     }
+  }
+
+  if (sign)
+    fval = - fval;
+
+  i = new_dp_pos - slen + dp;
+  k = abs(i);
+  tf = 1.0;
+
+  while (k > 0)
+    {
+       tf *= 10.0 ;
+       k -- ;
+    }
+
+  if (fval != 0.0)
+    {
+       if (i < 0)
+         {
+           fval = fval / tf;
+         }
+        else
+         {
+           fval = fval * tf;
+         }
+    }
+
+  switch (length)
+    {
+    case 4:
+      *((float *) dest) = (float)fval;
+      break;
+    case 8:
+      *((double *) dest) = fval;
+      break;
+    default:
+      internal_error ("Bad real number kind");
+    }
+
+  return 0;
+}
 
 
 /* read_l()-- Read a logical value */
@@ -433,7 +546,7 @@ read_radix (fnode * f, char *dest, int length, int radix)
       c -= '0';
       value = radix * value;
 
-      if (maxv - c > value)
+      if (maxv - c < value)
 	goto overflow;
       value += c;
     }
@@ -465,9 +578,12 @@ overflow:
 void
 read_f (fnode * f, char *dest, int length)
 {
-  int w, seen_dp, exponent, exponent_sign;
+  int w, seen_dp, exponent;
+  int exponent_sign, val_sign;
   char *p, *buffer, *n;
 
+  val_sign = 0;
+  seen_dp = 0;
   w = f->u.w;
   p = read_block (&w);
   if (p == NULL)
@@ -495,13 +611,18 @@ read_f (fnode * f, char *dest, int length)
   else
     buffer = get_mem (w + 2);
 
+  memset(buffer, 0, w + 2);
+
   n = buffer;
 
   /* Optional sign */
 
   if (*p == '-' || *p == '+')
     {
-      *n++ = *p++;
+      if (*p == '-')
+        val_sign = 1;
+      p++;
+
       if (--w == 0)
 	goto bad_float;
     }
@@ -613,6 +734,8 @@ exp2:
     goto bad_float;
 
   exponent = *p - '0';
+  p++;
+  w--;
 
   while (w > 0 && isdigit (*p))
     {
@@ -638,19 +761,13 @@ exp2:
 
 done:
   if (!seen_dp)
-    exponent += f->u.real.d;
-
-  *n++ = 'E';
-  if (exponent >= 0)
-    *n++ = '+';
-
-  strcpy (n, itoa (exponent));
+    exponent -= f->u.real.d;
 
   /* The number is syntactically correct and ready for conversion.
    * The only thing that can go wrong at this point is overflow or
    * underflow. */
 
-  convert_real (dest, buffer, length);
+  convert_precsion_real (dest, val_sign, buffer, length, exponent);
 
   if (buffer != scratch)
      free_mem (buffer);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 91bdc737334..a606fe97eaa 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -56,6 +56,8 @@ Boston, MA 02111-1307, USA.  */
 
 unit_t *current_unit;
 
+static int sf_seen_eor = 0;
+
 char scratch[SCRATCH_SIZE];
 static char *line_buffer = NULL;
 
@@ -126,18 +128,32 @@ read_sf (int *length)
   else
     p = base = data;
 
+  memset(base,'\0',*length);
+
   current_unit->bytes_left = options.default_recl;
   unity = 1;
   n = 0;
 
   do
     {
+      if (is_internal_unit())
+        {
+       /* unity may be modified inside salloc_r if is_internal_unit() is true */
+          unity = 1;
+        }
+
       q = salloc_r (current_unit->s, &unity);
       if (q == NULL)
 	break;
 
       if (*q == '\n')
-	{			/* Unexpected end of line */
+	{
+          if (current_unit->unit_number == options.stdin_unit)
+            { 
+              if (n <= 0)
+                continue;
+            }          
+			/* Unexpected end of line */
 	  if (current_unit->flags.pad == PAD_NO)
 	    {
 	      generate_error (ERROR_EOR, NULL);
@@ -146,11 +162,13 @@ read_sf (int *length)
 
 	  current_unit->bytes_left = 0;
 	  *length = n;
+          sf_seen_eor = 1;
 	  break;
 	}
 
       n++;
       *p++ = *q;
+      sf_seen_eor = 0;
     }
   while (n < *length);
 
@@ -422,8 +440,6 @@ formatted_transfer (bt type, void *p, int len)
 	case FMT_O:
 	  if (n == 0)
 	    goto need_data;
-	  if (require_type (BT_INTEGER, type, f))
-	    return;
 
 	  if (g.mode == READING)
 	    read_radix (f, p, len, 8);
@@ -435,8 +451,6 @@ formatted_transfer (bt type, void *p, int len)
 	case FMT_Z:
 	  if (n == 0)
 	    goto need_data;
-	  if (require_type (BT_INTEGER, type, f))
-	    return;
 
 	  if (g.mode == READING)
 	    read_radix (f, p, len, 16);
@@ -872,6 +886,9 @@ data_transfer_init (int read_flag)
   if (current_unit == NULL)
     return;
 
+  if (is_internal_unit() && g.mode==WRITING)
+    empty_internal_buffer (current_unit->s);
+
   /* Check the action */
 
   if (read_flag && current_unit->flags.action == ACTION_WRITE)
@@ -896,10 +913,17 @@ data_transfer_init (int read_flag)
     generate_error (ERROR_OPTION_CONFLICT,
 		    "Format present for UNFORMATTED data transfer");
 
-  if (current_unit->flags.form == FORM_FORMATTED && ioparm.format == NULL &&
-      !ioparm.list_format)
+  if (ioparm.namelist_name != NULL && ionml != NULL)
+     {
+        if(ioparm.format != NULL)
+           generate_error (ERROR_OPTION_CONFLICT,
+                    "A format cannot be specified with a namelist");
+     }
+  else if (current_unit->flags.form == FORM_FORMATTED &&
+           ioparm.format == NULL && !ioparm.list_format)
     generate_error (ERROR_OPTION_CONFLICT,
-		    "Missing format for FORMATTED data transfer");
+                    "Missing format for FORMATTED data transfer");
+
 
   if (is_internal_unit () && current_unit->flags.form == FORM_UNFORMATTED)
     generate_error (ERROR_OPTION_CONFLICT,
@@ -1017,7 +1041,10 @@ data_transfer_init (int read_flag)
       else
 	{
 	  if (ioparm.list_format)
-	    transfer = list_formatted_read;
+            {
+               transfer = list_formatted_read;
+               init_at_eol();
+            }
 	  else
 	    transfer = formatted_transfer;
 	}
@@ -1053,8 +1080,10 @@ data_transfer_init (int read_flag)
     }
 
   /* Start the data transfer if we are doing a formatted transfer */
-  if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format)
-    formatted_transfer (0, NULL, 0);
+  if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format
+      && ioparm.namelist_name == NULL && ionml == NULL)
+
+     formatted_transfer (0, NULL, 0);
 
 }
 
@@ -1116,10 +1145,19 @@ next_record_r (int done)
 
     case FORMATTED_SEQUENTIAL:
       length = 1;
+      if ((!done) || (sf_seen_eor && done))
+         break;
 
       do
         {
           p = salloc_r (current_unit->s, &length);
+
+          /*In case of internal file, there may not be any '\n'.*/
+          if (is_internal_unit() && p == NULL)
+            {
+               break;
+            }
+
           if (p == NULL)
             {
               generate_error (ERROR_OS, NULL);
@@ -1206,10 +1244,15 @@ next_record_w (int done)
     case FORMATTED_SEQUENTIAL:
       length = 1;
       p = salloc_w (current_unit->s, &length);
-      if (p == NULL)
-	goto io_error;
 
-      *p = '\n';
+      if (!(is_internal_unit()) && p == NULL)
+        {
+           goto io_error;
+        }
+
+      if (p != NULL)
+         *p = '\n';
+
       if (sfree (current_unit->s) == FAILURE)
  	goto io_error;
 
@@ -1252,8 +1295,18 @@ next_record (int done)
 static void
 finalize_transfer (void)
 {
+  if ((ionml != NULL) && (ioparm.namelist_name != NULL))
+    {
+       if (ioparm.namelist_read_mode)
+         namelist_read();
+       else
+         namelist_write();
+    }
 
   transfer = NULL;
+  if (current_unit == NULL)
+    return;
+
   if (ioparm.list_format && g.mode == READING)
     finish_list_read ();
   else
@@ -1292,8 +1345,11 @@ st_read (void)
 	break;
 
       case AT_ENDFILE:
-	generate_error (ERROR_END, NULL);
-	current_unit->endfile = AFTER_ENDFILE;
+        if (!is_internal_unit())
+          {
+            generate_error (ERROR_END, NULL);
+            current_unit->endfile = AFTER_ENDFILE;
+          }
 	break;
 
       case AFTER_ENDFILE:
@@ -1329,7 +1385,7 @@ st_write_done (void)
 
   /* Deal with endfile conditions associated with sequential files */
 
-  if (current_unit->flags.access == ACCESS_SEQUENTIAL)
+  if (current_unit != NULL && current_unit->flags.access == ACCESS_SEQUENTIAL)
     switch (current_unit->endfile)
       {
       case AT_ENDFILE:		/* Remain at the endfile record */
@@ -1349,3 +1405,70 @@ st_write_done (void)
 
   library_end ();
 }
+
+
+void
+st_set_nml_var (void * var_addr, char * var_name, int var_name_len,
+                int kind, bt type)
+{
+  namelist_info *t1 = NULL, *t2 = NULL;
+  namelist_info *nml = (namelist_info *) get_mem (sizeof(
+                                                    namelist_info ));
+  nml->mem_pos = var_addr;
+  nml->var_name = (char*) get_mem (var_name_len+1);
+  strncpy (nml->var_name,var_name,var_name_len);
+  nml->var_name[var_name_len] = 0;
+  nml->len = kind;
+  nml->type = type;
+
+  nml->next = NULL;
+
+  if (ionml == NULL)
+     ionml = nml;
+  else
+    {
+      t1 = ionml;
+      while (t1 != NULL)
+       {
+         t2 = t1;
+         t1 = t1->next;
+       }
+       t2->next = nml;
+    }
+}
+
+void
+st_set_nml_var_int (void * var_addr, char * var_name, int var_name_len,
+                int kind)
+{
+   st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_INTEGER);
+}
+
+void
+st_set_nml_var_float (void * var_addr, char * var_name, int var_name_len,
+                int kind)
+{
+   st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_REAL);
+}
+
+void
+st_set_nml_var_char (void * var_addr, char * var_name, int var_name_len,
+                int kind)
+{
+   st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_CHARACTER);
+}
+
+void
+st_set_nml_var_complex (void * var_addr, char * var_name, int var_name_len,
+                int kind)
+{
+   st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_COMPLEX);
+}
+
+void
+st_set_nml_var_log (void * var_addr, char * var_name, int var_name_len,
+                int kind)
+{
+   st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_LOGICAL);
+}
+
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 3685b3294db..40bd1c8d774 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -239,61 +239,6 @@ find_unit (int n)
   return p;
 }
 
-
-/* implicit_unit()-- Given a unit number open the implicit unit,
- * usually of the form "fort.n" unless overridden by an environment
- * variable.  The unit structure is inserted into the tree, and the
- * file is opened for reading and writing */
-
-static unit_t *
-implicit_unit (int unit_number)
-{
-  char *p, buffer[100];
-  stream *s;
-  unit_t *u;
-
-  strcpy (buffer, "G95_NAME_");
-  strcat (buffer, itoa (unit_number));
-
-  p = getenv (buffer);
-  if (p == NULL)
-    {
-      strcpy (buffer, "fort.");
-      strcat (buffer, itoa (unit_number));
-      p = buffer;
-    }
-
-  s = open_external (ACTION_READWRITE, STATUS_REPLACE);
-  if (s == NULL)
-    {
-      generate_error (ERROR_OS, NULL);
-      return NULL;
-    }
-
-  u = get_mem (sizeof (unit_t) + strlen (p));
-  u->unit_number = unit_number;
-  u->s = s;
-
-  /* Set flags */
-
-  u->flags.access = ACCESS_SEQUENTIAL;
-  u->flags.action = ACTION_READWRITE;
-  u->flags.blank = BLANK_NULL;
-  u->flags.delim = DELIM_NONE;
-  u->flags.form = (ioparm.format == NULL && ioparm.list_format)
-    ? FORM_UNFORMATTED : FORM_FORMATTED;
-
-  u->flags.position = POSITION_ASIS;
-
-  u->file_len = strlen (p);
-  memcpy (u->file, p, u->file_len);
-
-  insert_unit (u);
-
-  return u;
-}
-
-
 /* get_unit()-- Returns the unit structure associated with the integer
  * unit or the internal file. */
 
@@ -323,15 +268,7 @@ get_unit (int read_flag)
   if (u != NULL)
     return u;
 
-  if (read_flag)
-    {
-      generate_error (ERROR_BAD_UNIT, NULL);
-      return NULL;
-    }
-
-  /* Open an unit implicitly */
-
-  return implicit_unit (ioparm.unit);
+  return NULL;
 }
 
 
diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index bae8dfbce8e..86752334a21 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -558,7 +558,7 @@ mmap_alloc (unix_stream * s, offset_t where, int *len)
 
   offset = where & page_mask;	/* Round down to the next page */
 
-  length = ((where + *len - offset) & page_mask) + 2 * page_size;
+  length = ((where - offset) & page_mask) + 2 * page_size;
 
   p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
   if (p == MAP_FAILED)
@@ -725,6 +725,9 @@ mem_alloc_r_at (unix_stream * s, int *len, offset_t where)
   if (where < s->buffer_offset || where > s->buffer_offset + s->active)
     return NULL;
 
+  if (is_internal_unit() && where + *len > s->file_length)
+    return NULL;
+
   s->logical_offset = where + *len;
 
   n = (where - s->buffer_offset) - s->active;
@@ -799,6 +802,15 @@ mem_sfree (unix_stream * s)
   define functional equivalents of the following.
 *********************************************************************/
 
+/* empty_internal_buffer()-- Zero the buffer of Internal file */
+
+void
+empty_internal_buffer(stream *strm)
+{
+   unix_stream * s = (unix_stream *) strm;
+   memset(s->buffer, '\n', s->file_length);
+}
+
 /* open_internal()-- Returns a stream structure from an internal file */
 
 stream *
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index bc032231cdf..28a9cd28262 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -66,10 +66,13 @@ write_l (fnode * f, char *p, int len)
   p[f->u.w - 1] = *((int *) p) ? 'T' : 'F';
 }
 
-static int
+static int64_t
 extract_int (const void *p, int len)
 {
-  int i = 0;
+  int64_t i = 0;
+
+  if (p == NULL)
+    return i;
 
   switch (len)
     {
@@ -207,6 +210,7 @@ calculate_G_format (fnode *f, double value, int len, int *num_blank)
     }
 
   /* Use binary search to find the data magnitude range.  */
+  mid = 0;
   low = 0;
   high = d + 1;
   lbound = 0;
@@ -271,11 +275,12 @@ output_float (fnode *f, double value, int len)
   int sca, neval, itmp;
   char *p;
   const char *q, *intstr;
-  sign_t sign, esign;
-  double n, minv, maxv;
+  double n;
   format_token ft;
   char exp_char = 'E';
   int scale_flag = 1 ;
+  double minv = 0.0, maxv = 0.0;
+  sign_t sign = SIGN_NONE, esign = SIGN_NONE;
 
   int intval = 0, intlen = 0;
   int j;
@@ -462,6 +467,19 @@ write_float (fnode *f, const char *source, int len)
   fnode *f2 = NULL;
 
   n = extract_real (source, len);
+
+  if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z)
+   {
+     if (isinf (n))
+       {
+         nb =  f->u.real.w;
+         p = write_block (nb);
+         memset (p, ' ' , 1);
+         memset (p+1, '+' , nb-1);
+         return;
+       }
+   }
+
   if (f->format != FMT_G)
     {
       output_float (f, n, len);
@@ -483,11 +501,86 @@ write_float (fnode *f, const char *source, int len)
 
 
 static void
-write_int (fnode *f, const char *source, int len, char *(*conv) (unsigned))
+write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t))
 {
-  int n, w, m, digits, nsign, nzero, nblank;
-  char *p;
-  const char *q;
+  uint32_t ns =0;
+  uint64_t n = 0;
+  int w, m, digits, nzero, nblank;
+  char *p, *q;
+
+  w = f->u.integer.w;
+  m = f->u.integer.m;
+
+  n = extract_int (source, len);
+
+  /* Special case */
+
+  if (m == 0 && n == 0)
+    {
+      if (w == 0)
+        w = 1;
+
+      p = write_block (w);
+      if (p == NULL)
+        return;
+
+      memset (p, ' ', w);
+      goto done;
+    }
+
+
+  if (len < 8)
+     {
+       ns = n;
+       q = conv (ns);
+     }
+  else
+      q = conv (n);
+
+  digits = strlen (q);
+
+  /* Select a width if none was specified.  The idea here is to always
+   * print something. */
+
+  if (w == 0)
+    w = ((digits < m) ? m : digits);
+
+  p = write_block (w);
+  if (p == NULL)
+    return;
+
+  nzero = 0;
+  if (digits < m)
+    nzero = m - digits;
+
+  /* See if things will work */
+
+  nblank = w - (nzero + digits);
+
+  if (nblank < 0)
+    {
+      star_fill (p, w);
+      goto done;
+    }
+
+  memset (p, ' ', nblank);
+  p += nblank;
+
+  memset (p, '0', nzero);
+  p += nzero;
+
+  memcpy (p, q, digits);
+
+done:
+  return;
+}
+
+static void
+write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t))
+{
+  int64_t n = 0;
+  int w, m, digits, nsign, nzero, nblank;
+  char *p, *q;
   sign_t sign;
 
   w = f->u.integer.w;
@@ -500,11 +593,11 @@ write_int (fnode *f, const char *source, int len, char *(*conv) (unsigned))
   if (m == 0 && n == 0)
     {
       if (w == 0)
-	w = 1;
+        w = 1;
 
       p = write_block (w);
       if (p == NULL)
-	return;
+        return;
 
       memset (p, ' ', w);
       goto done;
@@ -515,8 +608,8 @@ write_int (fnode *f, const char *source, int len, char *(*conv) (unsigned))
     n = -n;
 
   nsign = sign == SIGN_NONE ? 0 : 1;
-
   q = conv (n);
+
   digits = strlen (q);
 
   /* Select a width if none was specified.  The idea here is to always
@@ -571,7 +664,7 @@ done:
 /* otoa()-- Convert unsigned octal to ascii */
 
 static char *
-otoa (unsigned n)
+otoa (uint64_t n)
 {
   char *p;
 
@@ -587,8 +680,9 @@ otoa (unsigned n)
 
   while (n != 0)
     {
-      *p-- = '0' + (n % 8);
-      n /= 8;
+      *p = '0' + (n & 7);
+      p -- ;
+      n >>= 3;
     }
 
   return ++p;
@@ -598,7 +692,7 @@ otoa (unsigned n)
 /* btoa()-- Convert unsigned binary to ascii */
 
 static char *
-btoa (unsigned n)
+btoa (uint64_t n)
 {
   char *p;
 
@@ -626,7 +720,7 @@ void
 write_i (fnode * f, const char *p, int len)
 {
 
-  write_int (f, p, len, (void *) itoa);
+  write_decimal (f, p, len, (void *) itoa);
 }
 
 
@@ -882,6 +976,9 @@ list_formatted_write (bt type, void *p, int len)
 {
   static int char_flag;
 
+  if (current_unit == NULL)
+    return;
+
   if (g.first_item)
     {
       g.first_item = 0;
@@ -917,3 +1014,60 @@ list_formatted_write (bt type, void *p, int len)
 
   char_flag = (type == BT_CHARACTER);
 }
+
+void
+namelist_write (void)
+{
+   namelist_info * t1, *t2;
+   int len,num;
+   void * p;
+
+   num = 0;
+   write_character("&",1);
+   write_character (ioparm.namelist_name, ioparm.namelist_name_len);
+   write_character("\n",1);
+
+   if (ionml != NULL)
+     {
+       t1 = ionml;
+       while (t1 != NULL)
+        {
+          num ++;
+          t2 = t1;
+          t1 = t1->next;
+          write_character(t2->var_name, strlen(t2->var_name));
+          write_character("=",1);
+          len = t2->len;
+          p = t2->mem_pos;
+          switch (t2->type)
+            {
+            case BT_INTEGER:
+              write_integer (p, len);
+              break;
+            case BT_LOGICAL:
+              write_logical (p, len);
+              break;
+            case BT_CHARACTER:
+              write_character (p, len);
+              break;
+            case BT_REAL:
+              write_real (p, len);
+              break;
+            case BT_COMPLEX:
+              write_complex (p, len);
+              break;
+            default:
+              internal_error ("Bad type for namelist write");
+            }
+         write_character(",",1);
+         if (num > 5)
+           {
+              num = 0;
+              write_character("\n",1);
+           }
+        }
+     }
+     write_character("/",1);
+
+}
+
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index ea79744e6c6..69a10e07d4e 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -249,10 +249,10 @@ void get_args (int *, char ***);
 char *rtoa (double f, int length, int oprec);
 
 #define itoa prefix(itoa)
-char *itoa (int);
+char *itoa (int64_t);
 
 #define xtoa prefix(xtoa)
-char *xtoa (unsigned);
+char *xtoa (uint64_t);
 
 #define os_error prefix(os_error)
 void os_error (const char *) __attribute__ ((noreturn));
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 8de5b220672..8cd980dff9a 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -113,7 +113,7 @@ rtoa (double f, int length, int oprec)
 /* Returns a pointer to a static buffer. */
 
 char *
-itoa (int n)
+itoa (int64_t n)
 {
   int negative;
   char *p;
@@ -151,7 +151,7 @@ itoa (int n)
  * static buffer. */
 
 char *
-xtoa (unsigned n)
+xtoa (uint64_t n)
 {
   int digit;
   char *p;