*** ChangeLog.orig	Wed Oct 12 10:57:01 1994
--- ChangeLog	Wed Oct 12 11:30:07 1994
***************
*** 317,326 ****
--- 317,332 ----
  	* config/i386/{nbsd.mh,nbsd.mt,nm-nbsd.h,tm-nbsd.h,xm-nbsd.h}:
  	  New files, support for NetBSD/i386.
  	* config/ns32k/{nbsd.mh,nbsd.mh,nm-nbsd.h,tm-nbsd.h,xm-nbsd.h}:
       	  New files, support for NetBSD/ns32k.
  
+ Sat Feb 26 22:11:42 1994  Eric Muller  (muller@procope.pa.dec.com)
+ 
+ 	* m3-exp.c (m3_parse_e7): parsing of function calls.
+ 
+ 	* valops.c (find_function_addr): support for Modula-3 functions.
+ 
  Tue Sep 20 11:34:27 1994  Jim Kingdon  (kingdon@lioth.cygnus.com)
  
  	* .gdbinit: Add list-objfiles command.
  
  	* TODO: Reword item regarding NO_STD_REGS.
*** Makefile.in.orig	Wed Oct 12 10:57:01 1994
--- Makefile.in	Wed Oct 12 11:30:07 1994
***************
*** 337,346 ****
--- 337,347 ----
  	gdbtypes.c infcmd.c inflow.c infrun.c language.c \
  	m2-exp.y m2-lang.c m2-typeprint.c m2-valprint.c main.c maint.c \
  	mem-break.c minsyms.c mipsread.c nlmread.c objfiles.c parse.c \
  	printcmd.c remote.c source.c stabsread.c stack.c symfile.c symmisc.c \
  	symtab.c target.c thread.c top.c \
+  	m3-exp.c m3-lang.c m3-typeprint.c m3-valprint.c \
  	typeprint.c utils.c valarith.c valops.c \
  	valprint.c values.c serial.c ser-unix.c mdebugread.c os9kread.c
  
  # All source files that lint should look at
  LINTFILES = $(SFILES) $(YYFILES) init.c
***************
*** 407,416 ****
--- 408,418 ----
  	nindy-share/block_io.h nindy-share/coff.h \
  	nindy-share/env.h nindy-share/stop.h \
  	vx-share/dbgRpcLib.h vx-share/ptrace.h vx-share/vxTypes.h \
  	vx-share/vxWorks.h vx-share/wait.h vx-share/xdr_ld.h \
  	vx-share/xdr_ptrace.h vx-share/xdr_rdb.h thread.h \
+  	m3-lang.h \
  	dcache.h remote-utils.h remote-sim.h top.h
  
  # Header files that already have srcdir in them, or which are in objdir.
  
  HFILES_WITH_SRCDIR = $(udiheaders) ../bfd/bfd.h
***************
*** 453,462 ****
--- 455,465 ----
  	dwarfread.o mipsread.o stabsread.o core.o \
  	c-lang.o ch-lang.o f-lang.o m2-lang.o \
  	complaints.o typeprint.o \
  	c-typeprint.o ch-typeprint.o f-typeprint.o m2-typeprint.o \
  	c-valprint.o cp-valprint.o ch-valprint.o f-valprint.o m2-valprint.o \
+  	m3-lang.o m3-typeprint.o m3-valprint.o m3-exp.o \
  	nlmread.o serial.o mdebugread.o os9kread.o top.o utils.o
  
  OBS = $(COMMON_OBS) main.o annotate.o
  
  LIBGDB_OBS = 
***************
*** 596,605 ****
--- 599,609 ----
  	#load ./init.c $(SFILES)
  	#unload $(srcdir)/c-exp.y $(srcdir)/m2-exp.y $(srcdir)/ch-exp.y
  	#unload vx-share/*.h
  	#unload nindy-share/[A-Z]*
  	#load c-exp.tab.c m2-exp.tab.c ch-exp.tab.c
+ 	#load m3-exp.c
  	#load copying.c version.c
  	#load ../opcodes/libopcodes.a
  	#load ../libiberty/libiberty.a
  	#load ../bfd/libbfd.a
  	#load ../readline/libreadline.a
***************
*** 1448,1454 ****
--- 1452,1460 ----
  	$(bfd_h) objfiles.h symfile.h
  
  m2-exp.tab.o: m2-exp.tab.c $(defs_h) $(expression_h) $(gdbtypes_h) \
  	language.h m2-lang.h parser-defs.h $(symtab_h) $(value_h) \
  	$(bfd_h) objfiles.h symfile.h
+ 
+ m3-valprint.c: m3-lang.h
  
  ### end of the gdb Makefile.in.
*** breakpoint.c.orig	Wed Oct 12 10:57:01 1994
--- breakpoint.c	Wed Oct 12 11:30:07 1994
***************
*** 71,81 ****
  map_breakpoint_numbers PARAMS ((char *,	void (*)(struct breakpoint *)));
  
  static void
  ignore_command PARAMS ((char *, int));
  
! static int
  breakpoint_re_set_one PARAMS ((char *));
  
  static void
  delete_command PARAMS ((char *, int));
  
--- 71,81 ----
  map_breakpoint_numbers PARAMS ((char *,	void (*)(struct breakpoint *)));
  
  static void
  ignore_command PARAMS ((char *, int));
  
! static long
  breakpoint_re_set_one PARAMS ((char *));
  
  static void
  delete_command PARAMS ((char *, int));
  
***************
*** 119,129 ****
  breakpoint_1 PARAMS ((int, int));
  
  static bpstat
  bpstat_alloc PARAMS ((struct breakpoint *, bpstat));
  
! static int
  breakpoint_cond_eval PARAMS ((char *));
  
  static void
  cleanup_executing_breakpoints PARAMS ((int));
  
--- 119,129 ----
  breakpoint_1 PARAMS ((int, int));
  
  static bpstat
  bpstat_alloc PARAMS ((struct breakpoint *, bpstat));
  
! static long
  breakpoint_cond_eval PARAMS ((char *));
  
  static void
  cleanup_executing_breakpoints PARAMS ((int));
  
***************
*** 1053,1063 ****
  /* Evaluate the expression EXP and return 1 if value is zero.
     This is used inside a catch_errors to evaluate the breakpoint condition. 
     The argument is a "struct expression *" that has been cast to char * to 
     make it pass through catch_errors.  */
  
! static int
  breakpoint_cond_eval (exp)
       char *exp;
  {
    value_ptr mark = value_mark ();
    int i = !value_true (evaluate_expression ((struct expression *)exp));
--- 1053,1063 ----
  /* Evaluate the expression EXP and return 1 if value is zero.
     This is used inside a catch_errors to evaluate the breakpoint condition. 
     The argument is a "struct expression *" that has been cast to char * to 
     make it pass through catch_errors.  */
  
! static long
  breakpoint_cond_eval (exp)
       char *exp;
  {
    value_ptr mark = value_mark ();
    int i = !value_true (evaluate_expression ((struct expression *)exp));
***************
*** 1093,1103 ****
  /* The value has not changed.  */
  #define WP_VALUE_NOT_CHANGED 3
  
  /* Check watchpoint condition.  */
  
! static int
  watchpoint_check (p)
       char *p;
  {
    bpstat bs = (bpstat) p;
    struct breakpoint *b;
--- 1093,1103 ----
  /* The value has not changed.  */
  #define WP_VALUE_NOT_CHANGED 3
  
  /* Check watchpoint condition.  */
  
! static long
  watchpoint_check (p)
       char *p;
  {
    bpstat bs = (bpstat) p;
    struct breakpoint *b;
***************
*** 3277,3287 ****
  
  /* Reset a breakpoint given it's struct breakpoint * BINT.
     The value we return ends up being the return value from catch_errors.
     Unused in this case.  */
  
! static int
  breakpoint_re_set_one (bint)
       char *bint;
  {
    struct breakpoint *b = (struct breakpoint *)bint;  /* get past catch_errs */
    struct value *mark;
--- 3277,3287 ----
  
  /* Reset a breakpoint given it's struct breakpoint * BINT.
     The value we return ends up being the return value from catch_errors.
     Unused in this case.  */
  
! static long
  breakpoint_re_set_one (bint)
       char *bint;
  {
    struct breakpoint *b = (struct breakpoint *)bint;  /* get past catch_errs */
    struct value *mark;
*** coffread.c.orig	Wed Oct 12 10:57:02 1994
--- coffread.c	Wed Oct 12 11:30:08 1994
***************
*** 1374,1387 ****
         struct type *new = (struct type *)
  		    obstack_alloc (&objfile->symbol_obstack, sizeof (struct type));
         
         memcpy (new, lookup_function_type (decode_function_type (cs, cs->c_type, aux)),
  		      sizeof(struct type));
!        SYMBOL_TYPE (sym) = new;
         in_function_type = SYMBOL_TYPE(sym);
  #else
!        SYMBOL_TYPE(sym) = 
  	 lookup_function_type (decode_function_type (cs, cs->c_type, aux));
  #endif
  
        SYMBOL_CLASS (sym) = LOC_BLOCK;
        if (cs->c_sclass == C_STAT)
--- 1374,1387 ----
         struct type *new = (struct type *)
  		    obstack_alloc (&objfile->symbol_obstack, sizeof (struct type));
         
         memcpy (new, lookup_function_type (decode_function_type (cs, cs->c_type, aux)),
  		      sizeof(struct type));
!        SET_SYMBOL_TYPE (sym) = new;
         in_function_type = SYMBOL_TYPE(sym);
  #else
!        SET_SYMBOL_TYPE(sym) = 
  	 lookup_function_type (decode_function_type (cs, cs->c_type, aux));
  #endif
  
        SYMBOL_CLASS (sym) = LOC_BLOCK;
        if (cs->c_sclass == C_STAT)
***************
*** 1389,1399 ****
        else if (cs->c_sclass == C_EXT)
  	add_symbol_to_list (sym, &global_symbols);
      }
    else
      {
!       SYMBOL_TYPE (sym) = decode_type (cs, cs->c_type, aux);
        switch (cs->c_sclass)
  	{
  	  case C_NULL:
  	    break;
  
--- 1389,1399 ----
        else if (cs->c_sclass == C_EXT)
  	add_symbol_to_list (sym, &global_symbols);
      }
    else
      {
!       SET_SYMBOL_TYPE (sym) = decode_type (cs, cs->c_type, aux);
        switch (cs->c_sclass)
  	{
  	  case C_NULL:
  	    break;
  
***************
*** 1478,1488 ****
  		temptype =
  		  lookup_fundamental_type (current_objfile, FT_INTEGER);
  		if (TYPE_LENGTH (SYMBOL_TYPE (sym)) < TYPE_LENGTH (temptype)
  		    && TYPE_CODE (SYMBOL_TYPE (sym)) == TYPE_CODE_INT)
  		  {
! 		    SYMBOL_TYPE (sym) =
  		      (TYPE_UNSIGNED (SYMBOL_TYPE (sym))
  		       ? lookup_fundamental_type (current_objfile,
  						  FT_UNSIGNED_INTEGER)
  		       : temptype);
  		  }
--- 1478,1488 ----
  		temptype =
  		  lookup_fundamental_type (current_objfile, FT_INTEGER);
  		if (TYPE_LENGTH (SYMBOL_TYPE (sym)) < TYPE_LENGTH (temptype)
  		    && TYPE_CODE (SYMBOL_TYPE (sym)) == TYPE_CODE_INT)
  		  {
! 		    SET_SYMBOL_TYPE (sym) =
  		      (TYPE_UNSIGNED (SYMBOL_TYPE (sym))
  		       ? lookup_fundamental_type (current_objfile,
  						  FT_UNSIGNED_INTEGER)
  		       : temptype);
  		  }
***************
*** 1999,2009 ****
        if (syms == osyms)
  	j = o_nsyms;
        for (; j < syms->nsyms; j++,n++)
  	{
  	  struct symbol *xsym = syms->symbol[j];
! 	  SYMBOL_TYPE (xsym) = type;
  	  TYPE_FIELD_NAME (type, n) = SYMBOL_NAME (xsym);
  	  TYPE_FIELD_VALUE (type, n) = 0;
  	  TYPE_FIELD_BITPOS (type, n) = SYMBOL_VALUE (xsym);
  	  TYPE_FIELD_BITSIZE (type, n) = 0;
  	}
--- 1999,2009 ----
        if (syms == osyms)
  	j = o_nsyms;
        for (; j < syms->nsyms; j++,n++)
  	{
  	  struct symbol *xsym = syms->symbol[j];
! 	  SET_SYMBOL_TYPE (xsym) = type;
  	  TYPE_FIELD_NAME (type, n) = SYMBOL_NAME (xsym);
  	  TYPE_FIELD_VALUE (type, n) = 0;
  	  TYPE_FIELD_BITPOS (type, n) = SYMBOL_VALUE (xsym);
  	  TYPE_FIELD_BITSIZE (type, n) = 0;
  	}
*** corelow.c.orig	Wed Oct 12 13:07:25 1994
--- corelow.c	Wed Oct 12 13:07:54 1994
***************
*** 34,44 ****
  
  static void
  core_files_info PARAMS ((struct target_ops *));
  
  #ifdef SOLIB_ADD
! static int 
  solib_add_stub PARAMS ((char *));
  #endif
  
  static void
  core_close PARAMS ((int));
--- 34,44 ----
  
  static void
  core_files_info PARAMS ((struct target_ops *));
  
  #ifdef SOLIB_ADD
! static long 
  solib_add_stub PARAMS ((char *));
  #endif
  
  static void
  core_close PARAMS ((int));
***************
*** 73,83 ****
  
  #ifdef SOLIB_ADD
  /* Stub function for catch_errors around shared library hacking.  FROM_TTYP
     is really an int * which points to from_tty.  */
  
! static int 
  solib_add_stub (from_ttyp)
       char *from_ttyp;
  {
    SOLIB_ADD (NULL, *(int *)from_ttyp, &current_target);
    return 0;
--- 73,83 ----
  
  #ifdef SOLIB_ADD
  /* Stub function for catch_errors around shared library hacking.  FROM_TTYP
     is really an int * which points to from_tty.  */
  
! static long 
  solib_add_stub (from_ttyp)
       char *from_ttyp;
  {
    SOLIB_ADD (NULL, *(int *)from_ttyp, &current_target);
    return 0;
*** defs.h.orig	Wed Oct 12 10:57:02 1994
--- defs.h	Wed Oct 12 11:30:08 1994
***************
*** 97,107 ****
     language_c, 			/* C */
     language_cplus, 		/* C++ */
     language_chill,		/* Chill */
     language_fortran,		/* Fortran */
     language_m2,			/* Modula-2 */
!    language_asm			/* Assembly language */
  };
  
  /* the cleanup list records things that have to be undone
     if an error happens (descriptors to be closed, memory to be freed, etc.)
     Each link in the chain records a function to call and an
--- 97,108 ----
     language_c, 			/* C */
     language_cplus, 		/* C++ */
     language_chill,		/* Chill */
     language_fortran,		/* Fortran */
     language_m2,			/* Modula-2 */
!    language_asm,		/* Assembly language */
!    language_m3			/* Modula-3 */
  };
  
  /* the cleanup list records things that have to be undone
     if an error happens (descriptors to be closed, memory to be freed, etc.)
     Each link in the chain records a function to call and an
***************
*** 591,602 ****
  typedef int return_mask;
  
  extern NORETURN void
  return_to_top_level PARAMS ((enum return_reason)) ATTR_NORETURN;
  
! extern int
! catch_errors PARAMS ((int (*) (char *), void *, char *, return_mask));
  
  extern void warning_setup PARAMS ((void));
  
  extern void warning ();
  
--- 592,603 ----
  typedef int return_mask;
  
  extern NORETURN void
  return_to_top_level PARAMS ((enum return_reason)) ATTR_NORETURN;
  
! extern long
! catch_errors PARAMS ((long (*) (char *), void *, char *, return_mask));
  
  extern void warning_setup PARAMS ((void));
  
  extern void warning ();
  
*** dwarfread.c.orig	Wed Oct 12 10:57:02 1994
--- dwarfread.c	Wed Oct 12 11:30:08 1994
***************
*** 1178,1188 ****
    if (!(TYPE_FLAGS (type) & TYPE_FLAG_STUB))
      {
        sym = new_symbol (dip, objfile);
        if (sym != NULL)
  	{
! 	  SYMBOL_TYPE (sym) = type;
  	  if (cu_language == language_cplus)
  	    {
  	      synthesize_typedef (dip, objfile, type);
  	    }
  	}
--- 1178,1188 ----
    if (!(TYPE_FLAGS (type) & TYPE_FLAG_STUB))
      {
        sym = new_symbol (dip, objfile);
        if (sym != NULL)
  	{
! 	  SET_SYMBOL_TYPE (sym) = type;
  	  if (cu_language == language_cplus)
  	    {
  	      synthesize_typedef (dip, objfile, type);
  	    }
  	}
***************
*** 1640,1650 ****
    
    type = enum_type (dip, objfile);
    sym = new_symbol (dip, objfile);
    if (sym != NULL)
      {
!       SYMBOL_TYPE (sym) = type;
        if (cu_language == language_cplus)
  	{
  	  synthesize_typedef (dip, objfile, type);
  	}
      }
--- 1640,1650 ----
    
    type = enum_type (dip, objfile);
    sym = new_symbol (dip, objfile);
    if (sym != NULL)
      {
!       SET_SYMBOL_TYPE (sym) = type;
        if (cu_language == language_cplus)
  	{
  	  synthesize_typedef (dip, objfile, type);
  	}
      }
***************
*** 1756,1766 ****
  	  SYMBOL_NAME (sym) = create_name (list -> field.name,
  					   &objfile->symbol_obstack);
  	  SYMBOL_INIT_LANGUAGE_SPECIFIC (sym, cu_language);
  	  SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
  	  SYMBOL_CLASS (sym) = LOC_CONST;
! 	  SYMBOL_TYPE (sym) = type;
  	  SYMBOL_VALUE (sym) = list -> field.bitpos;
  	  add_symbol_to_list (sym, list_in_scope);
  	}
        /* Now create the vector of fields, and record how big it is. This is
  	 where we reverse the order, by pulling the members off the list in
--- 1756,1766 ----
  	  SYMBOL_NAME (sym) = create_name (list -> field.name,
  					   &objfile->symbol_obstack);
  	  SYMBOL_INIT_LANGUAGE_SPECIFIC (sym, cu_language);
  	  SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
  	  SYMBOL_CLASS (sym) = LOC_CONST;
! 	  SET_SYMBOL_TYPE (sym) = type;
  	  SYMBOL_VALUE (sym) = list -> field.bitpos;
  	  add_symbol_to_list (sym, list_in_scope);
  	}
        /* Now create the vector of fields, and record how big it is. This is
  	 where we reverse the order, by pulling the members off the list in
***************
*** 2942,2952 ****
        SYMBOL_NAME (sym) = create_name (dip -> at_name,
  				       &objfile->symbol_obstack);
        /* default assumptions */
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        SYMBOL_CLASS (sym) = LOC_STATIC;
!       SYMBOL_TYPE (sym) = decode_die_type (dip);
  
        /* If this symbol is from a C++ compilation, then attempt to cache the
  	 demangled form for future reference.  This is a typical time versus
  	 space tradeoff, that was decided in favor of time because it sped up
  	 C++ symbol lookups by a factor of about 20. */
--- 2942,2952 ----
        SYMBOL_NAME (sym) = create_name (dip -> at_name,
  				       &objfile->symbol_obstack);
        /* default assumptions */
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        SYMBOL_CLASS (sym) = LOC_STATIC;
!       SET_SYMBOL_TYPE (sym) = decode_die_type (dip);
  
        /* If this symbol is from a C++ compilation, then attempt to cache the
  	 demangled form for future reference.  This is a typical time versus
  	 space tradeoff, that was decided in favor of time because it sped up
  	 C++ symbol lookups by a factor of about 20. */
***************
*** 2960,2970 ****
  	  SYMBOL_CLASS (sym) = LOC_LABEL;
  	  break;
  	case TAG_global_subroutine:
  	case TAG_subroutine:
  	  SYMBOL_VALUE (sym) = dip -> at_low_pc;
! 	  SYMBOL_TYPE (sym) = lookup_function_type (SYMBOL_TYPE (sym));
  	  SYMBOL_CLASS (sym) = LOC_BLOCK;
  	  if (dip -> die_tag == TAG_global_subroutine)
  	    {
  	      add_symbol_to_list (sym, &global_symbols);
  	    }
--- 2960,2970 ----
  	  SYMBOL_CLASS (sym) = LOC_LABEL;
  	  break;
  	case TAG_global_subroutine:
  	case TAG_subroutine:
  	  SYMBOL_VALUE (sym) = dip -> at_low_pc;
! 	  SET_SYMBOL_TYPE (sym) = lookup_function_type (SYMBOL_TYPE (sym));
  	  SYMBOL_CLASS (sym) = LOC_BLOCK;
  	  if (dip -> die_tag == TAG_global_subroutine)
  	    {
  	      add_symbol_to_list (sym, &global_symbols);
  	    }
***************
*** 3086,3096 ****
  	obstack_alloc (&objfile -> symbol_obstack, sizeof (struct symbol));
        memset (sym, 0, sizeof (struct symbol));
        SYMBOL_NAME (sym) = create_name (dip -> at_name,
  				       &objfile->symbol_obstack);
        SYMBOL_INIT_LANGUAGE_SPECIFIC (sym, cu_language);
!       SYMBOL_TYPE (sym) = type;
        SYMBOL_CLASS (sym) = LOC_TYPEDEF;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, list_in_scope);
      }
  }
--- 3086,3096 ----
  	obstack_alloc (&objfile -> symbol_obstack, sizeof (struct symbol));
        memset (sym, 0, sizeof (struct symbol));
        SYMBOL_NAME (sym) = create_name (dip -> at_name,
  				       &objfile->symbol_obstack);
        SYMBOL_INIT_LANGUAGE_SPECIFIC (sym, cu_language);
!       SET_SYMBOL_TYPE (sym) = type;
        SYMBOL_CLASS (sym) = LOC_TYPEDEF;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, list_in_scope);
      }
  }
*** eval.c.orig	Wed Oct 12 10:57:02 1994
--- eval.c	Wed Oct 12 11:30:08 1994
***************
*** 27,36 ****
--- 27,37 ----
  #include "target.h"
  #include "frame.h"
  #include "demangle.h"
  #include "language.h"	/* For CAST_IS_CONVERSION */
  #include "f-lang.h" /* for array bound stuff */
+ #include "m3-lang.h"
  
  /* Values of NOSIDE argument to eval_subexp.  */
  
  enum noside
  {
***************
*** 169,178 ****
--- 170,180 ----
    int tmp_pos, tmp1_pos; 
    struct symbol *tmp_symbol; 
    int upper, lower, retcode; 
    int code;
    struct internalvar *var; 
+   int float_ok, int_ok;
  
    pc = (*pos)++;
    op = exp->elts[pc].opcode;
  
    switch (op)
***************
*** 201,210 ****
--- 203,213 ----
  
      case OP_VAR_VALUE:
        (*pos) += 3;
        if (noside == EVAL_SKIP)
  	goto nosideret;
+ #if bad_for_m3
        if (noside == EVAL_AVOID_SIDE_EFFECTS)
  	{
  	  struct symbol * sym = exp->elts[pc + 2].symbol;
  	  enum lval_type lv;
  
***************
*** 227,236 ****
--- 230,240 ----
  	    }
  
  	  return value_zero (SYMBOL_TYPE (sym), lv);
  	}
        else
+ #endif
  	return value_of_variable (exp->elts[pc + 2].symbol,
  				  exp->elts[pc + 1].block);
  
      case OP_LAST:
        (*pos) += 2;
***************
*** 1253,1262 ****
--- 1257,1753 ----
  	}
  	
      case OP_THIS:
        (*pos) += 1;
        return value_of_this (1);
+ 
+     case OP_M3_LONG: {
+       value_ptr res;
+       (*pos) += 3;
+       res = allocate_value (exp->elts[pc+1].type);
+       *(LONGEST *) VALUE_CONTENTS_RAW (res) = exp->elts[pc + 2].longconst;
+       return res; }
+ 
+     case STRUCTOP_M3_INTERFACE:
+     case STRUCTOP_M3_MODULE:
+     case STRUCTOP_M3_STRUCT: {
+       struct type *t;
+       value_ptr v;
+       int offset;
+       CORE_ADDR tc_addr;
+       char name [100];
+ 
+       tem = longest_to_int (exp->elts[pc + 1].longconst);
+       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ 
+     deref:
+       t = VALUE_TYPE (arg1);
+       if (TYPE_CODE (t) == TYPE_CODE_M3_REFANY
+           || TYPE_CODE (t) == TYPE_CODE_M3_OBJECT
+           || TYPE_CODE (t) == TYPE_CODE_M3_ROOT) {
+         if (value_as_pointer (arg1) == 0) {
+           error ("Cannot dereference NIL"); }
+ 	t = find_m3_heap_type (value_as_pointer (arg1)); }
+ 
+       if (TYPE_CODE (t) == TYPE_CODE_M3_POINTER
+ 	  || TYPE_CODE (t) == TYPE_CODE_M3_INDIRECT) {
+ 	arg1 = value_at_lazy (TYPE_M3_TARGET (t), value_as_pointer (arg1)); 
+         goto deref; }
+ 
+       else if (TYPE_CODE (t) == TYPE_CODE_M3_OBJECT) {
+ 	tc_addr = find_m3_heap_tc_addr (value_as_pointer (arg1));
+ 	while (TYPE_CODE (t) == TYPE_CODE_M3_OBJECT) {
+ 	  if (find_m3_obj_field (t, &exp->elts[pc + 2].string, 0, &offset, &t)) {
+ 	    arg1 = value_at_lazy (t, value_as_pointer (arg1));
+ 	    offset += 8 * tc_address_to_dataOffset (tc_addr); 
+ 	    goto found; }
+ 
+ 	  if (find_m3_obj_method (t, 
+ 				  &exp->elts[pc + 2].string, 0, &offset, &t)) {
+ 	    arg1 = value_at_lazy (t, tc_address_to_defaultMethods (tc_addr));
+ 	    offset += 8 * tc_address_to_methodOffset (tc_addr);
+ 	    goto found; }
+ 
+ 	  tc_addr = tc_address_to_parent_tc_address (tc_addr); 
+ 	  t = find_m3_type_from_tc (tc_addr); }
+ 	t = 0;
+         found:; }
+ 	
+       else if (TYPE_CODE (t) == TYPE_CODE_M3_RECORD) {
+ 	if (! find_m3_rec_field (t, &exp->elts[pc + 2].string, 
+ 				 0, &offset, &t)) {
+ 	  t = 0; }}
+       else {
+ 	error ("this is not a record, a REF record nor an object");
+ 	return 0; }
+ 
+       if (!t) {
+ 	error ("no such field: %s", &exp->elts[pc + 2].string);
+ 	return 0; }
+ 
+       v = allocate_value (t);
+       VALUE_LVAL (v) = 1;
+       VALUE_ADDRESS (v) = VALUE_ADDRESS (arg1);
+ 
+       if (offset % 8 != 0) {
+ 	  /* We have a non-byte aligned value, we need to pull it
+ 	     now, so that we can shift the bits.  Fortunately, we
+ 	     know that the type is a scalar.  We need to pull the
+ 	     word that contains this field, because the offset is 
+ 	     expressed from the lsb of this word */
+ 	LONGEST i;
+ 	VALUE_LAZY (v) = 0; 
+ 	target_read_memory (VALUE_ADDRESS (v) + VALUE_OFFSET (arg1)
+ 			      + offset / TARGET_LONG_BIT, 
+ 			    (char*) &i, TYPE_LENGTH (t));
+ 	*(LONGEST *) VALUE_CONTENTS_RAW (v) = m3_unpack_int ((char *) &i,
+ 					           offset % TARGET_LONG_BIT, 
+ 							TYPE_M3_SIZE (t)); }
+       else {
+ 	VALUE_LAZY (v) = 1; }
+       VALUE_OFFSET (v) = VALUE_OFFSET (arg1) + offset / 8;
+       return (v); }
+ 
+     case M3_FINAL_TYPE: {
+       struct type *arg1_type;
+ 
+       arg1 = evaluate_subexp (0, exp, pos, noside);
+       arg1_type = VALUE_TYPE (arg1);
+ 
+       while (TYPE_CODE (arg1_type) == TYPE_CODE_M3_INDIRECT) {
+ 	arg1_type = TYPE_M3_TARGET (arg1_type);
+ 	arg1 = value_at_lazy (arg1_type, m3_unpack_pointer2 (arg1)); }
+ 
+       if ((TYPE_CODE (arg1_type) == TYPE_CODE_M3_REFANY
+            || TYPE_CODE (arg1_type) == TYPE_CODE_M3_ROOT
+            || TYPE_CODE (arg1_type) == TYPE_CODE_M3_OBJECT)
+           && value_as_pointer (arg1) != 0) {
+ 	arg1_type = find_m3_heap_type (value_as_pointer (arg1)); }
+ 
+ 
+       VALUE_TYPE (arg1) = arg1_type;
+       return (arg1); }
+ 
+     case UNOP_M3_IND: {
+       struct type *res_type, *arg1_type;
+ 
+       arg1 = evaluate_subexp (0, exp, pos, noside);
+       arg1_type = VALUE_TYPE (arg1);
+ 
+       while (TYPE_CODE (arg1_type) == TYPE_CODE_M3_INDIRECT) {
+ 	arg1_type = TYPE_M3_TARGET (arg1_type);
+ 	arg1 = value_at_lazy (arg1_type, m3_unpack_pointer2 (arg1)); }
+ 
+       if (value_as_pointer (arg1) == 0) {
+         error ("^ applied to NIL"); }
+ 
+       if (TYPE_CODE (arg1_type) == TYPE_CODE_M3_REFANY) {
+ 	arg1_type = find_m3_heap_type (value_as_pointer (arg1)); }
+ 
+       if (TYPE_CODE (arg1_type) == TYPE_CODE_M3_POINTER) {
+         res_type = TYPE_M3_TARGET (arg1_type); }
+ 
+       else {
+         error ("^ applied to a non-REF"); }
+ 
+       return value_at_lazy (res_type, m3_unpack_pointer2 (arg1)); }
+ 
+     case UNOP_M3_NEG: {
+       arg1 = evaluate_subexp (0, exp, pos, noside);
+ 
+       *(LONGEST *) VALUE_CONTENTS_RAW (arg1) = - m3_unpack_int2 (arg1);
+       return arg1; }
+ 
+     case UNOP_M3_FIRST:
+     case UNOP_M3_LAST: 
+     case UNOP_M3_NUMBER: {
+       value_ptr res, array;
+       struct type *array_type, *index_type;
+       LONGEST lowerbound, upperbound;
+ 
+       array = evaluate_subexp (0, exp, pos, noside);
+       array_type = VALUE_TYPE (array);
+ 
+       while (TYPE_CODE (array_type) == TYPE_CODE_M3_POINTER
+ 	     || TYPE_CODE (array_type) == TYPE_CODE_M3_INDIRECT) {
+ 	array_type = TYPE_M3_TARGET (array_type);
+ 	array = value_at_lazy (array_type, m3_unpack_pointer2 (array));
+         if (array == 0) {
+           error ("FIRST, LAST or NUMBER applied to NIL");  }}
+ 
+       if (TYPE_CODE (array_type) == TYPE_CODE_M3_ARRAY) {
+ 	index_type = TYPE_M3_ARRAY_INDEX (array_type);
+ 	m3_ordinal_bounds (index_type, &lowerbound, &upperbound);
+       } else if (TYPE_CODE (array_type) == TYPE_CODE_M3_OPEN_ARRAY) {
+ 	lowerbound = 0;
+ 	upperbound = *(long*) (VALUE_CONTENTS (array) + sizeof(long)) - 1;
+       } else {
+ 	error ("FIRST, LAST, NUMBER can only be applied to arrays.");
+       }
+ 
+       res = allocate_value (builtin_type_m3_integer);
+       VALUE_LAZY (res) = 0;
+       switch (op) 
+ 	{
+ 	case UNOP_M3_FIRST: 
+ 	  *(LONGEST *)VALUE_CONTENTS_RAW (res) = lowerbound;
+ 	  break;
+ 	case UNOP_M3_LAST: 
+ 	  *(LONGEST *)VALUE_CONTENTS_RAW (res) = upperbound;
+ 	  break;
+ 	case UNOP_M3_NUMBER:
+ 	  *(LONGEST *)VALUE_CONTENTS_RAW (res) = upperbound - lowerbound + 1; 
+ 	  break; }
+       return res; }
+ 
+     case UNOP_M3_ADR: {
+       value_ptr v = evaluate_subexp_for_address (exp, pos, noside); 
+       TYPE_CODE (VALUE_TYPE (v)) = TYPE_CODE_M3_ADDRESS;
+       TYPE_M3_SIZE (VALUE_TYPE (v)) = TARGET_PTR_BIT;
+       return v; }
+ 
+     case BINOP_M3_SUBSCRIPT: {
+       long lowerbound, upperbound, index_val; 
+       long offset;
+       struct type *index_type, *elem_type, *array_type;
+       value_ptr v, array, index;
+       long elt_size;
+ 
+       array = evaluate_subexp (0, exp, pos, noside);
+       index = evaluate_subexp (0, exp, pos, noside);
+       array_type = VALUE_TYPE (array);
+ 
+       while (TYPE_CODE (array_type) == TYPE_CODE_M3_POINTER
+ 	     || TYPE_CODE (array_type) == TYPE_CODE_M3_INDIRECT) {
+ 	array_type = TYPE_M3_TARGET (array_type);
+ 	array = value_at_lazy (array_type, m3_unpack_pointer2 (array)); }
+ 
+       if (TYPE_CODE (array_type) == TYPE_CODE_M3_ARRAY) {
+ 	index_type = TYPE_M3_ARRAY_INDEX (array_type);
+ 	elem_type  = TYPE_M3_ARRAY_ELEM (array_type);
+ 	elt_size   = TYPE_M3_SIZE (elem_type);
+ 	m3_ordinal_bounds (index_type, &lowerbound, &upperbound); }
+       else if (TYPE_CODE (array_type) == TYPE_CODE_M3_OPEN_ARRAY) {
+ 	elem_type = TYPE_M3_OPEN_ARRAY_ELEM (array_type);
+ 	lowerbound = 0;
+ 	upperbound = *(long*) (VALUE_CONTENTS (array) + TARGET_PTR_BIT/HOST_CHAR_BIT) - 1;
+         { struct type *e = elem_type;
+ 	  long n = (TARGET_PTR_BIT + TARGET_LONG_BIT) / HOST_CHAR_BIT;
+ 	  elt_size = 1;
+ 	  while (TYPE_CODE (e) == TYPE_CODE_M3_OPEN_ARRAY) {
+ 	    elt_size *= *(long*) (VALUE_CONTENTS (array) + n);
+ 	    n += sizeof (long);
+ 	    e = TYPE_M3_OPEN_ARRAY_ELEM (e); }
+ 	  elt_size *= TYPE_M3_SIZE (e); }}
+       else {
+ 	error ("indexed expression is not an array"); }
+ 
+       COERCE_REF (array);
+ 
+       index_val = m3_unpack_int2 (index);
+       if (lowerbound > index_val || index_val > upperbound) {
+ 	error ("range fault on array access");
+ 	return 0; }
+ 
+       offset = elt_size * (index_val - lowerbound);
+       if (offset % 8 != 0) {
+ 	error ("Extracting a bitfield"); 
+ 	return 0; }
+       
+       v = allocate_value (elem_type);
+ 
+       if (TYPE_CODE (array_type) == TYPE_CODE_M3_OPEN_ARRAY) {
+ 
+ 	if (TYPE_CODE (elem_type) == TYPE_CODE_M3_OPEN_ARRAY) {
+ 	  /* recreate a dope vector for the next guy */
+ 	  memcpy (VALUE_CONTENTS_RAW (v) + (TARGET_PTR_BIT / HOST_CHAR_BIT),
+ 		  VALUE_CONTENTS_RAW (array)
+ 		    + (TARGET_PTR_BIT + TARGET_LONG_BIT)/ HOST_CHAR_BIT, 
+ 		  TYPE_LENGTH (elem_type) - TARGET_LONG_BIT / HOST_CHAR_BIT);
+ 	  *(char **)VALUE_CONTENTS_RAW (v) = 
+ 	    *(char **)VALUE_CONTENTS_RAW (array) + offset / 8; }
+ 
+ 	else {
+ 	  /* mark the thing as not read yet */
+ 	  VALUE_LAZY (v) = 1;
+ 	  VALUE_LVAL (v) = VALUE_LVAL (array);
+ 	  VALUE_ADDRESS (v) = 
+ 	    (*(long*)(VALUE_CONTENTS_RAW (array))) + offset / 8;
+ 	  VALUE_OFFSET (v) = 0; }}
+ 
+       else {
+ 
+ 	if (VALUE_LAZY (array)) {
+ 	  VALUE_LAZY (v) = 1; }
+ 	else {
+ 	  memcpy (VALUE_CONTENTS_RAW (v), 
+ 		  VALUE_CONTENTS_RAW (array) + offset / 8,
+ 		  TYPE_LENGTH (elem_type)); }
+ 	VALUE_LVAL (v) = VALUE_LVAL (array);
+ 	if (VALUE_LVAL (array) == lval_internalvar) {
+ 	  VALUE_LVAL (v) = lval_internalvar_component; }
+ 	VALUE_ADDRESS (v) = VALUE_ADDRESS (array);
+ 	VALUE_OFFSET (v) = VALUE_OFFSET (array) + offset / 8;  }
+       return v; 
+       break; }
+       
+ 
+     case BINOP_M3_DIVIDE: {
+       float_ok = 1;
+       int_ok = 0;
+       goto arith_binop; }
+ 
+     case BINOP_M3_DIV:
+     case BINOP_M3_MOD: {
+       float_ok = 0;
+       int_ok = 1;
+       goto arith_binop; }
+ 
+     case BINOP_M3_MULT: 
+     case BINOP_M3_ADD:
+     case BINOP_M3_MINUS: {
+       float_ok = 1;
+       int_ok = 1;
+       goto arith_binop; }
+ 
+     arith_binop: {
+       value_ptr res;
+       LONGEST ival1, ival2;
+       double fval1, fval2;
+       struct type *arg1_type, *arg2_type;
+ 
+       arg1 = evaluate_subexp (0, exp, pos, noside);
+       arg2 = evaluate_subexp (0, exp, pos, noside);
+ 
+       arg1_type = VALUE_TYPE (arg1);
+     restart:
+       switch (TYPE_CODE (arg1_type)) 
+ 	{
+ 	case TYPE_CODE_M3_INDIRECT:
+ 	  arg1_type = TYPE_M3_TARGET (arg1_type);
+ 	  arg1 = value_at_lazy (arg1_type, m3_unpack_pointer2 (arg1));
+ 	  goto restart; 
+ 	case TYPE_CODE_M3_PACKED:
+ 	  arg1_type = TYPE_M3_TARGET (arg1_type);
+ 	  goto restart;
+ 	case TYPE_CODE_M3_CARDINAL:
+ 	case TYPE_CODE_M3_SUBRANGE:
+ 	  arg1_type = builtin_type_m3_integer;
+ 	  /* fall through */
+ 	case TYPE_CODE_M3_INTEGER:
+ 	  ival1 = m3_unpack_int2 (arg1);
+ 	  break;
+ 	case TYPE_CODE_FLT:
+ 	  fval1 = m3_unpack_float2 (arg1);
+ 	  arg1_type = builtin_type_double;
+ 	  break;
+ 	default:
+ 	  arg1_type = builtin_type_m3_void;
+ 	  break; }
+ 
+       arg2_type = VALUE_TYPE (arg2);
+     restart2:
+       switch (TYPE_CODE (arg2_type)) 
+ 	{
+ 	case TYPE_CODE_M3_INDIRECT:
+ 	  arg2_type = TYPE_M3_TARGET (arg2_type);
+ 	  arg2 = value_at_lazy (arg2_type, m3_unpack_pointer2 (arg2));
+ 	  goto restart2; 
+ 	case TYPE_CODE_M3_PACKED:
+ 	  arg2_type = TYPE_M3_TARGET (arg2_type);
+ 	  goto restart2;
+ 	case TYPE_CODE_M3_CARDINAL:
+ 	case TYPE_CODE_M3_SUBRANGE:
+ 	  arg2_type = builtin_type_m3_integer;
+ 	  /* fall through */
+ 	case TYPE_CODE_M3_INTEGER:
+ 	  ival2 = m3_unpack_int2 (arg2);
+ 	  break;
+ 	case TYPE_CODE_FLT:
+ 	  fval2 = m3_unpack_float2 (arg2);
+ 	  arg2_type = builtin_type_double;
+ 	  break;
+ 	default:
+ 	  arg2_type = builtin_type_m3_void;
+ 	  break; }
+ 
+ 
+       if (TYPE_CODE (arg1_type) != TYPE_CODE (arg2_type)
+ 	  || TYPE_CODE (arg1_type) == TYPE_CODE_M3_VOID
+ 	  || (TYPE_CODE (arg1_type) == TYPE_CODE_M3_INTEGER && !int_ok)
+ 	  || (TYPE_CODE (arg1_type) == TYPE_CODE_FLT && !float_ok)) {
+ 	error ("wrong arguments for binary operation"); }
+ 
+       if (TYPE_CODE (arg1_type) == TYPE_CODE_M3_INTEGER) {
+ 	res = allocate_value (builtin_type_m3_integer);
+ 	switch (op) 
+ 	  {
+ 	  case BINOP_M3_DIV: {
+ 	    long resval;
+ 	    if (ival1 == 0) {
+ 	      resval = 0; }
+ 	    else if (ival1 < 0) {
+ 	      if (ival2 < 0) {
+ 		resval =  (-ival1) / (-ival2); }
+ 	      else {
+ 		resval = - ((-ival1-1) / ival2) - 1; }}
+ 	    else {
+ 	      if (ival2 < 0) {
+ 		resval = - ((ival1 - 1) / (-ival2)) - 1; }
+ 	      else {
+ 		resval = ival1 / ival2; }}
+ 	    *(LONGEST *) VALUE_CONTENTS_RAW (res) = resval;
+ 	    break; }
+ 
+ 	  case BINOP_M3_MOD: {
+ 	    long resval;
+ 	    if (ival1 == 0) {
+ 	      resval = 0; }
+ 	    else if (ival1 < 0) {
+ 	      if (ival2 < 0) {
+ 		resval = - ((-ival1) % (-ival2)); }
+ 	      else {
+ 		resval = ival2 - 1 - ((-ival1-1) % ival2); }}
+ 	    else {
+ 	      if (ival2 < 0) {
+ 		resval = ival2 + 1 + ((ival1 - 1) % (-ival2)); }
+ 	      else {
+ 		resval = ival1 % ival2; }}
+ 	    *(LONGEST *) VALUE_CONTENTS_RAW (res) = resval;
+ 	    break; }
+ 
+ 	  case BINOP_M3_MULT: 
+ 	    *(LONGEST *) VALUE_CONTENTS_RAW (res) = ival1 * ival2;
+ 	    break;
+ 	  case BINOP_M3_ADD:
+ 	    *(LONGEST *) VALUE_CONTENTS_RAW (res) = ival1 + ival2;
+ 	    break;
+ 	  case BINOP_M3_MINUS:
+ 	    *(LONGEST *) VALUE_CONTENTS_RAW (res) = ival1 - ival2;
+ 	    break; }
+ 	return res; }
+ 
+       if (TYPE_CODE (arg1_type) == TYPE_CODE_FLT) {
+ 	res = allocate_value (builtin_type_double);
+ 	switch (op) 
+ 	  {
+ 	  case BINOP_M3_DIVIDE:
+ 	    *(double *) VALUE_CONTENTS_RAW (res) = fval1 / fval2;
+ 	    break;
+ 	  case BINOP_M3_MULT: 
+ 	    *(double *) VALUE_CONTENTS_RAW (res) = fval1 * fval2;
+ 	    break;
+ 	  case BINOP_M3_ADD:
+ 	    *(double *) VALUE_CONTENTS_RAW (res) = fval1 + fval2;
+ 	    break;
+ 	  case BINOP_M3_MINUS:
+ 	    *(double *) VALUE_CONTENTS_RAW (res) = fval1 - fval2;
+ 	    break; }
+ 	return res; }}
+ 
+     case UNOP_M3_NOT: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       if (m3_unpack_int2 (arg1) == 0) {
+ 	return m3_value_from_longest (builtin_type_m3_boolean, 1);  }
+       else {
+ 	return m3_value_from_longest (builtin_type_m3_boolean, 0);  }}
+ 	
+     case BINOP_M3_AND: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       if (m3_unpack_int2 (arg1) == 0) {
+ 	return arg1; }
+       else {
+ 	return evaluate_subexp (NULL_TYPE, exp, pos, noside); }}
+ 
+     case BINOP_M3_OR: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       if (m3_unpack_int2 (arg1) == 1) {
+ 	return arg1; }
+       else {
+ 	return evaluate_subexp (NULL_TYPE, exp, pos, noside); }}
+ 
+     case BINOP_M3_EQUAL: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
+       tem = m3_value_equal (arg1, arg2);
+       return m3_value_from_longest (builtin_type_m3_boolean, (LONGEST) tem); }
+ 
+     case BINOP_M3_NE: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
+       tem = ! m3_value_equal (arg1, arg2);
+       return value_from_longest (builtin_type_m3_boolean, (LONGEST) tem); }
+ 
+     case BINOP_M3_LT: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
+       tem = value_less (arg1, arg2);
+       return value_from_longest (builtin_type_m3_boolean, (LONGEST) tem); }
+ 
+     case BINOP_M3_LE: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
+       tem = ! (value_less (arg2, arg1));
+       return value_from_longest (builtin_type_m3_boolean, (LONGEST) tem); }
+ 
+     case BINOP_M3_GT: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
+       tem = value_less (arg2, arg1);
+       return value_from_longest (builtin_type_m3_boolean, (LONGEST) tem); }
+ 
+     case BINOP_M3_GE: {
+       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
+       tem = ! (value_less (arg1, arg2));
+       return value_from_longest (builtin_type_m3_boolean, (LONGEST) tem); }
+ 
+     case BINOP_M3_CAT:
+     case BINOP_M3_IN:
+       error ("Not yet implemented");
+       return 0; 
  
      case OP_TYPE:
        error ("Attempt to use a type name as an expression");
  
      default:
*** expression.h.orig	Wed Oct 12 10:57:02 1994
--- expression.h	Wed Oct 12 11:30:09 1994
***************
*** 279,289 ****
    OP_SCOPE,
  
    /* OP_TYPE is for parsing types, and used with the "ptype" command
       so we can look up types that are qualified by scope, either with
       the GDB "::" operator, or the Modula-2 '.' operator. */
!   OP_TYPE
  };
  
  union exp_element
  {
    enum exp_opcode opcode;
--- 279,320 ----
    OP_SCOPE,
  
    /* OP_TYPE is for parsing types, and used with the "ptype" command
       so we can look up types that are qualified by scope, either with
       the GDB "::" operator, or the Modula-2 '.' operator. */
!   OP_TYPE,
! 
!   /* M3 */
!   OP_M3_LONG,
!   STRUCTOP_M3_STRUCT,
!   STRUCTOP_M3_INTERFACE,
!   STRUCTOP_M3_MODULE,
!   M3_FINAL_TYPE,
!   UNOP_M3_IND,
!   UNOP_M3_NEG,
!   UNOP_M3_FIRST,
!   UNOP_M3_LAST,
!   UNOP_M3_NUMBER,
!   UNOP_M3_ADR,
!   UNOP_M3_NOT,
!   BINOP_M3_SUBSCRIPT,
!   BINOP_M3_MULT,
!   BINOP_M3_DIVIDE,
!   BINOP_M3_DIV,
!   BINOP_M3_MOD,
!   BINOP_M3_ADD,
!   BINOP_M3_MINUS,
!   BINOP_M3_CAT,
!   BINOP_M3_EQUAL,
!   BINOP_M3_NE,
!   BINOP_M3_LT,
!   BINOP_M3_LE,
!   BINOP_M3_GT,
!   BINOP_M3_GE,
!   BINOP_M3_IN,
!   BINOP_M3_AND,
!   BINOP_M3_OR
  };
  
  union exp_element
  {
    enum exp_opcode opcode;
*** gdbtypes.h.orig	Wed Oct 12 10:57:03 1994
--- gdbtypes.h	Wed Oct 12 11:30:09 1994
***************
*** 117,132 ****
--- 117,164 ----
  
    /* Boolean type.  0 is false, 1 is true, and other values are non-boolean
       (e.g. FORTRAN "logical" used as unsigned int).  */
    TYPE_CODE_BOOL,
  
+   /* Modula-3 */
+   TYPE_CODE_M3_first,
+   TYPE_CODE_M3_ARRAY,
+   TYPE_CODE_M3_OPEN_ARRAY,
+   TYPE_CODE_M3_ENUM,
+   TYPE_CODE_M3_PACKED,
+   TYPE_CODE_M3_RECORD,
+   TYPE_CODE_M3_OBJECT,
+   TYPE_CODE_M3_SET,
+   TYPE_CODE_M3_SUBRANGE,
+   TYPE_CODE_M3_POINTER,
+   TYPE_CODE_M3_INDIRECT,
+   TYPE_CODE_M3_PROC,
+   TYPE_CODE_M3_OPAQUE,
+   TYPE_CODE_M3_ADDRESS,
+   TYPE_CODE_M3_BOOLEAN,
+   TYPE_CODE_M3_CHAR,
+   TYPE_CODE_M3_INTEGER,
+   TYPE_CODE_M3_CARDINAL,
+   TYPE_CODE_M3_REFANY,
+   TYPE_CODE_M3_ROOT,
+   TYPE_CODE_M3_UN_ROOT,
+   TYPE_CODE_M3_MUTEX,
+   TYPE_CODE_M3_TEXT,
+   TYPE_CODE_M3_NULL,
+   TYPE_CODE_M3_VOID,
+ 
+   TYPE_CODE_M3_last,
+ 
    /* Fortran */
    TYPE_CODE_COMPLEX,		/* Complex float */
    TYPE_CODE_LITERAL_COMPLEX,	/* */
    TYPE_CODE_LITERAL_STRING	/* */
  };
  
+ #define M3_TYPEP(x) (((int)TYPE_CODE_M3_first < (int) (x)) \
+ 		     && ((int) (x) < (int) (TYPE_CODE_M3_last)))
+ 
  /* For now allow source to use TYPE_CODE_CLASS for C++ classes, as an
     alias for TYPE_CODE_STRUCT.  This is for DWARF, which has a distinct
     "class" attribute.  Perhaps we should actually have a separate TYPE_CODE
     so that we can print "class" or "struct" depending on what the debug
     info said.  It's not clear we should bother.  */
***************
*** 282,291 ****
--- 314,324 ----
  
        /* In a struct or enum type, type of this field.
  	 In a function type, type of this argument.
  	 In an array type, the domain-type of the array.  */
  
+       char m3_uid [9];
        struct type *type;
  
        /* Name of field, value or argument.
  	 NULL for range bounds and array domains.  */
  
***************
*** 325,334 ****
--- 358,374 ----
  	 cplus_struct_default, a default static instance of a struct
  	 cplus_struct_type. */
  
        struct cplus_struct_type *cplus_stuff;
  
+       /* M3 stuff */
+       struct {
+ 	LONGEST a, b, c, d, e;
+ 	char *s;
+ 	LONGEST m3_size; 
+ 	char *unit, *name;
+       } m3_stuff;
      } type_specific;
  };
  
  #define	NULL_TYPE ((struct type *) 0)
  
***************
*** 587,596 ****
--- 627,712 ----
  #define TYPE_FN_FIELD_STUB(thisfn, n) ((thisfn)[n].is_stub)
  #define TYPE_FN_FIELD_FCONTEXT(thisfn, n) ((thisfn)[n].fcontext)
  #define TYPE_FN_FIELD_VOFFSET(thisfn, n) ((thisfn)[n].voffset-2)
  #define TYPE_FN_FIELD_VIRTUAL_P(thisfn, n) ((thisfn)[n].voffset > 1)
  #define TYPE_FN_FIELD_STATIC_P(thisfn, n) ((thisfn)[n].voffset == VOFFSET_STATIC)
+ 
+ /* Modula 3 */
+ 
+ #define TYPE_FIELD_M3_UID(t,n) (TYPE_FIELDS(t)[n].m3_uid)
+ 
+ #define TYPE_M3_FIELD_TYPE(t,n) \
+   (TYPE_FIELD_TYPE (t, n) \
+     ? TYPE_FIELD_TYPE (t, n) \
+     : (TYPE_FIELD_TYPE (t, n) = m3_resolve_type (TYPE_FIELD_M3_UID (t,n))))
+ 
+ extern struct type *m3_resolve_type PARAMS ((char *));
+ 
+ #define TYPE_M3_UNIT(t)                 TYPE_M3_STUFF(t).unit
+ #define TYPE_M3_NAME(t)                 TYPE_M3_STUFF(t).name
+ 
+ #define TYPE_M3_SIZE(t)                 TYPE_M3_STUFF(t).m3_size
+ #define TYPE_M3_STUFF(t)                (t)->type_specific.m3_stuff
+ 
+ #define TYPE_M3_TARGET(t)               TYPE_M3_FIELD_TYPE(t,0)
+ 
+ 
+ #define TYPE_M3_ARRAY_INDEX(t)          TYPE_M3_FIELD_TYPE(t,0)
+ #define TYPE_M3_ARRAY_ELEM(t)           TYPE_M3_FIELD_TYPE(t,1)
+ 
+ #define TYPE_M3_OPEN_ARRAY_ELEM(t)      TYPE_M3_FIELD_TYPE(t,0)
+ 
+ #define TYPE_M3_ENUM_NVALS(t)           TYPE_NFIELDS(t)
+ #define TYPE_M3_ENUM_VALNAME(t,n)       TYPE_FIELD_NAME(t,n)
+ 
+ #define TYPE_M3_PACKED_TARGET(t)        TYPE_M3_FIELD_TYPE(t,0)
+ 
+ #define TYPE_M3_REC_NFIELDS(t)          TYPE_NFIELDS(t)
+ #define TYPE_M3_REC_FIELD_NAME(t,n)     TYPE_FIELD_NAME(t,n)
+ #define TYPE_M3_REC_FIELD_TYPE(t,n)     TYPE_M3_FIELD_TYPE(t,n)
+ #define TYPE_M3_REC_FIELD_BITPOS(t,n)   TYPE_FIELD_BITPOS(t,n)
+ #define TYPE_M3_REC_FIELD_BITSIZE(t,n)  TYPE_FIELD_BITSIZE(t,n)
+ 
+ #define TYPE_M3_OBJ_SUPER(t)            TYPE_M3_FIELD_TYPE(t,0)
+ #define TYPE_M3_OBJ_NFIELDS(t)          TYPE_M3_STUFF(t).a
+ #define TYPE_M3_OBJ_FIELD_NAME(t,n)     TYPE_FIELD_NAME(t,1+n+TYPE_M3_OBJ_NMETHODS(t))
+ #define TYPE_M3_OBJ_FIELD_TYPE(t,n)     TYPE_M3_FIELD_TYPE(t,1+n+TYPE_M3_OBJ_NMETHODS(t))
+ #define TYPE_M3_OBJ_FIELD_BITPOS(t,n)   TYPE_FIELD_BITPOS(t,1+n+TYPE_M3_OBJ_NMETHODS(t))
+ #define TYPE_M3_OBJ_FIELD_BITSIZE(t,n)  TYPE_FIELD_BITSIZE(t,1+n+TYPE_M3_OBJ_NMETHODS(t))
+ #define TYPE_M3_OBJ_NMETHODS(t)         TYPE_M3_STUFF(t).b
+ #define TYPE_M3_OBJ_METHOD_NAME(t,n)    TYPE_FIELD_NAME(t,1+n)
+ #define TYPE_M3_OBJ_METHOD_TYPE(t,n)    TYPE_M3_FIELD_TYPE(t,1+n)
+ #define TYPE_M3_OBJ_METHOD_BITPOS(t,n)  TYPE_FIELD_BITPOS(t,1+n)
+ #define TYPE_M3_OBJ_METHOD_BITSIZE(t,n) TYPE_FIELD_BITSIZE(t,1+n)
+ #define TYPE_M3_OBJ_TRACED(t)           TYPE_M3_STUFF(t).c
+ #define TYPE_M3_OBJ_BRANDED(t)          TYPE_M3_STUFF(t).d
+ #define TYPE_M3_OBJ_BRAND(t)            TYPE_M3_STUFF(t).s
+ 
+ #define TYPE_M3_SET_TARGET(t)           TYPE_M3_FIELD_TYPE(t,0)
+ 
+ #define TYPE_M3_SUBRANGE_MIN(t)         TYPE_M3_STUFF(t).a
+ #define TYPE_M3_SUBRANGE_MAX(t)         TYPE_M3_STUFF(t).b
+ #define TYPE_M3_SUBRANGE_TARGET(t)      TYPE_M3_FIELD_TYPE (t,0)
+ 
+ #define TYPE_M3_POINTER_TARGET(t)       TYPE_M3_FIELD_TYPE (t,0)
+ #define TYPE_M3_POINTER_TRACED(t)       TYPE_M3_STUFF(t).a
+ #define TYPE_M3_POINTER_BRANDED(t)      TYPE_M3_STUFF(t).b
+ #define TYPE_M3_POINTER_BRAND(t)        TYPE_M3_STUFF(t).s
+ 
+ #define TYPE_M3_INDIRECT_TARGET(t)      TYPE_M3_FIELD_TYPE (t,0)
+ 
+ #define TYPE_M3_PROC_NARGS(t)           TYPE_M3_STUFF(t).a
+ #define TYPE_M3_PROC_NRAISES(t)         TYPE_M3_STUFF(t).b
+ #define TYPE_M3_PROC_RESTYPE(t)         TYPE_M3_FIELD_TYPE(t,0)
+ #define TYPE_M3_PROC_ARG_NAME(t,n)      TYPE_FIELD_NAME(t,n+1)
+ #define TYPE_M3_PROC_ARG_TYPE(t,n)      TYPE_M3_FIELD_TYPE(t,n+1)
+ #define TYPE_M3_PROC_RAISE_NAME(t,n)    TYPE_FIELD_NAME(t,n+1+TYPE_M3_PROC_NARGS(t))
+ #define TYPE_M3_PROC_RAISE_TYPE(t,n)    TYPE_M3_FIELD_TYPE(t,n+1+TYPE_M3_PROC_NARGS(t))
+ 
+ #define TYPE_M3_OPAQUE_REVEALED(t)      TYPE_M3_FIELD_TYPE (t,0)
+ 
+ #define TYPE_M3_NAME_TYPE(t)            TYPE_M3_FIELD_TYPE (t,0)
  
  extern struct type *builtin_type_void;
  extern struct type *builtin_type_char;
  extern struct type *builtin_type_short;
  extern struct type *builtin_type_int;
*** infrun.c.orig	Wed Oct 12 13:06:27 1994
--- infrun.c	Wed Oct 12 13:07:15 1994
***************
*** 55,65 ****
  sig_print_header PARAMS ((void));
  
  static void
  resume_cleanups PARAMS ((int));
  
! static int
  hook_stop_stub PARAMS ((char *));
  
  /* GET_LONGJMP_TARGET returns the PC at which longjmp() will resume the
     program.  It needs to examine the jmp_buf argument and extract the PC
     from it.  The return value is non-zero on success, zero otherwise. */
--- 55,65 ----
  sig_print_header PARAMS ((void));
  
  static void
  resume_cleanups PARAMS ((int));
  
! static long
  hook_stop_stub PARAMS ((char *));
  
  /* GET_LONGJMP_TARGET returns the PC at which longjmp() will resume the
     program.  It needs to examine the jmp_buf argument and extract the PC
     from it.  The return value is non-zero on success, zero otherwise. */
***************
*** 1548,1558 ****
      }
   done:
    annotate_stopped ();
  }
  
! static int
  hook_stop_stub (cmd)
       char *cmd;
  {
    execute_user_command ((struct cmd_list_element *)cmd, 0);
    return (0);
--- 1548,1558 ----
      }
   done:
    annotate_stopped ();
  }
  
! static long
  hook_stop_stub (cmd)
       char *cmd;
  {
    execute_user_command ((struct cmd_list_element *)cmd, 0);
    return (0);
***************
*** 1879,1895 ****
  struct restore_selected_frame_args {
    FRAME_ADDR frame_address;
    int level;
  };
  
! static int restore_selected_frame PARAMS ((char *));
  
  /* Restore the selected frame.  args is really a struct
     restore_selected_frame_args * (declared as char * for catch_errors)
     telling us what frame to restore.  Returns 1 for success, or 0 for
     failure.  An error message will have been printed on error.  */
! static int
  restore_selected_frame (args)
       char *args;
  {
    struct restore_selected_frame_args *fr =
      (struct restore_selected_frame_args *) args;
--- 1879,1895 ----
  struct restore_selected_frame_args {
    FRAME_ADDR frame_address;
    int level;
  };
  
! static long restore_selected_frame PARAMS ((char *));
  
  /* Restore the selected frame.  args is really a struct
     restore_selected_frame_args * (declared as char * for catch_errors)
     telling us what frame to restore.  Returns 1 for success, or 0 for
     failure.  An error message will have been printed on error.  */
! static long
  restore_selected_frame (args)
       char *args;
  {
    struct restore_selected_frame_args *fr =
      (struct restore_selected_frame_args *) args;
*** language.c.orig	Wed Oct 12 10:57:03 1994
--- language.c	Wed Oct 12 11:30:09 1994
***************
*** 166,175 ****
--- 166,176 ----
      printf_unfiltered ("c                Use the C language\n");
      printf_unfiltered ("c++              Use the C++ language\n");
      printf_unfiltered ("chill            Use the Chill language\n");
      printf_unfiltered ("fortran          Use the Fortran language\n");
      printf_unfiltered ("modula-2         Use the Modula-2 language\n");
+     printf_unfiltered ("m3               Use the Modula-3 language\n"); 
      /* Restore the silly string. */
      set_language(current_language->la_language);
      return;
    }
  
***************
*** 457,466 ****
--- 458,469 ----
     case language_m2:
        /* If we are doing type-checking, l1 should equal l2, so this is
  	 not needed. */
        return l1 > l2 ? VALUE_TYPE(v1) : VALUE_TYPE(v2);
        break;
+    case language_m3:
+       error ("Missing M3 support in function binop_result_check.");/*FIXME*/
     case language_chill:
        error ("Missing Chill support in function binop_result_check.");/*FIXME*/
     }
     abort();
     return (struct type *)0;	/* For lint */
***************
*** 631,640 ****
--- 634,645 ----
  	 (TYPE_CODE(type) != TYPE_CODE_ENUM) ? 0 : 1;
     case language_m2:
        return TYPE_CODE(type) != TYPE_CODE_INT ? 0 : 1;
     case language_chill:
        error ("Missing Chill support in function integral_type.");  /*FIXME*/
+    case language_m3:
+       error ("Missing M3 support in function integral_type.");  /*FIXME*/
     default:
        error ("Language not supported.");
     }
  }
  
***************
*** 660,669 ****
--- 665,675 ----
  {
     switch(current_language->la_language)
     {
     case language_chill:
     case language_m2:
+    case language_m3:
        return TYPE_CODE(type) != TYPE_CODE_CHAR ? 0 : 1;
  
     case language_c:
     case language_cplus:
        return (TYPE_CODE(type) == TYPE_CODE_INT) &&
***************
*** 681,690 ****
--- 687,697 ----
  {
     switch(current_language->la_language)
     {
     case language_chill:
     case language_m2:
+    case language_m3:
        return TYPE_CODE(type) != TYPE_CODE_STRING ? 0 : 1;
  
     case language_c:
     case language_cplus:
        /* C does not have distinct string type. */
***************
*** 748,757 ****
--- 755,766 ----
        return (TYPE_CODE(type) == TYPE_CODE_STRUCT) ||
  	 (TYPE_CODE(type) == TYPE_CODE_SET) ||
  	    (TYPE_CODE(type) == TYPE_CODE_ARRAY);
     case language_chill:
        error ("Missing Chill support in function structured_type.");  /*FIXME*/
+    case language_m3:
+       error ("Missing M3 support in function structured_type.");  /*FIXME*/
     default:
        return (0);
     }
  }
  
***************
*** 937,946 ****
--- 946,964 ----
  #endif
  
  #ifdef _LANG_chill
         case language_chill:
  	 error ("Missing Chill support in function binop_type_check.");/*FIXME*/
+ #endif
+ 
+ #ifdef _LANG_m3
+        case language_m3:
+ 	 type = VALUE_TYPE (val);
+ 	 if (TYPE_CODE (type) != TYPE_CODE_M3_BOOLEAN)
+ 	   return 0;			/* Not a BOOLEAN at all */
+ 	 v = m3_unpack_int2 (val);
+ 	 return (v != 0); 
  #endif
  
        }
     }
  }
*** language.h.orig	Wed Oct 12 10:57:03 1994
--- language.h	Wed Oct 12 11:30:09 1994
***************
*** 33,42 ****
--- 33,43 ----
  /* #include "lang_def.h" */
  #define	_LANG_c
  #define	_LANG_m2
  #define	_LANG_chill
  #define _LANG_fortran
+ #define _LANG_m3
  
  #define MAX_FORTRAN_DIMS  7   /* Maximum number of F77 array dims */ 
  
  /* range_mode ==
     range_mode_auto:   range_check set automatically to default of language.
*** m3-exp.c.orig	Wed Oct 12 10:57:03 1994
--- m3-exp.c	Wed Oct 12 11:30:09 1994
***************
*** 0 ****
--- 1,857 ----
+ #include "defs.h"
+ #include "expression.h"
+ #include "parser-defs.h"
+ #include "value.h"
+ #include "language.h"
+ #include "m3-lang.h"
+ #include "gdbtypes.h"
+ 
+ #define TK_EOF                   '\000'
+ #define TK_IDENT                 '0'
+ #define TK_INT                   '1'
+ #define TK_LE                    '2'
+ #define TK_GE                    '3'
+ #define TK_WRONG                 '4'
+ #define TK_LIKE_FIRST            '5'
+ #define TK_GDB_HISTORY           '6'
+ #define TK_REGISTER              '7'
+ #define TK_GDB_VAR               '8'
+ #define TK_ASSIGN                '9'
+ 
+ #define TK_ABS                   'a'
+ #define TK_ADR		         'b'
+ #define TK_ADRSIZE		 'c'
+ #define TK_AND		         'd'
+ #define TK_ARRAY		 'e'
+ #define TK_BITSIZE		 'f'
+ #define TK_BYTESIZE	         'g'
+ #define TK_CEILING		 'h'
+ #define TK_DIV		         'i'
+ #define TK_EXTENDED    	         'j'
+ #define TK_FALSE		 'k'
+ #define TK_FLOAT		 'm'
+ #define TK_FLOOR		 'n'
+ #define TK_IN		         'o'
+ #define TK_INTEGER		 'p'
+ #define TK_ISTYPE		 'q'
+ #define TK_LONGREAL	         's'
+ #define TK_LOOPHOLE	         't'
+ #define TK_MAX		         'u'
+ #define TK_MIN		         'v'
+ #define TK_MOD		         'w'
+ #define TK_NARROW		 'x'
+ #define TK_NEW		         'y'
+ #define TK_NIL		         'z'
+ #define TK_NOT		         'A'
+ #define TK_OR		         'C'
+ #define TK_ORD		         'D'
+ #define TK_SUBARRAY	         'E'
+ #define TK_TRUE		         'F'
+ #define TK_TRUNC		 'G'
+ #define TK_TYPECODE	         'H'
+ #define TK_VAL		         'I'
+ #define TK_ROUND                 'J'
+ 
+ static struct {
+   char kind;
+   enum exp_opcode op;
+   char *string;
+   int length;
+   LONGEST intval;
+   } cur_tok;
+ 
+ extern char* lexptr;
+ 
+ struct reserved {char *name; char kind; enum exp_opcode op; };
+ static struct reserved reserved [] = {
+   {"ABS",	    TK_ABS},              
+   {"ADDRESS",	    TK_WRONG},            
+   {"ADR",	    TK_LIKE_FIRST,       UNOP_M3_ADR},              
+   {"ADRSIZE",	    TK_ADRSIZE},          
+   {"AND",	    TK_AND},              
+   {"ANY",	    TK_WRONG},              
+   {"ARRAY",	    TK_ARRAY},            
+   {"AS",	    TK_WRONG},               
+   {"BEGIN",	    TK_WRONG},            
+   {"BITS",	    TK_WRONG},             
+   {"BITSIZE",	    TK_BITSIZE},          
+   {"BOOLEAN",	    TK_WRONG},            
+   {"BRANDED",	    TK_WRONG},            
+   {"BY",	    TK_WRONG},               
+   {"BYTESIZE",      TK_BYTESIZE},         
+   {"CARDINAL",      TK_WRONG},            
+   {"CASE",	    TK_WRONG},             
+   {"CEILING",	    TK_CEILING},          
+   {"CHAR",	    TK_WRONG},             
+   {"CONST",	    TK_WRONG},            
+   {"DEC",	    TK_WRONG},              
+   {"DISPOSE",	    TK_WRONG},            
+   {"DIV",	    TK_DIV},              
+   {"DO",	    TK_WRONG},               
+   {"ELSE",	    TK_WRONG},             
+   {"ELSIF",	    TK_WRONG},            
+   {"END",	    TK_WRONG},              
+   {"EVAL",	    TK_WRONG},             
+   {"EXCEPT",	    TK_WRONG},            
+   {"EXCEPTION",     TK_WRONG},            
+   {"EXIT",	    TK_WRONG},             
+   {"EXPORTS",	    TK_WRONG},            
+   {"EXTENDED",      TK_EXTENDED},         
+   {"FALSE",	    TK_FALSE},            
+   {"FINALLY",	    TK_WRONG},            
+   {"FIRST",	    TK_LIKE_FIRST,       UNOP_M3_FIRST},            
+   {"FLOAT",	    TK_FLOAT},            
+   {"FLOOR",	    TK_FLOOR},            
+   {"FOR",	    TK_WRONG},              
+   {"FROM",	    TK_WRONG},             
+   {"GENERIC",	    TK_WRONG},            
+   {"IF",	    TK_WRONG},               
+   {"IMPORT",	    TK_WRONG},            
+   {"IN",	    TK_IN},               
+   {"INC",	    TK_WRONG},              
+   {"INTEGER",	    TK_INTEGER},          
+   {"INTERFACE",     TK_WRONG},            
+   {"ISTYPE",	    TK_ISTYPE},           
+   {"LAST",	    TK_LIKE_FIRST,      UNOP_M3_LAST},             
+   {"LOCK",	    TK_WRONG},             
+   {"LONGREAL",      TK_LONGREAL},         
+   {"LOOP",	    TK_WRONG},             
+   {"LOOPHOLE",      TK_LOOPHOLE},         
+   {"METHODS",	    TK_WRONG},            
+   {"MAX",	    TK_MAX},              
+   {"MIN",	    TK_MIN},              
+   {"MOD",	    TK_MOD},              
+   {"MODULE",	    TK_WRONG},            
+   {"MUTEX",	    TK_WRONG},            
+   {"NARROW",	    TK_NARROW},           
+   {"NEW",	    TK_NEW},              
+   {"NIL",	    TK_NIL},              
+   {"NOT",	    TK_NOT},              
+   {"NULL",	    TK_WRONG},             
+   {"NUMBER",	    TK_LIKE_FIRST,      UNOP_M3_NUMBER},             
+   {"OBJECT",	    TK_WRONG},            
+   {"OF",	    TK_WRONG},               
+   {"OR",	    TK_OR},               
+   {"ORD",	    TK_ORD},              
+   {"OVERRIDES",     TK_WRONG},            
+   {"PROCEDURE",     TK_WRONG},            
+   {"RAISE",	    TK_WRONG},            
+   {"RAISES",	    TK_WRONG},            
+   {"READONLY",      TK_WRONG},            
+   {"REAL",	    TK_WRONG},             
+   {"RECORD",	    TK_WRONG},            
+   {"REF",	    TK_WRONG},              
+   {"REFANY",	    TK_WRONG},            
+   {"REPEAT",	    TK_WRONG},            
+   {"RETURN",	    TK_WRONG},            
+   {"REVEAL",	    TK_WRONG},            
+   {"ROOT",	    TK_WRONG},             
+   {"ROUND",	    TK_ROUND},            
+   {"SET",	    TK_WRONG},              
+   {"SUBARRAY",      TK_SUBARRAY},         
+   {"TEXT",	    TK_WRONG},             
+   {"THEN",	    TK_WRONG},             
+   {"TO",	    TK_WRONG},               
+   {"TRUE",	    TK_TRUE},             
+   {"TRUNC",	    TK_TRUNC},            
+   {"TRY",	    TK_WRONG},              
+   {"TYPE",	    TK_WRONG},             
+   {"TYPECASE",      TK_WRONG},            
+   {"TYPECODE",      TK_TYPECODE},         
+   {"UNSAFE",	    TK_WRONG},            
+   {"UNTIL",	    TK_WRONG},            
+   {"UNTRACED",      TK_WRONG},            
+   {"VAL",	    TK_VAL},              
+   {"VALUE",	    TK_WRONG},            
+   {"VAR",	    TK_WRONG},              
+   {"WHILE",	    TK_WRONG},            
+   {"WITH",	    TK_WRONG}};           
+ 
+ static void recognize_reserved_word ()
+ {
+   int low, high, mid, cmp;
+ 
+   low = 0;
+   high = sizeof (reserved) / sizeof (struct reserved);
+ 
+   /* cur_tok.string may be in [low .. high[ */
+ 
+   while (low < high) {
+     mid = (low + high) / 2;
+     cmp = strcmp (reserved [mid].name, cur_tok.string);
+     if (cmp == 0) {
+       cur_tok.kind = reserved [mid].kind; 
+       cur_tok.op   = reserved [mid].op;
+       return; }
+     else if (cmp < 0) {
+       low  = mid + 1; }
+     else {
+       high = mid; }}
+ 
+   cur_tok.kind = TK_IDENT;
+   return; 
+ }
+ 
+ static void write_exp_text (opcode, str, len)
+      enum exp_opcode opcode;
+      char *str;
+      int len;
+ {
+   struct stoken t;
+   
+   write_exp_elt_opcode (opcode); 
+   t.ptr = str;
+   t.length = len;
+   write_exp_string (t);
+   write_exp_elt_opcode (opcode); 
+ }
+ 
+ static void write_exp_var (sym)
+      struct symbol *sym;
+ {
+   write_exp_elt_opcode (OP_VAR_VALUE);
+   write_exp_elt_block (block_found);
+   write_exp_elt_sym (sym);
+   write_exp_elt_opcode (OP_VAR_VALUE);
+ }
+ 
+ static void get_token ()
+ {
+   char *tokstart;
+   while (*lexptr == ' ' || *lexptr == '\t') {
+     lexptr++; }
+ 
+   switch (*(tokstart = lexptr))
+     {
+     case '\000':
+       cur_tok.kind = TK_EOF;
+       return;
+ 
+     case '$': {
+       int negate = 1;
+       tokstart++;
+       lexptr++;
+       switch (*lexptr)
+ 	{
+ 	case '$':
+ 	  tokstart++;
+ 	  lexptr++;
+ 	  negate = -1;
+ 	  /* fall through */
+ 	case '0':
+ 	case '1':
+ 	case '2':
+ 	case '3':
+ 	case '4':
+ 	case '5':
+ 	case '6':
+ 	case '7':
+ 	case '8':
+ 	case '9':
+ 	  while ('0' <= *lexptr && *lexptr <= '9') {
+ 	    lexptr++; }
+ 	  cur_tok.kind = TK_GDB_HISTORY;
+ 	  cur_tok.intval = ((lexptr == tokstart) ? 1 : atoi (tokstart))
+ 	                    * negate;
+ 	  return; 
+ 	  
+ 	default: {
+ 	  int len, c;
+ 	  lexptr = tokstart;
+ 	  while (('a' <= *lexptr && *lexptr <= 'z')
+ 		 || ('A' <= *lexptr && *lexptr <= 'Z')
+ 		 || ('0' <= *lexptr && *lexptr <= '9')
+ 		 || *lexptr == '_') {
+ 	    lexptr++; }
+ 	  len = lexptr - tokstart;
+ 	  if (len == 0) {
+ 	    cur_tok.kind = TK_GDB_HISTORY;
+ 	    cur_tok.intval = 0;
+ 	    return; }
+ 
+ 	  for (c = 0; c < NUM_REGS; c++) {
+ 	    if (len == strlen (reg_names [c])
+ 		&& STREQN (tokstart, reg_names[c], len)) {
+ 	      cur_tok.kind = TK_REGISTER;
+ 	      cur_tok.intval = c;
+ 	      return; }}
+ 
+ 	  for (c = 0; c < num_std_regs; c++) {
+ 	    if (len == strlen (std_regs [c].name)
+ 		&& STREQN (tokstart, std_regs[c].name, len)) {
+ 	      cur_tok.kind = TK_REGISTER;
+ 	      cur_tok.intval = std_regs[c].regnum; 
+ 	      return; }}
+ 
+ 	  cur_tok.kind = TK_GDB_VAR;
+ 	  cur_tok.string = (char *) malloc (lexptr - tokstart + 1);
+ 	  strncpy (cur_tok.string, tokstart, lexptr - tokstart);
+ 	  cur_tok.string [lexptr - tokstart] = '\0';
+ 	  cur_tok.length = lexptr - tokstart;
+ 	  return; }}}
+ 
+     case '<': {
+       if (*(tokstart + 1) == '=') {
+ 	cur_tok.kind = TK_LE;
+ 	lexptr = tokstart + 2; }
+       else {
+ 	cur_tok.kind = '<';
+ 	lexptr = tokstart + 1; }
+       return; }
+ 
+     case '>': {
+       if (*(tokstart + 1) == '=') {
+ 	cur_tok.kind = TK_GE;
+ 	lexptr = tokstart + 2; }
+       else {
+ 	cur_tok.kind = '>';
+ 	lexptr = tokstart + 1; }
+       return; }
+ 
+     case ':': {
+       if (*(tokstart + 1) == '=') {
+ 	cur_tok.kind = TK_ASSIGN;
+ 	lexptr = tokstart + 2; }
+       else {
+ 	cur_tok.kind = ':';
+ 	lexptr = tokstart + 1; }
+       return; }
+ 
+     case '=':
+     case '#':
+     case '&':
+     case '+':
+     case '-':
+     case '*':
+     case '/':
+     case '.':
+     case ',':
+     case '^': 
+     case '(':
+     case ')':
+     case '[': 
+     case ']': {
+       cur_tok.kind = *tokstart;
+       lexptr = tokstart + 1;
+       return; }
+ 
+     case '0':
+     case '1':
+     case '2':
+     case '3':
+     case '4':
+     case '5':
+     case '6':
+     case '7':
+     case '8':
+     case '9': {
+       char *c;
+       c = tokstart + 1;
+       while ('0' <= *c && *c <= '9') {
+ 	c++; }
+       cur_tok.kind = TK_INT;
+       sscanf (tokstart, "%ld", &cur_tok.intval);
+       if ((*c == '_') && (cur_tok.intval >= 2) && (cur_tok.intval <= 16)) {
+ 	LONGEST base = cur_tok.intval;
+ 	LONGEST digit;
+ 	LONGEST val = 0;
+ 	c++;
+ 	while (1) {
+ 	  if ('0' <= *c && *c <= '9') {
+ 	    digit = *c - '0'; }
+ 	  else if ('A' <= *c && *c <= 'F') {
+ 	    digit = *c - 'A' + 10; }
+ 	  else if ('a' <= *c && *c <= 'f') {
+ 	    digit = *c - 'a' + 10; }
+ 	  else {
+ 	    break; }
+ 	  if (digit >= base) {
+ 	    break; }
+ 	  val = val * base + digit;
+ 	  c++; }
+ 	cur_tok.intval = val; }
+       lexptr = c;
+       return; }
+ 
+     case '_':
+     case 'A':
+     case 'B':
+     case 'C':
+     case 'D':
+     case 'E':
+     case 'F':
+     case 'G':
+     case 'H':
+     case 'I':
+     case 'J':
+     case 'K':
+     case 'L':
+     case 'M':
+     case 'N':
+     case 'O':
+     case 'P':
+     case 'Q':
+     case 'R':
+     case 'S':
+     case 'T':
+     case 'U':
+     case 'V':
+     case 'W':
+     case 'X':
+     case 'Y':
+     case 'Z':
+     case 'a':
+     case 'b':
+     case 'c':
+     case 'd':
+     case 'e':
+     case 'f':
+     case 'g':
+     case 'h':
+     case 'i':
+     case 'j':
+     case 'k':
+     case 'l':
+     case 'm':
+     case 'n':
+     case 'o':
+     case 'p':
+     case 'q':
+     case 'r':
+     case 's':
+     case 't':
+     case 'u':
+     case 'v':
+     case 'w':
+     case 'x':
+     case 'y':
+     case 'z': {
+       lexptr = tokstart + 1;
+       while (   ('a' <= *lexptr && *lexptr <= 'z')
+ 	     || ('A' <= *lexptr && *lexptr <= 'Z')
+ 	     || ('0' <= *lexptr && *lexptr <= '9') 
+ 	     || (*lexptr == '_')) {
+ 	lexptr++; }
+       cur_tok.string = (char *) malloc (lexptr - tokstart + 1);
+       strncpy (cur_tok.string, tokstart, lexptr - tokstart);
+       cur_tok.string [lexptr - tokstart] = '\0';
+       cur_tok.length = lexptr - tokstart;
+       
+       recognize_reserved_word ();
+       return; }
+ 
+     default: {
+       error ("can't recognize start of token: %s", lexptr); }}
+ }
+ 
+ static int m3_parse_expr ();
+ 
+ static int m3_parse_e7 ()
+ {
+   switch (cur_tok.kind)
+     {
+     case TK_GDB_HISTORY:
+       write_exp_elt_opcode (OP_LAST);
+       write_exp_elt_longcst ((LONGEST) cur_tok.intval);
+       write_exp_elt_opcode (OP_LAST);
+       get_token ();
+       break; 
+ 
+     case TK_GDB_VAR: 
+       write_exp_elt_opcode (OP_INTERNALVAR);
+       write_exp_elt_intern (lookup_internalvar (cur_tok.string));
+       write_exp_elt_opcode (OP_INTERNALVAR);
+       get_token ();
+       break;
+ 
+     case TK_REGISTER:
+       write_exp_elt_opcode (OP_REGISTER);
+       write_exp_elt_longcst ((LONGEST) cur_tok.intval);
+       write_exp_elt_opcode (OP_REGISTER);
+       get_token ();
+       break;
+       
+     case TK_INT:
+       write_exp_elt_opcode (OP_M3_LONG);
+       write_exp_elt_type (builtin_type_m3_integer);
+       write_exp_elt_longcst ((LONGEST)(cur_tok.intval));
+       write_exp_elt_opcode (OP_M3_LONG); 
+       get_token ();
+       break; 
+ 
+ #if 0
+     case CHAR: EnumExpr;
+     case TEXT: TextExpr;
+     case REAL: ReelExpr;
+ #endif
+ 
+     case TK_TRUE:
+       write_exp_elt_opcode (OP_M3_LONG);
+       write_exp_elt_type (builtin_type_m3_boolean);
+       write_exp_elt_longcst ((LONGEST)(1));
+       write_exp_elt_opcode (OP_M3_LONG); 
+       get_token ();
+       break; 
+ 
+     case TK_FALSE:
+       write_exp_elt_opcode (OP_M3_LONG);
+       write_exp_elt_type (builtin_type_m3_boolean);
+       write_exp_elt_longcst ((LONGEST)(0));
+       write_exp_elt_opcode (OP_M3_LONG); 
+       get_token ();
+       break;
+ 
+     case '(': 
+       get_token ();
+       m3_parse_expr ();
+       if (cur_tok.kind != ')') {
+ 	error ("missing closing )"); }
+       get_token ();
+       break;
+ 
+     case TK_LIKE_FIRST: {
+       int this_op = cur_tok.op;
+       get_token ();
+       if (cur_tok.kind != '(') {
+ 	error ("missing opening ("); }
+       get_token ();
+       m3_parse_expr ();
+       if (cur_tok.kind != ')') {
+ 	error ("missing closing )"); }
+       get_token ();
+       write_exp_elt_opcode (this_op); 
+       return 0; }
+ 
+     case TK_IDENT: {
+       struct symbol *sym;
+       struct type *interfaces;
+       struct block *b;
+       char *current_unit_name = 0;
+       int i;
+ 
+       /* Rule 1a: is it local symbol ? */
+      if ((sym = lookup_symbol (cur_tok.string, expression_context_block,
+ 				VAR_NAMESPACE, 0, NULL)) != 0
+ 	  && sym->class != LOC_STATIC) {
+ 	write_exp_var (sym);
+ 	goto ident_ok; }
+ 
+       /* Rule 1b: could it be a global name in the current unit ?
+ 	 these are accessible only through the interface record,
+ 	 which happens to be the only symbol in the topmost block. */
+       b = expression_context_block;
+       while (b && BLOCK_SUPERBLOCK (b)) {
+ 	b = BLOCK_SUPERBLOCK (b); }
+       if (b) {
+ 	sym = BLOCK_SYM (b, 0);
+ 	current_unit_name = SYMBOL_NAME (sym) + 3;
+ 
+ 	if (find_m3_rec_field (SYMBOL_TYPE (sym), cur_tok.string, 0, 0, 0)) {
+ 	  write_exp_var (sym);
+ 	  write_exp_text (STRUCTOP_M3_STRUCT, cur_tok.string, cur_tok.length);
+ 	  goto ident_ok; }}
+ 	
+       /* Rule 1c: could it be a global name in one of the interfaces
+          exported by the current unit ? */
+       b = expression_context_block;
+       while (b && BLOCK_SUPERBLOCK (b) 
+ 	     && BLOCK_SUPERBLOCK (BLOCK_SUPERBLOCK (b))) {
+ 	b = BLOCK_SUPERBLOCK (b); }
+       if (b && BLOCK_SUPERBLOCK (b)) {
+ 	if (interfaces = find_m3_exported_interfaces (current_unit_name)) {
+ 	  for (i = 0; i < TYPE_NFIELDS (interfaces); i++) {
+ 	    if (sym = find_m3_ir ('I', TYPE_FIELD_NAME (interfaces, i))) {
+ 	      if (find_m3_rec_field (SYMBOL_TYPE (sym), 
+ 				     cur_tok.string, 0, 0, 0)) {
+ 		write_exp_var (sym);
+ 		write_exp_text (STRUCTOP_M3_STRUCT, 
+ 				cur_tok.string, cur_tok.length);
+ 		goto ident_ok; }}}}
+ 	else {
+ 	  if (sym = find_m3_ir ('I', current_unit_name)) {
+ 	    if (find_m3_rec_field (SYMBOL_TYPE (sym),
+ 				   cur_tok.string, 0, 0, 0)) {
+ 	      write_exp_var (sym);
+ 	      write_exp_text (STRUCTOP_M3_STRUCT,
+ 			      cur_tok.string, cur_tok.length);
+ 	      goto ident_ok; }}}}
+ 	    
+       /* Rule 2 and 3 really need to have ".entity" after them, and
+ 	 we need to know entity to resolve rule 2 properly (an entity
+ 	 in an exported interface does not show up in the module 
+ 	 interface record), so we may as well get it now. */
+ 
+       { char *compilation_unit_name = cur_tok.string;
+ 	struct symtab *symtab;
+ 
+ 	get_token ();
+ 	if (cur_tok.kind != '.') {
+ 	  error ("malformed expression");
+ 	  return 1; }
+ 	get_token ();
+ 	if (cur_tok.kind != TK_IDENT) {
+ 	  error ("malformed expression");
+ 	  return 1; }
+ 
+ 	/* Rule 2: could this be the name of a module ? */
+ 	if (sym = find_m3_ir ('M', compilation_unit_name)) {
+ 	  if (find_m3_rec_field (SYMBOL_TYPE (sym), 
+ 				 cur_tok.string, 0, 0, 0)) {
+ 	    write_exp_var (sym);
+ 	    write_exp_text (STRUCTOP_M3_MODULE, 
+ 			    cur_tok.string, cur_tok.length); 
+ 	    goto ident_ok; }
+ 
+ 	  /* may be it is in one of the interfaces exported by that module */
+ 	  if (current_unit_name
+ 	      && (interfaces = find_m3_exported_interfaces (current_unit_name))) {
+ 	    for (i = 0; i < TYPE_NFIELDS (interfaces); i++) {
+ 	      if (sym = find_m3_ir ('I', TYPE_FIELD_NAME (interfaces, i))) {
+ 		if (find_m3_rec_field (SYMBOL_TYPE (sym), 
+ 				       cur_tok.string, 0, 0, 0)) {
+ 		  write_exp_var (sym);
+ 		  write_exp_text (STRUCTOP_M3_STRUCT, 
+ 				  cur_tok.string, cur_tok.length);
+ 		  goto ident_ok; }}}}
+ 	  else {
+ 	    if (sym = find_m3_ir ('I', current_unit_name)) {
+ 	      if (find_m3_rec_field (SYMBOL_TYPE (sym),
+ 				     cur_tok.string, 0, 0, 0)) {
+ 		write_exp_var (sym);
+ 		write_exp_text (STRUCTOP_M3_STRUCT,
+ 				cur_tok.string, cur_tok.length);
+ 		goto ident_ok; }}}}
+ 
+ 	/* Rule 3: could this be the name of an interface ? */
+ 	if (sym = find_m3_ir ('I', compilation_unit_name)) {
+ 	  if (find_m3_rec_field (SYMBOL_TYPE (sym), cur_tok.string, 
+ 				 0, 0, 0)) {
+ 	    write_exp_var (sym);
+ 	    write_exp_text (STRUCTOP_M3_INTERFACE, 
+ 			    cur_tok.string, cur_tok.length); 
+ 	    goto ident_ok; }}}
+ 
+       /* out of ideas */
+       error ("can't find identifier: %s", cur_tok.string);
+ 
+     ident_ok:
+       get_token ();
+       break; }
+       
+     default: 
+       error ("what is this expression ?" ); }
+   
+   while (1) {
+     switch (cur_tok.kind)
+       {
+       case '^': 
+ 	write_exp_elt_opcode (UNOP_M3_IND);
+ 	get_token ();
+ 	break;
+ 
+       case '.': {
+ 	get_token ();
+ 	/* we cannot ascertain what the type what we have parsed
+ 	   so far is; it may be an object and we need the dynamic type.
+ 	   So we are just going to accept anything that looks ok. */
+ 
+ 	if (cur_tok.kind != TK_IDENT) {
+ 	  error ("Field name must be an identifier"); 
+ 	  return 1; }
+ 
+ 	write_exp_text (STRUCTOP_M3_STRUCT, cur_tok.string, cur_tok.length);
+ 	get_token ();
+ 	break; }
+ 
+       case '(': {
+ 	extern int arglist_len;
+ 	arglist_len = 0;
+ 	cur_tok.kind = ',';
+ 	start_arglist ();
+         while (cur_tok.kind == ',') {
+ 	  get_token ();
+ 	  m3_parse_expr ();
+ 	  arglist_len++; }
+ 	if (cur_tok.kind != ')') { 
+ 	  error ("missing ')'"); }
+ 	get_token ();
+         write_exp_elt_opcode (OP_FUNCALL);
+ 	write_exp_elt_longcst ((LONGEST) end_arglist ());
+ 	write_exp_elt_opcode (OP_FUNCALL);
+ 	break; }
+ 	
+       case '[': {
+ 	struct type *array_type;
+ 	cur_tok.kind = ',';
+ 	while (cur_tok.kind == ',') {
+ 	  get_token ();
+ 	  m3_parse_expr ();
+ 	  write_exp_elt_opcode (BINOP_M3_SUBSCRIPT); }
+ 	
+ 	if (cur_tok.kind != ']') {
+ 	  error ("missing ']'");  }
+ 	get_token ();
+ 	break; }
+ 
+       case TK_EOF:
+       default:
+ 	return 0; }}
+ }
+ 
+ 
+ static int m3_parse_e6 ()
+ {
+   int m = 0;
+ 
+   while (cur_tok.kind == '+' || cur_tok.kind == '-') {
+     if (cur_tok.kind == '-') {
+       m++; }
+     get_token (); }
+ 
+   if (m3_parse_e7 ()) {
+     return 1; }
+   if (m % 2 == 1) {
+     write_exp_elt_opcode (UNOP_M3_NEG); }
+   return 0;
+ }
+ 
+ static int m3_parse_e5 ()
+ {
+   if (m3_parse_e6 ()) {
+     return 1; }
+   while (1) {
+     switch (cur_tok.kind) 
+       {
+       case '*': 
+ 	get_token ();
+ 	if (m3_parse_e6 ()) {return 1;}
+ 	write_exp_elt_opcode (BINOP_M3_MULT);
+ 	break;
+       case '/':
+ 	get_token ();
+ 	if (m3_parse_e6 ()) {return 1;}
+ 	write_exp_elt_opcode (BINOP_M3_DIVIDE);
+ 	break; 
+       case TK_DIV:
+ 	get_token ();
+ 	if (m3_parse_e6 ()) {return 1;}
+ 	write_exp_elt_opcode (BINOP_M3_DIV);
+ 	break;
+       case TK_MOD:
+ 	get_token ();
+ 	if (m3_parse_e6 ()) {return 1;}
+ 	write_exp_elt_opcode (BINOP_M3_MOD);
+ 	break;
+       default:
+ 	return 0; }}
+ }
+ 
+ static int m3_parse_e4 ()
+ {
+   if (m3_parse_e5 ()) {
+     return 1; }
+   while (1) {
+     switch (cur_tok.kind) 
+       {
+       case '+': 
+ 	get_token ();
+ 	if (m3_parse_e5 ()) {return 1;}
+ 	write_exp_elt_opcode (BINOP_M3_ADD);
+ 	break;
+       case '-':
+ 	get_token ();
+ 	if (m3_parse_e5 ()) {return 1;}
+ 	write_exp_elt_opcode (BINOP_M3_MINUS);
+ 	break; 
+       case '&':
+ 	get_token ();
+ 	if (m3_parse_e5 ()) {return 1;}
+ 	write_exp_elt_opcode (BINOP_M3_CAT);
+ 	break; 
+       default:
+ 	return 0; }}
+ }
+ 
+ static int m3_parse_e3 ()
+ {
+   enum exp_opcode op;
+ 
+   if (m3_parse_e4 ()) {
+     return 1; }
+   while (1) {
+     switch (cur_tok.kind) 
+       {
+       case '=':   op = BINOP_M3_EQUAL; goto other_arg;
+       case '#':   op = BINOP_M3_NE;    goto other_arg;
+       case '<':   op = BINOP_M3_LT;    goto other_arg;
+       case TK_LE: op = BINOP_M3_LE;    goto other_arg;
+       case '>':   op = BINOP_M3_GT;    goto other_arg;
+       case TK_GE: op = BINOP_M3_GE;    goto other_arg;
+       case TK_IN: op = BINOP_M3_IN;    goto other_arg;
+ 
+       other_arg:
+ 	get_token ();
+ 	if (m3_parse_e4 ()) { return (1);}
+ 	write_exp_elt_opcode (op);
+ 	break; 
+ 
+       default:
+ 	return 0; }}
+ }
+ 
+ static int m3_parse_e2 ()
+ {
+   int n = 0;
+ 
+   while (cur_tok.kind == TK_NOT) {
+     n++; 
+     get_token (); }
+ 
+   if (m3_parse_e3 ()) {
+     return 1; }
+   if (n % 2 == 1) {
+     write_exp_elt_opcode (UNOP_M3_NOT); }
+   return 0;
+ }
+ 
+ static int m3_parse_e1 ()
+ {
+   if (m3_parse_e2 ()) {
+     return 1; }
+   while (cur_tok.kind == TK_AND) {
+     get_token ();
+     if (m3_parse_e2 ()) { 
+       return 1; }
+     write_exp_elt_opcode (BINOP_M3_AND); }
+   return 0; 
+ }
+ 
+ static int m3_parse_e0 ()
+ {
+   if (m3_parse_e1 ()) {
+     return 1; }
+   while (cur_tok.kind == TK_OR) {
+     get_token ();
+     if (m3_parse_e1 ()) { 
+       return 1; }
+     write_exp_elt_opcode (BINOP_M3_OR); }
+   return 0; 
+ }
+ 
+ static int m3_parse_expr ()
+ {
+   int lhs = 0, rhs = 0;
+   lhs = m3_parse_e0 ();
+   if (cur_tok.kind == TK_ASSIGN) {
+     get_token ();
+     rhs = m3_parse_e0 ();
+     write_exp_elt_opcode (BINOP_ASSIGN); }
+   write_exp_elt_opcode (M3_FINAL_TYPE);
+   return ((lhs + rhs) != 0);
+ }
+ 
+ int m3_parse ()
+ {
+   get_token ();
+   return m3_parse_expr ();
+ }
*** m3-lang.c.orig	Wed Oct 12 10:57:03 1994
--- m3-lang.c	Wed Oct 12 13:03:08 1994
***************
*** 0 ****
--- 1,1383 ----
+ /* M3 language support routines for GDB, the GNU debugger.
+    Copyright 1992, 1993 Free Software Foundation, Inc.
+ 
+ This file is part of GDB.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ #include "defs.h"
+ #include "symtab.h"
+ #include "gdbtypes.h"
+ #include "expression.h"
+ #include "parser-defs.h"
+ #include "language.h"
+ #include "value.h"
+ #include "m3-lang.h"
+ #include "frame.h"
+ #include "target.h"
+ 
+ /* Print the character C on STREAM as part of the contents of a literal
+    string whose delimiter is QUOTER.  Note that that format for printing
+    characters and strings is language specific. */
+ 
+ static void
+ emit_char (c, stream, quoter)
+      register int c;
+      FILE *stream;
+      int quoter;
+ {
+ 
+   c &= 0xFF;			/* Avoid sign bit follies */
+ 
+   if (PRINT_LITERAL_FORM (c))
+     {
+       if (c == '\\' || c == quoter)
+ 	{
+ 	  fputs_filtered ("\\", stream);
+ 	}
+       fprintf_filtered (stream, "%c", c);
+     }
+   else
+     {
+       switch (c)
+ 	{
+ 	case '\n':
+ 	  fputs_filtered ("\\n", stream);
+ 	  break;
+ 	case '\b':
+ 	  fputs_filtered ("\\b", stream);
+ 	  break;
+ 	case '\t':
+ 	  fputs_filtered ("\\t", stream);
+ 	  break;
+ 	case '\f':
+ 	  fputs_filtered ("\\f", stream);
+ 	  break;
+ 	case '\r':
+ 	  fputs_filtered ("\\r", stream);
+ 	  break;
+ 	case '\033':
+ 	  fputs_filtered ("\\e", stream);
+ 	  break;
+ 	case '\007':
+ 	  fputs_filtered ("\\a", stream);
+ 	  break;
+ 	default:
+ 	  fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
+ 	  break;
+ 	}
+     }
+ }
+ 
+ void
+ m3_printchar (c, stream)
+      int c;
+      FILE *stream;
+ {
+   fputs_filtered ("'", stream);
+   emit_char (c, stream, '\'');
+   fputs_filtered ("'", stream);
+ }
+ 
+ /* Print the character string STRING, printing at most LENGTH characters.
+    Printing stops early if the number hits print_max; repeat counts
+    are printed as appropriate.  Print ellipses at the end if we
+    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.  */
+ 
+ static void
+ m3_printstr (stream, string, length, force_ellipses)
+      FILE *stream;
+      char *string;
+      unsigned int length;
+      int force_ellipses;
+ {
+   register unsigned int i;
+   unsigned int things_printed = 0;
+   int in_quotes = 0;
+   int need_comma = 0;
+   extern int inspect_it;
+   extern int repeat_count_threshold;
+   extern int print_max;
+ 
+   /* If the string was not truncated due to `set print elements', and
+      the last byte of it is a null, we don't print that, in traditional C
+      style.  */
+   if ((!force_ellipses) && length > 0 && string[length-1] == '\0')
+     length--;
+ 
+   if (length == 0)
+     {
+       fputs_filtered ("\"\"", stdout);
+       return;
+     }
+ 
+   for (i = 0; i < length && things_printed < print_max; ++i)
+     {
+       /* Position of the character we are examining
+ 	 to see whether it is repeated.  */
+       unsigned int rep1;
+       /* Number of repetitions we have detected so far.  */
+       unsigned int reps;
+ 
+       QUIT;
+ 
+       if (need_comma)
+ 	{
+ 	  fputs_filtered (", ", stream);
+ 	  need_comma = 0;
+ 	}
+ 
+       rep1 = i + 1;
+       reps = 1;
+       while (rep1 < length && string[rep1] == string[i])
+ 	{
+ 	  ++rep1;
+ 	  ++reps;
+ 	}
+ 
+       if (reps > repeat_count_threshold)
+ 	{
+ 	  if (in_quotes)
+ 	    {
+ 	      if (inspect_it)
+ 		fputs_filtered ("\\\", ", stream);
+ 	      else
+ 		fputs_filtered ("\", ", stream);
+ 	      in_quotes = 0;
+ 	    }
+ 	  m3_printchar (string[i], stream);
+ 	  fprintf_filtered (stream, " <repeats %u times>", reps);
+ 	  i = rep1 - 1;
+ 	  things_printed += repeat_count_threshold;
+ 	  need_comma = 1;
+ 	}
+       else
+ 	{
+ 	  if (!in_quotes)
+ 	    {
+ 	      if (inspect_it)
+ 		fputs_filtered ("\\\"", stream);
+ 	      else
+ 		fputs_filtered ("\"", stream);
+ 	      in_quotes = 1;
+ 	    }
+ 	  emit_char (string[i], stream, '"');
+ 	  ++things_printed;
+ 	}
+     }
+ 
+   /* Terminate the quotes if necessary.  */
+   if (in_quotes)
+     {
+       if (inspect_it)
+ 	fputs_filtered ("\\\"", stream);
+       else
+ 	fputs_filtered ("\"", stream);
+     }
+ 
+   if (force_ellipses || i < length)
+     fputs_filtered ("...", stream);
+ }
+ 
+ /* Create a fundamental C type using default reasonable for the current
+    target machine.
+ 
+    Some object/debugging file formats (DWARF version 1, COFF, etc) do not
+    define fundamental types such as "int" or "double".  Others (stabs or
+    DWARF version 2, etc) do define fundamental types.  For the formats which
+    don't provide fundamental types, gdb can create such types using this
+    function.
+ 
+    FIXME:  Some compilers distinguish explicitly signed integral types
+    (signed short, signed int, signed long) from "regular" integral types
+    (short, int, long) in the debugging information.  There is some dis-
+    agreement as to how useful this feature is.  In particular, gcc does
+    not support this.  Also, only some debugging formats allow the
+    distinction to be passed on to a debugger.  For now, we always just
+    use "short", "int", or "long" as the type name, for both the implicit
+    and explicitly signed types.  This also makes life easier for the
+    gdb test suite since we don't have to account for the differences
+    in output depending upon what the compiler and debugging format
+    support.  We will probably have to re-examine the issue when gdb
+    starts taking it's fundamental type information directly from the
+    debugging information supplied by the compiler.  fnf@cygnus.com */
+ 
+ static struct type *
+ m3_create_fundamental_type (objfile, typeid)
+      struct objfile *objfile;
+      int typeid;
+ {
+   register struct type *type = NULL;
+ 
+   switch (typeid)
+     {
+       default:
+ 	/* FIXME:  For now, if we are asked to produce a type not in this
+ 	   language, create the equivalent of a C integer type with the
+ 	   name "<?type?>".  When all the dust settles from the type
+ 	   reconstruction work, this should probably become an error. */
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 			  0, "<?type?>", objfile);
+         warning ("internal error: no C/C++ fundamental type %d", typeid);
+ 	break;
+       case FT_VOID:
+ 	type = init_type (TYPE_CODE_VOID,
+ 			  TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ 			  0, "void", objfile);
+ 	break;
+       case FT_CHAR:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ 			  0, "char", objfile);
+ 	break;
+       case FT_SIGNED_CHAR:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ 			  0, "signed char", objfile);
+ 	break;
+       case FT_UNSIGNED_CHAR:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ 			  TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
+ 	break;
+       case FT_SHORT:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+ 			  0, "short", objfile);
+ 	break;
+       case FT_SIGNED_SHORT:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+ 			  0, "short", objfile);	/* FIXME-fnf */
+ 	break;
+       case FT_UNSIGNED_SHORT:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+ 			  TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
+ 	break;
+       case FT_INTEGER:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 			  0, "int", objfile);
+ 	break;
+       case FT_SIGNED_INTEGER:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 			  0, "int", objfile); /* FIXME -fnf */
+ 	break;
+       case FT_UNSIGNED_INTEGER:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 			  TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
+ 	break;
+       case FT_LONG:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_LONG_BIT / TARGET_CHAR_BIT,
+ 			  0, "long", objfile);
+ 	break;
+       case FT_SIGNED_LONG:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_LONG_BIT / TARGET_CHAR_BIT,
+ 			  0, "long", objfile); /* FIXME -fnf */
+ 	break;
+       case FT_UNSIGNED_LONG:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_LONG_BIT / TARGET_CHAR_BIT,
+ 			  TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
+ 	break;
+       case FT_LONG_LONG:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+ 			  0, "long long", objfile);
+ 	break;
+       case FT_SIGNED_LONG_LONG:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+ 			  0, "signed long long", objfile);
+ 	break;
+       case FT_UNSIGNED_LONG_LONG:
+ 	type = init_type (TYPE_CODE_INT,
+ 			  TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+ 			  TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
+ 	break;
+       case FT_FLOAT:
+ 	type = init_type (TYPE_CODE_FLT,
+ 			  TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
+ 			  0, "float", objfile);
+ 	break;
+       case FT_DBL_PREC_FLOAT:
+ 	type = init_type (TYPE_CODE_FLT,
+ 			  TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
+ 			  0, "double", objfile);
+ 	break;
+       case FT_EXT_PREC_FLOAT:
+ 	type = init_type (TYPE_CODE_FLT,
+ 			  TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
+ 			  0, "long double", objfile);
+ 	break;
+       }
+   return (type);
+ }
+ 
+ 
+ /* Table mapping opcodes into strings for printing operators
+    and precedences of the operators.  */
+ 
+ static const struct op_print m3_op_print_tab[] =
+   {
+     {",",  BINOP_COMMA, PREC_COMMA, 0},
+     {"=",  BINOP_ASSIGN, PREC_ASSIGN, 1},
+     {"||", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
+     {"&&", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
+     {"|",  BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0},
+     {"^",  BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0},
+     {"&",  BINOP_BITWISE_AND, PREC_BITWISE_AND, 0},
+     {"==", BINOP_EQUAL, PREC_EQUAL, 0},
+     {"!=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
+     {"<=", BINOP_LEQ, PREC_ORDER, 0},
+     {">=", BINOP_GEQ, PREC_ORDER, 0},
+     {">",  BINOP_GTR, PREC_ORDER, 0},
+     {"<",  BINOP_LESS, PREC_ORDER, 0},
+     {">>", BINOP_RSH, PREC_SHIFT, 0},
+     {"<<", BINOP_LSH, PREC_SHIFT, 0},
+     {"+",  BINOP_ADD, PREC_ADD, 0},
+     {"-",  BINOP_SUB, PREC_ADD, 0},
+     {"*",  BINOP_MUL, PREC_MUL, 0},
+     {"/",  BINOP_DIV, PREC_MUL, 0},
+     {"%",  BINOP_REM, PREC_MUL, 0},
+     {"@",  BINOP_REPEAT, PREC_REPEAT, 0},
+     {"-",  UNOP_NEG, PREC_PREFIX, 0},
+     {"!",  UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
+     {"~",  UNOP_COMPLEMENT, PREC_PREFIX, 0},
+     {"*",  UNOP_IND, PREC_PREFIX, 0},
+     {"&",  UNOP_ADDR, PREC_PREFIX, 0},
+     {"sizeof ", UNOP_SIZEOF, PREC_PREFIX, 0},
+     {"++", UNOP_PREINCREMENT, PREC_PREFIX, 0},
+     {"--", UNOP_PREDECREMENT, PREC_PREFIX, 0},
+     /* C++  */
+     {"::", BINOP_SCOPE, PREC_PREFIX, 0},
+     {NULL, 0, 0, 0}
+ };
+ 
+ 
+ struct type ** const (m3_builtin_types[]) = 
+ {
+   &builtin_type_m3_integer,
+   &builtin_type_long,
+   &builtin_type_short,
+   &builtin_type_char,
+   &builtin_type_float,
+   &builtin_type_double,
+   &builtin_type_void,
+   &builtin_type_long_long,
+   &builtin_type_signed_char,
+   &builtin_type_unsigned_char,
+   &builtin_type_unsigned_short,
+   &builtin_type_unsigned_int,
+   &builtin_type_unsigned_long,
+   &builtin_type_unsigned_long_long,
+   &builtin_type_long_double,
+   &builtin_type_complex,
+   &builtin_type_double_complex,
+   0
+ };
+ 
+ static void
+ m3_error (msg)
+      char *msg;
+ {
+   error (msg ? msg : "Invalid syntax in expression.");
+ }
+ 
+ 
+ const struct language_defn m3_language_defn = {
+   "m3",				/* Language name */
+   language_m3,
+   m3_builtin_types,
+   range_check_on,
+   type_check_off,
+   m3_parse,
+   m3_error,
+   m3_printchar,			/* Print a character constant */
+   m3_printstr,			/* Function to print string constant */
+   m3_create_fundamental_type,	/* Create fundamental type in this language */
+   m3_print_type,		/* Print a type using appropriate syntax */
+   m3_val_print,			/* Print a value using appropriate syntax */
+   m3_value_print,		/* Print a top-level value */
+   {"",       "",     "",  ""},	/* Binary format info */
+   {"8_%lo",  "8_",   "o", ""},	/* Octal format info */
+   {"%ld",    "",     "d", ""},	/* Decimal format info */
+   {"16_%lx", "16_",  "x", ""},	/* Hex format info */
+   m3_op_print_tab,		/* expression operators for printing */
+   LANG_MAGIC
+ };
+ 
+ 
+ 
+ #define eval(x) evaluate_expression (parse_expression (x))
+ #define print(x) value_print (x, stdout, 0, Val_pretty_default)
+ #define printx(y) value_print (y, stdout, 'x', Val_pretty_default)
+ 
+ 
+ static struct type *thread__t = 0;
+ static int thread__t__id_size, thread__t__id_offset;
+ static int thread__t__state_size, thread__t__state_offset;
+ static int thread__t__next_size, thread__t__next_offset;
+ static int thread__t__cond_size, thread__t__cond_offset;
+ static struct type * thread__t__cond_type;
+ static int thread__t__mutex_size, thread__t__mutex_offset;
+ static struct type * thread__t__mutex_type;
+ static int thread__t__time_size, thread__t__time_offset;
+ static struct type * thread__t__time_type;
+ static int thread__t__context_size, thread__t__context_offset;
+ static struct type * thread__t__context_type;
+ static int thread__t__buf_size, thread__t__buf_offset;
+ static struct type * thread__t__buf_type;
+ 
+ static void 
+ init_thread_constants ()
+ {
+   if (thread__t == 0) {
+     int thread__t__context_size, thread__t__context_offset;
+     struct type * thread__t__context_type;
+ 
+     thread__t = find_m3_type_named ("Thread.T");
+ 
+     find_m3_rec_field (thread__t, "id", 
+ 		       &thread__t__id_size, &thread__t__id_offset, 0);
+     find_m3_rec_field (thread__t, "state", 
+ 		       &thread__t__state_size, &thread__t__state_offset, 0);
+     find_m3_rec_field (thread__t, "next", 
+ 		       &thread__t__next_size, &thread__t__next_offset, 0);
+     find_m3_rec_field (thread__t, "waitingForCondition", 
+ 		       &thread__t__cond_size, &thread__t__cond_offset, 
+ 		       &thread__t__cond_type);
+     find_m3_rec_field (thread__t, "waitingForMutex", 
+ 		       &thread__t__mutex_size, &thread__t__mutex_offset, 
+ 		       &thread__t__mutex_type);
+     find_m3_rec_field (thread__t, "waitingForTime", 
+ 		       &thread__t__time_size, &thread__t__time_offset, 
+ 		       &thread__t__time_type);
+     find_m3_rec_field (thread__t, "context",
+ 		       &thread__t__context_size, &thread__t__context_offset,
+ 		       &thread__t__context_type);
+     find_m3_rec_field (thread__t__context_type, "buf",
+ 		       &thread__t__buf_size, &thread__t__buf_offset, 0);
+     thread__t__id_offset += 32;
+     thread__t__state_offset += 32;
+     thread__t__next_offset += 32;
+     thread__t__cond_offset += 32;
+     thread__t__mutex_offset += 32;
+     thread__t__time_offset += 32;
+     thread__t__buf_offset += 32 + thread__t__context_offset; }
+ }
+ 
+ #if 0
+     {	"zero",	"at",	"v0",	"v1",	"a0",	"a1",	"a2",	"a3", \
+ 	"t0",	"t1",	"t2",	"t3",	"t4",	"t5",	"t6",	"t7", \
+ 	"s0",	"s1",	"s2",	"s3",	"s4",	"s5",	"s6",	"s7", \
+ 	"t8",	"t9",	"k0",	"k1",	"gp",	"sp",	"s8",	"ra", \
+ 	"sr",	"lo",	"hi",	"bad",	"cause","pc",    \
+ 	"f0",   "f1",   "f2",   "f3",   "f4",   "f5",   "f6",   "f7", \
+ 	"f8",   "f9",   "f10",  "f11",  "f12",  "f13",  "f14",  "f15", \
+ 	"f16",  "f17",  "f18",  "f19",  "f20",  "f21",  "f22",  "f23",\
+ 	"f24",  "f25",  "f26",  "f27",  "f28",  "f29",  "f30",  "f31",\
+ 	"fsr",  "fir",  "fp",   "inx",  "rand", "tlblo","ctxt", "tlbhi",\
+ 	"epc",  "prid"\
+     }
+ #endif
+ 
+ static int regno_to_jmpbuf [] = {
+    3,  4,  5,  6,  7,  8,  9, 10,
+   11, 12, 13, 14, 15, 16, 17, 18,
+   19, 20, 21, 22, 23, 24, 25, 26,
+   27, 28, 29, 30, 31, 32, 33, 34,
+    3,  3,  3,  3,  3,  2,
+   38, 39, 40, 41, 42, 43, 44, 45,
+   46, 47, 48, 49, 50, 51, 52, 53,
+   54, 55, 56, 57, 58, 59, 60, 61,
+   62, 63, 64, 65, 66, 67, 68, 69,
+    3,  3,  3,  3,  3,  3,  3,  3,
+    3,  3};
+ 
+ char *current_thread_bits;
+ 
+ static void
+ look_in_thread (regno)
+      int regno;
+ {
+   for (regno = 0; regno < NUM_REGS; regno++) {
+     supply_register (regno, 
+          current_thread_bits + thread__t__buf_offset / 8 + regno_to_jmpbuf [regno] * 4); }
+ }
+ 
+ static void
+ switch_command (args, from_tty)
+      char *args;
+      int from_tty;
+ {
+   value_ptr v = eval ("ThreadPosix.self");
+   int  current_id, self_id, to_id;
+   static void (*saved_to_fetch_registers) PARAMS ((int)) = 0;
+   CORE_ADDR *tc_addr;
+ 
+   init_thread_constants ();
+ 
+   if (!args) {
+     error ("I need a thread id to switch to."); }
+   sscanf (args, "%d", &to_id);
+ 
+   m3_read_object_fields_bits (VALUE_CONTENTS (v), 0, thread__t, 
+ 			      &tc_addr, &current_thread_bits);
+   current_id = m3_unpack_int (current_thread_bits,
+ 			      thread__t__id_offset, thread__t__id_size);
+   self_id = current_id;
+ 
+   while (current_id != to_id) {
+     m3_read_object_fields_bits (current_thread_bits,
+ 		  thread__t__next_offset, thread__t,
+ 				&tc_addr, &current_thread_bits);
+     current_id = m3_unpack_int (current_thread_bits, 
+ 	  thread__t__id_offset, thread__t__id_size); }
+ 
+   if (current_id == self_id) {
+     if (current_target.to_fetch_registers == look_in_thread) {
+       current_target.to_fetch_registers = saved_to_fetch_registers; }}
+   else {
+     if (current_target.to_fetch_registers != look_in_thread) {
+       saved_to_fetch_registers = current_target.to_fetch_registers;
+       current_target.to_fetch_registers = look_in_thread; }}
+ 
+   registers_changed ();
+   reinit_frame_cache ();
+ }
+ 
+ 
+ static void
+ threads_command (args, from_tty)
+      char *args;
+      int from_tty;
+ {
+   value_ptr v = eval ("ThreadPosix.self");
+   int self_id, current_id; CORE_ADDR current_addr;
+   CORE_ADDR *tc_addr; char* bits;
+ 
+   init_thread_constants ();
+ 
+   current_addr = m3_unpack_pointer (VALUE_CONTENTS (v), 0);
+   m3_read_object_fields_bits (VALUE_CONTENTS (v), 0, thread__t, 
+ 			      &tc_addr, &bits);
+   self_id = m3_unpack_int (bits, thread__t__id_offset, thread__t__id_size);
+   current_id = self_id;
+ 
+   do {
+     int state;
+     state = m3_unpack_int (bits, thread__t__state_offset, 
+ 			   thread__t__state_size);
+     fprintf_filtered (stdout, "%d  16_%x  ", current_id, current_addr);
+     switch (state) 
+       {
+       case 0 /* alive */:
+ 	fprintf_filtered (stdout, "  alive");
+ 	fputs_filtered ("\n", stdout);
+ 	break; 
+       case 1 /* waiting */:
+ 	fprintf_filtered (stdout, "  waiting for condition 16_%x",
+ 			  m3_unpack_pointer (bits, thread__t__cond_offset));
+ 	fputs_filtered ("\n", stdout);
+ 	break;
+       case 2 /* locking */:
+ 	fprintf_filtered (stdout, "  waiting for mutex 16_%x",
+ 			  m3_unpack_pointer (bits, thread__t__mutex_offset));
+ 	fputs_filtered ("\n", stdout);
+ 	break;
+       case 3 /* pausing */:
+ 	fprintf_filtered (stdout, "  waiting until ");
+ 	m3_val_print2 (thread__t__time_type, bits, thread__t__time_offset, 
+ 		       thread__t__time_size, stdout, 0, 0);
+ 	fputs_filtered ("\n", stdout);
+ 	break;
+       case 4 /* blocking */:
+ 	fprintf_filtered (stdout, "  waiting for I/O");
+ 	fputs_filtered ("\n", stdout);
+ 	break;
+       case 5 /* dying */:
+ 	fprintf_filtered (stdout, "  waiting for somebody to join");
+ 	fputs_filtered ("\n", stdout);
+ 	break;
+       case 6 /* dead */:
+ 	fprintf_filtered (stdout, "  dead");
+ 	fputs_filtered ("\n", stdout);
+ 	break; }
+     current_addr = m3_unpack_pointer (bits, thread__t__next_offset);
+     m3_read_object_fields_bits (bits, thread__t__next_offset, thread__t,
+ 				&tc_addr, &bits);
+     current_id = m3_unpack_int (bits, thread__t__id_offset, thread__t__id_size);
+     } while (current_id != self_id);
+ }
+ 
+ 
+ #ifdef AT_SRC
+ 
+ #include <errno.h>
+ #include <sys/types.h>
+ #include <sys/socket.h>
+ #include <netinet/in.h>
+ #include <net/if.h>
+ #include <netdb.h>
+ #include <pwd.h>
+ 
+ static a_client ()
+ {
+   struct sockaddr_in sa;
+   struct hostent *he;
+   struct passwd *pw;
+   int s;
+ 
+   if ((s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) {
+     return; }
+   sa.sin_family = AF_INET;
+   sa.sin_port = 9785;
+   if ((he = gethostbyname ("procope.pa.dec.com")) == 0) {
+     return; }
+   sa.sin_addr.s_addr = *((int *) he->h_addr);
+   if (connect (s, &sa, sizeof (sa)) < 0) {
+      return; }
+    pw = getpwuid (getuid ());
+    write (s, pw->pw_name, strlen (pw->pw_name));
+    close (s);
+ }
+ #endif
+ 
+ struct type *builtin_type_m3_integer;
+ struct type *builtin_type_m3_cardinal;
+ struct type *builtin_type_m3_boolean;
+ struct type *builtin_type_m3_address;
+ struct type *builtin_type_m3_root;
+ struct type *builtin_type_m3_char;
+ struct type *builtin_type_m3_real;
+ struct type *builtin_type_m3_longreal;
+ struct type *builtin_type_m3_extended;
+ struct type *builtin_type_m3_null;
+ struct type *builtin_type_m3_refany;
+ struct type *builtin_type_m3_untraced_root;
+ struct type *builtin_type_m3_void;
+ 
+ void
+ _initialize_m3_language ()
+ {
+ #ifdef AT_SRC
+   a_client ();
+ #endif
+ 
+   builtin_type_m3_integer =
+     init_type (TYPE_CODE_M3_INTEGER, TARGET_LONG_BIT / HOST_CHAR_BIT,
+ 	       0,
+ 	       "INTEGER", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_integer) = TARGET_LONG_BIT;
+ 
+   builtin_type_m3_cardinal =
+     init_type (TYPE_CODE_M3_CARDINAL, TARGET_LONG_BIT / HOST_CHAR_BIT,
+ 	       0,
+ 	       "CARDINAL", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_cardinal) = TARGET_LONG_BIT;
+ 
+   builtin_type_m3_boolean =
+     init_type (TYPE_CODE_M3_BOOLEAN, 1,
+ 	       0,
+ 	       "BOOLEAN", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_boolean) = 8;
+ 
+   builtin_type_m3_void =
+     init_type (TYPE_CODE_M3_VOID, 0, 0,
+ 	       "VOID", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_void) = 0;
+ 
+   builtin_type_m3_address =
+     init_type (TYPE_CODE_M3_ADDRESS, TARGET_PTR_BIT / HOST_CHAR_BIT, 0,
+ 	       "ADDRESS", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_address) = TARGET_PTR_BIT;
+ 
+   builtin_type_m3_root =
+     init_type (TYPE_CODE_M3_ROOT, TARGET_PTR_BIT / HOST_CHAR_BIT, 0,
+ 	       "ROOT", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_root) = TARGET_PTR_BIT;
+ 
+   builtin_type_m3_char =
+     init_type (TYPE_CODE_M3_CHAR, TARGET_CHAR_BIT / HOST_CHAR_BIT, 0,
+ 	       "CHAR", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_char) = TARGET_CHAR_BIT;
+ 
+   builtin_type_m3_real =
+     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 0,
+ 	       "REAL", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_real) = TARGET_FLOAT_BIT;
+ 
+   builtin_type_m3_longreal =
+     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 0,
+ 	       "LONGREAL", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_longreal) = TARGET_DOUBLE_BIT;
+ 
+   builtin_type_m3_extended =
+     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 0,
+ 	       "EXTENDED", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_extended) = TARGET_DOUBLE_BIT;
+ 
+   builtin_type_m3_null =
+     init_type (TYPE_CODE_M3_NULL, TARGET_PTR_BIT / HOST_CHAR_BIT, 0,
+ 	       "NULL", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_null) = TARGET_PTR_BIT;
+ 
+   builtin_type_m3_refany =
+     init_type (TYPE_CODE_M3_REFANY, TARGET_PTR_BIT / HOST_CHAR_BIT, 0,
+ 	       "REFANY", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_refany) = TARGET_PTR_BIT;
+ 
+   builtin_type_m3_untraced_root =
+     init_type (TYPE_CODE_M3_UN_ROOT, TARGET_PTR_BIT / HOST_CHAR_BIT, 0,
+ 	       "UNTRACED_ROOT", (struct objfile *) NULL);
+   TYPE_M3_SIZE (builtin_type_m3_untraced_root) = TARGET_PTR_BIT;
+ 
+   add_language (&m3_language_defn);
+   add_com ("threads", class_stack, threads_command, "Lists the threads.");
+   add_com ("switch", class_stack, switch_command, "Allows to examine the stack of another thread.");
+ }
+ 
+ void 
+ m3_decode_struct (t)
+      struct type *t;
+ {
+   int i;
+   char *key, *type_specific_info;
+   
+   /* the format is M3<kind><uid><other info>
+       where kind is a one letter code, 
+             uid  is an 8 digits hex number
+             other info depends on the type;
+ 	               if there is a size is starts as <size>_ */
+ 
+   key = TYPE_TAG_NAME (t);
+   if (key == 0 || strlen (key) < 4 || key[0] != 'M' || key[1] != '3') {
+     return; }
+ 
+   sscanf (key + 11, "%ld", &TYPE_M3_SIZE (t));
+   type_specific_info = strchr (key + 11, '_') + 1;
+   
+ #define FIELD_HAS_UID(t,i) \
+   strncpy (TYPE_FIELD_M3_UID (t, i), TYPE_FIELD_NAME (t, i), 8); \
+   TYPE_FIELD_M3_UID (t, i) [8] = 0; \
+   TYPE_FIELD_TYPE (t,i) = 0; \
+   TYPE_FIELD_NAME (t,i) += 8
+ 
+   switch (key [2])
+     {
+     case 'n': 
+       FIELD_HAS_UID (t, 0);
+       break; 
+ 
+     case 'A': 
+       TYPE_CODE (t) = TYPE_CODE_M3_ARRAY;
+       FIELD_HAS_UID (t, 0);
+       FIELD_HAS_UID (t, 1);
+       break;
+ 
+     case 'B': 
+       TYPE_CODE (t) = TYPE_CODE_M3_OPEN_ARRAY;
+       FIELD_HAS_UID (t, 0);
+       break;
+ 
+     case 'C':
+       TYPE_CODE (t) = TYPE_CODE_M3_ENUM;
+       break;
+ 
+     case 'D':
+       TYPE_CODE (t) = TYPE_CODE_M3_PACKED;
+       FIELD_HAS_UID (t, 0);
+       break;
+ 
+     case 'R':
+       TYPE_CODE (t) = TYPE_CODE_M3_RECORD;
+       for (i = 0; i < TYPE_NFIELDS (t); i++) {
+ 	FIELD_HAS_UID (t, i);
+ 	sscanf (TYPE_FIELD_NAME (t, i), "%d_%d", 
+ 		&TYPE_FIELD_BITPOS (t, i), &TYPE_FIELD_BITSIZE (t, i)); 
+ 	TYPE_FIELD_NAME (t, i) =
+ 	  strchr (strchr (TYPE_FIELD_NAME (t, i), '_') + 1, '_') + 1; }
+       break;
+ 
+     case 'O':
+       TYPE_CODE (t) = TYPE_CODE_M3_OBJECT;
+       sscanf (type_specific_info, "%ld_%ld_%ld_",
+ 	      &TYPE_M3_OBJ_NFIELDS (t), &TYPE_M3_OBJ_TRACED (t),
+ 	      &TYPE_M3_OBJ_BRANDED (t));
+       if (TYPE_M3_OBJ_BRANDED (t)) {
+ 	TYPE_M3_OBJ_BRAND (t) = 
+ 	  strchr (strchr (strchr (type_specific_info, '_') + 1, '_') + 1, 
+ 		  '_') + 1; }
+       else {
+ 	TYPE_M3_OBJ_BRAND (t) = 0; }
+ 
+       TYPE_M3_OBJ_NMETHODS (t) = TYPE_NFIELDS (t) - TYPE_M3_OBJ_NFIELDS (t) - 1;
+       FIELD_HAS_UID (t, 0);
+ 
+       for (i = 1; i < TYPE_NFIELDS (t); i++) {
+ 	FIELD_HAS_UID (t, i);
+ 	sscanf (TYPE_FIELD_NAME (t, i), "%d_%d_", 
+ 		&TYPE_FIELD_BITPOS (t, i), &TYPE_FIELD_BITSIZE (t, i));
+ 	TYPE_FIELD_NAME (t, i) =
+ 	  strchr (strchr (TYPE_FIELD_NAME (t, i), '_') + 1, '_') + 1; }
+       break;
+ 
+     case 'S':
+       TYPE_CODE (t) = TYPE_CODE_M3_SET;
+       FIELD_HAS_UID (t, 0);
+       break;
+ 
+     case 'Z':
+       TYPE_CODE (t) = TYPE_CODE_M3_SUBRANGE;
+       sscanf (type_specific_info, "%ld_%ld", 
+ 	      &TYPE_M3_SUBRANGE_MIN (t), &TYPE_M3_SUBRANGE_MAX (t));
+       FIELD_HAS_UID (t, 0);
+       break;
+ 
+     case 'Y':
+       TYPE_CODE (t) = TYPE_CODE_M3_POINTER;
+       sscanf (type_specific_info, "%ld_%ld_", 
+ 	      &TYPE_M3_POINTER_TRACED (t),
+ 	      &TYPE_M3_POINTER_BRANDED (t));
+       TYPE_M3_POINTER_BRAND (t) = 
+ 	strchr (strchr (type_specific_info, '_') + 1, '_') + 1;
+       FIELD_HAS_UID (t, 0);
+       break;
+ 
+     case 'I': 
+       TYPE_CODE (t) = TYPE_CODE_M3_INDIRECT;
+       FIELD_HAS_UID (t, 0);
+       break;
+ 
+     case 'P': {
+       char c;
+       TYPE_CODE (t) = TYPE_CODE_M3_PROC;
+       sscanf (type_specific_info, "%c%ld", &c, &TYPE_M3_PROC_NRAISES (t));
+       if (c == 'A') {		/* RAISES ANY */
+ 	TYPE_M3_PROC_NARGS (t) = TYPE_NFIELDS (t) - 1;
+ 	TYPE_M3_PROC_NRAISES (t) = -1;
+ 	for (i = 0; i < TYPE_NFIELDS (t); i++) {
+ 	  FIELD_HAS_UID (t, i); }}
+       else {
+ 	TYPE_M3_PROC_NARGS (t) = TYPE_NFIELDS (t) - TYPE_M3_PROC_NRAISES (t) - 1;
+ 	for (i = 0; i < TYPE_NFIELDS (t) - TYPE_M3_PROC_NRAISES (t); i++) {
+ 	  FIELD_HAS_UID (t, i); }}
+       break; }
+ 
+     case 'Q':
+       TYPE_CODE (t) = TYPE_CODE_M3_OPAQUE;
+       FIELD_HAS_UID (t, 0);
+       break; }
+ 
+   TYPE_TAG_NAME (t) = key + 3;
+   TYPE_TAG_NAME (t) [8] = 0;
+ 
+   TYPE_LENGTH (t) = (TYPE_M3_SIZE (t) + 7) / 8; 
+ }
+ 
+ char *
+ m3_demangle (mangled)
+      char *mangled;
+ {
+   int i;
+   static char demangled [100];
+ 
+   char * u;
+ 
+   if (mangled [0] == 'M' && mangled [1] == '3') {
+     /* m3 type name for type uid: M3N<uid> */
+     /* m3 type uid for type name: M3n<uid><name> */
+     /* m3 type encoding: M3?<uid>* */
+     /* local variable encoding: M3_<uid>_name */
+     /* m3 exported interfaces M3iffffffff<module> */
+     for (i = 3; i < 11
+ 	 && (('0' <= mangled [i] && mangled [i] <= '9')
+ 	     || ('a' <= mangled [i] && mangled [i] <= 'f')); i++);
+     if (i == 11) {
+       if (mangled[2] == 'N') {
+ 	/* type name */
+ 	sprintf (demangled, "G$%.8s", mangled + 3); }
+       else if (mangled[2] == 'n') {
+ 	sprintf (demangled, "B$%s", mangled+11); }
+       else if (mangled[2] == '_') {
+         sprintf (demangled, "%s", mangled + 12); }
+       else if (mangled[2] == 'i') {
+ 	sprintf (demangled, "H$%s", mangled + 11); }
+       else {
+ 	sprintf (demangled, "%.8s", mangled+3); }
+       return demangled; }
+ 
+     /* m3 interface record: M3__[IM]_* */
+     if (mangled [2] == '_' && mangled [3] == '_' 
+ 	&& (mangled [4] == 'I' || mangled [4] == 'M')
+ 	&& mangled [5] == '_') {
+       sprintf (demangled, "%c$%s", mangled [4], mangled + 6);
+       return demangled; }}
+ 
+   /* type init proc: _t<uid>_INIT */
+   if (mangled [0] == '_' && mangled [1] == 't' && mangled [10] == '_'
+       && mangled [11] == 'I' && mangled [12] == 'N' && mangled [13] == 'I'
+       && mangled [14] == 'T' && mangled [14] == 0) {
+     for (i = 2; i < 2+8 
+ 	 && (('0' <= mangled [i] && mangled [i] <= '9')
+ 	     || ('a' <= mangled [i] && mangled [i] <= 'f')); i++);
+     if (i == 2+8) {
+       sprintf (demangled, "D$%.8s", mangled + 2); 
+       return demangled; }}
+ 
+   /* compilation unit body: _INIT[IM]_* */
+   if (mangled [0] == '_' && mangled [1] == 'I' && mangled [2] == 'N'
+       && mangled [3] == 'I' && mangled [4] == 'T' 
+       && (mangled [5] == 'I' || mangled [5] == 'M')
+       && mangled [6] == '_') {
+     sprintf (demangled, "%s.%c3.MAIN", 
+ 	     mangled + 7, mangled [5] == 'I' ? 'i' : 'm');
+     return demangled; }
+ 
+   /* procedure: *__*, but not *__t (Common C/C++ type names) */
+   if ((u = strchr (mangled, '_')) && u != mangled
+        && u[1] == '_' && u[2] != 't') {
+     strncpy (demangled, mangled, u - mangled);
+     demangled [u - mangled] = '.';
+     strcpy (demangled + (u - mangled) + 1, u + 2);
+     return demangled; }
+ 
+   return 0;
+ }
+ 
+ /* we have just read a symtab; fix it for Modula-3 purposes.
+    We want to clean variables: we should forget the type
+       indicated in the symbol table,
+       remember the uid in the place where the type resolver will find it.
+    We also want to find the connection between an interface record
+       and its type description (the uid of interface records is -1; 
+       this is about the only place where we have the scope information
+       that is necessary to make the connection. */
+ 
+ void
+ m3_fix_symtab (st)
+      struct symtab *st;
+ {
+   int i, j;
+   struct block *b;
+   struct symbol *ir = 0;
+   struct type *ir_type = 0;
+ 
+   for (i = 0; i < BLOCKVECTOR_NBLOCKS (BLOCKVECTOR (st)); i ++) {
+     b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (st), i);
+     for (j = 0; j < BLOCK_NSYMS (b); j++) {
+       struct symbol *s = BLOCK_SYM (b, j);
+       char *name = SYMBOL_NAME (s);
+ 
+       if (name [0] == 'M' && name [1] == '3') {
+ 	if (name [2] == '_' && name [3] == '_' 
+ 	    && (name [4] == 'I' || name [4] == 'M') && name [5] == '_') {
+ 	  ir = s; }
+ 	else if (name [2] == '_' && SYMBOL_NAMESPACE (s) == VAR_NAMESPACE) {
+ 	  SET_SYMBOL_TYPE (s) = 0; 
+ 	  strncpy (s->m3_uid, name + 3, 8);
+ 	  s->m3_uid [8] = 0; }
+ 	else if (strncmp (name + 2, "Rffffffff", 9) == 0) {
+ 	    ir_type = SYMBOL_TYPE (s); }}}}
+ 
+   if (ir) {
+     if (ir_type == 0) {
+       error ("Interface record, but no type"); }
+     SET_SYMBOL_TYPE (ir) = ir_type; }
+ }
+ 
+ void
+ m3_fix_target_type (t)
+      struct type *t;
+ {
+   if (TYPE_TARGET_TYPE (t)) return;
+ 
+   switch (TYPE_CODE (t))
+     {
+     case TYPE_CODE_M3_ARRAY:
+       TYPE_TARGET_TYPE (t) = TYPE_M3_ARRAY_ELEM (t);
+       break;
+     case TYPE_CODE_M3_OPEN_ARRAY:
+       TYPE_TARGET_TYPE (t) = TYPE_M3_OPEN_ARRAY_ELEM (t);
+       break;
+     case TYPE_CODE_M3_SUBRANGE:
+       TYPE_TARGET_TYPE (t) = TYPE_M3_SUBRANGE_TARGET (t);
+       break;
+     case TYPE_CODE_M3_POINTER:
+       TYPE_TARGET_TYPE (t) = TYPE_M3_POINTER_TARGET (t);
+       break;
+     case TYPE_CODE_M3_INDIRECT:
+       TYPE_TARGET_TYPE (t) = TYPE_M3_INDIRECT_TARGET (t);
+       break;
+     case TYPE_CODE_M3_PROC:
+       TYPE_TARGET_TYPE (t) = TYPE_M3_PROC_RESTYPE (t);
+       break;
+     default:
+       break;
+     }
+ }
+ 
+ struct type *
+ m3_resolve_type (uid)
+      char *uid;
+ {
+   struct symbol *sym = lookup_symbol (uid, 0, STRUCT_NAMESPACE, 0, 0);
+ 
+   if (sym) {
+     struct type *t = SYMBOL_TYPE (sym);
+     if (TYPE_CODE (t) == TYPE_CODE_M3_OPAQUE) {
+       t = m3_resolve_type (TYPE_FIELD_M3_UID (t, 0)); };
+     m3_fix_target_type (t);
+     return t; }
+   else if (STREQ (uid, "195c2a74")) { /* INTEGER */
+     return builtin_type_m3_integer; }
+   else if (STREQ (uid, "97e237e2")) { /* CARDINAL */
+     return builtin_type_m3_cardinal; }
+   else if (STREQ (uid, "1e59237d")) { /* BOOLEAN */
+     return builtin_type_m3_boolean; }
+   else if (STREQ (uid, "08402063")) { /* ADDRESS */
+     return builtin_type_m3_address; }
+   else if (STREQ (uid, "9d8fb489")) { /* ROOT */
+     return builtin_type_m3_root; }
+   else if (STREQ (uid, "56e16863")) { /* CHAR */
+     return builtin_type_m3_char; }
+   else if (STREQ (uid, "48e16572")) { /* REAL */
+     return builtin_type_m3_real; }
+   else if (STREQ (uid, "94fe32f6")) { /* LONGREAL */
+     return builtin_type_m3_longreal; }
+   else if (STREQ (uid, "9ee024e3")) { /* EXTENDED */
+     return builtin_type_m3_extended; }
+   else if (STREQ (uid, "48ec756e")) { /* NULL */
+     return builtin_type_m3_null; }
+   else if (STREQ (uid, "1c1c45e6")) { /* REFANY */
+     return builtin_type_m3_refany; }
+   else if (STREQ (uid, "898ea789")) { /* _UNTRACED_ROOT */
+     return builtin_type_m3_untraced_root; }
+   else if (STREQ (uid, "00000000")) { /* VOID */
+     return builtin_type_m3_void; }
+   else {
+     error ("Cannot resolve type with uid %s", uid); }
+ }
+ 
+ struct type *
+ find_m3_type_named (name)
+      char *name;
+ {
+   char struct_name [100];
+   struct symbol *s;
+ 
+   sprintf (struct_name, "B$%s", name);
+   s = lookup_symbol (struct_name, 0, STRUCT_NAMESPACE, 0, 0); 
+   return TYPE_M3_NAME_TYPE (SYMBOL_TYPE (s));
+ }
+ 
+ struct type *
+ find_m3_exported_interfaces (name)
+      char *name;
+      /* return the record type that has one field for each exported
+ 	interface; note that if the result is NIL, this means
+         that the module exports itself only. */
+ {
+   char struct_name [100];
+   struct symbol *s;
+ 
+   sprintf (struct_name, "H$%s", name);
+   if (s = lookup_symbol (struct_name, 0, STRUCT_NAMESPACE, 0, 0)) {
+     return (SYMBOL_TYPE (s)); }
+   else {
+     return 0; }
+ }
+   
+ struct symbol *
+ find_m3_ir (kind, name)
+      int kind; 
+      char *name;
+ {
+   char struct_name [100];
+   sprintf (struct_name, "%c$%s", kind, name);
+   return lookup_symbol (struct_name, 0, VAR_NAMESPACE, 0, 0);
+ }
+ 
+ char *
+ find_m3_type_name (t)
+      struct type *t;
+ {
+   char *uid = TYPE_TAG_NAME (t);
+   char struct_name [100];
+   struct symbol *sym;
+ 
+   if (TYPE_NAME (t) == 0) {
+     sprintf (struct_name, "G$%s", uid);
+     if (sym = lookup_symbol (struct_name, 0, STRUCT_NAMESPACE, 0, 0)) {
+       TYPE_NAME (t) = TYPE_FIELD_NAME (SYMBOL_TYPE (sym), 0); }
+     else {
+       char *n = malloc (18);
+       sprintf (n, "<typeid=%s>", uid);
+       TYPE_NAME (t) = n; }}
+ 
+   return TYPE_NAME (t);
+ }
+ 
+ static int rt0_tc_selfID_size,          rt0_tc_selfID_offset;
+ static int rt0_tc_dataOffset_size,      rt0_tc_dataOffset_offset;
+ static int rt0_tc_methodOffset_size,    rt0_tc_methodOffset_offset;
+ static int rt0_tc_dataSize_size,        rt0_tc_dataSize_offset;
+ static int rt0_tc_parent_size,          rt0_tc_parent_offset;
+ static int rt0_tc_defaultMethods_size,  rt0_tc_defaultMethods_offset;
+ static CORE_ADDR rt0u_types_value;
+ 
+ void
+ init_m3_constants ()
+ {
+   struct type* rt0_tc;
+   struct symbol *rt0u;
+   int rt0u_types_size, rt0u_types_offset;
+ 
+   if (rt0u_types_value) {
+     return; }
+ 
+   rt0_tc = find_m3_type_named ("RT0.Typecell");
+ 
+   find_m3_rec_field (rt0_tc, "selfID",
+ 		     &rt0_tc_selfID_size, &rt0_tc_selfID_offset, 0);
+   find_m3_rec_field (rt0_tc, "dataOffset", 
+ 		     &rt0_tc_dataOffset_size, &rt0_tc_dataOffset_offset, 0);
+   find_m3_rec_field (rt0_tc, "methodOffset", 
+ 		     &rt0_tc_methodOffset_size, &rt0_tc_methodOffset_offset, 0);
+   find_m3_rec_field (rt0_tc, "dataSize",
+ 		     &rt0_tc_dataSize_size, &rt0_tc_dataSize_offset, 0);
+   find_m3_rec_field (rt0_tc, "parent",
+ 		     &rt0_tc_parent_size, &rt0_tc_parent_offset, 0);
+   find_m3_rec_field (rt0_tc, "defaultMethods", 
+ 		     &rt0_tc_defaultMethods_size, 
+ 		     &rt0_tc_defaultMethods_offset, 0);
+ 
+   rt0u = find_m3_ir ('I', "RT0u");
+ 
+   find_m3_rec_field (SYMBOL_TYPE (rt0u), "types", 
+ 		     &rt0u_types_size, &rt0u_types_offset, 0);
+   
+   target_read_memory (SYMBOL_VALUE_ADDRESS (rt0u) + rt0u_types_offset / 8,
+ 		      (char *)&rt0u_types_value, rt0u_types_size / 8);
+ }
+ 
+ CORE_ADDR 
+ find_m3_heap_tc_addr (addr)
+      CORE_ADDR addr;
+ {
+   LONGEST typecode;
+   CORE_ADDR result;
+ 
+   init_m3_constants ();
+ 
+   target_read_memory (addr - (TARGET_PTR_BIT / TARGET_CHAR_BIT), 
+ 		      (char *)&typecode, 
+ 		      TARGET_PTR_BIT / TARGET_CHAR_BIT);
+   /* the typecode is in bits 1..21 */
+   typecode = (typecode >> 1) & 0xfffff;
+ 
+   target_read_memory (rt0u_types_value 
+ 		      + typecode * TARGET_PTR_BIT / TARGET_CHAR_BIT,
+ 		      (char *)&result, TARGET_PTR_BIT / TARGET_CHAR_BIT);
+   return result;
+ }
+ 
+ struct type *
+ find_m3_type_from_tc (tc_addr)
+      CORE_ADDR tc_addr;
+ {
+   int selfID;
+   char uid_name [10];
+ 
+   init_m3_constants ();
+ 
+   target_read_memory (tc_addr + rt0_tc_selfID_offset / TARGET_CHAR_BIT,
+ 		      (char *)&selfID, rt0_tc_selfID_size / HOST_CHAR_BIT);
+   sprintf (uid_name, "%08x", selfID);
+   return (m3_resolve_type (uid_name));
+ }
+ 
+ struct type *
+ find_m3_heap_type (addr)
+      CORE_ADDR addr;
+ {
+   return find_m3_type_from_tc (find_m3_heap_tc_addr (addr));
+ }
+ 
+ 
+ /* return LOOPHOLE (tc_addr, RT0.TypeDefn).dataOffset */
+ int 
+ tc_address_to_dataOffset (tc_addr)
+      CORE_ADDR tc_addr;
+ {
+   int result;
+   init_m3_constants ();
+ 
+   target_read_memory (tc_addr + rt0_tc_dataOffset_offset / 8,
+ 		      (char *)&result, rt0_tc_dataOffset_size / 8);
+   return result;
+ }
+ 
+ int 
+ tc_address_to_methodOffset (tc_addr)
+      CORE_ADDR tc_addr;
+ {
+   int result;
+   init_m3_constants ();
+   target_read_memory (tc_addr + rt0_tc_methodOffset_offset / TARGET_CHAR_BIT,
+ 		      (char *)&result, rt0_tc_methodOffset_size / TARGET_CHAR_BIT);
+   return result;
+ }
+ 		      
+ int 
+ tc_address_to_dataSize (tc_addr)
+      CORE_ADDR tc_addr;
+ {
+   int result;
+   init_m3_constants ();
+   target_read_memory (tc_addr + rt0_tc_dataSize_offset / TARGET_CHAR_BIT,
+ 		      (char *)&result, rt0_tc_dataSize_size / TARGET_CHAR_BIT);
+   return result;
+ }
+ 		      
+ CORE_ADDR  
+ tc_address_to_parent_tc_address (tc_addr)
+      CORE_ADDR tc_addr;
+ {
+   CORE_ADDR  result;
+   init_m3_constants ();
+   target_read_memory (tc_addr + rt0_tc_parent_offset / TARGET_CHAR_BIT,
+ 		      (char *)&result, rt0_tc_parent_size / TARGET_CHAR_BIT);
+   return result;
+ }
+ 		      
+ CORE_ADDR 
+ tc_address_to_defaultMethods (tc_addr)
+      CORE_ADDR tc_addr;
+ {
+   CORE_ADDR result;
+   init_m3_constants ();
+   target_read_memory (tc_addr + rt0_tc_defaultMethods_offset / TARGET_CHAR_BIT,
+ 		      (char *)&result, rt0_tc_defaultMethods_size / TARGET_CHAR_BIT);
+   return result;
+ }
+ 
+ int 
+ find_m3_rec_field (rec_type, name, size, offset, type)
+      struct type *rec_type;
+      char *name;
+      int *size, *offset;
+      struct type **type;
+ {
+   int i;
+   for (i = 0; i < TYPE_M3_REC_NFIELDS (rec_type); i++) {
+     if (STREQ (TYPE_M3_REC_FIELD_NAME (rec_type, i), name)) {
+       if (size) {
+ 	*size = TYPE_M3_REC_FIELD_BITSIZE (rec_type, i); }
+       if (offset) {
+ 	*offset = TYPE_M3_REC_FIELD_BITPOS (rec_type, i); }
+       if (type) {
+ 	*type = TYPE_M3_REC_FIELD_TYPE (rec_type, i); }
+       return 1; }}
+   return 0; 
+ }
+ 		      
+ int
+ find_m3_obj_field (obj_type, name, size, offset, type)
+      struct type *obj_type;
+      char *name;
+      int *size, *offset;
+      struct type **type;
+ {
+   int i;
+   for (i = 0; i < TYPE_M3_OBJ_NFIELDS (obj_type); i++) {
+     if (STREQ (TYPE_M3_OBJ_FIELD_NAME (obj_type, i), name)) {
+       if (size) {
+ 	*size = TYPE_M3_OBJ_FIELD_BITSIZE (obj_type, i); }
+       if (offset) {
+ 	*offset = TYPE_M3_OBJ_FIELD_BITPOS (obj_type, i); }
+       if (type) {
+ 	*type = TYPE_M3_OBJ_FIELD_TYPE (obj_type, i); }
+       return 1; }}
+   return 0; 
+ }
+ 
+ int
+ find_m3_obj_method (obj_type, name, size, offset, type)
+      struct type *obj_type;
+      char *name;
+      int *size, *offset;
+      struct type **type;
+ {
+   int i;
+   for (i = 0; i < TYPE_M3_OBJ_NMETHODS (obj_type); i++) {
+     if (STREQ (TYPE_M3_OBJ_METHOD_NAME (obj_type, i), name)) {
+       if (size) {
+ 	*size = TYPE_M3_OBJ_METHOD_BITSIZE (obj_type, i); }
+       if (offset) {
+ 	*offset = TYPE_M3_OBJ_METHOD_BITPOS (obj_type, i); }
+       if (type) {
+ 	*type = TYPE_M3_OBJ_METHOD_TYPE (obj_type, i); }
+       return 1; }}
+   return 0; 
+ }
+ 
+ void
+ m3_ordinal_bounds (type, lower, upper)
+      struct type *type;
+      register LONGEST *lower;
+      register LONGEST *upper;
+ {
+   switch (TYPE_CODE (type))
+     {
+     case TYPE_CODE_M3_SUBRANGE:
+       *lower = TYPE_M3_SUBRANGE_MIN (type);
+       *upper = TYPE_M3_SUBRANGE_MAX (type);
+       break;
+     case TYPE_CODE_M3_ENUM:
+       *lower = 0;
+       *upper = TYPE_M3_ENUM_NVALS (type) - 1;
+       break;
+     case TYPE_CODE_M3_BOOLEAN:
+       *lower = 0;
+       *upper = 1;
+       break;
+     case TYPE_CODE_M3_CHAR:
+       *lower = 0;
+       *upper = 255;
+       break;
+     case TYPE_CODE_M3_CARDINAL:
+       /* assumes a 2's complement machine... */
+       *lower = 0;
+       *upper = ~ ((-1L) << (TARGET_LONG_BIT-1));
+       break;
+     case TYPE_CODE_M3_INTEGER:
+       /* assumes a 2's complement machine... */
+       *lower = (-1L) << (TARGET_LONG_BIT-1);
+       *upper = ~ ((-1L) << (TARGET_LONG_BIT-1));
+       break;
+     default:
+       error ("gdb internal error: bad Modula-3 ordinal type");
+       *lower = 0;
+       *upper = 0;
+     }
+ }
*** m3-lang.h.orig	Wed Oct 12 10:57:04 1994
--- m3-lang.h	Wed Oct 12 11:30:10 1994
***************
*** 0 ****
--- 1,103 ----
+ /* C language support definitions for GDB, the GNU debugger.
+    Copyright 1992 Free Software Foundation, Inc.
+ 
+ This file is part of GDB.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ extern int
+ m3_parse PARAMS ((void));	/* Defined in c-exp.y */
+ 
+ extern void			/* Defined in c-typeprint.c */
+ m3_print_type PARAMS ((struct type *, char *, FILE *, int, int));
+ 
+ extern int
+ m3_val_print PARAMS ((struct type *, char *, CORE_ADDR, FILE *, int, int,
+ 		     int, enum val_prettyprint));
+ 
+ extern struct type *
+ m3_find_export_type PARAMS ((struct type *));
+ 
+ extern struct type *builtin_type_m3_integer;
+ extern struct type *builtin_type_m3_boolean;
+ extern struct type *builtin_type_m3_void;
+ 
+ extern LONGEST
+ m3_unpack_int PARAMS ((char *valaddr, int bitpos, int bitsize));
+ 
+ extern CORE_ADDR
+ m3_unpack_pointer PARAMS ((char *valaddr, int bitpos));
+ 
+ extern LONGEST
+ m3_unpack_int2 PARAMS ((value_ptr val));
+ 
+ extern double
+ m3_unpack_float2 PARAMS ((value_ptr val));
+ 
+ extern CORE_ADDR
+ m3_unpack_pointer2 PARAMS ((value_ptr val));
+ 
+ extern struct type *
+ find_m3_type_with_uid PARAMS ((int uid));
+ 
+ extern struct type *
+ find_m3_type_named PARAMS ((char *name));
+ 
+ extern struct type *
+ find_m3_exported_interfaces PARAMS ((char *name));
+ 
+ extern struct symbol *
+ find_m3_ir PARAMS ((int kind, char* name));
+ 
+ extern char *
+ find_m3_type_name PARAMS ((struct type *type));
+ 
+ 
+ /* given a heap reference,
+    find the address of the typecell for the actual type */
+ extern CORE_ADDR
+ find_m3_heap_tc_addr PARAMS ((CORE_ADDR addr));
+ 
+ /* given the address of a typecell, find the gdb type for it */
+ extern struct type *
+ find_m3_type_from_tc PARAMS ((CORE_ADDR tc_addr));
+ 
+ /* given a heap reference, find it's actual type */
+ extern struct type *
+ find_m3_heap_type PARAMS ((CORE_ADDR addr));
+ 
+ extern int
+ tc_address_to_dataOffset PARAMS ((CORE_ADDR tc_addr));
+ 
+ extern int
+ tc_address_to_methodOffset PARAMS ((CORE_ADDR tc_addr));
+ 
+ extern int
+ tc_address_to_dataSize PARAMS ((CORE_ADDR tc_addr));
+ 
+ extern CORE_ADDR
+ tc_address_to_parent_tc_address PARAMS ((CORE_ADDR tc_addr));
+ 
+ extern CORE_ADDR
+ tc_address_to_defaultMethods PARAMS ((CORE_ADDR tc_addr));
+ 
+ extern value_ptr
+ m3_value_from_longest PARAMS ((struct type *type, LONGEST num));
+ 
+ extern void
+ m3_ordinal_bounds PARAMS ((struct type *type, LONGEST *lower, LONGEST *upper));
+ 
+ extern int
+ m3_value_print PARAMS ((struct value *, GDB_FILE *, int, enum val_prettyprint));
*** m3-typeprint.c.orig	Wed Oct 12 10:57:04 1994
--- m3-typeprint.c	Wed Oct 12 11:30:10 1994
***************
*** 0 ****
--- 1,369 ----
+ /* Support for printing C and C++ types for GDB, the GNU debugger.
+    Copyright 1986, 1988, 1989, 1991 Free Software Foundation, Inc.
+ 
+ This file is part of GDB.
+ 
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+ 
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+ 
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ 
+ #include "defs.h"
+ #include "obstack.h"
+ #include "bfd.h"		/* Binary File Description */
+ #include "symtab.h"
+ #include "gdbtypes.h"
+ #include "expression.h"
+ #include "value.h"
+ #include "gdbcore.h"
+ #include "target.h"
+ #include "command.h"
+ #include "gdbcmd.h"
+ #include "language.h"
+ #include "demangle.h"
+ #include "c-lang.h"
+ #include "typeprint.h"
+ #include "symfile.h"
+ #include "objfiles.h"
+ 
+ #include <string.h>
+ #include <errno.h>
+ 
+ #include "m3-lang.h"
+ 
+ void
+ m3_type_print_base PARAMS ((struct type *, FILE *, int, int));
+ 
+ 
+ /* Print a description of a type in the format of a 
+    typedef for the current language.
+    NEW is the new name for a type TYPE. */
+ 
+ void
+ m3_typedef_print (type, new, stream)
+    struct type *type;
+    struct symbol *new;
+    FILE *stream;
+ {
+    switch (current_language->la_language)
+    {
+ #ifdef _LANG_c
+    case language_c:
+    case language_cplus:
+       fprintf_filtered(stream, "typedef ");
+       type_print(type,"",stream,0);
+       if(TYPE_NAME ((SYMBOL_TYPE (new))) == 0
+ 	 || !STREQ (TYPE_NAME ((SYMBOL_TYPE (new))), SYMBOL_NAME (new)))
+ 	fprintf_filtered(stream,  " %s", SYMBOL_SOURCE_NAME(new));
+       break;
+ #endif
+ #ifdef _LANG_m2
+    case language_m2:
+       fprintf_filtered(stream, "TYPE ");
+       if(!TYPE_NAME(SYMBOL_TYPE(new)) ||
+ 	 !STREQ (TYPE_NAME(SYMBOL_TYPE(new)), SYMBOL_NAME(new)))
+ 	fprintf_filtered(stream, "%s = ", SYMBOL_SOURCE_NAME(new));
+       else
+ 	 fprintf_filtered(stream, "<builtin> = ");
+       type_print(type,"",stream,0);
+       break;
+ #endif
+ #ifdef _LANG_m3
+    case language_m3:
+       fprintf_filtered(stream, "TYPE %s = ", SYMBOL_SOURCE_NAME(new));
+       type_print(type,"",stream,0);
+       break;
+ #endif
+ #ifdef _LANG_chill
+    case language_chill:
+       error ("Missing Chill support in function m3_typedef_print."); /*FIXME*/
+ #endif
+    default:
+       error("Language not supported.  4");
+    }
+    fprintf_filtered(stream, ";\n");
+ }
+ 
+ 
+ /* LEVEL is the depth to indent lines by.  */
+ 
+ void
+ m3_print_type (type, varstring, stream, show, level)
+      struct type *type;
+      char *varstring;
+      FILE *stream;
+      int show;
+      int level;
+ {
+   m3_type_print_base (type, stream, show, level);
+   if (varstring != NULL && *varstring != '\0') {
+     fputs_filtered (" ", stream); }
+   fputs_filtered (varstring, stream);
+ }
+ 
+ /* Print the name of the type (or the ultimate pointer target,
+    function value or array element), or the description of a
+    structure or union.
+ 
+    SHOW nonzero means don't print this type as just its name;
+    show its real definition even if it has a name.
+    SHOW zero means print just typename or struct tag if there is one
+    SHOW negative means abbreviate structure elements.
+    SHOW is decremented for printing of structure elements.
+ 
+    LEVEL is the depth to indent by.
+    We increase it for some recursive calls.  */
+ 
+ void
+ m3_type_print_base (type, stream, show, level)
+      struct type *type;
+      FILE *stream;
+      int show;
+      int level;
+ {
+   char *name;
+   register int i;
+   register int len;
+   char *mangled_name;
+   char *demangled_name;
+   enum {s_none, s_public, s_private, s_protected} section_type;
+   struct type *t;
+   QUIT;
+ 
+   wrap_here ("    ");
+   if (type == NULL)
+     {
+       fputs_filtered ("<type unknown>", stream);
+       return;
+     }
+ 
+   /* When SHOW is zero or less, and there is a valid type name, then always
+      just print the type name directly from the type. */
+ 
+   if (show <= 0) {
+     char *n = find_m3_type_name (type);
+     if (n) {
+       fputs_filtered (n, stream);
+       return; }}
+ 
+   switch (TYPE_CODE (type))
+     {
+     case TYPE_CODE_M3_ARRAY:
+       fprintf_filtered (stream, "ARRAY ");
+       m3_type_print_base (TYPE_M3_ARRAY_INDEX (type), stream, show-1, level);
+       fprintf_filtered (stream, " OF ");
+       m3_type_print_base (TYPE_M3_ARRAY_ELEM (type), stream, show-1, level);
+       break;
+ 
+     case TYPE_CODE_M3_OPEN_ARRAY:
+       fprintf_filtered (stream, "ARRAY OF ");
+       m3_type_print_base (TYPE_M3_OPEN_ARRAY_ELEM (type), stream, show-1, level);
+       break;
+ 
+     case TYPE_CODE_M3_PACKED:
+       fprintf_filtered (stream, "BITS %d FOR ", TYPE_M3_SIZE (type));
+       m3_type_print_base (TYPE_M3_TARGET (type), stream, show-1, level);
+       break;
+ 
+     case TYPE_CODE_M3_ENUM:
+       fprintf_filtered (stream, "{");
+       for (i = 0; i < TYPE_M3_ENUM_NVALS (type); i++) {
+ 	if (i != 0) {
+ 	  fprintf_filtered (stream, ", "); }
+ 	wrap_here ("    ");
+ 	fputs_filtered (TYPE_M3_ENUM_VALNAME (type, i), stream); }
+       fprintf_filtered (stream, "}");
+       break;
+ 
+     case TYPE_CODE_M3_INDIRECT:
+       m3_type_print_base (TYPE_M3_TARGET (type), stream, show, level);
+       break;
+ 
+     case TYPE_CODE_M3_OBJECT: {
+       int sc = TYPE_CODE (TYPE_M3_OBJ_SUPER (type));
+ 
+        if (sc == TYPE_CODE_M3_ROOT) {
+ 	 /* nothing */ }
+        else if (sc == TYPE_CODE_M3_UN_ROOT) {
+ 	 fprintf_filtered (stream, "UNTRACED "); }
+        else {
+ 	 m3_type_print_base (TYPE_M3_OBJ_SUPER (type) , stream, show-1, level);
+          wrap_here ("  "); }
+ 
+       if (TYPE_M3_OBJ_BRANDED (type)) {
+ 	fprintf_filtered (stream, " BRANDED \"%s\"", 
+ 			  TYPE_M3_OBJ_BRAND (type)); }
+ 
+       fprintf_filtered (stream, " OBJECT ");
+       for (i = 0; i < TYPE_M3_OBJ_NFIELDS (type); i++) {
+ 	fprintf_filtered (stream, "%s: ", TYPE_M3_OBJ_FIELD_NAME (type, i));
+ 	m3_type_print_base (TYPE_M3_OBJ_FIELD_TYPE (type, i), 
+ 			    stream, show-1, level);
+ 	fprintf_filtered (stream, "; ");
+ 	wrap_here ("    "); }
+ 
+       fprintf_filtered (stream, "METHODS ");
+       for (i = 0; i < TYPE_M3_OBJ_NMETHODS (type); i++) {
+ 	fprintf_filtered (stream, "%s ", TYPE_M3_OBJ_METHOD_NAME (type, i));
+ 	m3_type_print_base (TYPE_M3_OBJ_METHOD_TYPE (type, i), stream, show-1, level);
+ 	fprintf_filtered (stream, "; ");
+ 	wrap_here ("    "); }
+       fprintf_filtered (stream, "END;");
+       break; }
+ 
+     case TYPE_CODE_M3_PROC:
+       if (show < 0) {
+ 	fprintf_filtered (stream, "PROCEDURE ..."); 
+ 	break; }
+ 
+       fprintf_filtered (stream, "PROCEDURE (");
+       for (i = 0; i < TYPE_M3_PROC_NARGS (type); i++) {
+ 	if (i != 0) {
+ 	  fprintf_filtered (stream, "; ");
+ 	  wrap_here ("    "); }
+ 	fprintf_filtered (stream, "%s: ", TYPE_M3_PROC_ARG_NAME (type, i));
+ 	m3_type_print_base (TYPE_M3_PROC_ARG_TYPE (type, i), 
+ 			    stream, show-1, level); }
+       fprintf_filtered (stream, ")");
+       if (M3_TYPEP (TYPE_M3_PROC_RESTYPE (type))) {
+ 	fprintf_filtered (stream, ": ");
+ 	m3_type_print_base (TYPE_M3_PROC_RESTYPE (type),
+ 			    stream, show-1, level); }
+       switch (TYPE_M3_PROC_NRAISES (type))
+ 	{
+ 	case -1: fprintf_filtered (stream, " RAISES ANY");  break;
+         case  0:                                            break;
+ 	default: fprintf_filtered (stream, " RAISES {");
+ 	  for (i = 0; i < TYPE_M3_PROC_NRAISES (type); i++) {
+ 	    if (i != 0) {
+ 	      fprintf_filtered (stream, ", ");
+ 	      wrap_here ("    "); }
+ 	    fprintf_filtered (stream, "%s", 
+ 			      TYPE_M3_PROC_RAISE_NAME (type, i)); }
+ 	  fprintf_filtered (stream, "}"); }
+       break;
+ 	  
+     case TYPE_CODE_M3_RECORD:
+       fprintf_filtered (stream, "RECORD ");
+       for (i = 0; i < TYPE_M3_REC_NFIELDS (type); i++) {
+ 	fprintf_filtered (stream, "%s: ", TYPE_M3_REC_FIELD_NAME (type, i));
+ 	m3_type_print_base (TYPE_M3_REC_FIELD_TYPE (type, i),
+ 			    stream, show-1, level);
+ 	fprintf_filtered (stream, "; ");
+ 	wrap_here ("    "); }
+       fprintf_filtered (stream, "END; ");
+       break;
+       
+     case TYPE_CODE_M3_SET:
+       fprintf_filtered (stream, "SET OF ");
+       m3_type_print_base (TYPE_M3_SET_TARGET (type), stream, show-1, level);
+       break; 
+ 
+     case TYPE_CODE_M3_POINTER: {
+       if (! TYPE_M3_POINTER_TRACED (type)) {
+ 	fprintf_filtered (stream, "UNTRACED "); }
+ 	
+       if (TYPE_M3_POINTER_BRANDED (type)) {
+ 	fprintf_filtered (stream, "BRANDED \"%s\" ",
+ 			  TYPE_M3_POINTER_BRAND (type)); }
+       fprintf_filtered (stream, "REF ");
+       if (show >= 0) {
+ 	m3_type_print_base (TYPE_M3_POINTER_TARGET (type), stream,
+ 			    show-1, level); }
+       else {
+ 	fprintf_filtered (stream, "..."); }
+       break; }
+ 	
+     case TYPE_CODE_M3_SUBRANGE: {
+       LONGEST lower, upper;
+       struct type *target = TYPE_M3_SUBRANGE_TARGET (type);
+       int en = (TYPE_CODE (target) == TYPE_CODE_M3_ENUM);
+       
+       m3_ordinal_bounds (type, &lower, &upper);
+       fprintf_filtered (stream, "[");
+       if (en) {
+ 	fputs_filtered (TYPE_M3_ENUM_VALNAME (target, lower), stream); }
+       else {
+ 	fprintf_filtered (stream, "%ld", lower); }
+       fprintf_filtered (stream, " .. ");
+       if (en) {
+ 	fputs_filtered (TYPE_M3_ENUM_VALNAME (target, upper), stream); }
+       else {
+ 	fprintf_filtered (stream, "%ld", upper); }
+       fprintf_filtered (stream, "]");
+       break; }
+ 
+     case TYPE_CODE_M3_ADDRESS:
+       fprintf_filtered (stream, "ADDRESS");
+       break; 
+ 
+     case TYPE_CODE_M3_BOOLEAN:
+       fprintf_filtered (stream, "BOOLEAN");
+       break; 
+ 
+     case TYPE_CODE_M3_CHAR:
+       fprintf_filtered (stream, "CHAR");
+       break; 
+ 
+     case TYPE_CODE_M3_INTEGER:
+       fprintf_filtered (stream, "INTEGER");
+       break; 
+ 
+     case TYPE_CODE_M3_CARDINAL:
+       fprintf_filtered (stream, "CARDINAL");
+       break; 
+ 
+     case TYPE_CODE_M3_REFANY:
+       fprintf_filtered (stream, "REFANY");
+       break; 
+ 
+     case TYPE_CODE_M3_MUTEX:
+       fprintf_filtered (stream, "MUTEX");
+       break; 
+ 
+     case TYPE_CODE_M3_NULL:
+       fprintf_filtered (stream, "NULL");
+       break; 
+ 
+     case TYPE_CODE_M3_ROOT:
+       fprintf_filtered (stream, "ROOT");
+       break; 
+ 
+     case TYPE_CODE_M3_TEXT:
+       fprintf_filtered (stream, "TEXT");
+       break; 
+ 
+     case TYPE_CODE_M3_UN_ROOT:
+       fprintf_filtered (stream, "UNTRACED ROOT");
+       break; 
+ 
+     case TYPE_CODE_M3_VOID:
+       fprintf_filtered (stream, "VOID");
+       break; 
+ 
+     default:
+       /* Handle types not explicitly handled by the other cases,
+ 	 such as fundamental types.  For these, just print whatever
+ 	 the type name is, as recorded in the type itself.  If there
+ 	 is no type name, then complain. */
+       if (TYPE_NAME (type) != NULL)
+ 	{
+ 	  fputs_filtered (TYPE_NAME (type), stream);
+ 	}
+       else
+ 	{
+ 	  c_type_print_base (type, stream, show, level);
+ 	}
+       break;
+     }
+ }
+ 
*** m3-valprint.c.orig	Wed Oct 12 10:57:04 1994
--- m3-valprint.c	Wed Oct 12 11:30:10 1994
***************
*** 0 ****
--- 1,613 ----
+ /* Support for printing Modula-3 values for GDB, the GNU debugger.
+    Copyright 1994, Digitial Equipement Corporation */
+ 
+ #include "defs.h"
+ #include "symtab.h"
+ #include "gdbtypes.h"
+ #include "expression.h"
+ #include "value.h"
+ #include "demangle.h"
+ #include "valprint.h"
+ #include "language.h"
+ 
+ #include "m3-lang.h"
+ 
+ 
+ LONGEST
+ m3_unpack_int (valaddr, bitpos, bitsize)
+      char *valaddr;
+      int bitpos;
+      int bitsize;
+ {
+   LONGEST res, mask; 
+   int u;
+ 
+   if (bitsize <= 8) {		/* char access */
+     valaddr += bitpos / 8;
+     bitpos = bitpos % 8;
+     res = *((char *)valaddr);
+     u = 8; }
+   else if (bitsize <= 16) {	/* short access */
+     short *v = (short *)valaddr;
+     v += bitpos / 16;
+     bitpos = bitpos % 16;
+     res = *v;
+     u = 16; }
+   else if (bitsize <= 32) {	/* int access */
+     int *v = (int *)valaddr;
+     v += bitpos / 32;
+     bitpos = bitpos % 32;
+     res = *v;
+     u = 32; }
+   else if (bitsize <= TARGET_LONG_BIT) {	/* int access */
+     long *v = (long *)valaddr;
+     v += bitpos / 64;
+     bitpos = bitpos % 64;
+     res = *v;
+     u = 64; }
+   else {
+     error ("wrong bitsize in m3_unpack_int: %d", bitsize); }
+   
+   res = res >> bitpos;
+   res = res & ((~0L) >> (sizeof (res) * HOST_CHAR_BIT - bitsize));
+   return res;
+ }
+ 
+ LONGEST
+ m3_unpack_int2 (val)
+      value_ptr val;
+ {
+   return m3_unpack_int (VALUE_CONTENTS (val),  0,
+ 			TYPE_M3_SIZE (VALUE_TYPE (val)));
+ }
+ 
+ 
+ CORE_ADDR
+ m3_unpack_pointer (valaddr, bitpos)
+      char *valaddr;
+      int bitpos;
+ {
+   return (CORE_ADDR) m3_unpack_int (valaddr, bitpos, TARGET_PTR_BIT);
+ }
+ 
+ CORE_ADDR
+ m3_unpack_pointer2 (val)
+      value_ptr val;
+ {
+   return *(CORE_ADDR*) VALUE_CONTENTS (val);
+ }
+ 
+ 
+ double 
+ m3_unpack_float2 (val)
+      value_ptr val;
+ {
+   double res;
+   int size = TYPE_LENGTH (VALUE_TYPE (val));
+ 
+   if (size == 4) {
+     res = *(float *) VALUE_CONTENTS (val); }
+   else {
+     res = *(double*) VALUE_CONTENTS (val); }
+ }
+ 
+ 
+ static void 
+ m3_print_scalar (valaddr, bitpos, bitsize, stream, format)
+      char *valaddr;
+      int bitpos, bitsize;
+      FILE *stream;
+      int format;
+ {
+   LONGEST v = m3_unpack_int (valaddr, bitpos, bitsize);
+ 
+   switch (format) {
+     case 'x': fprintf_filtered (stream, "16_%lx", v); break;
+     case 'o': fprintf_filtered (stream, "8_%lo", v);  break;
+     case 'd':
+     default:  fprintf_filtered (stream, "%ld", v);    break; }
+ }
+ 
+ static 
+ m3_print_object_1 (valaddr, tc_addr, stream, format)
+      char *valaddr;
+      CORE_ADDR tc_addr;
+      FILE *stream;
+      int format;
+ {
+   char name [100];
+   struct type *this_obj;
+   struct symbol *this_obj_sym;
+   int i, data_offset; 
+   if (tc_addr == 0) {
+     return; }
+ 
+   this_obj = find_m3_type_from_tc (tc_addr);
+   if (TYPE_CODE (this_obj) == TYPE_CODE_M3_ROOT
+       || TYPE_CODE (this_obj) == TYPE_CODE_M3_UN_ROOT) {
+     return; }
+ 
+   m3_print_object_1 (valaddr, tc_address_to_parent_tc_address (tc_addr),
+ 		     stream, format);
+ 
+   data_offset = tc_address_to_dataOffset (tc_addr);
+ 
+   fputs_filtered ("{", stream);
+   for (i = 0; i < TYPE_M3_OBJ_NFIELDS (this_obj); i++) {
+     if (i != 0) {
+       fputs_filtered (", ", stream);
+       wrap_here ("    "); }
+     fputs_filtered (TYPE_M3_OBJ_FIELD_NAME (this_obj, i), stream);
+     fputs_filtered (" = ", stream);
+     m3_val_print2 (TYPE_M3_OBJ_FIELD_TYPE (this_obj, i), 
+ 		   valaddr, 
+ 		   data_offset * TARGET_CHAR_BIT + 
+ 		      TYPE_M3_OBJ_FIELD_BITPOS (this_obj, i),
+ 		   TYPE_M3_OBJ_FIELD_BITSIZE (this_obj, i),
+ 		   stream, format, 0, 0); }
+   fputs_filtered ("}", stream);
+ }
+ 
+ void m3_read_object_fields_bits (valaddr, bitpos, type, tc_addr_res, bits)
+      char *valaddr;
+      int bitpos;
+      struct type *type;
+      CORE_ADDR *tc_addr_res;
+      char **bits;
+ {
+   int typecode;
+   CORE_ADDR bits_addr, typecode_addr, tc_addr;
+   int dataSize, dataOffset;
+ 
+   bits_addr = m3_unpack_int (valaddr, bitpos, TARGET_PTR_BIT);
+ 
+   if (bits_addr == 0) {
+     *bits = 0;
+     return; }
+ 
+   tc_addr = find_m3_heap_tc_addr (bits_addr);
+   dataSize = tc_address_to_dataSize (tc_addr);
+   *bits = malloc (dataSize);
+   target_read_memory (bits_addr, *bits, dataSize);
+   if (tc_addr_res != 0) {
+     *tc_addr_res = tc_addr; }
+ }
+ 
+ static void
+ m3_print_object (valaddr, bitpos, type, stream, format)
+      char *valaddr;
+      int bitpos;
+      struct type *type;
+      FILE *stream;
+      int format;
+ {
+   char *bits;
+   CORE_ADDR tc_addr;
+ 
+   m3_read_object_fields_bits (valaddr, bitpos, type, &tc_addr, &bits);
+ 
+   if (bits == 0) {
+     fputs_filtered ("NIL", stream); 
+     return; }
+ 
+   m3_print_object_1 (bits, tc_addr, stream, format);
+ }
+ 
+ 
+ /* Print data of type TYPE located at VALADDR (within GDB), which came from
+    the inferior at address ADDRESS, onto stdio stream STREAM according to
+    FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
+    target byte order.
+    
+    If the data are a string pointer, returns the number of string characters
+    printed.
+    
+    If DEREF_REF is nonzero, then dereference references, otherwise just print
+    them like pointers.
+    
+    The PRETTY parameter controls prettyprinting.  */
+ 
+ static int 
+ compare (valaddr, bitpos1, bitpos2, bitsize)
+      char *valaddr;
+      int bitpos1, bitpos2, bitsize;
+ {
+   if ((bitpos1 % 8) != 0 || (bitpos2 % 8) != 0 || (bitsize % 8 != 0)) {
+     /* this comparaisons are too hard for now */
+     return 0; }
+   return memcmp (valaddr + bitpos1/8, valaddr + bitpos2/8, bitsize/8) == 0;
+ }
+ 
+ extern unsigned int repeat_count_threshold;
+ 
+ int
+ m3_val_print2 (type, valaddr, bitpos, bitsize, stream, format, deref_ref, toplevel)
+      struct type *type;
+      char *valaddr;
+      int bitpos;
+      int bitsize;
+      FILE *stream;
+      int format;
+      int deref_ref;
+      int toplevel;
+ {
+   register unsigned int i = 0;		/* Number of characters printed */
+   unsigned len;
+   struct type *elttype;
+   unsigned eltlen;
+   LONGEST val;
+   unsigned char c;
+   CORE_ADDR addr;
+   int things_printed = 0;
+   int reps, j;
+ 
+   switch (TYPE_CODE (type))
+     {
+     case TYPE_CODE_M3_ARRAY: {
+       struct type *index = TYPE_M3_ARRAY_INDEX (type);
+       struct type *elt   = TYPE_M3_ARRAY_ELEM (type);
+       LONGEST lower, upper, n;
+       
+       fputs_filtered ("{", stream);
+ 
+       m3_ordinal_bounds (index, &lower, &upper);
+       n = upper - lower + 1;
+ 
+       for (i = things_printed = 0; i < n && things_printed < print_max; i++) {
+ 	if (i != 0) {
+ 	  fputs_filtered (", ", stream);
+ 	  wrap_here ("    "); }
+ 
+ 	m3_val_print2 (elt, valaddr, 
+ 		       bitpos + i * TYPE_M3_SIZE (elt), TYPE_M3_SIZE (elt),
+ 		       stream, format, 0, 0);
+         things_printed++;
+ 	for (j = i + 1, reps = 1; 
+ 	     j < n &&  compare (valaddr, bitpos + i * TYPE_M3_SIZE (elt),
+ 				bitpos + j * TYPE_M3_SIZE (elt),
+ 				TYPE_M3_SIZE (elt));
+ 	     j++, reps++);
+ 	if (reps > repeat_count_threshold) {
+ 	  fprintf_filtered (stream, " <repeats %d times>", reps);
+ 	  i += reps - 1;
+ 	  things_printed += repeat_count_threshold; }}
+ 	    
+       if (i < n) {
+ 	fputs_filtered ("...", stream); }
+ 
+       fputs_filtered ("}", stream);
+       break; }
+       
+     case TYPE_CODE_M3_OPEN_ARRAY: {
+       struct type *elt_type   = TYPE_M3_OPEN_ARRAY_ELEM (type);
+       CORE_ADDR elems = m3_unpack_pointer (valaddr, bitpos);
+       int      nelems = m3_unpack_int (valaddr + TARGET_PTR_BIT/HOST_CHAR_BIT,
+ 				       bitpos, TARGET_LONG_BIT);
+       int      eltsize = 1;
+ 
+       if (bitpos % HOST_CHAR_BIT != 0) {
+ 	error ("improperly aligned open array"); }
+ 
+       valaddr += (bitpos / HOST_CHAR_BIT);
+       bitpos = 0;
+ 
+       { struct type *e = elt_type;
+ 	char *nelem_addr = valaddr
+ 	                    + (TARGET_PTR_BIT + TARGET_LONG_BIT)/HOST_CHAR_BIT;
+ 	while (TYPE_CODE (e) == TYPE_CODE_M3_OPEN_ARRAY) {
+ 	  eltsize = eltsize * m3_unpack_int (nelem_addr, 0, TARGET_LONG_BIT);
+ 	  nelem_addr += TARGET_LONG_BIT / HOST_CHAR_BIT;
+ 	  e = TYPE_M3_OPEN_ARRAY_ELEM (e); }
+ 	eltsize = eltsize * TYPE_M3_SIZE (e); }
+       if (eltsize % 8 != 0) {
+ 	error ("another improper alignment"); }
+       eltsize = eltsize / 8;
+ 
+       fputs_filtered ("{", stream);
+       if (TYPE_CODE (elt_type) == TYPE_CODE_M3_OPEN_ARRAY) {
+ 	for (i = things_printed = 0; 
+ 	     i < nelems && things_printed < print_max; i++) {
+ 	  if (i > 0) {
+ 	    fputs_filtered (",", stream); 
+ 	    wrap_here ("    "); }
+ 	  *(long*)(valaddr + TARGET_PTR_BIT / HOST_CHAR_BIT) = elems + i * eltsize;
+ 	  m3_val_print2 (elt_type, valaddr + TARGET_PTR_BIT / HOST_CHAR_BIT, 
+ 			 0, TYPE_M3_SIZE (elt_type), 
+ 			 stream, format, 0, 0);
+ 	  things_printed++; }}
+       else {
+ 	char *a = alloca (eltsize);
+ 	char *previous = alloca (eltsize);
+ 	reps = 0;
+ 	for (i = things_printed = 0; 
+ 	     i < nelems && things_printed < print_max; i++) {
+ 	  target_read_memory (elems, a, eltsize);
+ 	  if (reps > 0 && memcmp (a, previous, eltsize) == 0) {
+ 	    reps++; }
+ 	  else {
+ 	    if (reps > 1) {
+ 	      if (reps > repeat_count_threshold) {
+ 		fprintf_filtered (stream, " <repeats %d times>", reps); }
+ 	      else {
+ 		for (j = 0; j < reps - 1 && things_printed < print_max; j++) {
+ 		  if (things_printed) {
+ 		    fputs_filtered (",", stream); 
+ 		    wrap_here ("    "); }
+ 		  m3_val_print2 (elt_type, previous, 
+ 				 0, TYPE_M3_SIZE (elt_type), 
+ 				 stream, format, 0, 0);
+ 		  things_printed++; }}
+ 	      things_printed += reps; }
+ 	    if (things_printed < print_max) {
+ 	      if (things_printed) {
+ 		fputs_filtered (",", stream); 
+ 		wrap_here ("    "); }
+ 	      m3_val_print2 (elt_type, a, 
+ 			     0, TYPE_M3_SIZE (elt_type), 
+ 			     stream, format, 0, 0);
+ 	      things_printed++; }
+ 	    reps = 1;
+ 	    memcpy (previous, a, eltsize); }
+ 	  elems += eltsize; }
+ 	if (reps > 1) {
+ 	  if (reps > repeat_count_threshold) {
+ 	    fprintf_filtered (stream, " <repeats %d times>", reps); 
+ 	    things_printed += reps - 1; }
+ 	  else {
+ 	    for (j = 0; j < reps - 1 && things_printed < print_max; j++) {
+ 	      if (things_printed) {
+ 		fputs_filtered (",", stream); 
+ 		wrap_here ("    ");  }
+ 	      m3_val_print2 (elt_type, previous, 
+ 			     0, TYPE_M3_SIZE (elt_type),
+ 			     stream, format, 0, 0);
+ 	      things_printed++; }}}}
+       if (things_printed < nelems) {
+ 	fputs_filtered ("...", stream); }
+       fputs_filtered ("}", stream);
+       break; }
+ 
+     case TYPE_CODE_M3_PACKED: {
+       m3_val_print2 (TYPE_M3_TARGET (type), valaddr,
+ 		     bitpos, TYPE_M3_SIZE (type),
+ 		     stream, format, 0, 0);
+       break; }
+       
+     case TYPE_CODE_M3_ENUM: {
+       long val = m3_unpack_int (valaddr, bitpos, bitsize);
+       fputs_filtered (TYPE_M3_ENUM_VALNAME (type, val), stream);
+       break; }
+       
+     case TYPE_CODE_M3_INDIRECT: {
+       CORE_ADDR target_addr = m3_unpack_pointer (valaddr, 0);
+       struct type *target = TYPE_M3_INDIRECT_TARGET (type);
+       int target_size = TYPE_LENGTH (target);
+       char *target_val = alloca (target_size); 
+       
+       target_read_memory (target_addr, target_val, target_size);
+       m3_val_print2 (target, target_val, 
+ 		     0, TYPE_M3_SIZE (target), 
+ 		     stream, format, deref_ref, toplevel);
+       break; }
+       
+     case TYPE_CODE_M3_PROC: {
+       m3_print_scalar (valaddr, bitpos, bitsize, stream, format);
+       break; }
+       
+     case TYPE_CODE_M3_RECORD: {
+       int nonfirst = 0;
+ 
+       fputs_filtered ("{", stream);
+       for (i = 0; i < TYPE_M3_REC_NFIELDS (type); i++) {
+ 	if (TYPE_M3_REC_FIELD_NAME (type, i)[0] != '_') {
+ 	  if (nonfirst != 0) {
+ 	    fputs_filtered (", ", stream);
+ 	    wrap_here ("    "); }
+ 	  nonfirst = 1;
+ 
+ 	  fputs_filtered (TYPE_M3_REC_FIELD_NAME (type, i), stream);
+ 	  fputs_filtered (" = ", stream);
+ 	  m3_val_print2 (TYPE_M3_REC_FIELD_TYPE (type, i), valaddr,
+ 			 bitpos + TYPE_M3_REC_FIELD_BITPOS (type, i),
+ 			 TYPE_M3_SIZE (TYPE_M3_REC_FIELD_TYPE (type, i)),
+ 			 stream, format, 0, 0);  }}
+       fputs_filtered ("}", stream);
+       break; }
+       
+     case TYPE_CODE_M3_SET: {
+       int n = 0;
+       int j;
+       LONGEST lower, upper;
+       struct type *target = TYPE_M3_SET_TARGET (type);
+       int nelems = TYPE_NFIELDS (target);
+       int en = (TYPE_CODE (target) == TYPE_CODE_M3_ENUM);
+       int ch = (TYPE_CODE (target) == TYPE_CODE_M3_CHAR);
+       int chs = (TYPE_CODE (target) == TYPE_CODE_M3_SUBRANGE)
+ 	&& (TYPE_CODE (TYPE_M3_SUBRANGE_TARGET (target)) == TYPE_CODE_M3_CHAR);
+ 
+       m3_ordinal_bounds (target, &lower, &upper);
+       fputs_filtered ("{", stream);
+       
+       for (i = 0; i < TYPE_LENGTH (type) / sizeof (long); i++) {
+ 	val = m3_unpack_int (valaddr, bitpos, TARGET_LONG_BIT);
+ 	for (j = 0; j < TARGET_LONG_BIT; j++) {
+ 	  LONGEST ord = i * TARGET_LONG_BIT + j + lower;
+ 	  if (val & 1 << j) {
+ 	    if (n > 0) {
+ 	      fputs_filtered (", ", stream); }
+ 	    if (en) {
+ 	      fputs_filtered (TYPE_FIELD_NAME (target, ord), stream); }
+ 	    else if (ch) {
+ 	      fprintf_filtered (stream, "'%c'", ord); }
+ 	    else if (chs) {
+ 	      fprintf_filtered (stream, "'%c'", ord); }
+ 	    else {
+ 	      fprintf_filtered (stream, "%ld", ord); }
+ 	    n++; }}
+ 	valaddr += sizeof (long); }
+       
+       fputs_filtered ("}", stream);
+       
+       break; }
+       
+     case TYPE_CODE_M3_SUBRANGE: {
+       struct type *target = TYPE_M3_SUBRANGE_TARGET (type);
+       if (TYPE_CODE (target) == TYPE_CODE_M3_ENUM) {
+ 	long val = m3_unpack_int (valaddr, bitpos, TYPE_M3_SIZE (type));
+ 	fputs_filtered (TYPE_M3_ENUM_VALNAME (target, val), stream); }
+       else {
+ 	m3_print_scalar (valaddr, bitpos, bitsize, stream, format); }
+       break; }
+ 
+     case TYPE_CODE_M3_ADDRESS:
+       m3_print_scalar (valaddr, bitpos, bitsize, stream, 
+ 		       format ? format : 'x');
+       break;
+ 
+     case TYPE_CODE_M3_BOOLEAN:
+       if (m3_unpack_int (valaddr, bitpos, bitsize)) {
+ 	fputs_filtered ("TRUE", stream); }
+       else {
+ 	fputs_filtered ("FALSE", stream); }
+       break;
+ 
+     case TYPE_CODE_M3_CHAR:
+       m3_printchar (m3_unpack_int (valaddr, bitpos, 8), stream);
+       break;
+ 
+     case TYPE_CODE_M3_INTEGER:
+     case TYPE_CODE_M3_CARDINAL:
+     case TYPE_CODE_M3_NULL:
+     case TYPE_CODE_M3_VOID:
+       m3_print_scalar (valaddr, bitpos, bitsize, stream, format);
+       break;
+ 
+     case TYPE_CODE_M3_ROOT:
+     case TYPE_CODE_M3_UN_ROOT:
+     case TYPE_CODE_M3_OBJECT: {
+       if (deref_ref && !format) {
+ 	m3_print_object (valaddr, bitpos, type, stream, format); }
+       else {
+ 	m3_print_scalar (valaddr, bitpos, bitsize, stream, 
+ 			 format ? format : 'x'); }
+       break; }
+ 
+     case TYPE_CODE_M3_REFANY: {
+       m3_print_scalar (valaddr, bitpos, bitsize, stream, 
+ 		       format ? format : 'x');
+       break; }
+ 
+     case TYPE_CODE_M3_POINTER: {
+       struct type *target = TYPE_M3_POINTER_TARGET (type);
+       if (TYPE_CODE (target) == TYPE_CODE_M3_OPEN_ARRAY
+ 	  && TYPE_CODE (TYPE_M3_OPEN_ARRAY_ELEM (target)) == TYPE_CODE_M3_CHAR) {
+ 	CORE_ADDR chars_addr;
+ 	CORE_ADDR text_value;
+ 	text_value = m3_unpack_pointer (valaddr, bitpos);
+ 	if (text_value == 0) {
+ 	  fputs_filtered ("NIL", stream); }
+ 	else {
+ 	  target_read_memory (text_value, &chars_addr, TYPE_M3_SIZE (type));
+ 	  val_print_string (chars_addr, 0, stream); }}
+       else {
+ 	m3_print_scalar (valaddr, bitpos, bitsize, stream, 
+ 			 format ? format : 'x'); }
+ 
+       break; }
+ 
+     case TYPE_CODE_FLT: {
+       if (format) {
+ 	m3_print_scalar (valaddr, bitpos, bitsize, stream, format); }
+       else {
+ 	if (bitpos % 8 != 0) {
+ 	  error ("improperly aligned floating point value"); }
+ 	print_floating (valaddr + bitpos / 8, type, stream); }
+       break; }
+ 
+     default: 
+      return 1; }
+ 
+   fflush (stream);
+   return (0);
+ }
+ 
+ int
+ m3_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
+ 	     pretty)
+      struct type *type;
+      char *valaddr;
+      CORE_ADDR address;
+      FILE *stream;
+      int format;
+      int deref_ref;
+      int recurse;
+      enum val_prettyprint pretty;
+ {
+   if (m3_val_print2 (type, valaddr, 0, TYPE_M3_SIZE (type),
+ 		     stream, format, deref_ref, 1)) {
+     /* like the value of registers */
+     c_val_print (type, valaddr, address, stream, format, deref_ref,
+ 		 recurse, pretty); }
+ }
+ 
+ 
+ int
+ m3_value_print (val, stream, format, pretty)
+      value_ptr val;
+      GDB_FILE *stream;
+      int format;
+      enum val_prettyprint pretty;
+ {
+   /* A "repeated" value really contains several values in a row.
+      They are made by the @ operator.
+      Print such values as if they were arrays.  */
+ 
+   if (VALUE_REPEATED (val))
+     {
+       register unsigned int n = VALUE_REPETITIONS (val);
+       register unsigned int typelen = TYPE_LENGTH (VALUE_TYPE (val));
+       fprintf_filtered (stream, "{");
+       /* Print arrays of characters using string syntax.  */
+       if (typelen == 1 && TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_INT
+ 	  && format == 0)
+ 	LA_PRINT_STRING (stream, VALUE_CONTENTS (val), n, 0);
+       else
+ 	{
+ 	  value_print_array_elements (val, stream, format, pretty);
+ 	}
+       fprintf_filtered (stream, "}");
+       return (n * typelen);
+     }
+   else
+     {
+       struct type *type = VALUE_TYPE (val);
+ 
+       /* If it is a pointer, indicate what it points to.
+ 
+ 	 Print type also if it is a reference.
+ 
+          C++: if it is a member pointer, we will take care
+ 	 of that when we print it.  */
+       if (TYPE_CODE (type) == TYPE_CODE_PTR ||
+ 	  TYPE_CODE (type) == TYPE_CODE_REF)
+ 	{
+ 	  /* Hack:  remove (char *) for char strings.  Their
+ 	     type is indicated by the quoted string anyway. */
+           if (TYPE_CODE (type) == TYPE_CODE_PTR &&
+ 	      TYPE_LENGTH (TYPE_TARGET_TYPE (type)) == sizeof(char) &&
+ 	      TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_INT &&
+ 	      !TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
+ 	    {
+ 		/* Print nothing */
+ 	    }
+ 	  else
+ 	    {
+ 	      fprintf_filtered (stream, "(");
+ 	      type_print (type, "", stream, -1);
+ 	      fprintf_filtered (stream, ") ");
+ 	    }
+ 	}
+       return (val_print (type, VALUE_CONTENTS (val),
+ 			 VALUE_ADDRESS (val), stream, format, 1, 0, pretty));
+     }
+ }
*** mdebugread.c.orig	Wed Oct 12 10:57:04 1994
--- mdebugread.c	Wed Oct 12 12:49:06 1994
***************
*** 39,48 ****
--- 39,49 ----
     This module can read all four of the known byte-order combinations,
     on any type of host.  */
  
  #include "defs.h"
  #include "symtab.h"
+ #include "value.h"
  #include "gdbtypes.h"
  #include "gdbcore.h"
  #include "symfile.h"
  #include "objfiles.h"
  #include "obstack.h"
***************
*** 746,758 ****
        SYMBOL_CLASS (s) = class;
        add_symbol (s, b);
  
        /* Type could be missing in a number of cases */
        if (sh->sc == scUndefined || sh->sc == scNil)
! 	SYMBOL_TYPE (s) = builtin_type_int;	/* undefined? */
        else
! 	SYMBOL_TYPE (s) = parse_type (cur_fd, ax, sh->index, 0, bigend, name);
        /* Value of a data symbol is its memory address */
        break;
  
      case stParam:		/* arg to procedure, goes into current block */
        max_gdbinfo++;
--- 747,759 ----
        SYMBOL_CLASS (s) = class;
        add_symbol (s, b);
  
        /* Type could be missing in a number of cases */
        if (sh->sc == scUndefined || sh->sc == scNil)
! 	SET_SYMBOL_TYPE (s) = builtin_type_int;	/* undefined? */
        else
! 	SET_SYMBOL_TYPE (s) = parse_type (cur_fd, ax, sh->index, 0, bigend, name);
        /* Value of a data symbol is its memory address */
        break;
  
      case stParam:		/* arg to procedure, goes into current block */
        max_gdbinfo++;
***************
*** 784,794 ****
  	  /* Pass by value on stack.  */
  	  SYMBOL_CLASS(s) = LOC_ARG;
  	  break;
  	}
        SYMBOL_VALUE (s) = svalue;
!       SYMBOL_TYPE (s) = parse_type (cur_fd, ax, sh->index, 0, bigend, name);
        add_symbol (s, top_stack->cur_block);
  #if 0
        /* FIXME:  This has not been tested.  See dbxread.c */
        /* Add the type of this parameter to the function/procedure
  		   type of this block. */
--- 785,795 ----
  	  /* Pass by value on stack.  */
  	  SYMBOL_CLASS(s) = LOC_ARG;
  	  break;
  	}
        SYMBOL_VALUE (s) = svalue;
!       SET_SYMBOL_TYPE (s) = parse_type (cur_fd, ax, sh->index, 0, bigend, name);
        add_symbol (s, top_stack->cur_block);
  #if 0
        /* FIXME:  This has not been tested.  See dbxread.c */
        /* Add the type of this parameter to the function/procedure
  		   type of this block. */
***************
*** 799,809 ****
      case stLabel:		/* label, goes into current block */
        s = new_symbol (name);
        SYMBOL_NAMESPACE (s) = VAR_NAMESPACE;	/* so that it can be used */
        SYMBOL_CLASS (s) = LOC_LABEL;	/* but not misused */
        SYMBOL_VALUE_ADDRESS (s) = (CORE_ADDR) sh->value;
!       SYMBOL_TYPE (s) = builtin_type_int;
        add_symbol (s, top_stack->cur_block);
        break;
  
      case stProc:		/* Procedure, usually goes into global block */
      case stStaticProc:		/* Static procedure, goes into current block */
--- 800,810 ----
      case stLabel:		/* label, goes into current block */
        s = new_symbol (name);
        SYMBOL_NAMESPACE (s) = VAR_NAMESPACE;	/* so that it can be used */
        SYMBOL_CLASS (s) = LOC_LABEL;	/* but not misused */
        SYMBOL_VALUE_ADDRESS (s) = (CORE_ADDR) sh->value;
!       SET_SYMBOL_TYPE (s) = builtin_type_int;
        add_symbol (s, top_stack->cur_block);
        break;
  
      case stProc:		/* Procedure, usually goes into global block */
      case stStaticProc:		/* Static procedure, goes into current block */
***************
*** 838,848 ****
        /* Generate a template for the type of this function.  The
  	 types of the arguments will be added as we read the symbol
  	 table. */
        memcpy (lookup_function_type (t), SYMBOL_TYPE (s), sizeof (struct type));
  #else
!       SYMBOL_TYPE (s) = lookup_function_type (t);
  #endif
  
        /* Create and enter a new lexical context */
        b = new_block (top_stack->maxsyms);
        SYMBOL_BLOCK_VALUE (s) = b;
--- 839,849 ----
        /* Generate a template for the type of this function.  The
  	 types of the arguments will be added as we read the symbol
  	 table. */
        memcpy (lookup_function_type (t), SYMBOL_TYPE (s), sizeof (struct type));
  #else
!       SET_SYMBOL_TYPE (s) = lookup_function_type (t);
  #endif
  
        /* Create and enter a new lexical context */
        b = new_block (top_stack->maxsyms);
        SYMBOL_BLOCK_VALUE (s) = b;
***************
*** 1076,1086 ****
  			    obstack_alloc (&current_objfile->symbol_obstack,
  					   sizeof (struct symbol)));
  		memset ((PTR) enum_sym, 0, sizeof (struct symbol));
  		SYMBOL_NAME (enum_sym) = f->name;
  		SYMBOL_CLASS (enum_sym) = LOC_CONST;
! 		SYMBOL_TYPE (enum_sym) = t;
  		SYMBOL_NAMESPACE (enum_sym) = VAR_NAMESPACE;
  		SYMBOL_VALUE (enum_sym) = tsym.value;
  		add_symbol (enum_sym, top_stack->cur_block);
  
  		/* Skip the stMembers that we've handled. */
--- 1077,1087 ----
  			    obstack_alloc (&current_objfile->symbol_obstack,
  					   sizeof (struct symbol)));
  		memset ((PTR) enum_sym, 0, sizeof (struct symbol));
  		SYMBOL_NAME (enum_sym) = f->name;
  		SYMBOL_CLASS (enum_sym) = LOC_CONST;
! 		SET_SYMBOL_TYPE (enum_sym) = t;
  		SYMBOL_NAMESPACE (enum_sym) = VAR_NAMESPACE;
  		SYMBOL_VALUE (enum_sym) = tsym.value;
  		add_symbol (enum_sym, top_stack->cur_block);
  
  		/* Skip the stMembers that we've handled. */
***************
*** 1096,1116 ****
  	if (sh->iss == 0)
  	  break;
  
  	/* gcc puts out an empty struct for an opaque struct definitions,
  	   do not create a symbol for it either.  */
! 	if (TYPE_NFIELDS (t) == 0)
  	  {
  	    TYPE_FLAGS (t) |= TYPE_FLAG_STUB;
  	    break;
  	  }
  
  	s = new_symbol (name);
  	SYMBOL_NAMESPACE (s) = STRUCT_NAMESPACE;
  	SYMBOL_CLASS (s) = LOC_TYPEDEF;
  	SYMBOL_VALUE (s) = 0;
! 	SYMBOL_TYPE (s) = t;
  	add_symbol (s, top_stack->cur_block);
  	break;
  
  	/* End of local variables shared by struct, union, enum, and
  	   block (as yet unknown struct/union/enum) processing.  */
--- 1097,1117 ----
  	if (sh->iss == 0)
  	  break;
  
  	/* gcc puts out an empty struct for an opaque struct definitions,
  	   do not create a symbol for it either.  */
! 	if (TYPE_NFIELDS (t) == 0 && SYMBOL_LANGUAGE (s) != language_m3)
  	  {
  	    TYPE_FLAGS (t) |= TYPE_FLAG_STUB;
  	    break;
  	  }
  
  	s = new_symbol (name);
  	SYMBOL_NAMESPACE (s) = STRUCT_NAMESPACE;
  	SYMBOL_CLASS (s) = LOC_TYPEDEF;
  	SYMBOL_VALUE (s) = 0;
! 	SET_SYMBOL_TYPE (s) = t;
  	add_symbol (s, top_stack->cur_block);
  	break;
  
  	/* End of local variables shared by struct, union, enum, and
  	   block (as yet unknown struct/union/enum) processing.  */
***************
*** 1140,1149 ****
--- 1141,1151 ----
        break;
  
      case stEnd:		/* end (of anything) */
        if (sh->sc == scInfo || sh->sc == scCommon || sh->sc == scSCommon)
  	{
+  	  m3_decode_struct (top_stack->cur_type);
  	  /* Finished with type */
  	  top_stack->cur_type = 0;
  	}
        else if (sh->sc == scText &&
  	       (top_stack->blocktype == stProc ||
***************
*** 1159,1169 ****
  
  	  /* Make up special symbol to contain procedure specific info */
  	  s = new_symbol (MIPS_EFI_SYMBOL_NAME);
  	  SYMBOL_NAMESPACE (s) = LABEL_NAMESPACE;
  	  SYMBOL_CLASS (s) = LOC_CONST;
! 	  SYMBOL_TYPE (s) = builtin_type_void;
  	  e = ((struct mips_extra_func_info *)
  	       obstack_alloc (&current_objfile->symbol_obstack,
  			      sizeof (struct mips_extra_func_info)));
  	  SYMBOL_VALUE (s) = (long) e;
  	  e->numargs = top_stack->numargs;
--- 1161,1171 ----
  
  	  /* Make up special symbol to contain procedure specific info */
  	  s = new_symbol (MIPS_EFI_SYMBOL_NAME);
  	  SYMBOL_NAMESPACE (s) = LABEL_NAMESPACE;
  	  SYMBOL_CLASS (s) = LOC_CONST;
! 	  SET_SYMBOL_TYPE (s) = builtin_type_void;
  	  e = ((struct mips_extra_func_info *)
  	       obstack_alloc (&current_objfile->symbol_obstack,
  			      sizeof (struct mips_extra_func_info)));
  	  SYMBOL_VALUE (s) = (long) e;
  	  e->numargs = top_stack->numargs;
***************
*** 1265,1275 ****
  	break;
        s = new_symbol (name);
        SYMBOL_NAMESPACE (s) = VAR_NAMESPACE;
        SYMBOL_CLASS (s) = LOC_TYPEDEF;
        SYMBOL_BLOCK_VALUE (s) = top_stack->cur_block;
!       SYMBOL_TYPE (s) = t;
        add_symbol (s, top_stack->cur_block);
  
        /* Incomplete definitions of structs should not get a name.  */
        if (TYPE_NAME (SYMBOL_TYPE (s)) == NULL
  	  && (TYPE_NFIELDS (SYMBOL_TYPE (s)) != 0
--- 1267,1277 ----
  	break;
        s = new_symbol (name);
        SYMBOL_NAMESPACE (s) = VAR_NAMESPACE;
        SYMBOL_CLASS (s) = LOC_TYPEDEF;
        SYMBOL_BLOCK_VALUE (s) = top_stack->cur_block;
!       SET_SYMBOL_TYPE (s) = t;
        add_symbol (s, top_stack->cur_block);
  
        /* Incomplete definitions of structs should not get a name.  */
        if (TYPE_NAME (SYMBOL_TYPE (s)) == NULL
  	  && (TYPE_NFIELDS (SYMBOL_TYPE (s)) != 0
***************
*** 1495,1508 ****
  
  	  /* Usually, TYPE_CODE(tp) is already type_code.  The main
  	     exception is if we guessed wrong re struct/union/enum.
  	     But for struct vs. union a wrong guess is harmless, so
  	     don't complain().  */
! 	  if ((TYPE_CODE (tp) == TYPE_CODE_ENUM
  	       && type_code != TYPE_CODE_ENUM)
  	      || (TYPE_CODE (tp) != TYPE_CODE_ENUM
  		  && type_code == TYPE_CODE_ENUM))
  	    {
  	      complain (&bad_tag_guess_complaint, sym_name);
  	    }
  
  	  if (TYPE_CODE (tp) != type_code)
--- 1497,1511 ----
  
  	  /* Usually, TYPE_CODE(tp) is already type_code.  The main
  	     exception is if we guessed wrong re struct/union/enum.
  	     But for struct vs. union a wrong guess is harmless, so
  	     don't complain().  */
! 	  if (((TYPE_CODE (tp) == TYPE_CODE_ENUM
  	       && type_code != TYPE_CODE_ENUM)
  	      || (TYPE_CODE (tp) != TYPE_CODE_ENUM
  		  && type_code == TYPE_CODE_ENUM))
+ 	      && !M3_TYPEP (TYPE_CODE (tp)))
  	    {
  	      complain (&bad_tag_guess_complaint, sym_name);
  	    }
  
  	  if (TYPE_CODE (tp) != type_code)
***************
*** 1830,1840 ****
  /* FIXME -- delete.  We can't do symbol allocation now; it's all done.  */
        s = new_symbol (sh_name);
        SYMBOL_NAMESPACE (s) = VAR_NAMESPACE;
        SYMBOL_CLASS (s) = LOC_BLOCK;
        /* Donno its type, hope int is ok */
!       SYMBOL_TYPE (s) = lookup_function_type (builtin_type_int);
        add_symbol (s, top_stack->cur_block);
        /* Wont have symbols for this one */
        b = new_block (2);
        SYMBOL_BLOCK_VALUE (s) = b;
        BLOCK_FUNCTION (b) = s;
--- 1833,1843 ----
  /* FIXME -- delete.  We can't do symbol allocation now; it's all done.  */
        s = new_symbol (sh_name);
        SYMBOL_NAMESPACE (s) = VAR_NAMESPACE;
        SYMBOL_CLASS (s) = LOC_BLOCK;
        /* Donno its type, hope int is ok */
!       SET_SYMBOL_TYPE (s) = lookup_function_type (builtin_type_int);
        add_symbol (s, top_stack->cur_block);
        /* Wont have symbols for this one */
        b = new_block (2);
        SYMBOL_BLOCK_VALUE (s) = b;
        BLOCK_FUNCTION (b) = s;
***************
*** 3100,3110 ****
  		     obstack_alloc (&current_objfile->symbol_obstack,
  				    sizeof (struct mips_extra_func_info)));
  		  struct symbol *s = new_symbol (MIPS_EFI_SYMBOL_NAME);
  		  SYMBOL_NAMESPACE (s) = LABEL_NAMESPACE;
  		  SYMBOL_CLASS (s) = LOC_CONST;
! 		  SYMBOL_TYPE (s) = builtin_type_void;
  		  SYMBOL_VALUE (s) = (long) e;
  		  add_symbol_to_list (s, &local_symbols);
  		}
  	    }
  	  else if (sh.st == stLabel)
--- 3103,3113 ----
  		     obstack_alloc (&current_objfile->symbol_obstack,
  				    sizeof (struct mips_extra_func_info)));
  		  struct symbol *s = new_symbol (MIPS_EFI_SYMBOL_NAME);
  		  SYMBOL_NAMESPACE (s) = LABEL_NAMESPACE;
  		  SYMBOL_CLASS (s) = LOC_CONST;
! 		  SET_SYMBOL_TYPE (s) = builtin_type_void;
  		  SYMBOL_VALUE (s) = (long) e;
  		  add_symbol_to_list (s, &local_symbols);
  		}
  	    }
  	  else if (sh.st == stLabel)
***************
*** 3999,4009 ****
     * needed info.  Note we make it a nested procedure of sigvec,
     * which is the way the (assembly) code is actually written.
     */
    SYMBOL_NAMESPACE (s) = VAR_NAMESPACE;
    SYMBOL_CLASS (s) = LOC_BLOCK;
!   SYMBOL_TYPE (s) = init_type (TYPE_CODE_FUNC, 4, 0, (char *) NULL,
  			       st->objfile);
    TYPE_TARGET_TYPE (SYMBOL_TYPE (s)) = builtin_type_void;
  
    /* Need a block to allocate MIPS_EFI_SYMBOL_NAME in */
    b = new_block (1);
--- 4002,4012 ----
     * needed info.  Note we make it a nested procedure of sigvec,
     * which is the way the (assembly) code is actually written.
     */
    SYMBOL_NAMESPACE (s) = VAR_NAMESPACE;
    SYMBOL_CLASS (s) = LOC_BLOCK;
!   SET_SYMBOL_TYPE (s) = init_type (TYPE_CODE_FUNC, 4, 0, (char *) NULL,
  			       st->objfile);
    TYPE_TARGET_TYPE (SYMBOL_TYPE (s)) = builtin_type_void;
  
    /* Need a block to allocate MIPS_EFI_SYMBOL_NAME in */
    b = new_block (1);
***************
*** 4043,4053 ****
      current_objfile = st->objfile;	/* Keep new_symbol happy */
      s = new_symbol (MIPS_EFI_SYMBOL_NAME);
      SYMBOL_VALUE (s) = (long) e;
      SYMBOL_NAMESPACE (s) = LABEL_NAMESPACE;
      SYMBOL_CLASS (s) = LOC_CONST;
!     SYMBOL_TYPE (s) = builtin_type_void;
      current_objfile = NULL;
    }
  
    BLOCK_SYM (b, BLOCK_NSYMS (b)++) = s;
  }
--- 4046,4056 ----
      current_objfile = st->objfile;	/* Keep new_symbol happy */
      s = new_symbol (MIPS_EFI_SYMBOL_NAME);
      SYMBOL_VALUE (s) = (long) e;
      SYMBOL_NAMESPACE (s) = LABEL_NAMESPACE;
      SYMBOL_CLASS (s) = LOC_CONST;
!     SET_SYMBOL_TYPE (s) = builtin_type_void;
      current_objfile = NULL;
    }
  
    BLOCK_SYM (b, BLOCK_NSYMS (b)++) = s;
  }
*** parse.c.orig	Wed Oct 12 10:57:04 1994
--- parse.c	Wed Oct 12 11:30:11 1994
***************
*** 549,558 ****
--- 549,602 ----
        /* C++ */
      case OP_THIS:
        oplen = 2;
        break;
  
+       /* Modula-3 */
+     case OP_M3_LONG:
+       oplen = 4;
+       break;
+ 
+     case BINOP_M3_AND:
+     case BINOP_M3_OR:
+     case BINOP_M3_SUBSCRIPT:
+     case BINOP_M3_MULT:
+     case BINOP_M3_DIVIDE:
+     case BINOP_M3_DIV:
+     case BINOP_M3_MOD:
+     case BINOP_M3_ADD:
+     case BINOP_M3_MINUS:
+     case BINOP_M3_CAT:
+     case BINOP_M3_EQUAL:
+     case BINOP_M3_NE:
+     case BINOP_M3_LT:
+     case BINOP_M3_LE:
+     case BINOP_M3_GT:
+     case BINOP_M3_GE:
+     case BINOP_M3_IN:
+       args = 2;
+       break;
+ 
+     case UNOP_M3_NOT:
+     case UNOP_M3_IND:
+     case UNOP_M3_NEG:
+     case UNOP_M3_FIRST:
+     case UNOP_M3_LAST: 
+     case UNOP_M3_NUMBER:
+     case UNOP_M3_ADR:
+     case M3_FINAL_TYPE:
+       args = 1;
+       break;
+ 
+     case STRUCTOP_M3_INTERFACE:
+     case STRUCTOP_M3_MODULE:
+     case STRUCTOP_M3_STRUCT:
+       args = 1;
+       oplen = longest_to_int (expr->elts[endpos - 2].longconst);
+       oplen = 4 + BYTES_TO_EXP_ELEM (oplen + 1);
+       break;
+ 
      default:
        args = 1 + (i < (int) BINOP_END);
      }
  
    while (args > 0)
***************
*** 688,697 ****
--- 732,785 ----
        break;
  
        /* C++ */
      case OP_THIS:
        oplen = 2;
+       break;
+ 
+       /* Modula-3 */
+     case OP_M3_LONG:
+       oplen = 4;
+       break;
+ 
+     case BINOP_M3_AND:
+     case BINOP_M3_OR:
+     case BINOP_M3_SUBSCRIPT:
+     case BINOP_M3_MULT:
+     case BINOP_M3_DIVIDE:
+     case BINOP_M3_DIV:
+     case BINOP_M3_MOD:
+     case BINOP_M3_ADD:
+     case BINOP_M3_MINUS:
+     case BINOP_M3_CAT:
+     case BINOP_M3_EQUAL:
+     case BINOP_M3_NE:
+     case BINOP_M3_LT:
+     case BINOP_M3_LE:
+     case BINOP_M3_GT:
+     case BINOP_M3_GE:
+     case BINOP_M3_IN:
+       args = 2;
+       break;
+ 
+     case UNOP_M3_NOT:
+     case UNOP_M3_IND:
+     case UNOP_M3_NEG:
+     case UNOP_M3_FIRST:
+     case UNOP_M3_LAST: 
+     case UNOP_M3_NUMBER:
+     case UNOP_M3_ADR:
+     case M3_FINAL_TYPE:
+       args = 1;
+       break;
+ 
+     case STRUCTOP_M3_INTERFACE:
+     case STRUCTOP_M3_MODULE:
+     case STRUCTOP_M3_STRUCT:
+       args = 1;
+       oplen = longest_to_int (inexpr->elts[inend - 2].longconst);
+       oplen = 4 + BYTES_TO_EXP_ELEM (oplen + 1);
        break;
  
      default:
        args = 1 + ((int) opcode < (int) BINOP_END);
      }
*** remote.c.orig	Wed Oct 12 13:08:01 1994
--- remote.c	Wed Oct 12 13:08:30 1994
***************
*** 179,189 ****
  remote_fetch_registers PARAMS ((int regno));
  
  static void
  remote_resume PARAMS ((int pid, int step, enum target_signal siggnal));
  
! static int
  remote_start_remote PARAMS ((char *dummy));
  
  static void
  remote_open PARAMS ((char *name, int from_tty));
  
--- 179,189 ----
  remote_fetch_registers PARAMS ((int regno));
  
  static void
  remote_resume PARAMS ((int pid, int step, enum target_signal siggnal));
  
! static long
  remote_start_remote PARAMS ((char *dummy));
  
  static void
  remote_open PARAMS ((char *name, int from_tty));
  
***************
*** 336,346 ****
    objfile_relocate (symfile_objfile, offs);
  }
  
  /* Stub for catch_errors.  */
  
! static int
  remote_start_remote (dummy)
       char *dummy;
  {
    immediate_quit = 1;		/* Allow user to interrupt it */
  
--- 336,346 ----
    objfile_relocate (symfile_objfile, offs);
  }
  
  /* Stub for catch_errors.  */
  
! static long
  remote_start_remote (dummy)
       char *dummy;
  {
    immediate_quit = 1;		/* Allow user to interrupt it */
  
*** stabsread.c.orig	Wed Oct 12 10:57:05 1994
--- stabsread.c	Wed Oct 12 11:47:29 1994
***************
*** 426,455 ****
  	      if (*(pp-1) == 'F' || *(pp-1) == 'f')
  		{
  		  /* I don't think the linker does this with functions,
  		     so as far as I know this is never executed.
  		     But it doesn't hurt to check.  */
! 		  SYMBOL_TYPE (sym) =
  		    lookup_function_type (read_type (&pp, objfile));
  		}
  	      else
  		{
! 		  SYMBOL_TYPE (sym) = read_type (&pp, objfile);
  		}
  	      add_symbol_to_list (sym, &global_symbols);
  	    }
  	  else
  	    {
  	      pp += 2;
  	      if (*(pp-1) == 'F' || *(pp-1) == 'f')
  		{
! 		  SYMBOL_TYPE (sym) =
  		    lookup_function_type (read_type (&pp, objfile));
  		}
  	      else
  		{
! 		  SYMBOL_TYPE (sym) = read_type (&pp, objfile);
  		}
  	    }
  	}
      }
  }
--- 426,455 ----
  	      if (*(pp-1) == 'F' || *(pp-1) == 'f')
  		{
  		  /* I don't think the linker does this with functions,
  		     so as far as I know this is never executed.
  		     But it doesn't hurt to check.  */
! 		  SET_SYMBOL_TYPE (sym) =
  		    lookup_function_type (read_type (&pp, objfile));
  		}
  	      else
  		{
! 		  SET_SYMBOL_TYPE (sym) = read_type (&pp, objfile);
  		}
  	      add_symbol_to_list (sym, &global_symbols);
  	    }
  	  else
  	    {
  	      pp += 2;
  	      if (*(pp-1) == 'F' || *(pp-1) == 'f')
  		{
! 		  SET_SYMBOL_TYPE (sym) =
  		    lookup_function_type (read_type (&pp, objfile));
  		}
  	      else
  		{
! 		  SET_SYMBOL_TYPE (sym) = read_type (&pp, objfile);
  		}
  	    }
  	}
      }
  }
***************
*** 652,662 ****
  	 e.g. "b:c=e6,0" for "const b = blob1"
  	 (where type 6 is defined by "blobs:t6=eblob1:0,blob2:1,;").  */
        if (*p != '=')
  	{
  	  SYMBOL_CLASS (sym) = LOC_CONST;
! 	  SYMBOL_TYPE (sym) = error_type (&p);
  	  SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
  	  add_symbol_to_list (sym, &file_symbols);
  	  return sym;
  	}
        ++p;
--- 652,662 ----
  	 e.g. "b:c=e6,0" for "const b = blob1"
  	 (where type 6 is defined by "blobs:t6=eblob1:0,blob2:1,;").  */
        if (*p != '=')
  	{
  	  SYMBOL_CLASS (sym) = LOC_CONST;
! 	  SET_SYMBOL_TYPE (sym) = error_type (&p);
  	  SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
  	  add_symbol_to_list (sym, &file_symbols);
  	  return sym;
  	}
        ++p;
***************
*** 676,686 ****
  	       Problem is, what type should it be?
  
  	       Also, what should the name of this type be?  Should we
  	       be using 'S' constants (see stabs.texinfo) instead?  */
  
! 	    SYMBOL_TYPE (sym) = lookup_fundamental_type (objfile,
  							 FT_DBL_PREC_FLOAT);
  	    dbl_valu = (char *)
  	      obstack_alloc (&objfile -> symbol_obstack,
  			     TYPE_LENGTH (SYMBOL_TYPE (sym)));
  	    store_floating (dbl_valu, TYPE_LENGTH (SYMBOL_TYPE (sym)), d);
--- 676,686 ----
  	       Problem is, what type should it be?
  
  	       Also, what should the name of this type be?  Should we
  	       be using 'S' constants (see stabs.texinfo) instead?  */
  
! 	    SET_SYMBOL_TYPE (sym) = lookup_fundamental_type (objfile,
  							 FT_DBL_PREC_FLOAT);
  	    dbl_valu = (char *)
  	      obstack_alloc (&objfile -> symbol_obstack,
  			     TYPE_LENGTH (SYMBOL_TYPE (sym)));
  	    store_floating (dbl_valu, TYPE_LENGTH (SYMBOL_TYPE (sym)), d);
***************
*** 710,720 ****
  	      int_const_type =
  		init_type (TYPE_CODE_INT,
  			   sizeof (int) * HOST_CHAR_BIT / TARGET_CHAR_BIT, 0,
  			   "integer constant",
  			   (struct objfile *)NULL);
! 	    SYMBOL_TYPE (sym) = int_const_type;
  	    SYMBOL_VALUE (sym) = atoi (p);
  	    SYMBOL_CLASS (sym) = LOC_CONST;
  	  }
  	  break;
  	case 'e':
--- 710,720 ----
  	      int_const_type =
  		init_type (TYPE_CODE_INT,
  			   sizeof (int) * HOST_CHAR_BIT / TARGET_CHAR_BIT, 0,
  			   "integer constant",
  			   (struct objfile *)NULL);
! 	    SET_SYMBOL_TYPE (sym) = int_const_type;
  	    SYMBOL_VALUE (sym) = atoi (p);
  	    SYMBOL_CLASS (sym) = LOC_CONST;
  	  }
  	  break;
  	case 'e':
***************
*** 722,736 ****
  	     can be represented as integral.
  	     e.g. "b:c=e6,0" for "const b = blob1"
  	     (where type 6 is defined by "blobs:t6=eblob1:0,blob2:1,;").  */
  	  {
  	    SYMBOL_CLASS (sym) = LOC_CONST;
! 	    SYMBOL_TYPE (sym) = read_type (&p, objfile);
  
  	    if (*p != ',')
  	      {
! 		SYMBOL_TYPE (sym) = error_type (&p);
  		break;
  	      }
  	    ++p;
  
  	    /* If the value is too big to fit in an int (perhaps because
--- 722,736 ----
  	     can be represented as integral.
  	     e.g. "b:c=e6,0" for "const b = blob1"
  	     (where type 6 is defined by "blobs:t6=eblob1:0,blob2:1,;").  */
  	  {
  	    SYMBOL_CLASS (sym) = LOC_CONST;
! 	    SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
  
  	    if (*p != ',')
  	      {
! 		SET_SYMBOL_TYPE (sym) = error_type (&p);
  		break;
  	      }
  	    ++p;
  
  	    /* If the value is too big to fit in an int (perhaps because
***************
*** 743,771 ****
  	  }
  	  break;
  	default:
  	  {
  	    SYMBOL_CLASS (sym) = LOC_CONST;
! 	    SYMBOL_TYPE (sym) = error_type (&p);
  	  }
  	}
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &file_symbols);
        return sym;
  
      case 'C':
        /* The name of a caught exception.  */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_LABEL;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        SYMBOL_VALUE_ADDRESS (sym) = valu;
        add_symbol_to_list (sym, &local_symbols);
        break;
  
      case 'f':
        /* A static function definition.  */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_BLOCK;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &file_symbols);
        /* fall into process_function_types.  */
  
--- 743,771 ----
  	  }
  	  break;
  	default:
  	  {
  	    SYMBOL_CLASS (sym) = LOC_CONST;
! 	    SET_SYMBOL_TYPE (sym) = error_type (&p);
  	  }
  	}
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &file_symbols);
        return sym;
  
      case 'C':
        /* The name of a caught exception.  */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_LABEL;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        SYMBOL_VALUE_ADDRESS (sym) = valu;
        add_symbol_to_list (sym, &local_symbols);
        break;
  
      case 'f':
        /* A static function definition.  */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_BLOCK;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &file_symbols);
        /* fall into process_function_types.  */
  
***************
*** 782,796 ****
  
  	  /* Generate a template for the type of this function.  The 
  	     types of the arguments will be added as we read the symbol 
  	     table. */
  	  *new = *lookup_function_type (SYMBOL_TYPE(sym));
! 	  SYMBOL_TYPE(sym) = new;
  	  TYPE_OBJFILE (new) = objfile;
  	  in_function_type = new;
  #else
! 	  SYMBOL_TYPE (sym) = lookup_function_type (SYMBOL_TYPE (sym));
  #endif
  	}
        /* fall into process_prototype_types */
  
      process_prototype_types:
--- 782,796 ----
  
  	  /* Generate a template for the type of this function.  The 
  	     types of the arguments will be added as we read the symbol 
  	     table. */
  	  *new = *lookup_function_type (SYMBOL_TYPE(sym));
! 	  SET_SYMBOL_TYPE(sym) = new;
  	  TYPE_OBJFILE (new) = objfile;
  	  in_function_type = new;
  #else
! 	  SET_SYMBOL_TYPE (sym) = lookup_function_type (SYMBOL_TYPE (sym));
  #endif
  	}
        /* fall into process_prototype_types */
  
      process_prototype_types:
***************
*** 804,825 ****
        }
        break;
  
      case 'F':
        /* A global function definition.  */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_BLOCK;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &global_symbols);
        goto process_function_types;
  
      case 'G':
        /* For a class G (global) symbol, it appears that the
  	 value is not correct.  It is necessary to search for the
  	 corresponding linker definition to find the value.
  	 These definitions appear at the end of the namelist.  */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        i = hashname (SYMBOL_NAME (sym));
        SYMBOL_VALUE_CHAIN (sym) = global_sym_chain[i];
        global_sym_chain[i] = sym;
        SYMBOL_CLASS (sym) = LOC_STATIC;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
--- 804,825 ----
        }
        break;
  
      case 'F':
        /* A global function definition.  */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_BLOCK;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &global_symbols);
        goto process_function_types;
  
      case 'G':
        /* For a class G (global) symbol, it appears that the
  	 value is not correct.  It is necessary to search for the
  	 corresponding linker definition to find the value.
  	 These definitions appear at the end of the namelist.  */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        i = hashname (SYMBOL_NAME (sym));
        SYMBOL_VALUE_CHAIN (sym) = global_sym_chain[i];
        global_sym_chain[i] = sym;
        SYMBOL_CLASS (sym) = LOC_STATIC;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
***************
*** 829,839 ****
        /* This case is faked by a conditional above,
  	 when there is no code letter in the dbx data.
  	 Dbx data never actually contains 'l'.  */
      case 's':
      case 'l':
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_LOCAL;
        SYMBOL_VALUE (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &local_symbols);
        break;
--- 829,839 ----
        /* This case is faked by a conditional above,
  	 when there is no code letter in the dbx data.
  	 Dbx data never actually contains 'l'.  */
      case 's':
      case 'l':
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_LOCAL;
        SYMBOL_VALUE (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &local_symbols);
        break;
***************
*** 843,858 ****
  	/* pF is a two-letter code that means a function parameter in Fortran.
  	   The type-number specifies the type of the return value.
  	   Translate it into a pointer-to-function type.  */
  	{
  	  p++;
! 	  SYMBOL_TYPE (sym)
  	    = lookup_pointer_type
  	      (lookup_function_type (read_type (&p, objfile)));
  	}
        else
! 	SYMBOL_TYPE (sym) = read_type (&p, objfile);
  
        /* Normally this is a parameter, a LOC_ARG.  On the i960, it
  	 can also be a LOC_LOCAL_ARG depending on symbol type.  */
  #ifndef DBX_PARM_SYMBOL_CLASS
  #define	DBX_PARM_SYMBOL_CLASS(type)	LOC_ARG
--- 843,858 ----
  	/* pF is a two-letter code that means a function parameter in Fortran.
  	   The type-number specifies the type of the return value.
  	   Translate it into a pointer-to-function type.  */
  	{
  	  p++;
! 	  SET_SYMBOL_TYPE (sym)
  	    = lookup_pointer_type
  	      (lookup_function_type (read_type (&p, objfile)));
  	}
        else
! 	SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
  
        /* Normally this is a parameter, a LOC_ARG.  On the i960, it
  	 can also be a LOC_LOCAL_ARG depending on symbol type.  */
  #ifndef DBX_PARM_SYMBOL_CLASS
  #define	DBX_PARM_SYMBOL_CLASS(type)	LOC_ARG
***************
*** 940,950 ****
  	/* If PCC says a parameter is a short or a char,
  	   it is really an int.  */
  	if (TYPE_LENGTH (SYMBOL_TYPE (sym)) < TYPE_LENGTH (pcc_promotion_type)
  	    && TYPE_CODE (SYMBOL_TYPE (sym)) == TYPE_CODE_INT)
  	  {
! 	    SYMBOL_TYPE (sym) =
  	      TYPE_UNSIGNED (SYMBOL_TYPE (sym))
  		? pcc_unsigned_promotion_type
  		: pcc_promotion_type;
  	  }
  	break;
--- 940,950 ----
  	/* If PCC says a parameter is a short or a char,
  	   it is really an int.  */
  	if (TYPE_LENGTH (SYMBOL_TYPE (sym)) < TYPE_LENGTH (pcc_promotion_type)
  	    && TYPE_CODE (SYMBOL_TYPE (sym)) == TYPE_CODE_INT)
  	  {
! 	    SET_SYMBOL_TYPE (sym) =
  	      TYPE_UNSIGNED (SYMBOL_TYPE (sym))
  		? pcc_unsigned_promotion_type
  		: pcc_promotion_type;
  	  }
  	break;
***************
*** 964,974 ****
  	}
        /*FALLTHROUGH*/
  
      case 'R':
        /* Parameter which is in a register.  */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_REGPARM;
        SYMBOL_VALUE (sym) = STAB_REG_TO_REGNUM (valu);
        if (SYMBOL_VALUE (sym) >= NUM_REGS)
  	{
  	  complain (&reg_value_complaint, SYMBOL_SOURCE_NAME (sym));
--- 964,974 ----
  	}
        /*FALLTHROUGH*/
  
      case 'R':
        /* Parameter which is in a register.  */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_REGPARM;
        SYMBOL_VALUE (sym) = STAB_REG_TO_REGNUM (valu);
        if (SYMBOL_VALUE (sym) >= NUM_REGS)
  	{
  	  complain (&reg_value_complaint, SYMBOL_SOURCE_NAME (sym));
***************
*** 978,988 ****
        add_symbol_to_list (sym, &local_symbols);
        break;
  
      case 'r':
        /* Register variable (either global or local).  */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_REGISTER;
        SYMBOL_VALUE (sym) = STAB_REG_TO_REGNUM (valu);
        if (SYMBOL_VALUE (sym) >= NUM_REGS)
  	{
  	  complain (&reg_value_complaint, SYMBOL_SOURCE_NAME (sym));
--- 978,988 ----
        add_symbol_to_list (sym, &local_symbols);
        break;
  
      case 'r':
        /* Register variable (either global or local).  */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_REGISTER;
        SYMBOL_VALUE (sym) = STAB_REG_TO_REGNUM (valu);
        if (SYMBOL_VALUE (sym) >= NUM_REGS)
  	{
  	  complain (&reg_value_complaint, SYMBOL_SOURCE_NAME (sym));
***************
*** 1025,1035 ****
  		  && STREQ (SYMBOL_NAME (prev_sym), SYMBOL_NAME(sym)))
  		{
  		  SYMBOL_CLASS (prev_sym) = LOC_REGPARM;
  		  /* Use the type from the LOC_REGISTER; that is the type
  		     that is actually in that register.  */
! 		  SYMBOL_TYPE (prev_sym) = SYMBOL_TYPE (sym);
  		  SYMBOL_VALUE (prev_sym) = SYMBOL_VALUE (sym);
  		  sym = prev_sym;
  		  break;
  		}
  	    }
--- 1025,1035 ----
  		  && STREQ (SYMBOL_NAME (prev_sym), SYMBOL_NAME(sym)))
  		{
  		  SYMBOL_CLASS (prev_sym) = LOC_REGPARM;
  		  /* Use the type from the LOC_REGISTER; that is the type
  		     that is actually in that register.  */
! 		  SET_SYMBOL_TYPE (prev_sym) = SYMBOL_TYPE (sym);
  		  SYMBOL_VALUE (prev_sym) = SYMBOL_VALUE (sym);
  		  sym = prev_sym;
  		  break;
  		}
  	    }
***************
*** 1039,1062 ****
          add_symbol_to_list (sym, &file_symbols);
        break;
  
      case 'S':
        /* Static symbol at top level of file */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_STATIC;
        SYMBOL_VALUE_ADDRESS (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &file_symbols);
        break;
  
      case 't':
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
  
        /* For a nameless type, we don't want a create a symbol, thus we
  	 did not use `sym'. Return without further processing. */
        if (nameless) return NULL;
  
        SYMBOL_CLASS (sym) = LOC_TYPEDEF;
        SYMBOL_VALUE (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        /* C++ vagaries: we may have a type which is derived from
  	 a base type which did not have its name defined when the
--- 1039,1064 ----
          add_symbol_to_list (sym, &file_symbols);
        break;
  
      case 'S':
        /* Static symbol at top level of file */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_STATIC;
        SYMBOL_VALUE_ADDRESS (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &file_symbols);
        break;
  
      case 't':
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
  
        /* For a nameless type, we don't want a create a symbol, thus we
  	 did not use `sym'. Return without further processing. */
        if (nameless) return NULL;
  
+       m3_decode_struct (SYMBOL_TYPE (sym));
+ 
        SYMBOL_CLASS (sym) = LOC_TYPEDEF;
        SYMBOL_VALUE (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        /* C++ vagaries: we may have a type which is derived from
  	 a base type which did not have its name defined when the
***************
*** 1133,1143 ****
  	  type_synonym_name = obsavestring (SYMBOL_NAME (sym),
  					    strlen (SYMBOL_NAME (sym)),
  					    &objfile -> symbol_obstack);
  	}
  
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
  
        /* For a nameless type, we don't want a create a symbol, thus we
  	 did not use `sym'. Return without further processing. */
        if (nameless) return NULL;
  
--- 1135,1145 ----
  	  type_synonym_name = obsavestring (SYMBOL_NAME (sym),
  					    strlen (SYMBOL_NAME (sym)),
  					    &objfile -> symbol_obstack);
  	}
  
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
  
        /* For a nameless type, we don't want a create a symbol, thus we
  	 did not use `sym'. Return without further processing. */
        if (nameless) return NULL;
  
***************
*** 1165,1175 ****
  	}
        break;
  
      case 'V':
        /* Static symbol of local scope */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_STATIC;
        SYMBOL_VALUE_ADDRESS (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        if (os9k_stabs)
  	add_symbol_to_list (sym, &global_symbols);
--- 1167,1177 ----
  	}
        break;
  
      case 'V':
        /* Static symbol of local scope */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_STATIC;
        SYMBOL_VALUE_ADDRESS (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        if (os9k_stabs)
  	add_symbol_to_list (sym, &global_symbols);
***************
*** 1177,1187 ****
  	add_symbol_to_list (sym, &local_symbols);
        break;
  
      case 'v':
        /* Reference parameter */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_REF_ARG;
        SYMBOL_VALUE (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &local_symbols);
        break;
--- 1179,1189 ----
  	add_symbol_to_list (sym, &local_symbols);
        break;
  
      case 'v':
        /* Reference parameter */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_REF_ARG;
        SYMBOL_VALUE (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &local_symbols);
        break;
***************
*** 1189,1207 ****
      case 'X':
        /* This is used by Sun FORTRAN for "function result value".
  	 Sun claims ("dbx and dbxtool interfaces", 2nd ed)
  	 that Pascal uses it too, but when I tried it Pascal used
  	 "x:3" (local symbol) instead.  */
!       SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_LOCAL;
        SYMBOL_VALUE (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &local_symbols);
        break;
  
      default:
!       SYMBOL_TYPE (sym) = error_type (&p);
        SYMBOL_CLASS (sym) = LOC_CONST;
        SYMBOL_VALUE (sym) = 0;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &file_symbols);
        break;
--- 1191,1209 ----
      case 'X':
        /* This is used by Sun FORTRAN for "function result value".
  	 Sun claims ("dbx and dbxtool interfaces", 2nd ed)
  	 that Pascal uses it too, but when I tried it Pascal used
  	 "x:3" (local symbol) instead.  */
!       SET_SYMBOL_TYPE (sym) = read_type (&p, objfile);
        SYMBOL_CLASS (sym) = LOC_LOCAL;
        SYMBOL_VALUE (sym) = valu;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &local_symbols);
        break;
  
      default:
!       SET_SYMBOL_TYPE (sym) = error_type (&p);
        SYMBOL_CLASS (sym) = LOC_CONST;
        SYMBOL_VALUE (sym) = 0;
        SYMBOL_NAMESPACE (sym) = VAR_NAMESPACE;
        add_symbol_to_list (sym, &file_symbols);
        break;
***************
*** 3096,3106 ****
        if (syms == osyms)
  	j = o_nsyms;
        for (; j < syms->nsyms; j++,n++)
  	{
  	  struct symbol *xsym = syms->symbol[j];
! 	  SYMBOL_TYPE (xsym) = type;
  	  TYPE_FIELD_NAME (type, n) = SYMBOL_NAME (xsym);
  	  TYPE_FIELD_VALUE (type, n) = 0;
  	  TYPE_FIELD_BITPOS (type, n) = SYMBOL_VALUE (xsym);
  	  TYPE_FIELD_BITSIZE (type, n) = 0;
  	}
--- 3098,3108 ----
        if (syms == osyms)
  	j = o_nsyms;
        for (; j < syms->nsyms; j++,n++)
  	{
  	  struct symbol *xsym = syms->symbol[j];
! 	  SET_SYMBOL_TYPE (xsym) = type;
  	  TYPE_FIELD_NAME (type, n) = SYMBOL_NAME (xsym);
  	  TYPE_FIELD_VALUE (type, n) = 0;
  	  TYPE_FIELD_BITPOS (type, n) = SYMBOL_VALUE (xsym);
  	  TYPE_FIELD_BITSIZE (type, n) = 0;
  	}
***************
*** 3632,3642 ****
  
    if (common_block != NULL)
      for (j = common_block_i; j < common_block->nsyms; j++)
        add_symbol_to_list (common_block->symbol[j], &new);
  
!   SYMBOL_TYPE (sym) = (struct type *) new;
  
    /* Should we be putting local_symbols back to what it was?
       Does it matter?  */
  
    i = hashname (SYMBOL_NAME (sym));
--- 3634,3644 ----
  
    if (common_block != NULL)
      for (j = common_block_i; j < common_block->nsyms; j++)
        add_symbol_to_list (common_block->symbol[j], &new);
  
!   SET_SYMBOL_TYPE (sym) = (struct type *) new;
  
    /* Should we be putting local_symbols back to what it was?
       Does it matter?  */
  
    i = hashname (SYMBOL_NAME (sym));
***************
*** 3781,3790 ****
--- 3783,3796 ----
  	       TYPE_FLAG_TARGET_STUB for *type.  */
  	  }
  	  break;
  
  	default:
+ 	  if (M3_TYPEP (TYPE_CODE (*type)) 
+ 	      && (! (TYPE_FLAGS (*type) & TYPE_FLAG_STUB))) {
+ 	    break; }
+ 
  	badtype:
  	  {
  	    static struct complaint msg = {"\
  GDB internal error.  cleanup_undefined_types with bad type %d.", 0, 0};
  	    complain (&msg, TYPE_CODE (*type));
*** stack.c.orig	Wed Oct 12 10:57:05 1994
--- stack.c	Wed Oct 12 11:30:11 1994
***************
*** 116,129 ****
    int level;
    int source;
    int args;
  };
  
! static int print_stack_frame_stub PARAMS ((char *));
  
  /* Pass the args the way catch_errors wants them.  */
! static int
  print_stack_frame_stub (args)
       char *args;
  {
    struct print_stack_frame_args *p = (struct print_stack_frame_args *)args;
    print_frame_info (p->fi, p->level, p->source, p->args);
--- 116,129 ----
    int level;
    int source;
    int args;
  };
  
! static long print_stack_frame_stub PARAMS ((char *));
  
  /* Pass the args the way catch_errors wants them.  */
! static long
  print_stack_frame_stub (args)
       char *args;
  {
    struct print_stack_frame_args *p = (struct print_stack_frame_args *)args;
    print_frame_info (p->fi, p->level, p->source, p->args);
***************
*** 159,172 ****
  struct print_args_args {
    struct symbol *func;
    struct frame_info *fi;
  };
  
! static int print_args_stub PARAMS ((char *));
  
  /* Pass the args the way catch_errors wants them.  */
! static int
  print_args_stub (args)
       char *args;
  {
    int numargs;
    struct print_args_args *p = (struct print_args_args *)args;
--- 159,172 ----
  struct print_args_args {
    struct symbol *func;
    struct frame_info *fi;
  };
  
! static long print_args_stub PARAMS ((char *));
  
  /* Pass the args the way catch_errors wants them.  */
! static long
  print_args_stub (args)
       char *args;
  {
    int numargs;
    struct print_args_args *p = (struct print_args_args *)args;
*** symfile.c.orig	Wed Oct 12 10:57:05 1994
--- symfile.c	Wed Oct 12 11:30:11 1994
***************
*** 123,133 ****
    register struct symbol **s1, **s2;
  
    s1 = (struct symbol **) s1p;
    s2 = (struct symbol **) s2p;
  
!   return (STRCMP (SYMBOL_NAME (*s1), SYMBOL_NAME (*s2)));
  }
  
  /*
  
  LOCAL FUNCTION
--- 123,136 ----
    register struct symbol **s1, **s2;
  
    s1 = (struct symbol **) s1p;
    s2 = (struct symbol **) s2p;
  
!   if (SYMBOL_LANGUAGE (*s1) == language_m3) {
!     return (STRCMP (SYMBOL_SOURCE_NAME (*s1), SYMBOL_SOURCE_NAME (*s2))); }
!   else {
!     return (STRCMP (SYMBOL_NAME (*s1), SYMBOL_NAME (*s2))); }
  }
  
  /*
  
  LOCAL FUNCTION
***************
*** 274,283 ****
--- 277,289 ----
    if (!pst->readin)
      { 
        (*pst->read_symtab) (pst);
      }
  
+   if (pst->symtab->language == language_m3) {
+     m3_fix_symtab (pst->symtab); }
+ 
    return pst->symtab;
  }
  
  /* Initialize entry point information for this objfile. */
  
***************
*** 1245,1254 ****
--- 1251,1262 ----
      return language_chill;
    else if (STREQ (c, ".f") || STREQ (c, ".F"))
      return language_fortran;
    else if (STREQ (c, ".mod"))
      return language_m2;
+   else if(STREQ(c,".m3") || STREQ(c,".i3") || STREQ(c,".mc") || STREQ(c,".ic"))
+     return language_m3;
    else if (STREQ (c, ".s") || STREQ (c, ".S"))
      return language_asm;
  
    return language_unknown;		/* default */
  }
*** symmisc.c.orig	Wed Oct 12 13:05:40 1994
--- symmisc.c	Wed Oct 12 13:05:55 1994
***************
*** 69,79 ****
    struct symbol *symbol;
    int depth;
    GDB_FILE *outfile;
  };
  
! static int print_symbol PARAMS ((char *));
  
  static void
  free_symtab_block PARAMS ((struct objfile *, struct block *));
  
  
--- 69,79 ----
    struct symbol *symbol;
    int depth;
    GDB_FILE *outfile;
  };
  
! static long print_symbol PARAMS ((char *));
  
  static void
  free_symtab_block PARAMS ((struct objfile *, struct block *));
  
  
***************
*** 481,491 ****
  /* Print symbol ARGS->SYMBOL on ARGS->OUTFILE.  ARGS->DEPTH says how
     far to indent.  ARGS is really a struct print_symbol_args *, but is
     declared as char * to get it past catch_errors.  Returns 0 for error,
     1 for success.  */
  
! static int
  print_symbol (args)
       char *args;
  {
    struct symbol *symbol = ((struct print_symbol_args *)args)->symbol;
    int depth = ((struct print_symbol_args *)args)->depth;
--- 481,491 ----
  /* Print symbol ARGS->SYMBOL on ARGS->OUTFILE.  ARGS->DEPTH says how
     far to indent.  ARGS is really a struct print_symbol_args *, but is
     declared as char * to get it past catch_errors.  Returns 0 for error,
     1 for success.  */
  
! static long
  print_symbol (args)
       char *args;
  {
    struct symbol *symbol = ((struct print_symbol_args *)args)->symbol;
    int depth = ((struct print_symbol_args *)args)->depth;
*** symtab.c.orig	Wed Oct 12 10:57:05 1994
--- symtab.c	Wed Oct 12 11:30:12 1994
***************
*** 719,729 ****
  		*symtab = s;
  	      return sym;
  	    }
  	}
      }
- 
    if (symtab != NULL)
      *symtab = NULL;
    return 0;
  }
  
--- 719,728 ----
***************
*** 749,762 ****
    
    start = (global ?
  	   pst->objfile->global_psymbols.list + pst->globals_offset :
  	   pst->objfile->static_psymbols.list + pst->statics_offset  );
  
!   if (global)		/* This means we can use a binary search. */
!     {
!       do_linear_search = 0;
  
        /* Binary search.  This search is guaranteed to end with center
           pointing at the earliest partial symbol with the correct
  	 name.  At that point *all* partial symbols with that name
  	 will be checked against the correct namespace. */
  
--- 748,762 ----
    
    start = (global ?
  	   pst->objfile->global_psymbols.list + pst->globals_offset :
  	   pst->objfile->static_psymbols.list + pst->statics_offset  );
  
!   do_linear_search = SYMBOL_LANGUAGE (start) == language_cplus 
!     || SYMBOL_LANGUAGE (start) == language_m3;
  
+   if (global && !do_linear_search)
+     {
        /* Binary search.  This search is guaranteed to end with center
           pointing at the earliest partial symbol with the correct
  	 name.  At that point *all* partial symbols with that name
  	 will be checked against the correct namespace. */
  
***************
*** 765,778 ****
        while (top > bottom)
  	{
  	  center = bottom + (top - bottom) / 2;
  	  if (!(center < top))
  	    abort ();
- 	  if (!do_linear_search && SYMBOL_LANGUAGE (center) == language_cplus)
- 	    {
- 	      do_linear_search = 1;
- 	    }
  	  if (STRCMP (SYMBOL_NAME (center), name) >= 0)
  	    {
  	      top = center;
  	    }
  	  else
--- 765,774 ----
***************
*** 850,864 ****
       const enum namespace namespace;
  {
    register int bot, top, inc;
    register struct symbol *sym;
    register struct symbol *sym_found = NULL;
!   register int do_linear_search = 1;
  
    /* If the blocks's symbols were sorted, start with a binary search.  */
! 
!   if (BLOCK_SHOULD_SORT (block))
      {
        /* Reset the linear search flag so if the binary search fails, we
  	 won't do the linear search once unless we find some reason to
  	 do so, such as finding a C++ symbol during the binary search.
  	 Note that for C++ modules, ALL the symbols in a block should
--- 846,863 ----
       const enum namespace namespace;
  {
    register int bot, top, inc;
    register struct symbol *sym;
    register struct symbol *sym_found = NULL;
!   register int do_linear_search =
!     BLOCK_SHOULD_SORT (block) == 0
!       || (BLOCK_NSYMS (block) > 0 && 
! 	  (SYMBOL_LANGUAGE (BLOCK_SYM (block, 0)) == language_m3
! 	   || SYMBOL_LANGUAGE (BLOCK_SYM (block, 0)) == language_cplus));
  
    /* If the blocks's symbols were sorted, start with a binary search.  */
!   if (!do_linear_search)
      {
        /* Reset the linear search flag so if the binary search fails, we
  	 won't do the linear search once unless we find some reason to
  	 do so, such as finding a C++ symbol during the binary search.
  	 Note that for C++ modules, ALL the symbols in a block should
***************
*** 1526,1546 ****
     of the function.
     If the argument FUNFIRSTLINE is nonzero, we want the first line
     of real code inside the function.  */
  
  static struct symtab_and_line
! find_function_start_sal PARAMS ((struct symbol *sym, int));
  
  static struct symtab_and_line
! find_function_start_sal (sym, funfirstline)
       struct symbol *sym;
       int funfirstline;
  {
-   CORE_ADDR pc;
    struct symtab_and_line sal;
  
-   pc = BLOCK_START (SYMBOL_BLOCK_VALUE (sym));
    if (funfirstline)
      {
        pc += FUNCTION_START_OFFSET;
        SKIP_PROLOGUE (pc);
      }
--- 1525,1544 ----
     of the function.
     If the argument FUNFIRSTLINE is nonzero, we want the first line
     of real code inside the function.  */
  
  static struct symtab_and_line
! find_function_start_sal PARAMS ((struct symbol *sym, int, CORE_ADDR));
  
  static struct symtab_and_line
! find_function_start_sal (sym, funfirstline, pc)
       struct symbol *sym;
       int funfirstline;
+      CORE_ADDR pc;
  {
    struct symtab_and_line sal;
  
    if (funfirstline)
      {
        pc += FUNCTION_START_OFFSET;
        SKIP_PROLOGUE (pc);
      }
***************
*** 1550,1560 ****
    /* Convex: no need to suppress code on first line, if any */
    sal.pc = pc;
  #else
    /* Check if SKIP_PROLOGUE left us in mid-line, and the next
       line is still part of the same function.  */
!   if (sal.pc != pc
        && BLOCK_START (SYMBOL_BLOCK_VALUE (sym)) <= sal.end
        && sal.end < BLOCK_END (SYMBOL_BLOCK_VALUE (sym)))
      {
        /* First pc of next line */
        pc = sal.end;
--- 1548,1558 ----
    /* Convex: no need to suppress code on first line, if any */
    sal.pc = pc;
  #else
    /* Check if SKIP_PROLOGUE left us in mid-line, and the next
       line is still part of the same function.  */
!   if (sal.pc != pc && sym != NULL
        && BLOCK_START (SYMBOL_BLOCK_VALUE (sym)) <= sal.end
        && sal.end < BLOCK_END (SYMBOL_BLOCK_VALUE (sym)))
      {
        /* First pc of next line */
        pc = sal.end;
***************
*** 2052,2062 ****
  		  if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
  		    {
  		      values.sals = (struct symtab_and_line *)xmalloc (sizeof (struct symtab_and_line));
  		      values.nelts = 1;
  		      values.sals[0] = find_function_start_sal (sym,
! 								funfirstline);
  		    }
  		  else
  		    {
  		      values.nelts = 0;
  		    }
--- 2050,2061 ----
  		  if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
  		    {
  		      values.sals = (struct symtab_and_line *)xmalloc (sizeof (struct symtab_and_line));
  		      values.nelts = 1;
  		      values.sals[0] = find_function_start_sal (sym,
! 			funfirstline, BLOCK_START (SYMBOL_BLOCK_VALUE (sym)));
! 
  		    }
  		  else
  		    {
  		      values.nelts = 0;
  		    }
***************
*** 2226,2235 ****
--- 2225,2282 ----
        copy++;
      }
    while (*p == ' ' || *p == '\t') p++;
    *argptr = p;
  
+   /* Let's try to interpret the whole arg as an expression */
+   { struct expression *expr;
+     struct symbol *exports;
+     value_ptr val;
+     struct type *implementers;
+ 
+     if ((expr = (struct expression *) catch_errors ((long (*)()) parse_expression, saved_arg, (char *) 0, RETURN_MASK_ALL)) != 0
+ 	&& (val = (value_ptr) catch_errors ((long (*)()) evaluate_expression, expr, (char *) 0, RETURN_MASK_ALL)) != 0) {
+       if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_M3_PROC) {
+ 	pc = m3_unpack_pointer2 (val);
+ 
+ 	if (pc == 0 && expr->elts[1].opcode == STRUCTOP_M3_INTERFACE) {
+ 	  /* may be we found a procedure exported by an interface but
+ 	     implemented by a module with a different name, and the
+ 	     init code did not run yet, so the interface interface
+ 	     record isn't set yet.  It could also be a global var so
+ 	     we have to be careful. saved_arg is of the form a.b, we
+ 	     want to isolate a. */
+ 	  int interface_name_length = *argptr - saved_arg;
+ 	  char *interface_name = alloca (interface_name_length + 1);
+ 	  char foo [1000];
+ 	  int i;
+ 	  strncpy (interface_name, saved_arg, interface_name_length);
+ 	  interface_name [interface_name_length] = 0;
+ 
+ 	  exports = lookup_symbol ("_m3_exporters", 0, 
+ 				     VAR_NAMESPACE, 0, NULL);
+ 	  if (exports != 0
+ 	      && (implementers 
+ 		  = lookup_struct_elt_type (SYMBOL_TYPE (exports), 
+ 					    interface_name, 1))
+ 	      != 0) {
+ 	    for (i = 0; i < TYPE_NFIELDS (implementers); i++) {
+ 	      sprintf (foo, "%s%s", TYPE_FIELD_NAME (implementers, i),
+ 		       *argptr);
+ 	      if (expr = (struct expression *) catch_errors
+                      ((long (*)()) parse_expression, foo, (char *) 0, RETURN_MASK_ALL)) {
+ 		if ((val = (value_ptr) catch_errors ((long (*)()) evaluate_expression,
+ 						 expr, (char *) 0,
+ 						 RETURN_MASK_ALL)) != 0) {
+ 		  if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_M3_PROC) {
+ 		    pc = m3_unpack_pointer2 (val);
+ 		    break; }}}}}}
+ 	while (**argptr != '\000') {
+ 	  (*argptr)++; }
+ 	sym = 0;
+ 	goto i_have_a_pc; }}}
+ 
    /* Look up that token as a variable.
       If file specified, use that file's per-file block to start with.  */
  
    sym = lookup_symbol (copy,
  		       (s ? BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK)
***************
*** 2238,2259 ****
  
    if (sym != NULL)
      {
        if (SYMBOL_CLASS (sym) == LOC_BLOCK)
  	{
  	  /* Arg is the name of a function */
  	  values.sals = (struct symtab_and_line *)xmalloc (sizeof (struct symtab_and_line));
! 	  values.sals[0] = find_function_start_sal (sym, funfirstline);
  	  values.nelts = 1;
  
  	  /* Don't use the SYMBOL_LINE; if used at all it points to
  	     the line containing the parameters or thereabouts, not
  	     the first line of code.  */
  
  	  /* We might need a canonical line spec if it is a static
  	     function.  */
! 	  if (s == 0)
  	    {
  	      struct blockvector *bv = BLOCKVECTOR (sym_symtab);
  	      struct block *b = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
  	      if (lookup_block_symbol (b, copy, VAR_NAMESPACE) != NULL)
  		build_canonical_line_spec (values.sals, copy, canonical);
--- 2285,2308 ----
  
    if (sym != NULL)
      {
        if (SYMBOL_CLASS (sym) == LOC_BLOCK)
  	{
+ 	  pc = BLOCK_START (SYMBOL_BLOCK_VALUE (sym));
+ 	i_have_a_pc:
  	  /* Arg is the name of a function */
  	  values.sals = (struct symtab_and_line *)xmalloc (sizeof (struct symtab_and_line));
! 	  values.sals[0] = find_function_start_sal (sym, funfirstline, pc);
  	  values.nelts = 1;
  
  	  /* Don't use the SYMBOL_LINE; if used at all it points to
  	     the line containing the parameters or thereabouts, not
  	     the first line of code.  */
  
  	  /* We might need a canonical line spec if it is a static
  	     function.  */
! 	  if (sym != NULL && s == 0)
  	    {
  	      struct blockvector *bv = BLOCKVECTOR (sym_symtab);
  	      struct block *b = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
  	      if (lookup_block_symbol (b, copy, VAR_NAMESPACE) != NULL)
  		build_canonical_line_spec (values.sals, copy, canonical);
***************
*** 2362,2372 ****
    printf_unfiltered("[0] cancel\n[1] all\n");
    while (i < nelts)
      {
        if (sym_arr[i] && SYMBOL_CLASS (sym_arr[i]) == LOC_BLOCK)
  	{
! 	  values.sals[i] = find_function_start_sal (sym_arr[i], funfirstline);
  	  printf_unfiltered ("[%d] %s at %s:%d\n",
  			     (i+2),
  			     SYMBOL_SOURCE_NAME (sym_arr[i]),
  			     values.sals[i].symtab->filename,
  			     values.sals[i].line);
--- 2411,2422 ----
    printf_unfiltered("[0] cancel\n[1] all\n");
    while (i < nelts)
      {
        if (sym_arr[i] && SYMBOL_CLASS (sym_arr[i]) == LOC_BLOCK)
  	{
! 	  values.sals[i] = find_function_start_sal (sym_arr[i], funfirstline,
! 			       BLOCK_START (SYMBOL_BLOCK_VALUE (sym_arr[i])));
  	  printf_unfiltered ("[%d] %s at %s:%d\n",
  			     (i+2),
  			     SYMBOL_SOURCE_NAME (sym_arr[i]),
  			     values.sals[i].symtab->filename,
  			     values.sals[i].line);
*** symtab.h.orig	Wed Oct 12 10:57:05 1994
--- symtab.h	Wed Oct 12 12:59:51 1994
***************
*** 85,94 ****
--- 85,98 ----
      {
        struct cplus_specific      /* For C++ */
  	{
  	  char *demangled_name;
  	} cplus_specific;
+       struct m3_specific	 /* For M3 */
+ 	{
+ 	  char *demangled_name;
+ 	} m3_specific;
        struct chill_specific      /* For Chill */
  	{
  	  char *demangled_name;
  	} chill_specific;
      } language_specific;
***************
*** 119,135 ****
  #define SYMBOL_SECTION(symbol)		(symbol)->ginfo.section
  
  #define SYMBOL_CPLUS_DEMANGLED_NAME(symbol)	\
    (symbol)->ginfo.language_specific.cplus_specific.demangled_name
  
  /* Macro that initializes the language dependent portion of a symbol
     depending upon the language for the symbol. */
  
  #define SYMBOL_INIT_LANGUAGE_SPECIFIC(symbol,language)			\
    do {									\
      SYMBOL_LANGUAGE (symbol) = language;				\
!     if (SYMBOL_LANGUAGE (symbol) == language_cplus)			\
        {									\
  	SYMBOL_CPLUS_DEMANGLED_NAME (symbol) = NULL;			\
        }									\
      else if (SYMBOL_LANGUAGE (symbol) == language_chill)		\
        {									\
--- 123,146 ----
  #define SYMBOL_SECTION(symbol)		(symbol)->ginfo.section
  
  #define SYMBOL_CPLUS_DEMANGLED_NAME(symbol)	\
    (symbol)->ginfo.language_specific.cplus_specific.demangled_name
  
+ #define SYMBOL_M3_DEMANGLED_NAME(symbol)	\
+   (symbol)->ginfo.language_specific.m3_specific.demangled_name
+   
  /* Macro that initializes the language dependent portion of a symbol
     depending upon the language for the symbol. */
  
  #define SYMBOL_INIT_LANGUAGE_SPECIFIC(symbol,language)			\
    do {									\
      SYMBOL_LANGUAGE (symbol) = language;				\
!     if (SYMBOL_LANGUAGE (symbol) == language_m3)			\
!       {									\
! 	SYMBOL_M3_DEMANGLED_NAME (symbol) = NULL;			\
!       }									\
!     else if (SYMBOL_LANGUAGE (symbol) == language_cplus)		\
        {									\
  	SYMBOL_CPLUS_DEMANGLED_NAME (symbol) = NULL;			\
        }									\
      else if (SYMBOL_LANGUAGE (symbol) == language_chill)		\
        {									\
***************
*** 152,161 ****
--- 163,188 ----
     specified obstack. */
  
  #define SYMBOL_INIT_DEMANGLED_NAME(symbol,obstack)			\
    do {									\
      char *demangled = NULL;						\
+     if (SYMBOL_LANGUAGE (symbol) == language_m3			        \
+ 	|| SYMBOL_LANGUAGE (symbol) == language_auto)			\
+       {									\
+ 	demangled = m3_demangle (SYMBOL_NAME (symbol));                 \
+ 	if (demangled != NULL)						\
+ 	  {								\
+ 	    SYMBOL_LANGUAGE (symbol) = language_m3;			\
+ 	    SYMBOL_M3_DEMANGLED_NAME (symbol) = 			\
+ 	      obsavestring (demangled, strlen (demangled), (obstack));	\
+ 	    /* free (demangled); FIXME -- static */			\
+ 	  }								\
+ 	else								\
+ 	  {								\
+ 	    SYMBOL_M3_DEMANGLED_NAME (symbol) = NULL;			\
+ 	  }								\
+       }									\
      if (SYMBOL_LANGUAGE (symbol) == language_cplus			\
  	|| SYMBOL_LANGUAGE (symbol) == language_auto)			\
        {									\
  	demangled =							\
  	  cplus_demangle (SYMBOL_NAME (symbol), DMGL_PARAMS | DMGL_ANSI);\
***************
*** 197,211 ****
  
  /* Macro that returns the demangled name for a symbol based on the language
     for that symbol.  If no demangled name exists, returns NULL. */
  
  #define SYMBOL_DEMANGLED_NAME(symbol)					\
!   (SYMBOL_LANGUAGE (symbol) == language_cplus				\
!    ? SYMBOL_CPLUS_DEMANGLED_NAME (symbol)				\
!    : (SYMBOL_LANGUAGE (symbol) == language_chill			\
!       ? SYMBOL_CHILL_DEMANGLED_NAME (symbol)				\
!       : NULL))
  
  #define SYMBOL_CHILL_DEMANGLED_NAME(symbol)				\
    (symbol)->ginfo.language_specific.chill_specific.demangled_name
  
  /* Macro that returns the "natural source name" of a symbol.  In C++ this is
--- 224,240 ----
  
  /* Macro that returns the demangled name for a symbol based on the language
     for that symbol.  If no demangled name exists, returns NULL. */
  
  #define SYMBOL_DEMANGLED_NAME(symbol)					\
!   (SYMBOL_LANGUAGE (symbol) == language_m3				\
!    ? SYMBOL_M3_DEMANGLED_NAME (symbol)					\
!    : (SYMBOL_LANGUAGE (symbol) == language_cplus		       	\
!       ? SYMBOL_CPLUS_DEMANGLED_NAME (symbol)				\
!       : (SYMBOL_LANGUAGE (symbol) == language_chill			\
!          ? SYMBOL_CHILL_DEMANGLED_NAME (symbol)				\
!          : NULL)))
  
  #define SYMBOL_CHILL_DEMANGLED_NAME(symbol)				\
    (symbol)->ginfo.language_specific.chill_specific.demangled_name
  
  /* Macro that returns the "natural source name" of a symbol.  In C++ this is
***************
*** 567,576 ****
--- 596,606 ----
  
    struct general_symbol_info ginfo;
  
    /* Data type of value */
  
+   char m3_uid[9];
    struct type *type;
  
    /* Name space code.  */
  
    enum namespace namespace BYTE_BITFIELD;
***************
*** 596,606 ****
    aux_value;
  };
  
  #define SYMBOL_NAMESPACE(symbol)	(symbol)->namespace
  #define SYMBOL_CLASS(symbol)		(symbol)->class
! #define SYMBOL_TYPE(symbol)		(symbol)->type
  #define SYMBOL_LINE(symbol)		(symbol)->line
  #define SYMBOL_BASEREG(symbol)		(symbol)->aux_value.basereg
  
  /* A partial_symbol records the name, namespace, and address class of
     symbols whose types we have not parsed yet.  For functions, it also
--- 626,638 ----
    aux_value;
  };
  
  #define SYMBOL_NAMESPACE(symbol)	(symbol)->namespace
  #define SYMBOL_CLASS(symbol)		(symbol)->class
! #define SET_SYMBOL_TYPE(symbol) (symbol)->type
! #define SYMBOL_TYPE(symbol)	((symbol)->type ? (symbol)->type : \
! 				 ((symbol)->type = m3_resolve_type ((symbol)->m3_uid)))
  #define SYMBOL_LINE(symbol)		(symbol)->line
  #define SYMBOL_BASEREG(symbol)		(symbol)->aux_value.basereg
  
  /* A partial_symbol records the name, namespace, and address class of
     symbols whose types we have not parsed yet.  For functions, it also
***************
*** 1170,1176 ****
--- 1202,1211 ----
  extern void
  clear_symtab_users PARAMS ((void));
  
  extern enum language
  deduce_language_from_filename PARAMS ((char *));
+ 
+ extern char *
+ m3_demangle PARAMS ((char *));
  
  #endif /* !defined(SYMTAB_H) */
*** top.c.orig	Wed Oct 12 10:57:06 1994
--- top.c	Wed Oct 12 13:16:16 1994
***************
*** 135,145 ****
  
  static void complete_command PARAMS ((char *, int));
  
  static void do_nothing PARAMS ((int));
  
! static int quit_cover PARAMS ((char *));
  
  static void disconnect PARAMS ((int));
  
  static void source_cleanup PARAMS ((FILE *));
  
--- 135,145 ----
  
  static void complete_command PARAMS ((char *, int));
  
  static void do_nothing PARAMS ((int));
  
! static long quit_cover PARAMS ((char *));
  
  static void disconnect PARAMS ((int));
  
  static void source_cleanup PARAMS ((FILE *));
  
***************
*** 434,454 ****
     should be RETURN_MASK_ERROR, unless for some reason it is more
     useful to abort only the portion of the operation inside the
     catch_errors.  Note that quit should return to the command line
     fairly quickly, even if some further processing is being done.  */
  
! int
  catch_errors (func, args, errstring, mask)
!      int (*func) PARAMS ((char *));
       PTR args;
       char *errstring;
       return_mask mask;
  {
    jmp_buf saved_error;
    jmp_buf saved_quit;
    jmp_buf tmp_jmp;
!   int val;
    struct cleanup *saved_cleanup_chain;
    char *saved_error_pre_print;
  
    saved_cleanup_chain = save_cleanups ();
    saved_error_pre_print = error_pre_print;
--- 434,454 ----
     should be RETURN_MASK_ERROR, unless for some reason it is more
     useful to abort only the portion of the operation inside the
     catch_errors.  Note that quit should return to the command line
     fairly quickly, even if some further processing is being done.  */
  
! long
  catch_errors (func, args, errstring, mask)
!      long (*func) PARAMS ((char *));
       PTR args;
       char *errstring;
       return_mask mask;
  {
    jmp_buf saved_error;
    jmp_buf saved_quit;
    jmp_buf tmp_jmp;
!   long val;
    struct cleanup *saved_cleanup_chain;
    char *saved_error_pre_print;
  
    saved_cleanup_chain = save_cleanups ();
    saved_error_pre_print = error_pre_print;
***************
*** 492,502 ****
    kill (getpid (), SIGHUP);
  }
  
  /* Just a little helper function for disconnect().  */
  
! static int
  quit_cover (s)
  char *s;
  {
    caution = 0;		/* Throw caution to the wind -- we're exiting.
  			   This prevents asking the user dumb questions.  */
--- 492,502 ----
    kill (getpid (), SIGHUP);
  }
  
  /* Just a little helper function for disconnect().  */
  
! static long
  quit_cover (s)
  char *s;
  {
    caution = 0;		/* Throw caution to the wind -- we're exiting.
  			   This prevents asking the user dumb questions.  */
*** valarith.c.orig	Wed Oct 12 10:57:06 1994
--- valarith.c	Wed Oct 12 11:30:12 1994
***************
*** 918,927 ****
--- 918,982 ----
        error ("Invalid type combination in equality test.");
        return 0;  /* For lint -- never reached */
      }
  }
  
+ /* Simulate the Modula-3  operator = by returning a 1
+    iff ARG1 and ARG2 have equal contents.  */
+ 
+ int
+ m3_value_equal (arg1, arg2)
+      register value_ptr arg1, arg2;
+ 
+ {
+   register int len;
+   register char *p1, *p2;
+   enum type_code code1;
+   enum type_code code2;
+ 
+   COERCE_ARRAY (arg1);
+   COERCE_ARRAY (arg2);
+ 
+   code1 = TYPE_CODE (VALUE_TYPE (arg1));
+   code2 = TYPE_CODE (VALUE_TYPE (arg2));
+ 
+   if (code1 == TYPE_CODE_M3_INTEGER && code2 == TYPE_CODE_M3_INTEGER)
+     return m3_unpack_int2 (arg1) == m3_unpack_int2 (arg2);
+   else if (code1 == TYPE_CODE_FLT && code2 == TYPE_CODE_M3_INTEGER)
+     return m3_unpack_float2 (arg1) == (double) m3_unpack_int2 (arg2);
+   else if (code2 == TYPE_CODE_FLT && code1 == TYPE_CODE_M3_INTEGER)
+     return m3_unpack_float2 (arg2) == (double) m3_unpack_int2 (arg1);
+   else if (code1 == TYPE_CODE_FLT && code2 == TYPE_CODE_FLT)
+     return m3_unpack_float2 (arg1) == m3_unpack_float2 (arg2);
+ 
+   /* FIXME: Need to promote to either CORE_ADDR or LONGEST, whichever
+      is bigger.  */
+   else if (code1 == TYPE_CODE_M3_POINTER && code2 == TYPE_CODE_M3_INTEGER)
+     return m3_unpack_pointer2 (arg1) == (CORE_ADDR) m3_unpack_int2 (arg2);
+   else if (code2 == TYPE_CODE_M3_POINTER && code1 == TYPE_CODE_M3_INTEGER)
+     return (CORE_ADDR) m3_unpack_int2 (arg1) == m3_unpack_pointer2 (arg2);
+ 
+   else if (code1 == code2
+ 	   && ((len = TYPE_LENGTH (VALUE_TYPE (arg1)))
+ 	       == TYPE_LENGTH (VALUE_TYPE (arg2))))
+     {
+       p1 = VALUE_CONTENTS (arg1);
+       p2 = VALUE_CONTENTS (arg2);
+       while (--len >= 0)
+ 	{
+ 	  if (*p1++ != *p2++)
+ 	    break;
+ 	}
+       return len < 0;
+     }
+   else
+     {
+       error ("Invalid type combination in equality test.");
+       return 0;  /* For lint -- never reached */
+     }
+ }
+ 
  /* Simulate the C operator < by returning 1
     iff ARG1's contents are less than ARG2's.  */
  
  int
  value_less (arg1, arg2)
*** valops.c.orig	Wed Oct 12 10:57:06 1994
--- valops.c	Wed Oct 12 11:30:12 1994
***************
*** 849,858 ****
--- 849,862 ----
    if (code == TYPE_CODE_FUNC || code == TYPE_CODE_METHOD)
      {
        funaddr = VALUE_ADDRESS (function);
        value_type = TYPE_TARGET_TYPE (ftype);
      }
+   else if (code == TYPE_CODE_M3_PROC) {
+     funaddr = value_as_pointer (function);
+     value_type = TYPE_M3_PROC_RESTYPE (ftype);}
+ 
    else if (code == TYPE_CODE_PTR)
      {
        funaddr = value_as_pointer (function);
        if (TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_FUNC
  	  || TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_METHOD)
*** values.c.orig	Wed Oct 12 10:57:06 1994
--- values.c	Wed Oct 12 11:30:13 1994
***************
*** 624,633 ****
--- 624,636 ----
  {
    register enum type_code code = TYPE_CODE (type);
    register int len = TYPE_LENGTH (type);
    register int nosign = TYPE_UNSIGNED (type);
  
+   if (M3_TYPEP (code))
+     code = TYPE_CODE_INT;
+   
    switch (code)
      {
      case TYPE_CODE_ENUM:
      case TYPE_CODE_BOOL:
      case TYPE_CODE_INT:
***************
*** 1328,1342 ****
--- 1331,1396 ----
      case TYPE_CODE_INT:
      case TYPE_CODE_CHAR:
      case TYPE_CODE_ENUM:
      case TYPE_CODE_BOOL:
      case TYPE_CODE_RANGE:
+     case TYPE_CODE_M3_INTEGER:
+     case TYPE_CODE_M3_CARDINAL:
+     case TYPE_CODE_M3_CHAR:
+     case TYPE_CODE_M3_ENUM:
+     case TYPE_CODE_M3_SUBRANGE:
+     case TYPE_CODE_M3_BOOLEAN:
        store_signed_integer (VALUE_CONTENTS_RAW (val), len, num);
        break;
        
      case TYPE_CODE_REF:
      case TYPE_CODE_PTR:
+     case TYPE_CODE_M3_REFANY:
+     case TYPE_CODE_M3_POINTER:
+     case TYPE_CODE_M3_ADDRESS:
+     case TYPE_CODE_M3_ROOT:
+     case TYPE_CODE_M3_UN_ROOT:
+     case TYPE_CODE_M3_NULL:
+       /* This assumes that all pointers of a given length
+ 	 have the same form.  */
+       store_address (VALUE_CONTENTS_RAW (val), len, (CORE_ADDR) num);
+       break;
+ 
+     default:
+       error ("Unexpected type encountered for integer constant.");
+     }
+   return val;
+ }
+ 
+ /* Convert C numbers into newly allocated values */
+ 
+ value_ptr
+ m3_value_from_longest (type, num)
+      struct type *type;
+      register LONGEST num;
+ {
+   register value_ptr val = allocate_value (type);
+   register enum type_code code = TYPE_CODE (type);
+   register int len = TYPE_LENGTH (type);
+ 
+   switch (code)
+     {
+     case TYPE_CODE_M3_INTEGER:
+     case TYPE_CODE_M3_CARDINAL:
+     case TYPE_CODE_M3_CHAR:
+     case TYPE_CODE_M3_ENUM:
+     case TYPE_CODE_M3_SUBRANGE:
+     case TYPE_CODE_M3_BOOLEAN:
+       store_signed_integer (VALUE_CONTENTS_RAW (val), len, num);
+       break;
+       
+     case TYPE_CODE_M3_REFANY:
+     case TYPE_CODE_M3_POINTER:
+     case TYPE_CODE_M3_ADDRESS:
+     case TYPE_CODE_M3_ROOT:
+     case TYPE_CODE_M3_UN_ROOT:
+     case TYPE_CODE_M3_NULL:
        /* This assumes that all pointers of a given length
  	 have the same form.  */
        store_address (VALUE_CONTENTS_RAW (val), len, (CORE_ADDR) num);
        break;
  
