Bladeren bron

added support for debugger

ceriel 34 jaren geleden
bovenliggende
commit
640fe76319

+ 12 - 2
lang/m2/comp/Makefile

@@ -58,12 +58,12 @@ CSRC =	LLlex.c LLmessage.c error.c main.c \
 	tokenname.c idf.c input.c type.c def.c \
 	misc.c enter.c defmodule.c typequiv.c node.c \
 	cstoper.c chk_expr.c options.c walk.c desig.c \
-	code.c lookup.c Version.c
+	code.c lookup.c Version.c stab.c
 COBJ =	LLlex.o LLmessage.o char.o error.o main.o \
 	symbol2str.o tokenname.o idf.o input.o type.o def.o \
 	scope.o misc.o enter.o defmodule.o typequiv.o node.o \
 	cstoper.o chk_expr.o options.o walk.o casestat.o desig.o \
-	code.o tmpvar.o lookup.o Version.o next.o
+	code.o tmpvar.o lookup.o Version.o stab.o next.o
 GENC=	$(LSRC) symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c next.c
 SRC =	$(CSRC) $(GENC)
 
@@ -483,6 +483,16 @@ lookup.o: real.h
 lookup.o: scope.h
 lookup.o: target_sizes.h
 lookup.o: type.h
+stab.o: LLlex.h
+stab.o: bigparam.h
+stab.o: const.h
+stab.o: def.h
+stab.o: idf.h
+stab.o: nocross.h
+stab.o: real.h
+stab.o: scope.h
+stab.o: target_sizes.h
+stab.o: type.h
 tokenfile.o: Lpars.h
 program.o: LLlex.h
 program.o: Lpars.h

+ 6 - 1
lang/m2/comp/declar.g

@@ -112,10 +112,12 @@ declaration
 |
 			{	++proclevel; }
 	ProcedureHeading(&df, D_PROCEDURE)
+			{	if (options['g']) stb_string(df, D_PROCEDURE); }
 	';'
 	block(&(df->prc_body))
 	IDENT
-			{	EndProc(df, dot.TOK_IDF);
+			{	if (options['g']) stb_string(df, D_PEND);
+				EndProc(df, dot.TOK_IDF);
 				--proclevel;
 			}
 	';'
@@ -178,6 +180,7 @@ TypeDeclaration
 	'=' type(&tp)
 			{ DeclareType(nd, df, tp);
 			  FreeNode(nd);
+			  if (options['g']) stb_string(df, D_TYPE);
 			}
 ;
 
@@ -285,6 +288,7 @@ RecordType(t_type **ptp;)
 		  }
 		  *ptp = standard_type(T_RECORD, xalign, align(size, xalign));
 		  (*ptp)->rec_scope = scope;
+		  Reverse(&(scope->sc_def));
 		}
 	END
 ;
@@ -530,6 +534,7 @@ ConstantDeclaration
 			  df->con_const = nd->nd_token;
 			  df->df_type = nd->nd_type;
 			  FreeNode(nd);
+			  if (options['g']) stb_string(df, D_CONST);
 			}
 ;
 

+ 3 - 1
lang/m2/comp/def.H

@@ -101,11 +101,13 @@ struct def	{		/* list of definitions for a name */
 				*/
 #define D_INUSE		0x8000	/* identification in this scope (like D_IMPORT)
 				*/
+#define D_END		(D_MODULE|D_PROCEDURE)	/* special value for stab.c */
+#define D_PEND		(D_MODULE|D_PROCEDURE|D_VARIABLE)	/* special value for stab.c */
 #define D_VALUE	(D_PROCEDURE|D_VARIABLE|D_FIELD|D_ENUM|D_CONST|D_PROCHEAD)
 #define D_ISTYPE	(D_HIDDEN|D_TYPE)
 #define D_IMPORTED	(D_IMPORT|D_INUSE)
 #define is_type(dfx)	((dfx)->df_kind & D_ISTYPE)
-	unsigned short  df_flags;
+	unsigned short df_flags;
 #define D_NOREG		0x01	/* set if it may not reside in a register */
 #define D_USED		0x02	/* set if used */
 #define D_DEFINED	0x04	/* set if it is assigned a value */

+ 2 - 0
lang/m2/comp/em_m2.6

@@ -62,6 +62,8 @@ By default, warnings in class \fBO\fR and \fBW\fR are given.
 allow for warning messages whose class is a member of \fIclasses\fR.
 .IP \fB\-x\fR
 make all procedure names global, so that \fIadb\fR(1) understands them.
+.IP \fB\-g\fR
+produce a DBX-style symbol table.
 .IP \fB\-l\fR
 enable local extensions. Currently, the only local extension consists of
 procedure constants.

+ 14 - 7
lang/m2/comp/enter.c

@@ -41,9 +41,11 @@ Enter(name, kind, type, pnam)
 	df = define(str2idf(name, 0), CurrentScope, kind);
 	df->df_type = type;
 	if (pnam) df->df_value.df_stdname = pnam;
+	else if (options['g']) stb_string(df, kind);
 	return df;
 }
 
+t_def *
 EnterType(name, type)
 	char *name;
 	t_type *type;
@@ -52,9 +54,7 @@ EnterType(name, type)
 		"type" in the Current Scope.
 	*/
 
-	if (! Enter(name, D_TYPE, type, 0)) {
-		assert(0);
-	}
+	return Enter(name, D_TYPE, type, 0);
 }
 
 EnterEnumList(Idlist, type)
@@ -68,7 +68,7 @@ EnterEnumList(Idlist, type)
 		be exported, in which case its literals must also be exported.
 		Thus, we need an easy way to get to them.
 	*/
-	register t_def *df;
+	register t_def *df, *df1 = 0;
 	register t_node *idlist = Idlist;
 
 	type->enm_ncst = 0;
@@ -76,8 +76,11 @@ EnterEnumList(Idlist, type)
 		df = define(idlist->nd_IDF, CurrentScope, D_ENUM);
 		df->df_type = type;
 		df->enm_val = (type->enm_ncst)++;
-		df->enm_next = type->enm_enums;
-		type->enm_enums = df;
+		if (! df1) {
+			type->enm_enums = df;
+		}
+		else	df1->enm_next = df;
+		df1 = df;
 	}
 	FreeNode(Idlist);
 }
@@ -177,6 +180,7 @@ EnterVarList(Idlist, type, local)
 				C_ina_dnam(df->var_name);
 			}
 		}
+		if (options['g']) stb_string(df, D_VARIABLE);
 	}
 	FreeNode(Idlist);
 }
@@ -218,8 +222,11 @@ EnterParamList(ppr, Idlist, type, VARp, off)
 		df->df_flags |= VARp;
 
 		if (IsConformantArray(type)) {
-			/* we need room for the base address and a descriptor
+			/* we need room for the base address and a descriptor:
+			   arr_low and arr_high are set to their offset
 			*/
+			type->arr_low = *off + pointer_size;
+			type->arr_high = *off + pointer_size + word_size;
 			*off += pointer_size + word_size + dword_size;
 		}
 		else if (VARp == D_VARPAR || IsBigParamTp(type)) {

+ 15 - 9
lang/m2/comp/main.c

@@ -17,6 +17,7 @@
 #include	<em_code.h>
 #include	<alloc.h>
 #include	<assert.h>
+#include	<stb.h>
 
 #include	"strict3rd.h"
 #include	"input.h"
@@ -82,6 +83,13 @@ Compile(src, dst)
 	LineNumber = 1;
 	FileName = src;
 	WorkingDir = getwdir(src);
+	C_init(word_size, pointer_size);
+	if (! C_open(dst)) fatal("could not open output file");
+	C_magic();
+	C_ms_emx(word_size, pointer_size);
+	if (options['g']) {
+		C_ms_std(FileName, N_SO, 0);
+	}
 	init_idf();
 	InitCst();
 	reserve(tkidf);
@@ -97,10 +105,6 @@ Compile(src, dst)
 	open_scope(OPENSCOPE);
 	GlobalVis = CurrVis;
 	close_scope(0);
-	C_init(word_size, pointer_size);
-	if (! C_open(dst)) fatal("could not open output file");
-	C_magic();
-	C_ms_emx(word_size, pointer_size);
 	CheckForLineDirective();
 	CompUnit();
 	C_ms_src((int)LineNumber - 1, FileName);
@@ -211,17 +215,19 @@ AddStandards()
 	EnterType("LONGINT", longint_type);
 	EnterType("REAL", real_type);
 	EnterType("LONGREAL", longreal_type);
-	EnterType("BOOLEAN", bool_type);
 	EnterType("CARDINAL", card_type);
+	EnterType("(void)", void_type);
 	df = Enter("NIL", D_CONST, address_type, 0);
 	df->con_const = nilconst;
 
 	EnterType("PROC", construct_type(T_PROCEDURE, NULLTYPE));
 	EnterType("BITSET", bitset_type);
-	df = Enter("TRUE", D_ENUM, bool_type, 0);
-	df->enm_val = 1;
-	df->enm_next = Enter("FALSE", D_ENUM, bool_type, 0);
-	assert(df->enm_next->enm_val == 0 && df->enm_next->enm_next == 0);
+	df = Enter("FALSE", D_ENUM, bool_type, 0);
+	bool_type->enm_enums = df;
+	df->enm_next = Enter("TRUE", D_ENUM, bool_type, 0);
+	df->enm_next->enm_val = 1;
+	assert(df->enm_val == 0 && df->enm_next->enm_next == 0);
+	EnterType("BOOLEAN", bool_type);
 }
 
 do_SYSTEM()

+ 2 - 0
lang/m2/comp/modula-2.1

@@ -78,6 +78,8 @@ If no \fIclasses\fR are given, all warnings are suppressed.
 By default, warnings in class \fBO\fR and \fBW\fR are given.
 .IP \fB\-W\fR\fIclasses\fR
 allow for warning messages whose class is a member of \fIclasses\fR.
+.IP \fB\-g\fR
+produce a DBX-style symbol table.
 .IP \fB\-x\fR
 make all procedure names global, so that \fIadb\fR(1) understands them.
 .IP \fB\-Xs\fR

+ 1 - 0
lang/m2/comp/options

@@ -1,5 +1,6 @@
 options:
 
+g:	symbol table for debugger
 l:	local extensions enabled
 n:	no register messages
 s:	symmetric range for integers: MIN(INTEGER) = -MAX(INTEGER)

+ 1 - 0
lang/m2/comp/options.c

@@ -57,6 +57,7 @@ DoOption(text)
 	case 's':	/* symmetric: MIN(INTEGER) = -MAX(INTEGER) */
 	case '3':	/* strict 3rd edition Modula-2 */
 	case 'l':	/* local additions enabled */
+	case 'g':	/* generate symbol table for debugger */
 		options[text[-1]]++;
 		break;
 

+ 10 - 2
lang/m2/comp/program.g

@@ -60,8 +60,10 @@ ModuleDeclaration
 	';'
 	import(1)*
 	export(&qualified, &exportlist)
+			{ if (options['g']) stb_string(df, D_MODULE); }
 	block(&(df->mod_body))
 	IDENT		{ EnterExportList(exportlist, qualified);
+			  if (options['g']) stb_string(df, D_END);
 			  close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
 			  match_id(df->df_idf, dot.TOK_IDF);
 			}
@@ -139,7 +141,6 @@ DefinitionModule
 	DEFINITION
 	MODULE IDENT	{ df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
 			  df->df_flags |= D_BUSY | ForeignFlag;
-			  if (!Defined) Defined = df;
 		  	  currscope->sc_definedby = df;
 			  if (DefId && df->df_idf != DefId) {
 				error("DEFINITION MODULE name is \"%s\", not \"%s\"",
@@ -151,6 +152,10 @@ DefinitionModule
 			  df->df_type = standard_type(T_RECORD, 1, (arith) 1);
 			  df->df_type->rec_scope = currscope;
 			  DefinitionModule++;
+			  if (!Defined) {
+				Defined = df;
+				if (options['g']) stb_string(df, D_MODULE);
+			  }
 			}
 	';'
 	import(0)* 
@@ -201,6 +206,7 @@ definition
 			}
 	  ]
 	  ';'
+			{ if (options['g']) stb_string(df, D_TYPE); }
 	]*
 |
 	VAR [ %persistent VariableDeclaration ';' ]*
@@ -223,12 +229,14 @@ ProgramModule
 			df->mod_vis = CurrVis;
 			CurrentScope->sc_name = "__M2M_";
 		  	CurrentScope->sc_definedby = df;
+			if (options['g']) stb_string(df, D_MODULE);
 		  }
 		}
 	priority(&(df->mod_priority))
 	';' import(0)*
 	block(&(df->mod_body)) IDENT
-		{ close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
+		{ if (options['g']) stb_string(df, D_END);
+		  close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
 		  match_id(df->df_idf, dot.TOK_IDF);
 		}
 	'.'

+ 4 - 1
lang/m2/comp/scope.C

@@ -32,6 +32,8 @@ extern char options[];
 
 /* STATICALLOCDEF "scopelist" 10 */
 
+static int	sc_count;
+
 open_scope(scopetype)
 {
 	/*	Open a scope that is either open (automatic imports) or closed.
@@ -48,6 +50,7 @@ open_scope(scopetype)
 	if (! sc->sc_scopeclosed) {
 		ls->sc_next = ls->sc_encl;
 	}
+	ls->sc_count = sc_count++;
 	CurrVis = ls;
 }
 
@@ -161,7 +164,7 @@ Reverse(pdf)
 		from this list.
 	*/
 	register t_def *df, *df1;
-#define INTERESTING (D_MODULE|D_PROCEDURE|D_PROCHEAD|D_VARIABLE|D_IMPORTED|D_TYPE|D_CONST)
+#define INTERESTING (D_MODULE|D_PROCEDURE|D_PROCHEAD|D_VARIABLE|D_IMPORTED|D_TYPE|D_CONST|D_FIELD)
 
 	df = 0;
 	df1 = *pdf;

+ 1 - 0
lang/m2/comp/scope.h

@@ -40,6 +40,7 @@ struct scopelist {
 	struct scopelist *sc_next;
 	struct scope *sc_scope;
 	struct scopelist *sc_encl;
+	int sc_count;
 };
 
 typedef struct scope t_scope;

+ 378 - 0
lang/m2/comp/stab.c

@@ -0,0 +1,378 @@
+/*
+ * (c) copyright 1990 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
+/* D E B U G G E R   S Y M B O L   T A B L E */
+
+/* $Header$ */
+
+#include	<alloc.h>
+#include	<em.h>
+#include	<flt_arith.h>
+#include	<stb.h>
+
+#include	"LLlex.h"
+#include	"def.h"
+#include	"type.h"
+#include	"idf.h"
+#include	"const.h"
+#include	"scope.h"
+#include	"main.h"
+
+#define INCR_SIZE	64
+
+extern int	proclevel;
+
+static struct db_str {
+	unsigned	sz;
+	char		*base;
+	char		*currpos;
+} db_str;
+
+static
+create_db_str()
+{
+	if (! db_str.base) {
+		db_str.base = Malloc(INCR_SIZE);
+		db_str.sz = INCR_SIZE;
+	}
+	db_str.currpos = db_str.base;
+}
+
+static
+addc_db_str(c)
+	int	c;
+{
+	int df = db_str.currpos - db_str.base;
+	if (df >= db_str.sz-1) {
+		db_str.sz += INCR_SIZE;
+		db_str.base = Realloc(db_str.base, db_str.sz);
+		db_str.currpos = db_str.base + df;
+	}
+	*db_str.currpos++ = c;
+	*db_str.currpos = '\0';
+}
+
+static
+adds_db_str(s)
+	char	*s;
+{
+	while (*s) addc_db_str(*s++);
+}
+
+static
+stb_type(tp, assign_num)
+	register t_type	*tp;
+{
+	char buf[128];
+	static int	stb_count;
+
+	if (tp->tp_dbindex > 0) {
+		adds_db_str(sprint(buf, "%d", tp->tp_dbindex));
+		return;
+	}
+	if (tp->tp_dbindex < 0) {
+		if (tp->tp_next == 0) {
+			adds_db_str(sprint(buf, "%d", -tp->tp_dbindex));
+			return;
+		}
+		tp->tp_dbindex = -tp->tp_dbindex;
+	}
+	if (tp->tp_dbindex == 0 && assign_num) {
+		tp->tp_dbindex = ++stb_count;
+	}
+	if (tp->tp_dbindex > 0) {
+		adds_db_str(sprint(buf, "%d=", tp->tp_dbindex));
+	}
+	if (tp == void_type) {
+		adds_db_str(sprint(buf, "%d", tp->tp_dbindex));
+		return;
+	}
+	switch(tp->tp_fund) {
+	/* simple types ... */
+	case T_INTEGER:
+		adds_db_str(sprint(buf,
+		       "r%d;%ld;%ld",
+		       tp->tp_dbindex,
+		       (long) min_int[(int)tp->tp_size],
+		       (long) max_int[(int)tp->tp_size]));
+		break;
+	case T_CARDINAL:
+		adds_db_str(sprint(buf,
+		       "r%d;0;-1",
+		       tp->tp_dbindex));
+		break;
+	case T_REAL:
+		adds_db_str(sprint(buf,
+		       "r%d;%ld;0",
+		       tp->tp_dbindex,
+		       (long)tp->tp_size));
+		break;
+	case T_CHAR:
+		adds_db_str(sprint(buf,
+		       "r%d;0;255",
+		       tp->tp_dbindex));
+		break;
+	case T_WORD:
+		if (tp->tp_size == word_size) {
+			adds_db_str(sprint(buf,
+		       		"r%d;0;-1",
+		       		tp->tp_dbindex));
+		}
+		else {
+			adds_db_str(sprint(buf,
+		       		"r%d;0;255",
+		       		tp->tp_dbindex));
+		}
+		break;
+
+	/* constructed types ... */
+	case T_SUBRANGE:
+		adds_db_str(sprint(buf,
+		       "r%d;%ld;%ld",
+		       tp->tp_next->tp_dbindex,
+		       (long) tp->sub_lb,
+		       (long) tp->sub_ub));
+		break;
+	case T_EQUAL:
+		stb_type(tp->tp_next, 0);
+		if (tp->tp_dbindex < 0) tp->tp_dbindex = -tp->tp_dbindex;
+		break;
+	case T_HIDDEN:
+		if (DefinitionModule && CurrVis == Defined->mod_vis) {
+			tp->tp_dbindex = - ++stb_count;
+			adds_db_str(sprint(buf, "%d", -tp->tp_dbindex));
+		}
+		else {
+			/* ??? what to do here??? */
+			addc_db_str('*');
+			stb_type(void_type, 0);
+			/* ??? this certainly is not correct */
+		}
+		break;
+	case T_POINTER:
+		if (tp->tp_next) {
+			addc_db_str('*');
+			stb_type(tp->tp_next, 0);
+			if (tp->tp_dbindex < 0) tp->tp_dbindex = -tp->tp_dbindex;
+		}
+		else {
+			tp->tp_dbindex = - ++stb_count;
+			adds_db_str(sprint(buf, "%d", -tp->tp_dbindex));
+		}
+		break;
+	case T_SET:
+		addc_db_str('S');
+		stb_type(tp->tp_next, 0);
+		adds_db_str(sprint(buf, ";%ld;%ld;", tp->tp_size, tp->set_low));
+		break;
+	case T_ARRAY:
+		addc_db_str('a');
+		if (IsConformantArray(tp)) {
+			addc_db_str('r');
+			stb_type(tp->tp_next, 0);
+			adds_db_str(sprint(buf, ";0;A%ld", tp->arr_high));
+		}
+		else {
+			stb_type(tp->tp_next, 0);
+		}
+		addc_db_str(';');
+		stb_type(tp->arr_elem, 0);
+		break;
+	case T_ENUMERATION:
+		addc_db_str('e');
+		{
+			register struct def	*edef = tp->enm_enums;
+
+			while (edef) {
+				adds_db_str(sprint(buf, "%s:%ld,",
+					edef->df_idf->id_text,
+					edef->enm_val));
+				edef = edef->enm_next;
+			}
+		}
+		addc_db_str(';');
+		break;
+	case T_RECORD:
+		adds_db_str(sprint(buf, "s%ld", tp->tp_size));
+		{
+			register struct def	*sdef = tp->rec_scope->sc_def;
+
+			while (sdef) {
+				adds_db_str(sdef->df_idf->id_text);
+				addc_db_str(':');
+				stb_type(sdef->df_type, 0);
+				adds_db_str(sprint(buf,
+					",%ld,%ld;",
+					sdef->df_type->tp_size*8,
+					sdef->fld_off*8));
+				sdef = sdef->df_nextinscope;
+			}
+		}
+		addc_db_str(';');
+		break;
+	case T_PROCEDURE:
+		addc_db_str('Q');
+		stb_type(tp->tp_next ? tp->tp_next : void_type, 0);
+		{
+			register struct paramlist *p = tp->prc_params;
+			int paramcount = 0;
+
+			while (p) {
+				paramcount++;
+				p = p->par_next;
+			}
+			adds_db_str(sprint(buf, ",%d;", paramcount));
+			p = tp->prc_params;
+			while (p) {
+				addc_db_str(IsVarParam(p) 
+					? 'v'
+					: IsConformantArray(TypeOfParam(p)) 
+						? 'i'
+						: 'p');
+				stb_type(TypeOfParam(p), 0);
+				addc_db_str(';');
+				p = p->par_next;
+			}
+		}
+	}
+}
+
+stb_string(df, kind)
+	register t_def *df;
+{
+	register t_type	*tp = df->df_type;
+	char buf[64];
+
+	create_db_str();
+	adds_db_str(df->df_idf->id_text);
+	addc_db_str(':');
+	switch(kind) {
+	case D_MODULE:
+		adds_db_str(sprint(buf, "M%d;", df->mod_vis->sc_count));
+		C_ms_stb_pnam(db_str.base, N_FUN, proclevel, df->mod_vis->sc_scope->sc_name);
+		break;
+	case D_PROCEDURE:
+		adds_db_str(sprint(buf, "Q%d;", df->prc_vis->sc_count));
+		stb_type(tp->tp_next ? tp->tp_next : void_type, 0);
+		addc_db_str(';');
+		C_ms_stb_pnam(db_str.base, N_FUN, proclevel, df->prc_vis->sc_scope->sc_name);
+		{
+			register struct paramlist *p = tp->prc_params;
+			while (p) {
+				stb_string(p->par_def, D_VARIABLE);
+				p = p->par_next;
+			}
+		}
+		break;
+	case D_END:
+		adds_db_str(sprint(buf, "E%d;", df->mod_vis->sc_count));
+		C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, 0);
+		break;
+	case D_PEND:
+		adds_db_str(sprint(buf, "E%d;", df->prc_vis->sc_count));
+		C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, 0);
+		break;
+	case D_VARIABLE:
+		if (DefinitionModule && CurrVis != Defined->mod_vis) break;
+		if (df->df_flags & D_VARPAR) {	/* VAR parameter */
+			addc_db_str('v');
+			stb_type(tp, 0);
+			addc_db_str(';');
+			C_ms_stb_cst(db_str.base, N_PSYM, 0, df->var_off);
+		}
+		else if (df->df_flags & D_VALPAR) {	/* value parameter */
+			addc_db_str(IsConformantArray(tp)
+				? 'i'
+				: 'p');
+			stb_type(tp, 0);
+			addc_db_str(';');
+			C_ms_stb_cst(db_str.base, N_PSYM, 0, df->var_off);
+		}
+		else if (!proclevel ||
+			 (df->df_flags & D_ADDRGIVEN)) {	/* global */
+			addc_db_str('G');
+			stb_type(tp, 0);
+			addc_db_str(';');
+			if (df->df_flags & D_ADDRGIVEN) {
+				C_ms_stb_cst(db_str.base, N_LCSYM, 0, df->var_off);
+			}
+			else {
+				C_ms_stb_dnam(db_str.base, N_LCSYM, 0, df->var_name, (arith) 0);
+			}
+		}
+		else {	/* local variable */
+			stb_type(tp, 0);
+			addc_db_str(';');
+			C_ms_stb_cst(db_str.base, N_LSYM, 0, df->var_off);
+		}
+		break;
+	case D_TYPE:
+		addc_db_str('t');
+		stb_type(tp, 1);
+		addc_db_str(';');
+		C_ms_stb_cst(db_str.base,
+			     N_LSYM,
+			     tp == void_type || tp->tp_size >= max_int[2]
+			       ? 0
+			       : (int)tp->tp_size,
+			     (arith) 0);
+		break;
+	case D_CONST:
+		if (DefinitionModule && CurrVis != Defined->mod_vis) break;
+		addc_db_str('c');
+		addc_db_str('=');
+		tp = BaseType(tp);
+		switch(tp->tp_fund) {
+		case T_INTEGER:
+		case T_INTORCARD:
+		case T_CARDINAL:
+		case T_WORD:
+		case T_POINTER:
+		case T_PROCEDURE:
+			adds_db_str(sprint(buf, "i%ld;", df->con_const.TOK_INT));
+			break;
+		case T_CHAR:
+			adds_db_str(sprint(buf, "c%ld;", df->con_const.TOK_INT));
+			break;
+		case T_REAL:
+			if (! df->con_const.TOK_REAL) {
+				char buf2[FLT_STRLEN];
+
+				flt_flt2str(&df->con_const.TOK_RVAL, buf2, FLT_STRLEN);
+				adds_db_str(sprint(buf, "r%s;", buf2));
+			}
+			else adds_db_str(sprint(buf, "r%s;", df->con_const.TOK_REAL));
+			break;
+		case T_STRING:
+			adds_db_str(sprint(buf, "s'%s';", df->con_const.TOK_STR));
+			break;
+		case T_ENUMERATION:
+			addc_db_str('e');
+			stb_type(tp, 0);
+			adds_db_str(sprint(buf, ",%ld;", df->enm_val));
+			break;
+		case T_SET: {
+			register int i;
+
+			addc_db_str('S');
+			stb_type(tp, 0);
+			for (i = 0; i < tp->tp_size; i++) {
+				adds_db_str(sprint(buf, ",%ld",
+					(df->con_const.tk_data.tk_set[i/(int) word_size] >> (8*(i%(int)word_size)))&0377));
+			}
+			addc_db_str(';');
+			}
+			break;
+		}
+		C_ms_stb_cst(db_str.base,
+			     N_LSYM,
+			     tp->tp_size < max_int[2] ? (int)tp->tp_size : 0,
+			     (arith) 0);
+		break;
+	}
+}
+

+ 3 - 1
lang/m2/comp/type.H

@@ -80,7 +80,7 @@ struct type	{
 	struct type *tp_next;	/* used with ARRAY, PROCEDURE, POINTER, SET,
 				   SUBRANGE, EQUAL
 				*/
-	int tp_fund;		/* fundamental type  or constructor */
+	short tp_fund;		/* fundamental type  or constructor */
 #define T_RECORD	0x0001
 #define	T_ENUMERATION	0x0002
 #define	T_INTEGER	0x0004
@@ -102,6 +102,7 @@ struct type	{
 #define T_INDEX		(T_ENUMERATION|T_CHAR|T_SUBRANGE)
 #define T_DISCRETE	(T_INDEX|T_INTORCARD)
 #define	T_CONSTRUCTED	(T_ARRAY|T_SET|T_RECORD)
+	short tp_dbindex;	/* index in debugger symbol table */
 	int tp_align;		/* alignment requirement of this type */
 	arith tp_size;		/* size of this type */
 	union {
@@ -132,6 +133,7 @@ extern t_type
 	*address_type,
 	*intorcard_type,
 	*bitset_type,
+	*void_type,
 	*std_type,
 	*error_type;		/* All from type.c */
 

+ 3 - 0
lang/m2/comp/type.c

@@ -68,6 +68,7 @@ t_type
 	*address_type,
 	*intorcard_type,
 	*bitset_type,
+	*void_type,
 	*std_type,
 	*error_type;
 
@@ -213,6 +214,7 @@ InitTypes()
 	*/
 	error_type = new_type();
 	*error_type = *char_type;
+	void_type = error_type;
 }
 
 int
@@ -654,6 +656,7 @@ DeclareType(nd, df, tp)
 			node_error(nd,
 				 "opaque type \"%s\" has a circular definition",
 				 df->df_idf->id_text);
+			tp->tp_next = error_type;
 		}
 	}
 	else {

+ 23 - 2
lang/m2/comp/walk.c

@@ -22,6 +22,7 @@
 #include	<m2_traps.h>
 #include	<assert.h>
 #include	<alloc.h>
+#include	<stb.h>
 
 #include	"strict3rd.h"
 #include	"LLlex.h"
@@ -121,11 +122,19 @@ DoLineno(nd)
 {
 	/*	Generate line number information, if necessary.
 	*/
-	if (! options['L'] &&
+	if ((! options['L'] || options['g']) &&
 	    nd->nd_lineno &&
 	    nd->nd_lineno != oldlineno) {
 		oldlineno = nd->nd_lineno;
-		C_lin((arith) nd->nd_lineno);
+		if (! options['L']) C_lin((arith) nd->nd_lineno);
+		if ( options['g']) {
+			static int	ms_lineno;
+
+			if (ms_lineno != nd->nd_lineno) {
+				C_ms_std((char *) 0, N_SLINE, nd->nd_lineno);
+				ms_lineno = nd->nd_lineno;
+			}
+		}
 	}
 }
 
@@ -212,11 +221,17 @@ WalkModule(module)
 	}
 	WalkDefList(sc->sc_def, MkCalls);
 	proclevel++;
+	if (options['g']) {
+		C_ms_std((char *) 0, N_LBRAC, proclevel);
+	}
 	WalkNode(module->mod_body, NO_EXIT_LABEL, REACH_FLAG);
 	DO_DEBUG(options['X'], PrNode(module->mod_body, 0));
 	def_ilb(RETURN_LABEL);
 	EndPriority();
 	C_ret((arith) 0);
+	if (options['g']) {
+		C_ms_std((char *) 0, N_RBRAC, proclevel);
+	}
 	C_end(-sc->sc_off);
 	proclevel--;
 	TmpClose();
@@ -431,6 +446,9 @@ WalkProcedure(procedure)
 	C_ret(func_res_size);
 	C_beginpart(partno2);
 	C_pro(procscope->sc_name, -procscope->sc_off);
+	if (options['g']) {
+		C_ms_std((char *) 0, N_LBRAC, proclevel);
+	}
 	C_ms_par(procedure->df_type->prc_nbpar
 #ifdef BIG_RESULT_ON_STACK
 		+ (too_big ? func_res_size : 0)
@@ -438,6 +456,9 @@ WalkProcedure(procedure)
 		);
 	if (! options['n']) WalkDefList(procscope->sc_def, RegisterMessage);
 	C_endpart(partno2);
+	if (options['g']) {
+		C_ms_std((char *) 0, N_RBRAC, proclevel);
+	}
 	C_end(-procscope->sc_off);
 	if (! fit(procscope->sc_off, (int) word_size)) {
 		node_error(procedure->prc_body,