required.h
scope.H
scope.c
+stab.c
statement.g
tmpvar.C
tokenname.c
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
df->con_const = nd;
df->df_type = nd->nd_type;
df->df_flags |= D_SET;
+ if (options['g']) stb_string(df, D_CONST);
}
}
;
{ if( df = define(id, CurrentScope, D_TYPE) ) {
df->df_type = tp;
df->df_flags |= D_SET;
+ if (options['g']) stb_string(df, D_TYPE);
}
}
;
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();
}
]
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);
}
#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)
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;
df->df_value.df_reqname = pnam;
df->df_flags |= D_SET;
}
+ else if (options['g']) stb_string(df, kind);
return df;
}
df->var_name = output;
set_outp();
}
+ if (options['g']) stb_string(df, D_VARIABLE);
}
}
else {
/* 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;
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);
}
df->var_name = df->df_idf->id_text;
df->df_flags |= D_NOREG;
}
+ if (options['g']) stb_string(df, D_VARIABLE);
}
FreeNode(Idlist);
}
#include <em.h>
#include <em_mes.h>
#include <system.h>
+#include <stb.h>
#include "LLlex.h"
#include "Lpars.h"
#include "required.h"
#include "tokenname.h"
#include "type.h"
+#include "scope.h"
char options[128];
char *ProgName;
InitScope();
InitTypes();
- AddRequired();
if( options['c'] ) tkclass['"'] = STSTR;
if( options['u'] || options['U'] ) {
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();
* 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);
(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);
/* 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->df_flags |= D_SET;
- df->enm_next = Enter("false", D_ENUM, bool_type, 0);
- df = df->enm_next;
- df->enm_val = 0;
+ 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 = NULLDEF;
+ if (options['g']) stb_string(df, D_CONST);
}
#ifdef DEBUG
-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
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
+#include <em_code.h>
+#include <stb.h>
#include "LLlex.h"
#include "def.h"
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;
open_scope();
GlobalScope = CurrentScope;
(*df)->prc_vis = CurrVis;
+ if (options['g']) stb_string(*df, D_MODULE);
}
[
'('
struct scopelist {
struct scopelist *next;
struct scope *sc_scope;
+ int sc_count;
};
/* ALLOCDEF "scopelist" 10 */
struct scope *GlobalScope, *PervasiveScope, *BlockScope;
struct scopelist *CurrVis;
extern int proclevel; /* declared in declar.g */
+static int sccount;
InitScope()
{
PervasiveScope = sc;
ls->next = 0;
ls->sc_scope = PervasiveScope;
+ ls->sc_count = ++sccount;
CurrVis = ls;
}
sc->sc_level = proclevel;
ls->sc_scope = sc;
ls->next = CurrVis;
+ ls->sc_count = ++sccount;
CurrVis = ls;
}
--- /dev/null
+/*
+ * (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;
+ }
+}
+
{
#include <alloc.h>
#include <em.h>
+#include <stb.h>
#include "LLlex.h"
#include "chk_expr.h"
]?
{ 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
/* 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
};
#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 */
*text_type,
*nil_type,
*emptyset_type,
+ *void_type,
*error_type; /* All from type.c */
#include "nocross.h"
*text_type,
*nil_type,
*emptyset_type,
+ *void_type,
*error_type;
CheckTypeSizes()
/* 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
*/
public / ack.git / commitdiff