d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Added debugger support

Browse source
This commit is contained in:
ceriel 1990-12-11 13:52:08 +00:00
parent b3287b2b0f
commit f997bd0be8
15 changed files with 449 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lang/pc/comp/.distr
View file

@ -51,6 +51,7 @@ readwrite.c
required.h
scope.H
scope.c
stab.c
statement.g
tmpvar.C
tokenname.c

6
lang/pc/comp/Makefile
View file

@ -61,11 +61,11 @@ LOBJ = declar.o expression.o program.o statement.o tokenfile.o
CSRC = LLlex.c LLmessage.c body.c chk_expr.c code.c\
cstoper.c def.c desig.c enter.c error.c idf.c input.c label.c\
lookup.c main.c misc.c node.c options.c readwrite.c\
scope.c symbol2str.c tokenname.c type.c typequiv.c progs.c
scope.c symbol2str.c tokenname.c type.c typequiv.c progs.c stab.c
COBJ = LLlex.o LLmessage.o body.o casestat.o char.o chk_expr.o code.o\
cstoper.o def.o desig.o enter.o error.o idf.o input.o label.o\
lookup.o main.o misc.o next.o node.o options.o readwrite.o\
scope.o symbol2str.o tmpvar.o tokenname.o type.o typequiv.o progs.o
lookup.o main.o misc.o next.o node.o options.o readwrite.o scope.o\
symbol2str.o tmpvar.o tokenname.o type.o typequiv.o progs.o stab.o
# Extra object for generating peephole-optimizer-code-expander version.
# The Sun-3 version is faster when the text-size exceeds 180K! ARRGH

9
lang/pc/comp/declar.g
View file

@ -180,6 +180,7 @@ ConstantDefinition
df->con_const = nd;
df->df_type = nd->nd_type;
df->df_flags |= D_SET;
if (options['g']) stb_string(df, D_CONST);
}
}
;
@ -196,6 +197,7 @@ TypeDefinition
{ if( df = define(id, CurrentScope, D_TYPE) ) {
df->df_type = tp;
df->df_flags |= D_SET;
if (options['g']) stb_string(df, D_TYPE);
}
}
;
@ -286,9 +288,12 @@ ProcedureDeclaration
Directive
{ DoDirective(dot.TOK_IDF, nd, tp, scl, 0); }
|
{ df = DeclProc(nd, tp, scl); }
{ df = DeclProc(nd, tp, scl);
if (options['g']) stb_string(df, D_PROCEDURE);
}
Block(df)
{ /* open_scope() is simulated in DeclProc() */
if (options['g']) stb_string(df, D_PEND);
close_scope();
}
]
@ -363,10 +368,12 @@ FunctionDeclaration
df->prc_bool =
CurrentScope->sc_off =
df->prc_res - int_size;
if (options['g']) stb_string(df, D_FUNCTION);
}
}
Block(df)
{ if( df ) {
if (options['g']) stb_string(df, D_PEND);
EndFunc(df);
}

4
lang/pc/comp/def.H
View file

@ -103,6 +103,10 @@ struct def { /* list of definitions for a name */
#define D_MODULE 0x080000 /* the module */
#define D_INUSE 0x100000 /* variable is in use */
/* special values for stab.c */
#define D_END (D_MODULE|D_PROCEDURE)
#define D_PEND (D_MODULE|D_PROCEDURE|D_VARIABLE)
#define D_VALUE (D_FUNCTION | D_CONST | D_ENUM | D_FIELD | D_VARIABLE\
| D_FWFUNCTION | D_LBOUND | D_UBOUND)
#define D_ROUTINE (D_FUNCTION | D_FWFUNCTION | D_PROCEDURE | D_FWPROCEDURE)

11
lang/pc/comp/desig.c
View file

@ -435,20 +435,19 @@ CodeBoundDesig(df, ds)
if( df->df_scope->sc_level < proclevel ) {
C_lxa((arith) (proclevel - df->df_scope->sc_level));
C_lof(df->bnd_type->arr_cfdescr);
if( df->df_kind == D_UBOUND ) {
C_ldf(df->bnd_type->arr_cfdescr);
C_lxa((arith) (proclevel - df->df_scope->sc_level));
C_lof(df->bnd_type->arr_cfdescr+word_size);
C_adi(word_size);
}
else
C_lof(df->bnd_type->arr_cfdescr);
}
else {
C_lol(df->bnd_type->arr_cfdescr);
if( df->df_kind == D_UBOUND ) {
C_ldl(df->bnd_type->arr_cfdescr);
C_lol(df->bnd_type->arr_cfdescr+word_size);
C_adi(word_size);
}
else
C_lol(df->bnd_type->arr_cfdescr);
}
ds->dsg_kind = DSG_LOADED;

10
lang/pc/comp/enter.c
View file

@ -34,6 +34,7 @@ Enter(name, kind, type, pnam)
df->df_value.df_reqname = pnam;
df->df_flags |= D_SET;
}
else if (options['g']) stb_string(df, kind);
return df;
}
@ -64,6 +65,7 @@ EnterProgList(Idlist)
df->var_name = output;
set_outp();
}
if (options['g']) stb_string(df, D_VARIABLE);
}
}
else {
@ -85,7 +87,7 @@ EnterEnumList(Idlist, type)
/* Put a list of enumeration literals in the symbol table.
They all have type "type". Also assign numbers to them.
*/
register struct def *df;
register struct def *df, *df1 = 0;
register struct node *idlist = Idlist;
type->enm_ncst = 0;
@ -94,6 +96,11 @@ EnterEnumList(Idlist, type)
df->df_type = type;
df->enm_val = (type->enm_ncst)++;
df->df_flags |= D_SET;
if (! df1) {
type->enm_enums = df;
}
else df1->enm_next = df;
df1 = df;
}
FreeNode(Idlist);
}
@ -156,6 +163,7 @@ EnterVarList(Idlist, type, local)
df->var_name = df->df_idf->id_text;
df->df_flags |= D_NOREG;
}
if (options['g']) stb_string(df, D_VARIABLE);
}
FreeNode(Idlist);
}

31
lang/pc/comp/main.c
View file

@ -5,6 +5,7 @@
#include <em.h>
#include <em_mes.h>
#include <system.h>
#include <stb.h>
#include "LLlex.h"
#include "Lpars.h"
@ -19,6 +20,7 @@
#include "required.h"
#include "tokenname.h"
#include "type.h"
#include "scope.h"
char options[128];
char *ProgName;
@ -82,7 +84,6 @@ Compile(src, dst)
InitScope();
InitTypes();
AddRequired();
if( options['c'] ) tkclass['"'] = STSTR;
if( options['u'] || options['U'] ) {
@ -105,6 +106,10 @@ Compile(src, dst)
fatal("couldn't open output file");
C_magic();
C_ms_emx(word_size, pointer_size);
if (options['g']) {
C_ms_std(FileName, N_SO, 0);
}
AddRequired();
C_df_dlb(++data_label);
C_rom_scon(FileName,(arith) strlen(FileName) + 1);
LLparse();
@ -161,6 +166,15 @@ AddRequired()
* in the grammar
*/
df = Enter("false", D_ENUM, bool_type, 0);
df->enm_val = 0;
df->df_flags |= D_SET;
bool_type->enm_enums = df;
df->enm_next = Enter("true", D_ENUM, bool_type, 0);
df->enm_next->enm_val = 1;
df->df_flags |= D_SET;
df->enm_next->enm_next = NULLDEF;
(void) Enter("rewrite", D_PROCEDURE, std_type, R_REWRITE);
(void) Enter("put", D_PROCEDURE, std_type, R_PUT);
(void) Enter("reset", D_PROCEDURE, std_type, R_RESET);
@ -216,6 +230,7 @@ AddRequired()
(void) Enter("real", D_TYPE, real_type, 0);
(void) Enter("boolean", D_TYPE, bool_type, 0);
(void) Enter("text", D_TYPE, text_type, 0);
(void) Enter("(void)", D_TYPE, void_type, 0);
if( options['d'] )
(void) Enter("long", D_TYPE, long_type, 0);
@ -229,19 +244,13 @@ AddRequired()
/* CONSTANTS */
/* nil is TOKEN and thus part of the grammar */
df = Enter("maxint", D_CONST, int_type, 0);
df->con_const = &maxintnode;
df->df_flags |= D_SET;
maxintnode.nd_type = int_type;
maxintnode.nd_INT = max_int; /* defined in cstoper.c */
df = Enter("true", D_ENUM, bool_type, 0);
df->enm_val = 1;
df = define(str2idf("maxint", 0), CurrentScope, D_CONST);
df->df_type = int_type;
df->con_const = &maxintnode;
df->df_flags |= D_SET;
df->enm_next = Enter("false", D_ENUM, bool_type, 0);
df = df->enm_next;
df->enm_val = 0;
df->df_flags |= D_SET;
df->enm_next = NULLDEF;
if (options['g']) stb_string(df, D_CONST);
}
#ifdef DEBUG

1
lang/pc/comp/options.c
View file

@ -31,6 +31,7 @@ DoOption(text)
-i: largest value of set of integer
-u, -U: allow underscore in identifier
-w: no warnings
-g: generate symbol table for debugger
-R: no range checks
-A: range checks for array references
and many more if DEBUG

11
lang/pc/comp/program.g
View file

@ -4,6 +4,8 @@
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
#include <em_code.h>
#include <stb.h>
#include "LLlex.h"
#include "def.h"
@ -24,7 +26,13 @@ Program
struct def *df;
arith dummy;
}:
ProgramHeading(&df) ';' Block(df) '.'
ProgramHeading(&df)
';' Block(df) '.'
{ if (options['g']) {
C_ms_stb_cst(df->df_idf->id_text, N_MAIN, 0, (arith) 0);
stb_string(df, D_END);
}
}
| { df = new_def();
df->df_idf = str2idf(FileName, 1);
df->df_kind = D_MODULE;
@ -44,6 +52,7 @@ ProgramHeading(register struct def **df;):
open_scope();
GlobalScope = CurrentScope;
(*df)->prc_vis = CurrVis;
if (options['g']) stb_string(*df, D_MODULE);
}
[
'('

1
lang/pc/comp/scope.H
View file

@ -15,6 +15,7 @@ struct scope {
struct scopelist {
struct scopelist *next;
struct scope *sc_scope;
int sc_count;
};
/* ALLOCDEF "scopelist" 10 */

3
lang/pc/comp/scope.c
View file

@ -18,6 +18,7 @@
struct scope *GlobalScope, *PervasiveScope, *BlockScope;
struct scopelist *CurrVis;
extern int proclevel; /* declared in declar.g */
static int sccount;
InitScope()
{
@ -29,6 +30,7 @@ InitScope()
PervasiveScope = sc;
ls->next = 0;
ls->sc_scope = PervasiveScope;
ls->sc_count = ++sccount;
CurrVis = ls;
}
@ -40,6 +42,7 @@ open_scope()
sc->sc_level = proclevel;
ls->sc_scope = sc;
ls->next = CurrVis;
ls->sc_count = ++sccount;
CurrVis = ls;
}

369
lang/pc/comp/stab.c Normal file
View file

@ -0,0 +1,369 @@
/*
* (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_arith.h>
#include <em_label.h>
#include <em_code.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"
#include "node.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 struct 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->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:
case T_LONG: {
arith l = full_mask[(int)tp->tp_size] & ~(1L << (tp->tp_size*8-1));
adds_db_str(sprint(buf,
"r%d;%ld;%ld",
tp->tp_dbindex,
(long) -l-1,
(long) l));
}
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;
/* constructed types ... */
case T_SUBRANGE:
adds_db_str(sprint(buf,
"r%d;%ld;%ld",
tp->next->tp_dbindex,
(long) tp->sub_lb,
(long) tp->sub_ub));
break;
case T_POINTER:
if (tp->next) {
addc_db_str('*');
stb_type(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->next, 0);
adds_db_str(sprint(buf, ";%ld;%ld;", tp->tp_size, 0L));
break;
case T_ARRAY:
addc_db_str('a');
if (IsConformantArray(tp)) {
addc_db_str('r');
stb_type(tp->next, 0);
adds_db_str(sprint(buf, ";A%ld;Z%ld", tp->arr_cfdescr, tp->arr_cfdescr));
}
else {
stb_type(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->fld_off*8,
sdef->df_type->tp_size*8));
sdef = sdef->df_nextinscope;
}
}
addc_db_str(';');
break;
case T_PROCEDURE:
case T_FUNCTION:
addc_db_str('Q');
stb_type(tp->next ? tp->next : void_type, 0);
{
register struct paramlist *p = tp->prc_params;
int paramcount = 0;
while (p) {
paramcount++;
p = p->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->next;
}
}
break;
case T_FILE:
addc_db_str('L');
stb_type(tp->next);
break;
case T_STRING:
addc_db_str('*');
stb_type(char_type);
break;
}
}
stb_string(df, kind)
register struct def *df;
{
register struct 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->prc_vis->sc_count));
C_ms_stb_pnam(db_str.base, N_FUN, proclevel, "m_a_i_n");
break;
case D_PROCEDURE:
case D_FUNCTION:
adds_db_str(sprint(buf, "Q%d;", df->prc_vis->sc_count));
stb_type(tp->next ? tp->next : void_type, 0);
addc_db_str(';');
C_ms_stb_pnam(db_str.base, N_FUN, proclevel, df->df_idf->id_text);
{
register struct paramlist *p = tp->prc_params;
while (p) {
stb_string(p->par_def, D_VARIABLE);
p = p->next;
}
}
for (df = df->prc_vis->sc_scope->sc_def; df; df = df->df_nextinscope) {
if (df->df_kind == D_LBOUND ||
df->df_kind == D_UBOUND) {
stb_string(df, df->df_kind);
}
}
break;
case D_END:
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 (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) {
addc_db_str('G');
stb_type(tp, 0);
addc_db_str(';');
C_ms_stb_dnam(db_str.base, N_LCSYM, 0, df->var_name, (arith) 0);
}
else { /* local variable */
stb_type(tp, 1); /* assign type num to avoid
difficult to parse string */
addc_db_str(';');
C_ms_stb_cst(db_str.base, N_LSYM, 0, df->var_off);
}
break;
case D_LBOUND:
case D_UBOUND:
addc_db_str(kind == D_LBOUND ? 'A' : 'Z');
addc_db_str('p');
stb_type(tp, 0);
addc_db_str(';');
C_ms_stb_cst(db_str.base, N_PSYM, 0, df->bnd_type->arr_cfdescr);
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 > 32767
? 0
: (int)tp->tp_size,
(arith) 0);
break;
case D_CONST:
addc_db_str('c');
addc_db_str('=');
tp = BaseType(tp);
switch(tp->tp_fund) {
case T_INTEGER:
case T_LONG:
case T_POINTER:
case T_PROCEDURE:
adds_db_str(sprint(buf, "i%ld;", df->con_const->nd_INT));
break;
case T_CHAR:
adds_db_str(sprint(buf, "c%ld;", df->con_const->nd_INT));
break;
case T_REAL:
addc_db_str('r');
adds_db_str(df->con_const->nd_REL);
addc_db_str(';');
break;
case T_STRINGCONST: {
register char *p = df->con_const->nd_STR;
adds_db_str("s'");
while (*p) {
if (*p == '\'' || *p == '\\') {
addc_db_str('\\');
}
addc_db_str(*p++);
}
adds_db_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->nd_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 <= 32767 ? (int)tp->tp_size : 0,
(arith) 0);
break;
}
}

9
lang/pc/comp/statement.g
View file

@ -2,6 +2,7 @@
{
#include <alloc.h>
#include <em.h>
#include <stb.h>
#include "LLlex.h"
#include "chk_expr.h"
@ -46,6 +47,14 @@ Statement
]?
{ if( !options['L'] )
C_lin((arith) dot.tk_lineno);
if (options['g']) {
static int ms_lineno;
if (ms_lineno != dot.tk_lineno) {
C_ms_std((char *) 0, N_SLINE, dot.tk_lineno);
ms_lineno = dot.tk_lineno;
}
}
}
[
SimpleStatement

4
lang/pc/comp/type.H
View file

@ -10,8 +10,10 @@ struct paramlist { /* structure for parameterlist of a PROCEDURE */
/* ALLOCDEF "paramlist" 50 */
struct enume {
struct def *en_enums;
unsigned int en_ncst; /* number of constants */
label en_rck; /* label of range check descriptor */
#define enm_enums tp_value.tp_enum.en_enums
#define enm_ncst tp_value.tp_enum.en_ncst
#define enm_rck tp_value.tp_enum.en_rck
};
@ -95,6 +97,7 @@ struct type {
#define T_HASFILE 0x1 /* set if type has a filecomponent */
#define T_PACKED 0x2 /* set if type is packed */
#define T_CHECKED 0x4 /* set if array has been checked */
short tp_dbindex; /* index in debugger symbol table */
int tp_align; /* alignment requirement of this type */
int tp_palign; /* in packed structures */
arith tp_size; /* size of this type */
@ -121,6 +124,7 @@ extern struct type
*text_type,
*nil_type,
*emptyset_type,
*void_type,
*error_type; /* All from type.c */
#include "nocross.h"

2
lang/pc/comp/type.c
View file

@ -48,6 +48,7 @@ struct type
*text_type,
*nil_type,
*emptyset_type,
*void_type,
*error_type;
CheckTypeSizes()
@ -128,6 +129,7 @@ InitTypes()
/* an unique type indicating an error
*/
error_type = standard_type(T_ERROR, 1, (arith) 1);
void_type = error_type;
/* the nilvalue has an unique type
*/