/* 2155, Tue 16 May 00 SRL.C: First attempt at an SRL compiler Copyright (C) 1998-2002 by Nevil Brownlee, CAIDA | University of Auckland */ /* * $Log: srl.c,v $ * Revision 1.1.1.2.2.11 2002/02/23 01:57:41 nevil * Moving srl examples to examples/ directory. Modified examples/Makefile.in * * Revision 1.1.1.2.2.6 2000/08/08 19:44:59 nevil * 44b8 release * * Revision 1.1.1.2.2.4 2000/06/06 03:38:32 nevil * Combine NEW_ATR with TCP_ATR, various bug fixes * * Revision 1.1.1.2.2.1 2000/01/12 02:57:15 nevil * Implement 'packet pair matched' turnaroundtime distribution attributes. * Fix ASN-related bugs in NeTraMet, distribution-related bugs in fd_filter. * * Revision 1.1.1.2 1999/10/03 21:06:34 nevil * *** empty log message *** * * Revision 1.1.1.1.2.7 1999/09/22 05:34:09 nevil * Implement command-line defines * - Initialise scanner in init_symbol_table() * - Add get_command_define() to scanner. This dummies up a define * statement then calls push_include to invoke it * - Call get_command_define from main when we see a -D option * * Revision 1.1.1.1.2.6 1999/04/26 05:20:57 nevil * -Allow redeclaration of 'built-ins,' i.e. well-known ports, address * families and transport types. A warning is given telling the * user what was redclared. * -Fix bug in checking of subroutine calls. If a call appears before * the subroutine declaration, it must have an integer label matching * the highest one in the subroutine. This is because the compiler * doesn't emit dummy rules (to allow for returns) until after the * declaration. * -Warn user that NeMaC doesn't handle return labels > 200. * -Warn user that NeMaC requires one SET and one FORMAT statement, * and that every program should have at least one COUNT statement. * * Revision 1.1.1.1.2.5 1999/03/31 03:01:51 nevil * Added better error messages (and error recovery): * Attempt to redefine reserved word, protocol, port, address family * Char constants must have just one character * Corrected err_msg() to avoid msg buffer overflow when printing * an error message from within the body of a define. * Improved error reovery for invald tokens in subroutine declarations * and call statements. * * Revision 1.1.1.1.2.4 1999/01/28 03:12:09 nevil * Mis-spelt attribute names are now correctly reported as errors * * Revision 1.1.1.1.2.3 1999/01/27 04:26:17 nevil * Minor corrections to fix compiler warnings * * Revision 1.1.1.1.2.2 1999/01/08 01:38:41 nevil * Distribution file for 4.3b7 * * Revision 1.1.1.1.2.1 1998/12/16 02:59:09 nevil * Make compiler distinguish between 'save attrib' and 'save attrib = 0' * These both used to produce a rule which saved the whole attrib value! * * Revision 1.1.1.1 1998/11/16 03:57:32 nevil * Import of NeTraMet 4.3b3 * * Revision 1.1.1.1 1998/11/16 03:22:03 nevil * Import of release 4.3b3 * * Revision 1.1.1.1 1998/10/28 20:31:33 nevil * Import of NeTraMet 4.3b1 * * Revision 1.1.2.2 1998/10/27 04:39:19 nevil * 4.3b1 release * * Revision 1.2 1998/10/21 09:17:32 nguba * Now compiler only displays stats about errors and warnings when * either an error or a warning have occurred. It now exits with the * right return value when un/successful (doesn't accept the emacs * compile.el anymore) * * Revision 1.1.2.1 1998/10/22 21:40:37 nevil * Moved srl from src/manager to its own subdirectory * * Revision 1.1.3.2 1998/10/18 23:44:13 nevil * Added Nicolai's patches, some 'tidying up' of the source * * Revision 1.1.3.1 1998/10/13 02:48:26 nevil * Import of Nicolai's 4.2.2 * * Revision 1.1.1.1 1998/08/24 12:09:29 nguba * NetraMet 4.2 Original Distribution * * Revision 1.2 1998/07/21 00:43:57 rtfm * Change attrib numbers for 'New Attribs' I-D * First release version of SRL */ #if HAVE_CONFIG_H #include #endif #include #include #include #include #if HAVE_MALLOC_H # include #endif #include #define SRLEXT #include "rtfm_atr.h" #include "srl.h" char *ver = "SRL compiler, version " ver_str; void q2(int x) /* For debugging breakpoint */ { } static int n_sets, n_formats, n_counts; void check_mask(struct pt_node *a) { int k; unsigned char ac[50]; for (k = 0; k != sizeof(a->d.operand.attrib); ++k) { if ((a->d.operand.value[k] & ~a->d.operand.mask[k]) != 0) { sprintvalmsk(ac, a); err_msg(ET_WARN, "%s value has bits not covered by mask", ac); /* Don't try to correct this by stripping bad bits here! */ break; } } } struct pt_node *operand(int attrib) { struct pt_node *op; if (testing) printf(". . . operand(%d)\n", attrib); op = alloc_node(); op->type = NT_OPERAND; op->d.operand.attrib = attrib; if (!get_value(op->d.operand.value, attrib)) { err_msg(ET_ERR, "Value expected"); if (toktype != TOK_SPECIAL || toksubtype != ')') next(); } else { next(); if (toktype == TOK_SPECIAL && (toksubtype == '&' || toksubtype == '/')) { if (toksubtype == '/') { next(); if (toktype == TOK_NUMBER) mask_from_width(op->d.operand.mask, get_number()); else err_msg(ET_ERR, "Width expected"); } else if (toksubtype == '&') { next(); if (!get_value(op->d.operand.mask, attrib)) err_msg(ET_ERR, "Mask expected"); } check_mask(op); next(); } else get_default_mask(op->d.operand.mask, attrib); } if (testing > 1) printf(". . . operand() exit, token=%s\n", token); return op; } struct pt_node *operand_list(int attrib) { struct pt_node *op, *nop; if (testing) printf(". . . operand_list(%d)\n", attrib); if (toktype == TOK_SPECIAL && toksubtype == '(') { /* Operand list */ next(); op = operand(attrib); while (toktype == TOK_SPECIAL && toksubtype == ',') { next(); nop = alloc_node(); nop->type = NT_BINOP; nop->d.binop.operator = SC_SAMEOR; nop->left = op; nop->right = operand(attrib); op = nop; } if (toktype != TOK_SPECIAL && toksubtype != ')') err_msg(ET_ERR, ") expected"); next(); } else op = operand(attrib); /* Single operand */ if (testing > 1) printf(". . . operand_list() exit, token=%s\n", token); return op; } struct pt_node *expression(void); struct pt_node *factor(void) { struct pt_node *op; struct symbol *sp; int attrib; if (testing) printf(". . . factor()\n"); attrib = 0; if (toktype == TOK_ATTRIB) { if (!if_OK(attrib = toksubtype)) err_msg(ET_ERR, "This attribute can't be tested in an IF"); } else if (toktype == TOK_SYMBOL) { sp = &st[st_ix]; if (sp->symtype == ST_ADDRESS || sp->symtype == ST_VARIABLE) attrib = param_attrib(sp); else err_msg(ET_ERR, "Attribute expected"); } if (attrib != 0) { next(); if (toktype != TOK_SPECIAL || toksubtype != SC_EQUAL) err_msg(ET_ERR, "== expected"); if (toktype == TOK_SPECIAL && (toksubtype == SC_EQUAL || toksubtype == '=')) next(); op = operand_list(attrib); } else { if (toktype == TOK_SPECIAL && toksubtype == '(') { next(); op = expression(); if (toktype == TOK_SPECIAL && toksubtype == ')') next(); else err_msg(ET_ERR, ") expected"); } else { err_msg(ET_ERR, "Factor expected"); op = NULL; } } if (testing > 1) printf(". . . factor() exit, token=%s\n", token); return op; } struct pt_node *term(void) { struct pt_node *op, *nop; if (testing) printf(". . . term()\n"); op = factor(); while (toktype == TOK_SPECIAL && toksubtype == SC_LAND) { /* && */ if (testing) printf(". . . term() loop\n"); next(); nop = alloc_node(); nop->type = NT_BINOP; nop->left = op; nop->d.binop.operator = SC_LAND; nop->right = factor(); op = nop; } if (testing > 1) printf(". . . term() exit, token=%s\n", token); return op; } struct pt_node *expression(void) { struct pt_node *op, *nop; if (testing) printf(". . . expression()\n"); op = term(); while (toktype == TOK_SPECIAL && toksubtype == SC_LOR) { /* || */ if (testing) printf(". . . expression() loop\n"); next(); nop = alloc_node(); nop->type = NT_BINOP; nop->left = op; nop->d.binop.operator = SC_LOR; nop->right = term(); op = nop; } if (testing > 1) printf(". . . expression() exit, token=%s\n", token); return op; } void find_arg_sep(void) { if (testing) printf(". . . find_arg_sep()\n"); for (;;) { if (toktype == TOK_EOF) return; if (toktype == TOK_SPECIAL && (toksubtype == ',' || toksubtype == ')')) { return; } else if (toktype == TOK_NUMBER) get_number(); /* Move past the number */ next(); } } void find_semi(void) { if (testing) printf(". . . find_semi()\n"); for (;;) { if (toktype == TOK_EOF) return; if (toktype == TOK_SPECIAL && (toksubtype == ';' || toksubtype == '}')) { next(); /* Get next token after ; or } */ return; } else if (toktype == TOK_NUMBER) get_number(); /* Move past the number */ next(); } } int find_res_word(int word) { if (testing) printf(". . . find_res_word(%d)\n", word); for (;;) { if (toktype == TOK_EOF) return 0; if (toktype == TOK_NUMBER) get_number(); /* Move past the number */ else if (word == 0) { /* Find something that could start a statement */ if (toktype == TOK_SPECIAL && toksubtype == '{') return 1; if (toktype == TOK_RSVWD) return 1; } else if (toktype == TOK_RSVWD /* Find specified reserved word */ && toksubtype == word) { next(); /* Get next token after word */ return 1; } next(); } } void check_semi(void) { if (toktype != TOK_SPECIAL || toksubtype != ';') err_msg(ET_ERR, "; expected"); find_semi(); } static int start_opt_lev; /* Optimise level (from command line) */ void set_opt_level(void) /* Let user give compiler some hints */ { next(); if (toktype == TOK_SPECIAL && toksubtype == '*') { emit_opt_level(-1); /* Mark break between optimised groups */ next(); } else if (toktype == TOK_SPECIAL && toksubtype == ';') emit_opt_level(optimise_level = start_opt_lev); else if (toktype == TOK_NUMBER) { emit_opt_level(optimise_level = get_number()); next(); } else err_msg(ET_WARN, "integer, * or ; expected"); check_semi(); } static int a_ln = 0, /* Start of an action */ n_ln = 0, /* Next IF clause */ g_ln = 0, /* End of an IF or CALL group */ u_ln = 0; /* Name for a user symbol */ void make_label(char *buf, int kind) { int n; if (kind == 'a') n = ++a_ln; else if (kind == 'n') n = ++n_ln; else if (kind == 'g') n = ++g_ln; else if (kind == 'u') n = ++u_ln; sprintf(buf, "%c%d", kind, n); } void set_st_name(struct symbol *sp, int dummy) { if (sp->name[0] != '\0') return; /* Already set */ if (asmint && !dummy) strcpy(sp->name, id_table[sp->idx].id); else make_label(sp->name, 'u'); } struct symbol *block_check(int stx, int type) { struct symbol *sp; sp = &st[stx]; if (sp->symtype == ST_SYMBOL) { /* New symbol */ sp->symtype = type; set_st_name(sp, 0); } else { if (type == ST_LABEL) { if (subr_stx != 0 && stx > subr_stx) err_msg(ET_ERR, "Already declared inside SUBROUTINE"); else if (subr_stx == 0) err_msg(ET_ERR, "Already declared"); add_symbol(type); /* Declare new label */ sp = &st[stx = st_top-1]; set_st_name(sp, 1); } else { /* Subroutine parameter */ if (stx < subr_stx) { /* Declared in enclosing block */ add_symbol(type); /* Declare new symbol in this block */ sp = &st[stx = st_top-1]; } else err_msg(ET_ERR, "Already declared in SUBROUTINE"); } } if (sp->symtype != type) err_msg(ET_ERR, "%s expected", sym_types[type]); return sp; } void set_subr_n_returns(int r) { int n = st[subr_stx].d.sub.n_returns; if (r > n) st[subr_stx].d.sub.n_returns = r; if (r > MXRETURNOFFSET) err_msg(ET_WARN, "NeMaC doesn't allow return labels > %d", MXRETURNOFFSET); } void check_subrs_declared(int blk_stx) { int j; for (j = st_top-1; j >= blk_stx; --j) { if (st[j].symtype == ST_SUBROUTINE && strcmp(st[j+1].name, "<>") != 0) err_msg(ET_ERR, "No SUBROUTINE declaration for %s", id_table[st[j].idx].id); } } void Statement(void); void IF_statement(char *outer_grp_lbl) { struct pt_node *op; char nbuf[IDENT_LN+1], lbuf[IDENT_LN+1]; char a_lbl[IDENT_LN+1], n_lbl[IDENT_LN+1]; char g_lbl[IDENT_LN+1], *grp_lbl; struct symbol *sp; int which; char *action, *next_if; unsigned long n; int save_reqd, done, single; if (testing) printf(". . . IF_statement()\n"); if (outer_grp_lbl == NULL) { make_label(g_lbl, 'g'); /* Make this IF group's closing label */ grp_lbl = g_lbl; } else grp_lbl = outer_grp_lbl; next(); op = expression(); set_mxd_pt(op); set_grpsz_pt(op); if (verbose) { printf("+++ expression tree:\n"); print_pt(op, 0, ""); printf("---\n"); } if (op == NULL) /* Invalid expression */ find_res_word(0); /* Resync on any reserved word */ if (toktype == TOK_RSVWD && toksubtype == RW_SAVE) { nextnb(); /* 1-char lookahead */ if (ic == ';') { /* SAVE ; */ next(); next(); single = 1; which = RW_SAVE; action = grp_lbl; done = 1; } else if (ic == ',') { /* SAVE , */ next(); next(); save_reqd = 1; single = 0; done = 0; } else { /* SAVE statement */ save_reqd = 0; single = 0; done = 0; } } else if (toktype == TOK_SPECIAL && toksubtype == ';') { /* Null stmt */ next(); single = 1; which = RW_EXIT; action = grp_lbl; done = 1; } else save_reqd = done = 0; if (!done) { /* Action not yet determined */ if (toktype == TOK_RSVWD) { switch(toksubtype) { case RW_EXIT: next(); if (toktype == TOK_SYMBOL) { /* Get the label */ single = 1; which = save_reqd ? RW_SAVE : RW_EXIT; sp = &st[st_ix]; if (sp->symtype != ST_LABEL) { err_msg(ET_ERR, "Undeclared label"); sp = block_check(st_ix, ST_LABEL); /* Declare it */ action = NULL; } else strcpy(action = lbuf, sp->name); if (subr_stx != 0 && st_ix < subr_stx) err_msg(ET_ERR, "Can't EXIT to label outside SUBROUTINE"); next(); check_semi(); } else err_msg(ET_ERR, "Exit label expected"); break; case RW_IGNORE: single = 1; which = RW_IGNORE; action = NULL; next(); check_semi(); break; case RW_NOMATCH: single = 1; which = RW_NOMATCH; action = NULL; next(); check_semi(); break; case RW_RETURN: if (save_reqd) single = 0; else { if (subr_stx == 0) err_msg(ET_ERR, "Return only allowed inside a subroutine"); next(); single = 1; which = RW_RETURN; if (toktype == TOK_NUMBER) { sprintf(nbuf, "%lu", n = get_number()); action = nbuf; set_subr_n_returns(n); next(); } else action = id_table[st[subr_stx].idx].id; check_semi(); } break; default: single = 0; break; } } else single = 0; } make_label(n_lbl, 'n'); /* Make this IF action's closing label */ if (single) emit_expression(op, which, action, n_lbl); else { make_label(a_lbl, 'a'); /* Make an action label */ emit_expression(op, save_reqd ? RW_SAVE : RW_EXIT, a_lbl, n_lbl); emit_IF_level(+1); emit_label(a_lbl); Statement(); emit_goto(grp_lbl); emit_IF_level(-1); } emit_label(n_lbl); free_pt(op); /* Finished with expression parse tree */ if (toktype == TOK_RSVWD && toksubtype == RW_OPTIMISE) set_opt_level(); if (toktype == TOK_RSVWD && toksubtype == RW_ELSE) { next(); if (toktype == TOK_RSVWD && toksubtype == RW_OPTIMISE) set_opt_level(); if (toktype == TOK_RSVWD && toksubtype == RW_IF) { IF_statement(grp_lbl); /* Continue this IF group */ } else Statement(); } if (outer_grp_lbl == NULL) emit_label(grp_lbl); } struct pt_node *Save_statement(int emit) { int attrib, action; struct pt_node *op; struct symbol *sp; if (testing) printf(". . . Save_statement()\n"); if (toktype == TOK_ATTRIB) { if (!save_OK(attrib = toksubtype)) err_msg(ET_ERR, "This attribute may not be SAVEd"); } else if (toktype == TOK_SYMBOL) { sp = &st[st_ix]; if (sp->symtype == ST_ADDRESS || sp->symtype == ST_VARIABLE) { attrib = param_attrib(sp); if (sp->symtype == ST_VARIABLE) err_msg(ET_ERR, "Address expected"); } else err_msg(ET_ERR, "Attribute expected"); } else err_msg(ET_ERR, "Attribute expected"); if (attrib != 0) { action = RW_SAVE; next(); if (toktype == TOK_SPECIAL && (toksubtype == '/' || toksubtype == '&' || toksubtype == '=')) { if (toksubtype == '/') { next(); op = alloc_node(); op->type = NT_OPERAND; op->d.operand.attrib = attrib; if (toktype == TOK_NUMBER) { mask_from_width(op->d.operand.mask, get_number()); next(); } else err_msg(ET_ERR, "Width expected"); } else if (toksubtype == '&') { next(); op = alloc_node(); op->type = NT_OPERAND; op->d.operand.attrib = attrib; if (!get_value(op->d.operand.mask, attrib)) err_msg(ET_ERR, "Mask expected"); else next(); } else { /* = */ action = RW_SAVE_V; next(); op = operand(attrib); } } else { /* No mask or width */ op = alloc_node(); op->type = NT_OPERAND; op->d.operand.attrib = attrib; get_default_mask(op->d.operand.mask, attrib); } if (emit) { emit_imperative(op, action, NULL); if (op != NULL) free_node(op); return NULL; } else return op; } else err_msg(ET_ERR, "Attribute expected"); return NULL; } struct pt_node *Store_statement(int emit) { int attrib; struct pt_node *op; struct symbol *sp; if (testing) printf(". . . Store_statement()\n"); attrib = 0; if (toktype == TOK_ATTRIB) { if (!store_OK(attrib = toksubtype)) err_msg(ET_ERR, "Variable expected"); } else if (toktype == TOK_SYMBOL) { sp = &st[st_ix]; if (sp->symtype == ST_ADDRESS || sp->symtype == ST_VARIABLE) { attrib = param_attrib(sp); if (sp->symtype == ST_ADDRESS) err_msg(ET_ERR, "Variable expected"); } else err_msg(ET_ERR, "Variable expected"); } else err_msg(ET_ERR, "Variable expected"); if (attrib != 0) { op = alloc_node(); op->type = NT_OPERAND; op->d.operand.attrib = attrib; op->d.operand.mask[0] = 255; next(); if (toktype == TOK_SPECIAL && toksubtype == SC_ASSIGN) { next(); if (toktype == TOK_NUMBER) { op->d.operand.attrib = FTFLOWKIND; /* Force get_value width */ if (!get_value(op->d.operand.value, op->d.operand.attrib)) { err_msg(ET_ERR, "Value expected"); } else next(); op->d.operand.attrib = attrib; } else err_msg(ET_ERR, "Value expected"); if (emit) emit_imperative(op, RW_STORE, NULL); } else err_msg(ET_ERR, ":= expected"); if (emit) { free_node(op); return NULL; } else return op; } return NULL; } void Imperative_statement(void) { struct pt_node *op; struct symbol *sp; char nbuf[IDENT_LN]; int which; unsigned long n; if (testing) printf(". . . Imperative_statement()\n"); which = toksubtype; op = NULL; next(); switch(which) { case RW_EXIT: if (toktype == TOK_SYMBOL) { /* Get the label */ sp = &st[st_ix]; if (sp->symtype != ST_LABEL) { if (sp->symtype == ST_SYMBOL) /* New symbol */ err_msg(ET_ERR, "Undeclared label"); sp = block_check(st_ix, ST_LABEL); /* Declare it */ } else if (subr_stx != 0 && st_ix < subr_stx) err_msg(ET_ERR, "Can't EXIT to label outside SUBROUTINE"); emit_imperative(op, RW_EXIT, sp->name); next(); } else err_msg(ET_ERR, "Label expected"); break; case RW_SAVE: Save_statement(1); break; case RW_COUNT: ++n_counts; emit_imperative(op, RW_COUNT, NULL); break; case RW_IGNORE: emit_imperative(op, RW_IGNORE, NULL); break; case RW_NOMATCH: emit_imperative(op, RW_NOMATCH, NULL); break; case RW_STORE: Store_statement(1); break; case RW_RETURN: if (subr_stx == 0) err_msg(ET_ERR, "Return only allowed inside a subroutine"); if (toktype == TOK_NUMBER) { sprintf(nbuf, "%lu", n = get_number()); emit_imperative(op, RW_RETURN, nbuf); set_subr_n_returns(n); next(); } else emit_imperative(op, RW_RETURN, st[subr_stx].name); break; } check_semi(); } void Compound_statement(void) { struct symbol *sp; int first_line = line_nbr; if (testing) printf(". . . Compound_statement()\n"); sp = NULL; if (ic == ':') { if (toktype == TOK_SYMBOL) { sp = block_check(st_ix, ST_LABEL); next(); /* Move past the : */ next(); } else { err_msg(ET_ERR, "label expected"); find_semi(); } } if (toktype == TOK_SPECIAL && toksubtype == '{') { next(); for (;;) { if (toktype == TOK_EOF) { err_msg(ET_ERR, "EOF in compound statement which began on line %d", first_line); return; } Statement(); if (toktype == TOK_SPECIAL && toksubtype == '}') { next(); if (sp != NULL) emit_label(sp->name); if (testing > 1 ) printf(". . . leaving Compound_statement(s)\n"); return; } } } else err_msg(ET_ERR, "{ expected"); if (testing > 1) printf(". . . leaving Compound_statement(f)\n"); } int subr_match(int call_stx, int sub_stx, int params) { /* Returns 1 if st entries match */ int k, cx,sx; if (params) { if ((k = st[call_stx].d.sub.n_params) != st[sub_stx].d.sub.n_params) return 0; for (cx = call_stx+2, sx = sub_stx+2; k != 0; ++cx, ++sx, --k) { if (st[cx].symtype != st[sx].symtype) return 0; } return 1; } else { /* Compare nbr of returns */ if (strcmp(st[call_stx+1].name, st[sub_stx+1].name) == 0) return 1; /* Need a <> and a <> */ return st[call_stx].d.sub.n_returns >= st[sub_stx].d.sub.n_returns; } } struct return_stmt_info { int ret_nbr; struct pt_node opnode; int which; /* Action */ char a_lbl[IDENT_LN+1]; }; static int call_grp_cmp(const void *ap, const void *bp) { struct return_stmt_info *a, *b; a = (struct return_stmt_info *)ap; b = (struct return_stmt_info *)bp; if (a->ret_nbr < b->ret_nbr) return -1; else if (a->ret_nbr > b->ret_nbr) return 1; else return 0; } void Call_statement(void) { struct symbol *call_sp, *sub_sp, *sp; int first_line, call_stx, sub_stx, arg_reg, params, single, which, p_type, call_grp_sz, /* Nbr of return labels */ mx_ret_value, /* Max return label */ lbls_this_stmt, j,k; unsigned long n; struct pt_node *op; struct return_stmt_info *rip; char g_lbl[IDENT_LN+1], a_lbl[IDENT_LN+1], s_lbl[IDENT_LN+1], *target; struct return_stmt_info ret_info[MXCALLGRP]; first_line = line_nbr; next(); if (toktype != TOK_SYMBOL) err_msg(ET_ERR, "Subroutine name expected"); else { sub_sp = NULL; arg_reg = subr_reg; call_sp = &st[call_stx = st_ix]; /* ST entry for the symbol */ if (call_sp->symtype == ST_SYMBOL) { /* New symbol */ call_sp->symtype = ST_SUBROUTINE; set_st_name(call_sp, 0); } else { sub_sp = call_sp; sub_stx = call_stx; arg_reg = sub_sp->d.sub.first_param - 1; add_symbol(ST_SUBROUTINE); /* New copy of subroutine entry */ call_sp = &st[call_stx = st_top-1]; /* ST entry for the symbol */ strcpy(call_sp->name, sub_sp->name); } start_st_block("<>"); next(); if (toktype != TOK_SPECIAL || toksubtype != '(') err_msg(ET_ERR, "( expected"); else { next(); call_sp->d.sub.first_param = arg_reg+1; params = 0; if (toktype == TOK_SPECIAL &&toksubtype == ')') next(); /* No parameters */ else for (;;) { if (toktype == TOK_EOF) break; if (toktype == TOK_ATTRIB) { which = toksubtype; p_type = store_OK(which) ? ST_VARIABLE : ST_ADDRESS; add_argument(p_type, ++arg_reg, which); ++params; call_sp->d.sub.n_params = params; next(); } else { err_msg(ET_ERR, "Attribute or Variable expected"); find_arg_sep(); } if (toktype == TOK_SPECIAL) { if (toksubtype == ',') { next(); continue; } else if (toksubtype == ')') { next(); break; } else err_msg(ET_ERR, ", or ) expected"); } } if (sub_sp != NULL) { /* Previous subroutine, check parameters */ if (!subr_match(call_stx, sub_stx, 1)) err_msg(ET_ERR, "Call parameters don't match subroutine or previous call"); } else subr_reg = arg_reg; /* Allocate arg registers */ emit_subr_call(call_stx); make_label(g_lbl, 'g'); /* Make this CALL group's closing label */ emit_IF_level(+1); call_grp_sz = mx_ret_value = 0; for (;;) { /* Handle the return statement list */ if (toktype == TOK_EOF) { err_msg(ET_ERR, "EOF in call which began on line %d", first_line); break; } if (toktype == TOK_RSVWD && toksubtype == RW_ENDCALL) { break; } if (toktype == TOK_RSVWD && toksubtype == RW_ENDSUB) { err_msg(ET_WARN, "CALL statement should end with ENDCALL"); break; } lbls_this_stmt = 0; if (toktype != TOK_NUMBER) { err_msg(ET_ERR, "Integer (return number) expected"); break; } while (toktype == TOK_NUMBER) { /* Build return list */ n = get_number(); if (n > mx_ret_value) mx_ret_value = n; ret_info[call_grp_sz++].ret_nbr = n; ++lbls_this_stmt; next(); if (toktype == TOK_SPECIAL && toksubtype == ':') next(); else err_msg(ET_ERR, ": expected"); } make_label(a_lbl, 'a'); /* Make an action label */ emit_label(a_lbl); single = 0; op = NULL; if (toktype == TOK_RSVWD) { switch(toksubtype) { case RW_IGNORE: case RW_NOMATCH: case RW_COUNT: ++n_counts; single = 1; which = toksubtype; target = NULL; next(); check_semi(); break; case RW_EXIT: next(); if (toktype == TOK_SYMBOL) { /* Get the label */ single = 1; which = RW_EXIT; sp = &st[st_ix]; if (sp->symtype != ST_LABEL) { err_msg(ET_ERR, "Undeclared label"); sp = block_check(st_ix, ST_LABEL); /* Declare it */ target = NULL; } else strcpy(target = s_lbl, sp->name); if (subr_stx != 0 && st_ix < subr_stx) err_msg(ET_ERR, "Can't EXIT to label outside SUBROUTINE"); next(); check_semi(); } else err_msg(ET_ERR, "Exit label expected"); break; case RW_RETURN: if (subr_stx == 0) err_msg(ET_ERR, "Return only allowed inside a subroutine"); next(); single = 1; which = RW_RETURN; if (toktype == TOK_NUMBER) { sprintf(s_lbl, "%lu", n = get_number()); target = s_lbl; set_subr_n_returns(n); next(); } else target = id_table[st[subr_stx].idx].id; check_semi(); break; case RW_SAVE: next(); op = Save_statement(0); check_semi(); single = 1; which = RW_SAVE; target = g_lbl; break; case RW_STORE: next(); op = Store_statement(0); check_semi(); single = 1; which = RW_STORE; target = g_lbl; break; default: single = 0; break; } } if (!single) { /* Emit statement code block */ Statement(); emit_goto(g_lbl); which = RW_EXIT; target = a_lbl; } for (j = 0; j != lbls_this_stmt; ++j) { rip = &ret_info[call_grp_sz-1-j]; if (op != NULL) { memcpy(&rip->opnode, op, sizeof(struct pt_node)); free_pt(op); /* Finished with operand node */ } else memset(&rip->opnode, 0, sizeof(struct pt_node)); rip->which = which; if (target == NULL) rip->a_lbl[0] = '\0'; else strcpy(rip->a_lbl, target); } } if (sub_sp == NULL) /* Call of undeclared subroutine */ call_sp->d.sub.n_returns = mx_ret_value; #if 0 else if strcmp(sub_sp->name, "<>") == 0) { /* nth call, still undeclared */ if (mx_ret_value < call_sp->d.sub.n_returns) call_sp->d.sub.n_returns = mx_ret_value; } #endif emit_IF_level(-1); #if 0 /* We'll dummy up returns to match declaration */ if (sub_sp != NULL) { /* Previous subroutine, check nbr of returns */ if (!subr_match(call_stx, sub_stx, 0)) err_msg(ET_WARN, "Return range smaller in call than in subroutine"); if (mx_ret_value > sub_sp->d.sub.n_returns) sub_sp->d.sub.n_returns = mx_ret_value; } #endif qsort(ret_info, call_grp_sz,sizeof(struct return_stmt_info), call_grp_cmp); for (k = 1, j = 0; j != call_grp_sz; ++j, ++k) { rip = &ret_info[j]; for ( ; k != rip->ret_nbr; ++k) { emit_return_code(NULL, RW_EXIT, g_lbl); } emit_return_code(&rip->opnode, rip->which, rip->a_lbl); } if (sub_sp != 0) { for (++k ; k <= sub_sp->d.sub.n_returns; ++k) emit_return_code(NULL, RW_EXIT, g_lbl); } emit_return_code(NULL, RW_EXIT, g_lbl); /* For un-numbered RETURNs */ emit_label(g_lbl); } if (verbose) dump_symbol_table(); clear_st_subroutine(call_stx); if (verbose > 1) dump_symbol_table(); } if (!find_res_word(RW_ENDCALL)) err_msg(ET_ERR, "ENDCALL expected for call which began on line %d", first_line); check_semi(); } void Statement(void) { struct symbol *sp; if (testing) printf(". . . Statement()\n"); nextnb(); /* Enable 1-char lookahead! */ if (toktype == TOK_SYMBOL && ic == ':') Compound_statement(); else if (toktype == TOK_SPECIAL && toksubtype == '{') { Compound_statement(); } else if (toktype == TOK_RSVWD) { switch(toksubtype) { case RW_OPTIMISE: set_opt_level(); break; case RW_IF: IF_statement(NULL); /* Begin an IF group */ break; case RW_EXIT: case RW_SAVE: case RW_COUNT: case RW_IGNORE: case RW_NOMATCH: case RW_RETURN: case RW_STORE: Imperative_statement(); break; case RW_CALL: Call_statement(); break; default: err_msg(ET_ERR, "Statement expected"); find_semi(); break; } } else if (toktype == TOK_SPECIAL && toksubtype == ';') next(); /* Null statement */ else if (toktype == TOK_SPECIAL && toksubtype == '}') { err_msg(ET_ERR, "Unmatched }"); next(); } else { err_msg(ET_ERR, "Statement expected"); find_semi(); } if (testing > 1) printf(". . . leaving Statement()\n"); } void Subroutine_declaration(void) { struct symbol *call_sp, *sub_sp, *sp; int first_line, params, p_type, call_stx, arg_reg; first_line = line_nbr; next(); if (toktype != TOK_SYMBOL) err_msg(ET_ERR, "Subroutine name expected"); else { call_sp = NULL; arg_reg = subr_reg; sub_sp = &st[subr_stx = st_ix]; if (sub_sp->symtype == ST_SYMBOL) { /* New symbol */ sub_sp->symtype = ST_SUBROUTINE; set_st_name(sub_sp, 0); } else { if (strcmp(st[subr_stx+1].name, "<>") != 0) err_msg(ET_ERR, "Subroutine already declared"); call_sp = sub_sp; call_stx = subr_stx; arg_reg = call_sp->d.sub.first_param - 1; add_symbol(ST_SUBROUTINE); /* New copy of subroutine entry */ sub_sp = &st[subr_stx = st_top-1]; /* ST entry for the symbol */ strcpy(sub_sp->name, call_sp->name); } start_st_block("<>"); next(); if (toktype != TOK_SPECIAL || toksubtype != '(') err_msg(ET_ERR, "( expected"); else { next(); sub_sp->d.sub.first_param = arg_reg + 1; params = 0; if (toktype == TOK_SPECIAL && toksubtype == ')') next(); /* No parameters */ else for (;;) { if (toktype == TOK_EOF) break; if (toktype == TOK_RSVWD && (toksubtype == RW_ADDRESS || toksubtype == RW_VARIABLE)) { p_type = toksubtype; next(); if (toktype != TOK_SYMBOL) err_msg(ET_ERR, "Parameter name expected"); else { sp = block_check(st_ix, p_type == RW_ADDRESS ? ST_ADDRESS : ST_VARIABLE); sp->d.arg.reg = ++arg_reg; ++params; } sub_sp->d.sub.n_params = params; next(); } else { err_msg(ET_ERR, "ADDRESS or VARIABLE expected"); find_arg_sep(); } if (toktype == TOK_SPECIAL) { if (toksubtype == ',') { next(); continue; } else if (toksubtype == ')') { next(); break; } else err_msg(ET_ERR, ", or ) expected"); } } if (call_sp != 0) { /* Previous call, check parameters */ if (!subr_match(call_stx, subr_stx, 1)) err_msg(ET_ERR, "Subroutine parameters don't match earlier calls"); } else subr_reg = arg_reg; /* Allocate arg registers */ emit_IF_level(+1); emit_label(sub_sp->name); for (;;) { if (toktype == TOK_EOF) { err_msg(ET_ERR, "EOF in subroutine which began on line %d", first_line); break; } else { Statement(); if (toktype == TOK_RSVWD && toksubtype == RW_ENDSUB) { break; } if (toktype == TOK_RSVWD && toksubtype == RW_ENDCALL) { err_msg(ET_WARN, "SOUBROUTINE declaration should end with ENDSUB"); break; } } } emit_imperative( /* RETURN ; after subroutine body */ NULL, RW_RETURN, id_table[st[subr_stx].idx].id); emit_IF_level(-1); if (call_sp != 0) { /* Previous call, check nbr of returns */ if (!subr_match(call_stx, subr_stx, 0)) err_msg(ET_ERR, "Return range smaller in previous call than in subroutine"); } } if (verbose) dump_symbol_table(); if (call_sp != NULL) { /* Clear the subroutine declaration */ call_sp->d.sub.n_returns = sub_sp->d.sub.n_returns; strcpy(st[call_stx+1].name, "<>"); } clear_st_subroutine(subr_stx); if (verbose > 1) dump_symbol_table(); } if (!find_res_word(RW_ENDSUB)) err_msg(ET_ERR, "ENDSUB expected for subroutine which began on line %d", first_line); check_semi(); } void NeMaC_set(void) { char nbuf[IDENT_LN]; if (n_sets != 0) err_msg(ET_WARN, "Program should only have one SET statement"); ++n_sets; next(); if (toktype == TOK_NUMBER) { sprintf(nbuf, "%lu", get_number()); } else if (toktype == TOK_SYMBOL) { strcpy(nbuf, token); st[st_ix].symtype = ST_NEMAC_CMD; } else err_msg(ET_ERR, "Set name (or number) expected"); emit_NeMaC_command("set %s;\n", nbuf); next(); check_semi(); } static char fbuf[81]; static unsigned char *fbp; static int flen; void build_format_line(char *tok) { int toklen = strlen(tok); if (flen+toklen > sizeof(fbuf)-4) { strcpy(fbp, "\n"); emit_NeMaC_command(fbuf); flen = 0; } if (flen == 0) { fbp = strmov((unsigned char *)fbuf,(unsigned char *)" "); flen = 1; } *fbp++ = ' '; fbp = strmov(fbp, (unsigned char *)tok); flen += toklen+1; } void NeMaC_format(void) { if (n_formats != 0) err_msg(ET_WARN, "Program should only have one FORMAT statement"); ++n_formats; emit_NeMaC_command("format\n"); next(); for (flen = 0; ; ) { if (toktype == TOK_EOF) break; else if (toktype == TOK_SPECIAL && toksubtype == ';') break; else if (toktype == TOK_ATTRIB || toktype == TOK_STRING) { if (toktype == TOK_ATTRIB && !format_OK(toksubtype)) err_msg(ET_ERR, "Attribute not allowed in FORMAT"); build_format_line(token); } else { err_msg(ET_ERR, "Attribute or separator string expected"); break; } next(); } strcpy(fbp, ";\n"); emit_NeMaC_command(fbuf); check_semi(); } void NeMaC_statistics(void) { next(); if (toktype != TOK_SPECIAL || toksubtype != ';') err_msg(ET_ERR, "; expected"); emit_NeMaC_command("statistics;\n"); check_semi(); } void scan_file(char *sfname) { next(); /* Get started */ for (;;) { if (testing) printf(". . . scan_file()\n"); if (toktype == TOK_EOF) break; nextnb(); /* Enable 1-char lookahead! */ if (ic == ':') Compound_statement(); else if (toktype == TOK_SPECIAL && toksubtype == '{') { Compound_statement(); } else if (toktype == TOK_RSVWD) { switch(toksubtype) { case RW_IF: case RW_EXIT: case RW_SAVE: case RW_COUNT: case RW_IGNORE: case RW_NOMATCH: case RW_RETURN: case RW_STORE: case RW_CALL: Statement(); break; case RW_SUBROUTINE: Subroutine_declaration(); break; case RW_OPTIMISE: set_opt_level(); break; case RW_SET: NeMaC_set(); break; case RW_FORMAT: NeMaC_format(); break; case RW_STATS: NeMaC_statistics(); break; default: err_msg(ET_ERR, "Statement or Declaration expected"); find_semi(); break; } } else if (toktype == TOK_SPECIAL && toksubtype == ';') next(); /* Null statement */ else if (toktype == TOK_SPECIAL && toksubtype == '}') { err_msg(ET_ERR, "Unmatched }"); next(); /* Unmatched ('floating') } */ } else { err_msg(ET_ERR, "Statement or Declaration expected"); find_semi(); } } fclose(sfp); if (n_counts == 0) err_msg(ET_WARN, "Program should have at least one COUNT statement"); if (n_sets == 0) err_msg(ET_WARN, "NeMaC requires one SET statement"); if (n_formats == 0) err_msg(ET_WARN, "NeMaC requires one FORMAT statement"); } int main(int argc, char *argv[]) { char *ap, sfname[FNAME_LN+1], sfprefix[FNAME_LN+1], *sfp; char codefn[FNAME_LN+1]; int a, syntax; time_t t; char *ts; #if 0 printf("N_OLD_ATRS=%d, N_METER_ATRS=%d, N_VBLS=%d\n", N_OLD_ATRS, N_METER_ATRS, N_VBLS); printf("N_DIST_ATRS=%d, N_NF_ATRS=%d, N_TC_ATRS=%d\n", N_DIST_ATRS, N_NF_ATRS, N_TCP_ATRS); exit(0); #endif if (argc < 2) { fprintf(stderr, "%s [options] program.srl\n\n", argv[0]); exit(0); } syntax = list_source = verbose = testing = 0; asmint = optimise_level = 1; sfname[0] = codefn[0] = '\0'; init_symbol_table(); for (a = 1; a < argc; ++a) { if (argv[a][0] == '-') { ap = argv[a]+2; switch (argv[a][1]) { case 'O': if (isdigit(*ap)) optimise_level = *ap-'0'; else optimise_level = 1; break; case 'a': if (isdigit(*ap)) asmint = *ap-'0'; else ++asmint; break; case 'l': ++list_source; break; case 'o': if (*ap == '\0') ap = argv[++a]; strncpy(codefn, ap, FNAME_LN); /* Code file name */ codefn[FNAME_LN-1] = '\0'; break; case 's': ++syntax; break; case 't': if (isdigit(*ap)) testing = *ap-'0'; else ++testing; break; case 'v': if (isdigit(*ap)) verbose = *ap-'0'; else ++verbose; break; case 'D': if (*ap == '\0') ap = argv[++a]; get_cmd_define(ap); break; default: fprintf(stderr, "Invalid option: -%c\n", argv[a][1]); break; } continue; } if (sfname[0] == '\0') { strncpy(sfname,argv[a],sizeof(sfname)-1); sfname[sizeof(sfname)-1] = '\0'; } } printf("Nevil's %s\n", ver); if (sfname[0] == '\0') { printf(">>> No srl file specified <<<\n"); exit(11); } if (!parse_open((unsigned char *)sfname)) { printf(">>> Couldn't open srl file %s <<<\n", sfname); exit(12); } time(&t); ts = fmt_time(&t); printf("%s: Compiling %s\n", ts, sfname); strcpy(sfprefix, sfname); for (sfp = sfprefix; *sfp != '\0'; ++sfp) { /* Delete .srl suffix */ if (strcmp(sfp,".srl") == 0) break; } *sfp = '\0'; if (!intermediate_open(sfprefix)) { printf(">>> Couldn't open intermediate file <<<\n"); exit(13); } emit_comment("#Source file: %s\n", sfname); emit_comment("#Compiled by: %s\n", ver); emit_comment("#Time: %s\n", ts); emit_opt_level(start_opt_lev = optimise_level); n_sets = n_formats = n_counts = 0; subr_stx = subr_reg = 0; scan_file(sfname); /* Pass 1 */ intermediate_close(); if (subr_reg > 5) err_msg(ET_ERR, "Too many subroutine parameters in program !!!"); check_subrs_declared(0); if (sferrors == 0 && !syntax) emit_pass2(codefn); /* Pass 2 */ if (verbose) dump_symbol_table(); if (list_source) printf("\n"); if (sferrors || sfwarnings) printf("\n%s compiled: %d errors and %d warnings\n", sfname, sferrors, sfwarnings); exit(sferrors != 0 ? EXIT_FAILURE : EXIT_SUCCESS); }