* top.c (line_completion_function): Renamed from

	symbol_completion_function, takes the line buffer and the
	point in the line buffer as additional arguments.
	(readline_line_completion_function):  New function, interface
	between readline and line_completion_function.
	(init_main):  Use it.
	(complete_command):  Use line_completion_function instead of
	abusing rl_line_buffer. Free completion strings after printing
	them.
	* symtab.c (completion_list_add_name):  Recheck for duplicates
	if we intend to add a modified symbol.

	* gdbtypes.h (cplus_struct_type):  nfn_fields_total no longer
	includes the number of methods from the baseclasses.
	* stabsread.c (attach_fn_fields_to_type):  No longer add the
	number of methods from the baseclasses to TYPE_NFN_FIELDS_TOTAL,
	the baseclass type might not have been completely filled in yet.
	* symtab.c (total_number_of_methods):  New function to compute
	the total number of methods for a type, including the methods
	from baseclasses.
	(decode_line_1):  Use it instead of TYPE_NFN_FIELDS_TOTAL to
	allocate the symbol array for find_methods.

	* stabsread.c (scan_file_globals):  Add default case to minimal
	symbol type switch, to avoid gcc -Wall warnings.

	* config/rs6000/tm-rs6000.h (INIT_EXTRA_FRAME_INFO):
	Don't test for zero backchain pointer to recognize a signal
	handler frame, if read() gets interrupted by a signal, the
	backchain will be non zero.
	(SIG_FRAME_FP_OFFSET):  Move to here from rs6000-tdep.c,
	improve comment.
	(SIG_FRAME_PC_OFFSET):  New definition.
	(FRAME_SAVED_PC):  Return saved pc from sigcontext if this
	is a signal handler frame.
	* rs6000-tdep.c (function_frame_info):  Do not error out
	if we can't access the instructions.

	* config/rs6000/tm-rs6000.h (CONVERT_FROM_FUNC_PTR_ADDR):
	New definition to get the function address from a function pointer.
	* valops.c (find_function_addr):  Use it when calling a user
	function through a function pointer.

6 files changed, 592 insertions, 85 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index f442ae6..2eeceb5 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,48 @@
+Sat Oct 29 02:40:40 1994  Peter Schauer  (pes@regent.e-technik.tu-muenchen.de)
+
+	* top.c (line_completion_function):  Renamed from
+	symbol_completion_function, takes the line buffer and the
+	point in the line buffer as additional arguments.
+	(readline_line_completion_function):  New function, interface
+	between readline and line_completion_function.
+	(init_main):  Use it.
+	(complete_command):  Use line_completion_function instead of
+	abusing rl_line_buffer. Free completion strings after printing
+	them.
+	* symtab.c (completion_list_add_name):  Recheck for duplicates
+	if we intend to add a modified symbol.
+
+	* gdbtypes.h (cplus_struct_type):  nfn_fields_total no longer
+	includes the number of methods from the baseclasses.
+	* stabsread.c (attach_fn_fields_to_type):  No longer add the
+	number of methods from the baseclasses to TYPE_NFN_FIELDS_TOTAL,
+	the baseclass type might not have been completely filled in yet.
+	* symtab.c (total_number_of_methods):  New function to compute
+	the total number of methods for a type, including the methods
+	from baseclasses.
+	(decode_line_1):  Use it instead of TYPE_NFN_FIELDS_TOTAL to
+	allocate the symbol array for find_methods.
+
+	* stabsread.c (scan_file_globals):  Add default case to minimal
+	symbol type switch, to avoid gcc -Wall warnings.
+
+	* config/rs6000/tm-rs6000.h (INIT_EXTRA_FRAME_INFO):
+	Don't test for zero backchain pointer to recognize a signal
+	handler frame, if read() gets interrupted by a signal, the
+	backchain will be non zero.
+	(SIG_FRAME_FP_OFFSET):  Move to here from rs6000-tdep.c,
+	improve comment.
+	(SIG_FRAME_PC_OFFSET):  New definition.
+	(FRAME_SAVED_PC):  Return saved pc from sigcontext if this
+	is a signal handler frame.
+	* rs6000-tdep.c (function_frame_info):  Do not error out
+	if we can't access the instructions.
+
+	* config/rs6000/tm-rs6000.h (CONVERT_FROM_FUNC_PTR_ADDR):
+	New definition to get the function address from a function pointer.
+	* valops.c (find_function_addr):  Use it when calling a user
+	function through a function pointer.
+
 Fri Oct 28 16:16:52 1994  Stan Shebs  (shebs@andros.cygnus.com)
 
 	* Makefile.in (MMALLOC_DIR): New definition.
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 278a220..c3b5f31 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -1,5 +1,5 @@
 /* Internal type definitions for GDB.
-   Copyright (C) 1992 Free Software Foundation, Inc.
+   Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
    Contributed by Cygnus Support, using pieces from other GDB modules.
 
 This file is part of GDB.
@@ -349,7 +349,7 @@ struct cplus_struct_type
 
   short nfn_fields;
 
-  /* Number of methods described for this type plus all the
+  /* Number of methods described for this type, not including the
      methods that it derives from.  */
 
   int nfn_fields_total;
diff --git a/gdb/rs6000-tdep.c b/gdb/rs6000-tdep.c
index 18fe4e9..796b082 100644
--- a/gdb/rs6000-tdep.c
+++ b/gdb/rs6000-tdep.c
@@ -564,12 +564,16 @@ function_frame_info (pc, fdata)
 {
   unsigned int tmp;
   register unsigned int op;
+  char buf[4];
 
   fdata->offset = 0;
   fdata->saved_gpr = fdata->saved_fpr = fdata->alloca_reg = -1;
   fdata->frameless = 1;
 
-  op  = read_memory_integer (pc, 4);
+  /* Do not error out if we can't access the instructions.  */
+  if (target_read_memory (pc, buf, 4))
+    return;
+  op = extract_unsigned_integer (buf, 4);
   if (op == 0x7c0802a6) {		/* mflr r0 */
     pc += 4;
     op = read_memory_integer (pc, 4);
@@ -1094,17 +1098,7 @@ rs6000_frame_chain (thisframe)
   if (inside_entry_file ((thisframe)->pc))
     return 0;
   if (thisframe->signal_handler_caller)
-    {
-      /* This was determined by experimentation on AIX 3.2.  Perhaps
-	 it corresponds to some offset in /usr/include/sys/user.h or
-	 something like that.  Using some system include file would
-	 have the advantage of probably being more robust in the face
-	 of OS upgrades, but the disadvantage of being wrong for
-	 cross-debugging.  */
-
-#define SIG_FRAME_FP_OFFSET 284
-      fp = read_memory_integer (thisframe->frame + SIG_FRAME_FP_OFFSET, 4);
-    }
+    fp = read_memory_integer (thisframe->frame + SIG_FRAME_FP_OFFSET, 4);
   else
     fp = read_memory_integer ((thisframe)->frame, 4);
 
diff --git a/gdb/stabsread.c b/gdb/stabsread.c
index 042d450..6eb5790 100644
--- a/gdb/stabsread.c
+++ b/gdb/stabsread.c
@@ -2751,17 +2751,6 @@ attach_fn_fields_to_type (fip, type)
 {
   register int n;
 
-  for (n = 0; n < TYPE_N_BASECLASSES (type); n++)
-    {
-      if (TYPE_CODE (TYPE_BASECLASS (type, n)) == TYPE_CODE_UNDEF)
-	{
-	  /* @@ Memory leak on objfile -> type_obstack?  */
-	  return 0;
-	}
-      TYPE_NFN_FIELDS_TOTAL (type) +=
-	TYPE_NFN_FIELDS_TOTAL (TYPE_BASECLASS (type, n));
-    }
-
   for (n = TYPE_NFN_FIELDS (type);
        fip -> fnlist != NULL;
        fip -> fnlist = fip -> fnlist -> next)
@@ -3822,6 +3811,8 @@ scan_file_globals (objfile)
 	case mst_file_data:
 	case mst_file_bss:
 	  continue;
+	default:
+	  break;
 	}
 
       prev = NULL;
diff --git a/gdb/top.c b/gdb/top.c
index 3e1df9b..a149129 100644
--- a/gdb/top.c
+++ b/gdb/top.c
@@ -58,7 +58,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 /* Prototypes for local functions */
 
-static char * symbol_completion_function PARAMS ((char *, int));
+static char * line_completion_function PARAMS ((char *, int, char *, int));
+
+static char * readline_line_completion_function PARAMS ((char *, int));
 
 static void command_loop_marker PARAMS ((int));
 
@@ -1169,30 +1171,32 @@ filename_completer (text, word)
    */
 
 /* Generate completions one by one for the completer.  Each time we are
-   called return another potential completion to the caller.  The function
-   is misnamed; it just completes on commands or passes the buck to the
-   command's completer function; the stuff specific to symbol completion
+   called return another potential completion to the caller.
+   line_completion just completes on commands or passes the buck to the
+   command's completer function, the stuff specific to symbol completion
    is in make_symbol_completion_list.
 
-   TEXT is readline's idea of the "word" we are looking at; we don't really
-   like readline's ideas about word breaking so we ignore it.
+   TEXT is the caller's idea of the "word" we are looking at.
 
    MATCHES is the number of matches that have currently been collected from
    calling this completion function.  When zero, then we need to initialize,
    otherwise the initialization has already taken place and we can just
    return the next potential completion string.
 
-   Returns NULL if there are no more completions, else a pointer to a string
-   which is a possible completion.
+   LINE_BUFFER is available to be looked at; it contains the entire text
+   of the line.  POINT is the offset in that line of the cursor.  You
+   should pretend that the line ends at POINT.
 
-   RL_LINE_BUFFER is available to be looked at; it contains the entire text
-   of the line.  RL_POINT is the offset in that line of the cursor.  You
-   should pretend that the line ends at RL_POINT. */
+   Returns NULL if there are no more completions, else a pointer to a string
+   which is a possible completion, it is the caller's responsibility to
+   free the string.  */
 
 static char *
-symbol_completion_function (text, matches)
+line_completion_function (text, matches, line_buffer, point)
      char *text;
      int matches;
+     char *line_buffer;
+     int point;
 {
   static char **list = (char **)NULL;		/* Cache of completions */
   static int index;				/* Next cached completion */
@@ -1228,17 +1232,17 @@ symbol_completion_function (text, matches)
 	  gdb_completer_word_break_characters;
 
       /* Decide whether to complete on a list of gdb commands or on symbols. */
-      tmp_command = (char *) alloca (rl_point + 1);
+      tmp_command = (char *) alloca (point + 1);
       p = tmp_command;
 
-      strncpy (tmp_command, rl_line_buffer, rl_point);
-      tmp_command[rl_point] = '\0';
+      strncpy (tmp_command, line_buffer, point);
+      tmp_command[point] = '\0';
       /* Since text always contains some number of characters leading up
-	 to rl_point, we can find the equivalent position in tmp_command
+	 to point, we can find the equivalent position in tmp_command
 	 by subtracting that many characters from the end of tmp_command.  */
-      word = tmp_command + rl_point - strlen (text);
+      word = tmp_command + point - strlen (text);
 
-      if (rl_point == 0)
+      if (point == 0)
 	{
 	  /* An empty line we want to consider ambiguous; that is, it
 	     could be any command.  */
@@ -1271,7 +1275,7 @@ symbol_completion_function (text, matches)
 	  q = p;
 	  while (*q && (isalnum (*q) || *q == '-' || *q == '_'))
 	    ++q;
-	  if (q != tmp_command + rl_point)
+	  if (q != tmp_command + point)
 	    {
 	      /* There is something beyond the ambiguous
 		 command, so there are no possible completions.  For
@@ -1303,7 +1307,7 @@ symbol_completion_function (text, matches)
 	{
 	  /* We've recognized a full command.  */
 
-	  if (p == tmp_command + rl_point)
+	  if (p == tmp_command + point)
 	    {
 	      /* There is no non-whitespace in the line beyond the command.  */
 
@@ -1402,6 +1406,16 @@ symbol_completion_function (text, matches)
   return (output);
 }
 
+/* Line completion interface function for readline.  */
+
+static char *
+readline_line_completion_function (text, matches)
+     char *text;
+     int matches;
+{
+  return line_completion_function (text, matches, rl_line_buffer, rl_point);
+}
+
 /* Skip over a possibly quoted word (as defined by the quote characters
    and word break characters the completer uses).  Returns pointer to the
    location after the "word". */
@@ -2137,25 +2151,22 @@ complete_command (arg, from_tty)
      int from_tty;
 {
   int i;
+  int argpoint;
   char *completion;
 
   dont_repeat ();
 
   if (arg == NULL)
-    {
-      rl_line_buffer[0] = '\0';
-      rl_point = 0;
-    }
-  else
-    {
-      strcpy (rl_line_buffer, arg);
-      rl_point = strlen (arg);
-    }
+    arg = "";
+  argpoint = strlen (arg);
 
-  for (completion = symbol_completion_function (rl_line_buffer, i = 0);
+  for (completion = line_completion_function (arg, i = 0, arg, argpoint);
        completion;
-       completion = symbol_completion_function (rl_line_buffer, ++i))
-    printf_unfiltered ("%s\n", completion);
+       completion = line_completion_function (arg, ++i, arg, argpoint))
+    {
+      printf_unfiltered ("%s\n", completion);
+      free (completion);
+    }
 }
 
 /* The "show" command with no arguments shows all the settings.  */
@@ -3005,7 +3016,7 @@ init_main ()
   write_history_p = 0;
 
   /* Setup important stuff for command line editing.  */
-  rl_completion_entry_function = (int (*)()) symbol_completion_function;
+  rl_completion_entry_function = (int (*)()) readline_line_completion_function;
   rl_completer_word_break_characters = gdb_completer_word_break_characters;
   rl_completer_quote_characters = gdb_completer_quote_characters;
   rl_readline_name = "gdb";
diff --git a/gdb/valops.c b/gdb/valops.c
index 06f3527..100160e 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -51,6 +51,17 @@ static value_ptr search_struct_method PARAMS ((char *, value_ptr *,
 static int check_field_in PARAMS ((struct type *, const char *));
 
 static CORE_ADDR allocate_space_in_inferior PARAMS ((int));
+
+static value_ptr f77_cast_into_complex PARAMS ((struct type *, value_ptr));
+
+static value_ptr f77_assign_from_literal_string PARAMS ((value_ptr,
+							 value_ptr));
+
+static value_ptr f77_assign_from_literal_complex PARAMS ((value_ptr,
+							  value_ptr));
+
+#define VALUE_SUBSTRING_START(VAL) VALUE_FRAME(VAL)
+
 
 /* Allocate NBYTES of space in the inferior using the inferior's malloc
    and return a value that is a pointer to the allocated space. */
@@ -124,6 +135,14 @@ value_cast (type, arg2)
 
   code1 = TYPE_CODE (type);
   code2 = TYPE_CODE (VALUE_TYPE (arg2));
+
+  if (code1 == TYPE_CODE_COMPLEX) 
+    return f77_cast_into_complex (type, arg2); 
+  if (code1 == TYPE_CODE_BOOL) 
+    code1 = TYPE_CODE_INT; 
+  if (code2 == TYPE_CODE_BOOL) 
+    code2 = TYPE_CODE_INT; 
+
   scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_FLT
 	    || code2 == TYPE_CODE_ENUM);
 
@@ -292,6 +311,19 @@ value_assign (toval, fromval)
   char raw_buffer[MAX_REGISTER_RAW_SIZE];
   int use_buffer = 0;
 
+  if (current_language->la_language == language_fortran)
+    {
+      /* Deal with literal assignment in F77.  All composite (i.e. string
+	 and complex number types) types are allocated in the superior
+	 NOT the inferior.  Therefore assigment is somewhat tricky.  */
+
+      if (TYPE_CODE (VALUE_TYPE (fromval)) == TYPE_CODE_LITERAL_STRING)
+	return f77_assign_from_literal_string (toval, fromval);
+
+      if (TYPE_CODE (VALUE_TYPE (fromval)) == TYPE_CODE_LITERAL_COMPLEX)
+	return f77_assign_from_literal_complex (toval, fromval);
+    }
+
   if (!toval->modifiable)
     error ("Left operand of assignment is not a modifiable lvalue.");
 
@@ -824,7 +856,15 @@ find_function_addr (function, retval_type)
       funaddr = value_as_pointer (function);
       if (TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_FUNC
 	  || TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_METHOD)
-	value_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (ftype));
+	{
+#ifdef CONVERT_FROM_FUNC_PTR_ADDR
+	  /* FIXME: This is a workaround for the unusual function
+	     pointer representation on the RS/6000, see comment
+	     in config/rs6000/tm-rs6000.h  */
+	  funaddr = CONVERT_FROM_FUNC_PTR_ADDR (funaddr);
+#endif
+	  value_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (ftype));
+	}
       else
 	value_type = builtin_type_int;
     }
@@ -903,11 +943,11 @@ call_function_by_hand (function, nargs, args)
   old_sp = sp = read_sp ();
 
 #if 1 INNER_THAN 2		/* Stack grows down */
-  sp -= sizeof dummy;
+  sp -= sizeof dummy1;
   start_sp = sp;
 #else				/* Stack grows up */
   start_sp = sp;
-  sp += sizeof dummy;
+  sp += sizeof dummy1;
 #endif
 
   funaddr = find_function_addr (function, &value_type);
@@ -941,7 +981,7 @@ call_function_by_hand (function, nargs, args)
 #endif
 
 #if CALL_DUMMY_LOCATION == ON_STACK
-  write_memory (start_sp, (char *)dummy1, sizeof dummy);
+  write_memory (start_sp, (char *)dummy1, sizeof dummy1);
 #endif /* On stack.  */
 
 #if CALL_DUMMY_LOCATION == BEFORE_TEXT_END
@@ -951,13 +991,13 @@ call_function_by_hand (function, nargs, args)
     extern CORE_ADDR text_end;
     static checked = 0;
     if (!checked)
-      for (start_sp = text_end - sizeof dummy; start_sp < text_end; ++start_sp)
+      for (start_sp = text_end - sizeof dummy1; start_sp < text_end; ++start_sp)
 	if (read_memory_integer (start_sp, 1) != 0)
 	  error ("text segment full -- no place to put call");
     checked = 1;
     sp = old_sp;
-    real_pc = text_end - sizeof dummy;
-    write_memory (real_pc, (char *)dummy1, sizeof dummy);
+    real_pc = text_end - sizeof dummy1;
+    write_memory (real_pc, (char *)dummy1, sizeof dummy1);
   }
 #endif /* Before text_end.  */
 
@@ -967,7 +1007,7 @@ call_function_by_hand (function, nargs, args)
     int errcode;
     sp = old_sp;
     real_pc = text_end;
-    errcode = target_write_memory (real_pc, (char *)dummy1, sizeof dummy);
+    errcode = target_write_memory (real_pc, (char *)dummy1, sizeof dummy1);
     if (errcode != 0)
       error ("Cannot write text segment -- call_function failed");
   }
@@ -1916,7 +1956,7 @@ f77_value_literal_string (lowbound, highbound, elemvec)
   register value_ptr val;
   struct type *rangetype;
   struct type *arraytype;
-  CORE_ADDR addr;
+  char *addr;
 
   /* Validate that the bounds are reasonable and that each of the elements
      have the same size. */
@@ -1938,7 +1978,7 @@ f77_value_literal_string (lowbound, highbound, elemvec)
 
   /* Allocate space to store the array */ 
 
-  addr = malloc (nelem); 
+  addr = xmalloc (nelem); 
   for (idx = 0; idx < nelem; idx++)
     {
       memcpy (addr + (idx), VALUE_CONTENTS (elemvec[idx]), 1);
@@ -1956,10 +1996,10 @@ f77_value_literal_string (lowbound, highbound, elemvec)
      a standard literal string, not one that is a substring of  
      some base */ 
 
-  VALUE_SUBSTRING_START (val) = NULL; 
+  VALUE_SUBSTRING_MEMADDR (val) = (CORE_ADDR)0;
 
   VALUE_LAZY (val) = 0; 
-  VALUE_LITERAL_DATA (val) = addr; 
+  VALUE_LITERAL_DATA (val) = addr;
 
   /* Since this is a standard literal string with no real lval, 
      make sure that value_lval indicates this fact */ 
@@ -1985,7 +2025,7 @@ f77_value_substring (str, from, to)
   struct type *rangetype;
   struct type *arraytype;
   struct internalvar *var; 
-  CORE_ADDR addr;
+  char *addr;
 
   /* Validate that the bounds are reasonable. */ 
 
@@ -2003,7 +2043,7 @@ f77_value_substring (str, from, to)
 
   /* Allocate space to store the substring array */ 
 
-  addr = malloc (nelem); 
+  addr = xmalloc (nelem); 
 
   /* Copy over the data */
 
@@ -2020,13 +2060,13 @@ f77_value_substring (str, from, to)
 
   if (VALUE_LVAL (str) == lval_memory) 
     {
-      if (VALUE_SUBSTRING_START (str) == NULL) 
+      if (VALUE_SUBSTRING_MEMADDR (str) == (CORE_ADDR)0)
 	{
 	  /* 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);
+	  VALUE_SUBSTRING_MEMADDR (val) = VALUE_ADDRESS (str) + (from - 1); 
+	  target_read_memory (VALUE_SUBSTRING_MEMADDR (val), addr, nelem);
 	}
       else
 	{
@@ -2035,8 +2075,8 @@ f77_value_substring (str, from, to)
 	  /* 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); 
+	  VALUE_SUBSTRING_MYADDR (val) = VALUE_LITERAL_DATA(str)+(from - 1); 
+	  memcpy(addr, VALUE_SUBSTRING_MYADDR (val), nelem); 
 #else
 	  error ("Cannot get substrings of substrings"); 
 #endif
@@ -2051,16 +2091,16 @@ f77_value_substring (str, from, to)
  
         var = VALUE_INTERNALVAR (str);
         
-        if (VALUE_SUBSTRING_START (str) == NULL) 
-           VALUE_SUBSTRING_START (val) =
-	     VALUE_LITERAL_DATA (var->value) + (from - 1);
+        if (VALUE_SUBSTRING_MEMADDR (str) == (CORE_ADDR)0) 
+           VALUE_SUBSTRING_MYADDR (val) =
+	     ((char *) VALUE_LITERAL_DATA (var->value)) + (from - 1);
         else 
 #if 0 
-	  VALUE_SUBSTRING_START(val)=VALUE_LITERAL_DATA(str)+(from -1);
+	  VALUE_SUBSTRING_MYADDR (val) = VALUE_LITERAL_DATA(str)+(from -1);
 #else
 	error ("Cannot get substrings of substrings"); 
 #endif
-        memcpy (addr, VALUE_SUBSTRING_START (val), nelem);
+        memcpy (addr, VALUE_SUBSTRING_MYADDR (val), nelem);
       }
     else
       error ("Substrings can not be applied to this data item"); 
@@ -2107,14 +2147,20 @@ f77_value_literal_complex (arg1, arg2, size)
     arg2 = value_cast (builtin_type_f_real_s8, arg2);
      
   complex_type = f77_create_literal_complex_type (VALUE_TYPE (arg1),
-						  VALUE_TYPE (arg2),
-						  size);
+						  VALUE_TYPE (arg2)
+#if 0
+/* FIXME: does f77_create_literal_complex_type need to do something with
+   this?  */
+						  ,
+						  size
+#endif
+						  );
 
   val = allocate_value (complex_type); 
 
   /* Now create a pointer to enough memory to hold the the two args */
   
-  addr = malloc (TYPE_LENGTH (complex_type)); 
+  addr = xmalloc (TYPE_LENGTH (complex_type)); 
 
   /* Copy over the two components */
 
@@ -2133,3 +2179,423 @@ f77_value_literal_complex (arg1, arg2, size)
   VALUE_LVAL (val) = not_lval; 
   return val;
 }
+
+/* Cast a value into the appropriate complex data type. Only works 
+   if both values are complex.  */
+
+static value_ptr
+f77_cast_into_complex (type, val)
+     struct type *type;
+     register value_ptr val;
+{
+  register enum type_code valcode;
+  float tmp_f;
+  double tmp_d;
+  register value_ptr piece1, piece2; 
+   
+  int lenfrom, lento;
+
+  valcode = TYPE_CODE (VALUE_TYPE (val));
+
+  /* This casting will only work if the right hand side is 
+     either a regular complex type or a literal complex type. 
+     I.e: this casting is only for size adjustment of 
+     complex numbers not anything else. */ 
+
+  if ((valcode != TYPE_CODE_COMPLEX) && 
+      (valcode != TYPE_CODE_LITERAL_COMPLEX))
+    error ("Cannot cast from a non complex type!"); 
+
+  lenfrom = TYPE_LENGTH (VALUE_TYPE (val));
+  lento =   TYPE_LENGTH (type); 
+
+  if (lento == lenfrom)
+    error ("Value to be cast is already of type %s", TYPE_NAME (type));
+
+  if (lento == 32 || lenfrom == 32) 
+    error ("Casting into/out of complex*32 unsupported"); 
+
+  switch (lento)
+    {
+    case 16:
+      {
+	/* Since we have excluded lenfrom == 32 and 
+	   lenfrom == 16, it MUST be 8 */ 
+
+	if (valcode == TYPE_CODE_LITERAL_COMPLEX) 
+	  {
+	    /* Located in superior's memory. Routine should 
+	       deal with both real literal complex numbers
+	       as well as internal vars */ 
+
+	    /* Grab the two 4 byte reals that make up the complex*8 */ 
+                     
+	    tmp_f = *((float *) VALUE_LITERAL_DATA (val));
+                     
+	    piece1 = value_from_double(builtin_type_f_real_s8,tmp_f);
+	    
+	    tmp_f = *((float *) (((char *) VALUE_LITERAL_DATA (val))
+				 + sizeof(float))); 
+                     
+	    piece2 = value_from_double (builtin_type_f_real_s8, tmp_f);
+	  }
+	else
+	  {
+	    /* Located in inferior memory, so first we need 
+	       to read the 2 floats that make up the 8 byte
+	       complex we are are casting from */ 
+
+	    read_memory ((CORE_ADDR) VALUE_CONTENTS (val),
+			 (char *) &tmp_f, sizeof(float));
+	    
+	    piece1 = value_from_double (builtin_type_f_real_s8, tmp_f);
+	    
+	    read_memory ((CORE_ADDR) VALUE_CONTENTS (val) + sizeof(float),
+			 (char *) &tmp_f, sizeof(float));
+                     
+	    piece2 = value_from_double (builtin_type_f_real_s8, tmp_f);
+	  }
+	return f77_value_literal_complex (piece1, piece2, 16);
+      }
+
+    case 8:
+      {
+	/* Since we have excluded lenfrom == 32 and 
+	   lenfrom == 8, it MUST be 16. NOTE: in this 
+	   case data may be since we are dropping precison */ 
+
+	if (valcode == TYPE_CODE_LITERAL_COMPLEX) 
+	  {
+	    /* Located in superior's memory. Routine should 
+	       deal with both real literal complex numbers
+	       as well as internal vars */ 
+	    
+	    /* Grab the two 8 byte reals that make up the complex*16 */ 
+                     
+	    tmp_d = *((double *) VALUE_LITERAL_DATA (val));
+                     
+	    piece1 = value_from_double (builtin_type_f_real, tmp_d);
+
+	    tmp_d = *((double *) (((char *) VALUE_LITERAL_DATA (val))
+				  + sizeof(double)));
+                     
+	    piece2 = value_from_double (builtin_type_f_real, tmp_d);
+	  }
+	else
+	  {
+	    /* Located in inferior memory, so first we need to read the
+	       2 floats that make up the 8 byte complex we are are
+	       casting from.  */ 
+
+	    read_memory ((CORE_ADDR) VALUE_CONTENTS (val),
+			 (char *) &tmp_d, sizeof(double));
+                     
+	    piece1 = value_from_double (builtin_type_f_real, tmp_d);
+
+	    read_memory ((CORE_ADDR) VALUE_CONTENTS (val) + sizeof(double),
+			 (char *) &tmp_f, sizeof(double));
+                     
+	    piece2 = value_from_double (builtin_type_f_real, tmp_d);
+	  }
+	return f77_value_literal_complex (piece1, piece2, 8);
+      }
+                     
+    default:
+      error ("Invalid F77 complex number cast");
+    }
+}
+
+/* The following function is called in order to assign 
+   a literal F77 array to either an internal GDB variable 
+   or to a real array variable in the inferior. 
+   This function is necessary because in F77, literal 
+   arrays are allocated in the superior's memory space 
+   NOT the inferior's.  This function provides a way to 
+   get the F77 stuff to work without messing with the 
+   way C deals with this issue. NOTE: we are assuming 
+   that all F77 array literals are STRING array literals.  F77 
+   users have no good way of expressing non-string 
+   literal strings. 
+
+   This routine now also handles assignment TO literal strings 
+   in the peculiar case of substring assignments of the 
+   form:
+
+   STR(2:3) = 'foo' 
+
+   */ 
+
+static value_ptr
+f77_assign_from_literal_string (toval, fromval)
+     register value_ptr toval, fromval;
+{
+  register struct type *type = VALUE_TYPE (toval);
+  register value_ptr val;
+  struct internalvar *var; 
+  int lenfrom, lento; 
+  CORE_ADDR tmp_addr; 
+  char *c; 
+
+  lenfrom = TYPE_LENGTH (VALUE_TYPE (fromval));
+  lento = TYPE_LENGTH (VALUE_TYPE (toval)); 
+   
+  if ((VALUE_LVAL (toval) == lval_internalvar
+       || VALUE_LVAL (toval) == lval_memory)
+      && VALUE_SUBSTRING_START (toval) != 0) 
+    {
+      /* We are assigning TO a substring type. This is of the form:
+            
+	 set A(2:5) = 'foov'
+
+	 The result of this will be a modified toval not a brand new 
+	 value. This is high F77 weirdness.  */ 
+
+      /* Simply overwrite the relevant memory, wherever it 
+	 exists. Use standard F77 character assignment rules 
+	 (if len(toval) > len(fromval) pad with blanks,
+	 if len(toval) < len(fromval) truncate else just copy. */ 
+
+      if (VALUE_LVAL (toval) == lval_internalvar)
+	{
+	  /* Memory in superior.  */ 
+	  var = VALUE_INTERNALVAR (toval); 
+	  memcpy ((char *) VALUE_SUBSTRING_START (toval),
+		  (char *) VALUE_LITERAL_DATA (fromval),
+		  (lento > lenfrom) ? lenfrom : lento); 
+	  
+	  /* Check to see if we have to pad. */
+
+	  if (lento > lenfrom) 
+	    {
+	      memset((char *) VALUE_SUBSTRING_START(toval) + lenfrom,
+		     ' ', lento - lenfrom); 
+	    }
+	}
+      else
+	{
+	  /* Memory in inferior.  */ 
+	  write_memory ((CORE_ADDR) VALUE_SUBSTRING_START (toval),
+			(char *) VALUE_LITERAL_DATA (fromval),
+			(lento > lenfrom) ? lenfrom : lento); 
+
+	  /* Check to see if we have to pad.  */
+
+	  if (lento > lenfrom) 
+	    {
+	      c = alloca (lento-lenfrom); 
+	      memset (c, ' ', lento - lenfrom);
+
+	      tmp_addr = VALUE_SUBSTRING_START (toval) + lenfrom; 
+	      write_memory (tmp_addr, c, lento - lenfrom);
+	    } 
+	}
+      return fromval;
+    }
+  else 
+    { 
+      if (VALUE_LVAL (toval) == lval_internalvar)
+	type = VALUE_TYPE (fromval); 
+
+      val = allocate_value (type);
+
+      switch (VALUE_LVAL (toval))
+	{
+	case lval_internalvar:
+
+	  /* Internal variables are funny.  Their value information 
+	     is stored in the location.internalvar sub structure.  */ 
+
+	  var = VALUE_INTERNALVAR (toval); 
+
+	  /* The item in toval is a regular internal variable
+	     and this assignment is of the form:
+
+	     set var $foo = 'hello' */
+
+	  /* First free up any old stuff in this internalvar.  */
+
+	  free (VALUE_LITERAL_DATA (var->value));
+	  VALUE_LITERAL_DATA (var->value) = 0; 
+	  VALUE_LAZY (var->value) = 0; /* Disable lazy fetches since this 
+					  is not located in inferior. */ 
+
+	  /* Copy over the relevant value data from 'fromval' */
+
+	  set_internalvar (VALUE_INTERNALVAR (toval), fromval);
+
+	  /* Now replicate the VALUE_LITERAL_DATA field so that 
+	     we may later safely de-allocate fromval. */
+
+	  VALUE_LITERAL_DATA (var->value) = 
+	    malloc (TYPE_LENGTH (VALUE_TYPE (fromval)));
+         
+	  memcpy((char *) VALUE_LITERAL_DATA (var->value), 
+		 (char *) VALUE_LITERAL_DATA (fromval), 
+		 lenfrom); 
+         
+	  /* Copy over all relevant value data from 'toval'.  into 
+	     the structure to returned */ 
+
+	  memcpy (val, toval, sizeof(struct value));
+         
+	  /* Lastly copy the pointer to the area where the 
+	     internalvar data is stored to the VALUE_CONTENTS field.
+	     This will be a helpful shortcut for printout 
+	     routines later */ 
+
+	  VALUE_LITERAL_DATA (val) = VALUE_LITERAL_DATA (var->value); 
+	  break;
+
+	case lval_memory:
+
+	  /* We are copying memory from the local (superior) 
+	     literal string to a legitimate address in the 
+	     inferior. VALUE_ADDRESS is the address in 
+	     the inferior. VALUE_OFFSET is not used because
+	     structs do not exist in F77. */ 
+
+	  /* Copy over all relevant value data from 'toval'.  */ 
+
+	  memcpy (val, toval, sizeof(struct value));
+
+	  write_memory ((CORE_ADDR) VALUE_ADDRESS (val),
+			(char *) VALUE_LITERAL_DATA (fromval),
+			(lento > lenfrom) ? lenfrom : lento); 
+               
+	  /* Check to see if we have to pad */
+               
+	  if (lento > lenfrom) 
+	    {
+	      c = alloca (lento - lenfrom); 
+	      memset (c, ' ', lento - lenfrom);
+	      tmp_addr = VALUE_ADDRESS (val) + lenfrom; 
+	      write_memory (tmp_addr, c, lento - lenfrom);
+	    }
+	  break;
+
+	default:
+	  error ("Unknown lval type in f77_assign_from_literal_string"); 
+	}
+
+      /* Now free up the transient literal string's storage. */
+
+      free (VALUE_LITERAL_DATA (fromval)); 
+
+      VALUE_TYPE (val) = type;
+  
+      return val; 
+    }
+}
+
+
+/* The following function is called in order to assign a literal F77
+   complex to either an internal GDB variable or to a real complex
+   variable in the inferior.  This function is necessary because in F77,
+   composite literals are allocated in the superior's memory space 
+   NOT the inferior's.  This function provides a way to get the F77 stuff
+   to work without messing with the way C deals with this issue. */ 
+
+static value_ptr
+f77_assign_from_literal_complex (toval, fromval)
+     register value_ptr toval, fromval;
+{
+  register struct type *type = VALUE_TYPE (toval);
+  register value_ptr val;
+  struct internalvar *var; 
+  float tmp_float=0;
+  double tmp_double = 0;
+
+  if (VALUE_LVAL (toval) == lval_internalvar)
+    type = VALUE_TYPE (fromval); 
+
+  /* Allocate a value node for the result.  */
+
+  val = allocate_value (type);
+
+  if (VALUE_LVAL (toval) == lval_internalvar)
+    {
+      /* Internal variables are funny.  Their value information 
+	 is stored in the location.internalvar sub structure.  */ 
+
+      var = VALUE_INTERNALVAR (toval);
+
+      /* First free up any old stuff in this internalvar. */
+
+      free (VALUE_LITERAL_DATA (var->value));
+      VALUE_LITERAL_DATA (var->value) = 0; 
+      VALUE_LAZY (var->value) = 0; /* Disable lazy fetches since 
+				      this is not located in inferior. */ 
+              
+      /* Copy over the relevant value data from 'fromval'.  */
+
+      set_internalvar (VALUE_INTERNALVAR (toval), fromval);
+
+      /* Now replicate the VALUE_LITERAL_DATA field so that 
+	 we may later safely de-allocate  fromval.  */
+
+      VALUE_LITERAL_DATA (var->value) = 
+	malloc (TYPE_LENGTH (VALUE_TYPE (fromval)));
+         
+      memcpy ((char *) VALUE_LITERAL_DATA (var->value), 
+	      (char *) VALUE_LITERAL_DATA (fromval), 
+	      TYPE_LENGTH (VALUE_TYPE (fromval))); 
+
+      /* Copy over all relevant value data from 'toval' into the
+	 structure to be returned.  */ 
+
+      memcpy (val, toval, sizeof(struct value));
+    }
+  else
+    { 
+      /* We are copying memory from the local (superior) process to a
+	 legitimate address in the inferior. VALUE_ADDRESS is the
+	 address in the inferior. */ 
+
+      /* Copy over all relevant value data from 'toval'.  */ 
+
+      memcpy (val, toval, sizeof(struct value));
+         
+      if (TYPE_LENGTH (VALUE_TYPE (fromval))
+	  > TYPE_LENGTH (VALUE_TYPE (toval)))
+	{
+	  /* Since all literals are actually complex*16 types, deal with
+	     the case when one tries to assign a literal to a complex*8.  */
+
+	  if ((TYPE_LENGTH(VALUE_TYPE(fromval)) == 16) && 
+	      (TYPE_LENGTH(VALUE_TYPE(toval)) == 8))
+	    {
+	      tmp_double = *((double *) VALUE_LITERAL_DATA (fromval));
+	      
+	      tmp_float = (float) tmp_double;
+
+	      write_memory (VALUE_ADDRESS(val),
+			    (char *) &tmp_float, sizeof(float));
+
+	      tmp_double = *((double *) 
+			     (((char *) VALUE_LITERAL_DATA (fromval))
+			      + sizeof(double))); 
+	      
+	      tmp_float = (float) tmp_double;
+
+	      write_memory(VALUE_ADDRESS(val) + sizeof(float),
+			   (char *) &tmp_float, sizeof(float));
+	    }
+	  else
+	    error ("Cannot assign literal complex to variable!");
+	}
+      else 
+	{
+	  write_memory (VALUE_ADDRESS (val),
+			(char *) VALUE_LITERAL_DATA (fromval),
+			TYPE_LENGTH (VALUE_TYPE (fromval)));
+	}
+    }
+
+  /* Now free up the transient literal string's storage */
+   
+  free (VALUE_LITERAL_DATA (fromval)); 
+
+  VALUE_TYPE (val) = type;
+  
+  return val;
+}