Initial Fortran language support, adapted from work by Farooq Butt

	(fmbutt@engage.sps.mot.com).
	* Makefile.in: Add Fortran-related files and dependencies.
	* defs.h (language_fortran): New language enum.
	* language.h (_LANG_fortran): Define.
	(MAX_FORTRAN_DIMS): Define.
	* expression.h: Reformat to standard.
	(MULTI_F77_SUBSCRIPT, OP_F77_UNDETERMINED_ARGLIST,
	OP_F77_LITERAL_COMPLEX, OP_F77_SUBSTR): New expression opcodes.
	* gdbtypes.h (TYPE_CODE_COMPLEX, TYPE_CODE_LITERAL_COMPLEX,
	TYPE_CODE_LITERAL_STRING): New type codes.
	(type): New fields upper_bound_type and lower_bound_type.
	(TYPE_ARRAY_UPPER_BOUND_TYPE, TYPE_ARRAY_LOWER_BOUND_TYPE,
	TYPE_ARRAY_UPPER_BOUND_VALUE, TYPE_ARRAY_LOWER_BOUND_VALUE): New
	macros.
	(builtin_type_f_character, etc): Declare.
	* value.h (VALUE_LITERAL_DATA, VALUE_SUBSTRING_START): Define.
	* f-exp.y: New file, Fortran expression grammar.
	* f-lang.c: New file, Fortran language support functions.
	* f-lang.h: New file, Fortran language support declarations.
	* f-typeprint.c: New file, Fortran type printing.
	* f-valprint.c: New file, Fortran value printing.
	* eval.c (evaluate_subexp): Add code for new expression opcodes,
	fix wording of error message.
	* gdbtypes.c (f77_create_literal_complex_type,
	f77_create_literal_string_type): New functions.
	* language.c (set_language_command): Add Fortran info.
	(calc_f77_array_dims): New function.
	* parse.c (length_of_subexp, prefixify_subexp): Add cases for new
	expression opcodes.
	* symfile.c (deduce_language_from_filename): Recognize .f and .F
	as Fortran source files.
	* valops.c (f77_value_literal_string, f77_value_substring,
	f77_value_literal_complex): New functions.

1 files changed, 355 insertions, 112 deletions

diff --git a/gdb/valops.c b/gdb/valops.c
index 24f2c78..06f3527 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -33,31 +33,24 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 /* Local functions.  */
 
-static int
-typecmp PARAMS ((int staticp, struct type *t1[], value t2[]));
-
-static CORE_ADDR
-find_function_addr PARAMS ((value, struct type **));
+static int typecmp PARAMS ((int staticp, struct type *t1[], value_ptr t2[]));
 
-static CORE_ADDR
-value_push PARAMS ((CORE_ADDR, value));
+static CORE_ADDR find_function_addr PARAMS ((value_ptr, struct type **));
 
-static CORE_ADDR
-value_arg_push PARAMS ((CORE_ADDR, value));
+static CORE_ADDR value_push PARAMS ((CORE_ADDR, value_ptr));
 
-static value
-search_struct_field PARAMS ((char *, value, int, struct type *, int));
+static CORE_ADDR value_arg_push PARAMS ((CORE_ADDR, value_ptr));
 
-static value
-search_struct_method PARAMS ((char *, value *, value *, int, int *,
-			      struct type *));
+static value_ptr search_struct_field PARAMS ((char *, value_ptr, int,
+					      struct type *, int));
 
-static int
-check_field_in PARAMS ((struct type *, const char *));
+static value_ptr search_struct_method PARAMS ((char *, value_ptr *,
+					       value_ptr *,
+					       int, int *, struct type *));
 
-static CORE_ADDR
-allocate_space_in_inferior PARAMS ((int));
+static int check_field_in PARAMS ((struct type *, const char *));
 
+static CORE_ADDR allocate_space_in_inferior PARAMS ((int));
 
 /* Allocate NBYTES of space in the inferior using the inferior's malloc
    and return a value that is a pointer to the allocated space. */
@@ -66,11 +59,11 @@ static CORE_ADDR
 allocate_space_in_inferior (len)
      int len;
 {
-  register value val;
+  register value_ptr val;
   register struct symbol *sym;
   struct minimal_symbol *msymbol;
   struct type *type;
-  value blocklen;
+  value_ptr blocklen;
   LONGEST maddr;
 
   /* Find the address of malloc in the inferior.  */
@@ -115,10 +108,10 @@ allocate_space_in_inferior (len)
    and if ARG2 is an lvalue it can be cast into anything at all.  */
 /* In C++, casts may change pointer or object representations.  */
 
-value
+value_ptr
 value_cast (type, arg2)
      struct type *type;
-     register value arg2;
+     register value_ptr arg2;
 {
   register enum type_code code1;
   register enum type_code code2;
@@ -141,8 +134,8 @@ value_cast (type, arg2)
       /* Look in the type of the source to see if it contains the
 	 type of the target as a superclass.  If so, we'll need to
 	 offset the object in addition to changing its type.  */
-      value v = search_struct_field (type_name_no_tag (type),
-				     arg2, 0, VALUE_TYPE (arg2), 1);
+      value_ptr v = search_struct_field (type_name_no_tag (type),
+					 arg2, 0, VALUE_TYPE (arg2), 1);
       if (v)
 	{
 	  VALUE_TYPE (v) = type;
@@ -167,8 +160,8 @@ value_cast (type, arg2)
 	      && TYPE_CODE (t2) == TYPE_CODE_STRUCT
 	      && TYPE_NAME (t1) != 0) /* if name unknown, can't have supercl */
 	    {
-	      value v = search_struct_field (type_name_no_tag (t1),
-					     value_ind (arg2), 0, t2, 1);
+	      value_ptr v = search_struct_field (type_name_no_tag (t1),
+						 value_ind (arg2), 0, t2, 1);
 	      if (v)
 		{
 		  v = value_addr (v);
@@ -198,12 +191,12 @@ value_cast (type, arg2)
 
 /* Create a value of type TYPE that is zero, and return it.  */
 
-value
+value_ptr
 value_zero (type, lv)
      struct type *type;
      enum lval_type lv;
 {
-  register value val = allocate_value (type);
+  register value_ptr val = allocate_value (type);
 
   memset (VALUE_CONTENTS (val), 0, TYPE_LENGTH (type));
   VALUE_LVAL (val) = lv;
@@ -220,12 +213,17 @@ value_zero (type, lv)
    is tested in the VALUE_CONTENTS macro, which is used if and when 
    the contents are actually required.  */
 
-value
+value_ptr
 value_at (type, addr)
      struct type *type;
      CORE_ADDR addr;
 {
-  register value val = allocate_value (type);
+  register value_ptr val;
+
+  if (TYPE_CODE (type) == TYPE_CODE_VOID)
+    error ("Attempt to dereference a generic pointer.");
+
+  val = allocate_value (type);
 
   read_memory (addr, VALUE_CONTENTS_RAW (val), TYPE_LENGTH (type));
 
@@ -237,12 +235,17 @@ value_at (type, addr)
 
 /* Return a lazy value with type TYPE located at ADDR (cf. value_at).  */
 
-value
+value_ptr
 value_at_lazy (type, addr)
      struct type *type;
      CORE_ADDR addr;
 {
-  register value val = allocate_value (type);
+  register value_ptr val;
+
+  if (TYPE_CODE (type) == TYPE_CODE_VOID)
+    error ("Attempt to dereference a generic pointer.");
+
+  val = allocate_value (type);
 
   VALUE_LVAL (val) = lval_memory;
   VALUE_ADDRESS (val) = addr;
@@ -265,7 +268,7 @@ value_at_lazy (type, addr)
 
 int
 value_fetch_lazy (val)
-     register value val;
+     register value_ptr val;
 {
   CORE_ADDR addr = VALUE_ADDRESS (val) + VALUE_OFFSET (val);
 
@@ -280,12 +283,12 @@ value_fetch_lazy (val)
 /* Store the contents of FROMVAL into the location of TOVAL.
    Return a new value with the location of TOVAL and contents of FROMVAL.  */
 
-value
+value_ptr
 value_assign (toval, fromval)
-     register value toval, fromval;
+     register value_ptr toval, fromval;
 {
   register struct type *type;
-  register value val;
+  register value_ptr val;
   char raw_buffer[MAX_REGISTER_RAW_SIZE];
   int use_buffer = 0;
 
@@ -514,12 +517,12 @@ Can't handle bitfield which doesn't fit in a single register.");
 
 /* Extend a value VAL to COUNT repetitions of its type.  */
 
-value
+value_ptr
 value_repeat (arg1, count)
-     value arg1;
+     value_ptr arg1;
      int count;
 {
-  register value val;
+  register value_ptr val;
 
   if (VALUE_LVAL (arg1) != lval_memory)
     error ("Only values in memory can be extended with '@'.");
@@ -537,12 +540,12 @@ value_repeat (arg1, count)
   return val;
 }
 
-value
+value_ptr
 value_of_variable (var, b)
      struct symbol *var;
      struct block *b;
 {
-  value val;
+  value_ptr val;
   FRAME fr;
 
   if (b == NULL)
@@ -590,9 +593,9 @@ value_of_variable (var, b)
    the coercion to pointer type.
    */
 
-value
+value_ptr
 value_coerce_array (arg1)
-     value arg1;
+     value_ptr arg1;
 {
   register struct type *type;
 
@@ -615,9 +618,9 @@ value_coerce_array (arg1)
 /* Given a value which is a function, return a value which is a pointer
    to it.  */
 
-value
+value_ptr
 value_coerce_function (arg1)
-     value arg1;
+     value_ptr arg1;
 {
 
   if (VALUE_LVAL (arg1) != lval_memory)
@@ -629,9 +632,9 @@ value_coerce_function (arg1)
 
 /* Return a pointer value for the object for which ARG1 is the contents.  */
 
-value
+value_ptr
 value_addr (arg1)
-     value arg1;
+     value_ptr arg1;
 {
   struct type *type = VALUE_TYPE (arg1);
   if (TYPE_CODE (type) == TYPE_CODE_REF)
@@ -639,7 +642,7 @@ value_addr (arg1)
       /* Copy the value, but change the type from (T&) to (T*).
 	 We keep the same location information, which is efficient,
 	 and allows &(&X) to get the location containing the reference. */
-      value arg2 = value_copy (arg1);
+      value_ptr arg2 = value_copy (arg1);
       VALUE_TYPE (arg2) = lookup_pointer_type (TYPE_TARGET_TYPE (type));
       return arg2;
     }
@@ -658,9 +661,9 @@ value_addr (arg1)
 
 /* Given a value of a pointer type, apply the C unary * operator to it.  */
 
-value
+value_ptr
 value_ind (arg1)
-     value arg1;
+     value_ptr arg1;
 {
   COERCE_ARRAY (arg1);
 
@@ -729,7 +732,7 @@ push_bytes (sp, buffer, len)
 static CORE_ADDR
 value_push (sp, arg)
      register CORE_ADDR sp;
-     value arg;
+     value_ptr arg;
 {
   register int len = TYPE_LENGTH (VALUE_TYPE (arg));
 
@@ -747,9 +750,9 @@ value_push (sp, arg)
 /* Perform the standard coercions that are specified
    for arguments to be passed to C functions.  */
 
-value
+value_ptr
 value_arg_coerce (arg)
-     value arg;
+     value_ptr arg;
 {
   register struct type *type;
 
@@ -789,7 +792,7 @@ value_arg_coerce (arg)
 static CORE_ADDR
 value_arg_push (sp, arg)
      register CORE_ADDR sp;
-     value arg;
+     value_ptr arg;
 {
   return value_push (sp, value_arg_coerce (arg));
 }
@@ -799,7 +802,7 @@ value_arg_push (sp, arg)
 
 static CORE_ADDR
 find_function_addr (function, retval_type)
-     value function;
+     value_ptr function;
      struct type **retval_type;
 {
   register struct type *ftype = VALUE_TYPE (function);
@@ -861,11 +864,11 @@ find_function_addr (function, retval_type)
    May fail to return, if a breakpoint or signal is hit
    during the execution of the function.  */
 
-value
+value_ptr
 call_function_by_hand (function, nargs, args)
-     value function;
+     value_ptr function;
      int nargs;
-     value *args;
+     value_ptr *args;
 {
   register CORE_ADDR sp;
   register int i;
@@ -1018,30 +1021,30 @@ call_function_by_hand (function, nargs, args)
 
 #if defined (REG_STRUCT_HAS_ADDR)
   {
-    /* This is a machine like the sparc, where we need to pass a pointer
+    /* This is a machine like the sparc, where we may need to pass a pointer
        to the structure, not the structure itself.  */
-    if (REG_STRUCT_HAS_ADDR (using_gcc))
-      for (i = nargs - 1; i >= 0; i--)
-	if (TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRUCT)
-	  {
-	    CORE_ADDR addr;
+    for (i = nargs - 1; i >= 0; i--)
+      if (TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRUCT
+	  && REG_STRUCT_HAS_ADDR (using_gcc, VALUE_TYPE (args[i])))
+	{
+	  CORE_ADDR addr;
 #if !(1 INNER_THAN 2)
-	    /* The stack grows up, so the address of the thing we push
-	       is the stack pointer before we push it.  */
-	    addr = sp;
+	  /* The stack grows up, so the address of the thing we push
+	     is the stack pointer before we push it.  */
+	  addr = sp;
 #endif
-	    /* Push the structure.  */
-	    sp = value_push (sp, args[i]);
+	  /* Push the structure.  */
+	  sp = value_push (sp, args[i]);
 #if 1 INNER_THAN 2
-	    /* The stack grows down, so the address of the thing we push
-	       is the stack pointer after we push it.  */
-	    addr = sp;
+	  /* The stack grows down, so the address of the thing we push
+	     is the stack pointer after we push it.  */
+	  addr = sp;
 #endif
-	    /* The value we're going to pass is the address of the thing
-	       we just pushed.  */
-	    args[i] = value_from_longest (lookup_pointer_type (value_type),
-				       (LONGEST) addr);
-	  }
+	  /* The value we're going to pass is the address of the thing
+	     we just pushed.  */
+	  args[i] = value_from_longest (lookup_pointer_type (value_type),
+					(LONGEST) addr);
+	}
   }
 #endif /* REG_STRUCT_HAS_ADDR.  */
 
@@ -1146,11 +1149,11 @@ the function call).", name);
   }
 }
 #else /* no CALL_DUMMY.  */
-value
+value_ptr
 call_function_by_hand (function, nargs, args)
-     value function;
+     value_ptr function;
      int nargs;
-     value *args;
+     value_ptr *args;
 {
   error ("Cannot invoke functions on this machine.");
 }
@@ -1167,16 +1170,16 @@ call_function_by_hand (function, nargs, args)
    first element, and all elements must have the same size (though we
    don't currently enforce any restriction on their types). */
 
-value
+value_ptr
 value_array (lowbound, highbound, elemvec)
      int lowbound;
      int highbound;
-     value *elemvec;
+     value_ptr *elemvec;
 {
   int nelem;
   int idx;
   int typelength;
-  value val;
+  value_ptr val;
   struct type *rangetype;
   struct type *arraytype;
   CORE_ADDR addr;
@@ -1228,12 +1231,12 @@ value_array (lowbound, highbound, elemvec)
    zero and an upper bound of LEN - 1.  Also note that the string may contain
    embedded null bytes. */
 
-value
+value_ptr
 value_string (ptr, len)
      char *ptr;
      int len;
 {
-  value val;
+  value_ptr val;
   struct type *rangetype;
   struct type *stringtype;
   CORE_ADDR addr;
@@ -1273,7 +1276,7 @@ static int
 typecmp (staticp, t1, t2)
      int staticp;
      struct type *t1[];
-     value t2[];
+     value_ptr t2[];
 {
   int i;
 
@@ -1327,10 +1330,10 @@ typecmp (staticp, t1, t2)
    If LOOKING_FOR_BASECLASS, then instead of looking for struct fields,
    look for a baseclass named NAME.  */
 
-static value
+static value_ptr
 search_struct_field (name, arg1, offset, type, looking_for_baseclass)
      char *name;
-     register value arg1;
+     register value_ptr arg1;
      int offset;
      register struct type *type;
      int looking_for_baseclass;
@@ -1346,7 +1349,7 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
 
 	if (t_field_name && STREQ (t_field_name, name))
 	  {
-	    value v;
+	    value_ptr v;
 	    if (TYPE_FIELD_STATIC (type, i))
 	      {
 		char *phys_name = TYPE_FIELD_STATIC_PHYSNAME (type, i);
@@ -1368,7 +1371,7 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
 
   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
     {
-      value v;
+      value_ptr v;
       /* If we are looking for baseclasses, this is what we get when we
 	 hit them.  But it could happen that the base part's member name
 	 is not yet filled in.  */
@@ -1378,7 +1381,7 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
 
       if (BASETYPE_VIA_VIRTUAL (type, i))
 	{
-	  value v2;
+	  value_ptr v2;
 	  /* Fix to use baseclass_offset instead. FIXME */
 	  baseclass_addr (type, i, VALUE_CONTENTS (arg1) + offset,
 			  &v2, (int *)NULL);
@@ -1407,15 +1410,15 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
    If found, return value, else if name matched and args not return (value)-1,
    else return NULL. */
 
-static value
+static value_ptr
 search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
      char *name;
-     register value *arg1p, *args;
+     register value_ptr *arg1p, *args;
      int offset, *static_memfuncp;
      register struct type *type;
 {
   int i;
-  value v;
+  value_ptr v;
   int name_matched = 0;
   char dem_opname[64];
 
@@ -1448,11 +1451,11 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
 			    TYPE_FN_FIELD_ARGS (f, j), args))
 		{
 		  if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
-		    return (value)value_virtual_fn_field (arg1p, f, j, type, offset);
+		    return value_virtual_fn_field (arg1p, f, j, type, offset);
 		  if (TYPE_FN_FIELD_STATIC_P (f, j) && static_memfuncp)
 		    *static_memfuncp = 1;
-		  v = (value)value_fn_field (arg1p, f, j, type, offset);
-		  if (v != (value)NULL) return v;
+		  v = value_fn_field (arg1p, f, j, type, offset);
+		  if (v != NULL) return v;
 		}
 	      j--;
 	    }
@@ -1475,7 +1478,7 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
         }
       v = search_struct_method (name, arg1p, args, base_offset + offset,
 				static_memfuncp, TYPE_BASECLASS (type, i));
-      if (v == (value) -1)
+      if (v == (value_ptr) -1)
 	{
 	  name_matched = 1;
 	}
@@ -1486,7 +1489,7 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
 	  return v;
         }
     }
-  if (name_matched) return (value) -1;
+  if (name_matched) return (value_ptr) -1;
   else return NULL;
 }
 
@@ -1504,15 +1507,15 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
 
    ERR is an error message to be printed in case the field is not found.  */
 
-value
+value_ptr
 value_struct_elt (argp, args, name, static_memfuncp, err)
-     register value *argp, *args;
+     register value_ptr *argp, *args;
      char *name;
      int *static_memfuncp;
      char *err;
 {
   register struct type *t;
-  value v;
+  value_ptr v;
 
   COERCE_ARRAY (*argp);
 
@@ -1558,7 +1561,7 @@ value_struct_elt (argp, args, name, static_memfuncp, err)
 
       v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
 
-      if (v == (value) -1)
+      if (v == (value_ptr) -1)
 	error ("Cannot take address of a method");
       else if (v == 0)
 	{
@@ -1575,8 +1578,8 @@ value_struct_elt (argp, args, name, static_memfuncp, err)
       if (!args[1])
 	{
 	  /* destructors are a special case.  */
-	  v = (value)value_fn_field (NULL, TYPE_FN_FIELDLIST1 (t, 0),
-				TYPE_FN_FIELDLIST_LENGTH (t, 0), 0, 0);
+	  v = value_fn_field (NULL, TYPE_FN_FIELDLIST1 (t, 0),
+			      TYPE_FN_FIELDLIST_LENGTH (t, 0), 0, 0);
 	  if (!v) error("could not find destructor function named %s.", name);
 	  else return v;
 	}
@@ -1588,7 +1591,7 @@ value_struct_elt (argp, args, name, static_memfuncp, err)
   else
     v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
 
-  if (v == (value) -1)
+  if (v == (value_ptr) -1)
     {
 	error("Argument list of %s mismatch with component in the structure.", name);
     }
@@ -1671,7 +1674,7 @@ check_field_in (type, name)
 
 int
 check_field (arg1, name)
-     register value arg1;
+     register value_ptr arg1;
      const char *name;
 {
   register struct type *t;
@@ -1702,7 +1705,7 @@ check_field (arg1, name)
    "pointers to member functions".  This function is used
    to resolve user expressions of the form "DOMAIN::NAME".  */
 
-value
+value_ptr
 value_struct_elt_for_reference (domain, offset, curtype, name, intype)
      struct type *domain, *curtype, *intype;
      int offset;
@@ -1710,7 +1713,7 @@ value_struct_elt_for_reference (domain, offset, curtype, name, intype)
 {
   register struct type *t = curtype;
   register int i;
-  value v;
+  value_ptr v;
 
   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
       && TYPE_CODE (t) != TYPE_CODE_UNION)
@@ -1822,7 +1825,7 @@ value_struct_elt_for_reference (domain, offset, curtype, name, intype)
     }
   for (i = TYPE_N_BASECLASSES (t) - 1; i >= 0; i--)
     {
-      value v;
+      value_ptr v;
       int base_offset;
 
       if (BASETYPE_VIA_VIRTUAL (t, i))
@@ -1843,7 +1846,7 @@ value_struct_elt_for_reference (domain, offset, curtype, name, intype)
 /* C++: return the value of the class instance variable, if one exists.
    Flag COMPLAIN signals an error if the request is made in an
    inappropriate context.  */
-value
+value_ptr
 value_of_this (complain)
      int complain;
 {
@@ -1852,7 +1855,7 @@ value_of_this (complain)
   struct block *b;
   int i;
   static const char funny_this[] = "this";
-  value this;
+  value_ptr this;
 
   if (selected_frame == 0)
     if (complain)
@@ -1890,3 +1893,243 @@ value_of_this (complain)
     error ("`this' argument at unknown address");
   return this;
 }
+
+/* Create a value for a literal string.  We copy data into a local 
+   (NOT inferior's memory) buffer, and then set up an array value.
+
+   The array bounds are set from LOWBOUND and HIGHBOUND, and the array is
+   populated from the values passed in ELEMVEC.
+
+   The element type of the array is inherited from the type of the
+   first element, and all elements must have the same size (though we
+   don't currently enforce any restriction on their types). */
+
+value_ptr
+f77_value_literal_string (lowbound, highbound, elemvec)
+     int lowbound;
+     int highbound;
+     value_ptr *elemvec;
+{
+  int nelem;
+  int idx;
+  int typelength;
+  register value_ptr val;
+  struct type *rangetype;
+  struct type *arraytype;
+  CORE_ADDR addr;
+
+  /* Validate that the bounds are reasonable and that each of the elements
+     have the same size. */
+
+  nelem = highbound - lowbound + 1;
+  if (nelem <= 0)
+    error ("bad array bounds (%d, %d)", lowbound, highbound);
+  typelength = TYPE_LENGTH (VALUE_TYPE (elemvec[0]));
+  for (idx = 0; idx < nelem; idx++)
+    {
+      if (TYPE_LENGTH (VALUE_TYPE (elemvec[idx])) != typelength)
+	error ("array elements must all be the same size");
+    }
+
+  /* Make sure we are dealing with characters */ 
+
+  if (typelength != 1)
+    error ("Found a non character type in a literal string "); 
+
+  /* Allocate space to store the array */ 
+
+  addr = malloc (nelem); 
+  for (idx = 0; idx < nelem; idx++)
+    {
+      memcpy (addr + (idx), VALUE_CONTENTS (elemvec[idx]), 1);
+    }
+
+  rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
+				 lowbound, highbound);
+
+  arraytype = f77_create_literal_string_type ((struct type *) NULL, 
+                                              rangetype); 
+
+  val = allocate_value (arraytype); 
+
+  /* Make sure that this the rest of the world knows that this is 
+     a standard literal string, not one that is a substring of  
+     some base */ 
+
+  VALUE_SUBSTRING_START (val) = NULL; 
+
+  VALUE_LAZY (val) = 0; 
+  VALUE_LITERAL_DATA (val) = addr; 
+
+  /* Since this is a standard literal string with no real lval, 
+     make sure that value_lval indicates this fact */ 
+
+  VALUE_LVAL (val) = not_lval; 
+  return val;
+}
+
+/* Create a value for a substring.  We copy data into a local 
+   (NOT inferior's memory) buffer, and then set up an array value.
+
+   The array bounds for the string are (1:(to-from +1))
+   The elements of the string are all characters.  */
+
+value_ptr
+f77_value_substring (str, from, to)
+     value_ptr str; 
+     int from;
+     int to; 
+{
+  int nelem;
+  register value_ptr val;
+  struct type *rangetype;
+  struct type *arraytype;
+  struct internalvar *var; 
+  CORE_ADDR addr;
+
+  /* Validate that the bounds are reasonable. */ 
+
+  nelem = to - from + 1;
+  if (nelem <= 0)
+    error ("bad substring bounds (%d, %d)", from, to);
+
+  rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
+				 1, nelem);
+
+  arraytype = f77_create_literal_string_type ((struct type *) NULL, 
+					      rangetype); 
+
+  val = allocate_value (arraytype); 
+
+  /* Allocate space to store the substring array */ 
+
+  addr = malloc (nelem); 
+
+  /* Copy over the data */
+
+  /* In case we ever try to use this substring on the LHS of an assignment 
+     remember where the SOURCE substring begins, for lval_memory 
+     types this ptr is to a location in legal inferior memory, 
+     for lval_internalvars it is a ptr. to superior memory. This 
+     helps us out later when we do assigments like:
+
+     set var ARR(2:3) = 'ab'
+ 
+     */ 
+
+
+  if (VALUE_LVAL (str) == lval_memory) 
+    {
+      if (VALUE_SUBSTRING_START (str) == NULL) 
+	{
+	  /* This is a regular lval_memory string located in the
+	     inferior */ 
+
+	  VALUE_SUBSTRING_START (val) = VALUE_ADDRESS (str) + (from - 1); 
+	  target_read_memory (VALUE_SUBSTRING_START (val), addr, nelem);
+	}
+      else
+	{
+
+#if 0 
+	  /* str is a substring allocated in the superior. Just 
+	     do a memcpy */ 
+
+	  VALUE_SUBSTRING_START(val) = VALUE_LITERAL_DATA(str)+(from - 1); 
+	  memcpy(addr,VALUE_SUBSTRING_START(val),nelem); 
+#else
+	  error ("Cannot get substrings of substrings"); 
+#endif
+	}
+    }
+  else
+    if (VALUE_LVAL(str) == lval_internalvar)
+      {
+        /* Internal variables of type TYPE_CODE_LITERAL_STRING 
+           have their data located in the superior 
+           process not the inferior */ 
+ 
+        var = VALUE_INTERNALVAR (str);
+        
+        if (VALUE_SUBSTRING_START (str) == NULL) 
+           VALUE_SUBSTRING_START (val) =
+	     VALUE_LITERAL_DATA (var->value) + (from - 1);
+        else 
+#if 0 
+	  VALUE_SUBSTRING_START(val)=VALUE_LITERAL_DATA(str)+(from -1);
+#else
+	error ("Cannot get substrings of substrings"); 
+#endif
+        memcpy (addr, VALUE_SUBSTRING_START (val), nelem);
+      }
+    else
+      error ("Substrings can not be applied to this data item"); 
+
+  VALUE_LAZY (val) = 0; 
+  VALUE_LITERAL_DATA (val) = addr; 
+
+  /* This literal string's *data* is located in the superior BUT 
+     we do need to know where it came from (i.e. was the source
+     string an internalvar or a regular lval_memory variable), so 
+     we set the lval field to indicate this.  This will be useful 
+     when we use this value on the LHS of an expr. */ 
+     
+  VALUE_LVAL (val) = VALUE_LVAL (str); 
+  return val;
+}
+
+/* Create a value for a FORTRAN complex number.  Currently most of 
+   the time values are coerced to COMPLEX*16 (i.e. a complex number 
+   composed of 2 doubles.  This really should be a smarter routine 
+   that figures out precision inteligently as opposed to assuming 
+   doubles. FIXME: fmb */ 
+
+value_ptr
+f77_value_literal_complex (arg1, arg2, size)
+     value_ptr arg1;
+     value_ptr arg2;
+     int size;
+{
+  struct type *complex_type; 
+  register value_ptr val;
+  char *addr; 
+
+  if (size != 8 && size != 16 && size != 32)
+    error ("Cannot create number of type 'complex*%d'", size);
+  
+  /* If either value comprising a complex number is a non-floating 
+     type, cast to double. */
+
+  if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_FLT)
+    arg1 = value_cast (builtin_type_f_real_s8, arg1);
+
+  if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_FLT)
+    arg2 = value_cast (builtin_type_f_real_s8, arg2);
+     
+  complex_type = f77_create_literal_complex_type (VALUE_TYPE (arg1),
+						  VALUE_TYPE (arg2),
+						  size);
+
+  val = allocate_value (complex_type); 
+
+  /* Now create a pointer to enough memory to hold the the two args */
+  
+  addr = malloc (TYPE_LENGTH (complex_type)); 
+
+  /* Copy over the two components */
+
+  memcpy (addr, VALUE_CONTENTS_RAW (arg1), TYPE_LENGTH (VALUE_TYPE (arg1)));
+  
+  memcpy (addr + TYPE_LENGTH (VALUE_TYPE (arg1)), VALUE_CONTENTS_RAW (arg2),
+	  TYPE_LENGTH (VALUE_TYPE (arg2)));
+
+  VALUE_ADDRESS (val) = 0; /* Not located in the inferior */ 
+  VALUE_LAZY (val) = 0; 
+  VALUE_LITERAL_DATA (val) = addr; 
+
+  /* Since this is a literal value, make sure that value_lval indicates 
+     this fact */ 
+
+  VALUE_LVAL (val) = not_lval; 
+  return val;
+}