added support for debugger

This commit is contained in:
ceriel 1990-07-30 15:56:25 +00:00
parent 8206965ae9
commit 8eecdff85a
16 changed files with 478 additions and 26 deletions

View file

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

View file

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

View file

@ -101,6 +101,8 @@ struct def { /* list of definitions for a name */
*/ */
#define D_INUSE 0x8000 /* identification in this scope (like D_IMPORT) #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_VALUE (D_PROCEDURE|D_VARIABLE|D_FIELD|D_ENUM|D_CONST|D_PROCHEAD)
#define D_ISTYPE (D_HIDDEN|D_TYPE) #define D_ISTYPE (D_HIDDEN|D_TYPE)
#define D_IMPORTED (D_IMPORT|D_INUSE) #define D_IMPORTED (D_IMPORT|D_INUSE)

View file

@ -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. allow for warning messages whose class is a member of \fIclasses\fR.
.IP \fB\-x\fR .IP \fB\-x\fR
make all procedure names global, so that \fIadb\fR(1) understands them. 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 .IP \fB\-l\fR
enable local extensions. Currently, the only local extension consists of enable local extensions. Currently, the only local extension consists of
procedure constants. procedure constants.

View file

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

View file

@ -17,6 +17,7 @@
#include <em_code.h> #include <em_code.h>
#include <alloc.h> #include <alloc.h>
#include <assert.h> #include <assert.h>
#include <stb.h>
#include "strict3rd.h" #include "strict3rd.h"
#include "input.h" #include "input.h"
@ -82,6 +83,13 @@ Compile(src, dst)
LineNumber = 1; LineNumber = 1;
FileName = src; FileName = src;
WorkingDir = getwdir(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(); init_idf();
InitCst(); InitCst();
reserve(tkidf); reserve(tkidf);
@ -97,10 +105,6 @@ Compile(src, dst)
open_scope(OPENSCOPE); open_scope(OPENSCOPE);
GlobalVis = CurrVis; GlobalVis = CurrVis;
close_scope(0); 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(); CheckForLineDirective();
CompUnit(); CompUnit();
C_ms_src((int)LineNumber - 1, FileName); C_ms_src((int)LineNumber - 1, FileName);
@ -211,17 +215,19 @@ AddStandards()
EnterType("LONGINT", longint_type); EnterType("LONGINT", longint_type);
EnterType("REAL", real_type); EnterType("REAL", real_type);
EnterType("LONGREAL", longreal_type); EnterType("LONGREAL", longreal_type);
EnterType("BOOLEAN", bool_type);
EnterType("CARDINAL", card_type); EnterType("CARDINAL", card_type);
EnterType("(void)", void_type);
df = Enter("NIL", D_CONST, address_type, 0); df = Enter("NIL", D_CONST, address_type, 0);
df->con_const = nilconst; df->con_const = nilconst;
EnterType("PROC", construct_type(T_PROCEDURE, NULLTYPE)); EnterType("PROC", construct_type(T_PROCEDURE, NULLTYPE));
EnterType("BITSET", bitset_type); EnterType("BITSET", bitset_type);
df = Enter("TRUE", D_ENUM, bool_type, 0); df = Enter("FALSE", D_ENUM, bool_type, 0);
df->enm_val = 1; bool_type->enm_enums = df;
df->enm_next = Enter("FALSE", D_ENUM, bool_type, 0); df->enm_next = Enter("TRUE", D_ENUM, bool_type, 0);
assert(df->enm_next->enm_val == 0 && df->enm_next->enm_next == 0); df->enm_next->enm_val = 1;
assert(df->enm_val == 0 && df->enm_next->enm_next == 0);
EnterType("BOOLEAN", bool_type);
} }
do_SYSTEM() do_SYSTEM()

View file

@ -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. By default, warnings in class \fBO\fR and \fBW\fR are given.
.IP \fB\-W\fR\fIclasses\fR .IP \fB\-W\fR\fIclasses\fR
allow for warning messages whose class is a member of \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 .IP \fB\-x\fR
make all procedure names global, so that \fIadb\fR(1) understands them. make all procedure names global, so that \fIadb\fR(1) understands them.
.IP \fB\-Xs\fR .IP \fB\-Xs\fR

View file

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

View file

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

View file

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

View file

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

View file

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

378
lang/m2/comp/stab.c Normal file
View file

@ -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;
}
}

View file

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

View file

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

View file

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