struct expr *
lambda(struct expr * e, struct context * context)
{
int i;
const struct list *lp, *la;
struct expr *pe, *pr;
struct context *ctx;
/* assume e is a valid func call expr */
ctx = new_context();
ctx->is_root_level = 0;
ctx->next = (struct context *) context;
dbgprintf("created new context\n");
for (i = 0, lp = e->v.list->v->v.list->next->v->v.list, la = e->v.list->next; lp && la; ++i, lp = lp->next, la = la->next) {
dbgprintf("evaluating arguments, iter %d\n", i);
pe = add_to_context(ctx, strdup(lp->v->v.atom->v), eval(la->v, context));
full_free_expr(pe);
}
dbgprintf("eval'ing e expr\n");
pr = eval(e->v.list->v->v.list->next->next->v, ctx);
free_expr(e);
free_context(ctx);
return pr;
}
struct expr *
defun(struct expr * e, struct context * ctx)
{
struct expr *pe, *pl;
struct list *l;
if (!e || list_len(e) < 4) {
free_expr(e);
return empty_list();
}
if (!e->v.list->next || !e->v.list->next->v || e->v.list->next->v->t != LATOM || !e->v.list->next->v->v.atom || !e->v.list->next->v->v.atom->v) {
free_expr(e);
return empty_list();
}
if (!e->v.list->next->next || !is_valid_p_expr(e->v.list->next->next->v)) {
free_expr(e);
return empty_list();
}
if (!e->v.list->next->next->next || !e->v.list->next->next->next->v) {
free_expr(e);
return empty_list();
}
pl = new_expr(LLIST);
pl->v.list = new_list();
pl->v.list->v = new_expr(LATOM);
pl->v.list->v->v.atom = new_atom("lambda");
pl->v.list->next = new_list();
pl->v.list->next->v = exprs_dup(e->v.list->next->next->v);
pl->v.list->next->next = new_list();
pl->v.list->next->next->v = exprs_dup(e->v.list->next->next->next->v);
pe = add_to_context(ctx, strdup(e->v.list->next->v->v.atom->v), pl);
full_free_expr(pe);
free_expr(e);
return empty_list();
}
struct expr *
label(struct expr * e, struct context * ctx)
{
struct expr *pe;
if (!e || list_len(e) < 3) {
dbgprintf("first\n");
free_expr(e);
return empty_list();
}
if (!e->v.list->v || e->v.list->v->t != LATOM || !e->v.list->v->v.atom || !e->v.list->v->v.atom->v) {
dbgprintf("second\n");
free_expr(e);
return empty_list();
}
if (!is_valid_lambda_expr(e->v.list->next->next->v)) {
free_expr(e);
return empty_list();
}
pe = add_to_context(ctx, strdup(e->v.list->next->v->v.atom->v), exprs_dup(e->v.list->next->next->v));
full_free_expr(pe);
free_expr(e);
return empty_list();
}
/*
* process a line from the logfile
*/
void
process_logline()
{
struct context *this_context;
struct rule *this_rule, *this_rule_next;
int check_stop=0;
if ( logline[0] == '\0' )
return;
if ( logline[strlen(logline)-1] == '\n' )
logline[strlen(logline)-1]='\0';
#ifdef DEBUG
(void) printf("processing logline: %s\n", logline);
#endif
if ( (logline_context=(struct context_line *)malloc(sizeof(struct context_line)))
== NULL ) {
(void) fprintf(stderr, "out of memory processing logling: %s\n",
logline);
return;
}
if ( (logline_context->content=strdup(logline)) == NULL ) {
(void) fprintf(stderr, "out of memory processing logling: %s\n",
logline);
(void) free(logline_context);
return;
}
logline_context->linenumber=logline_num;
logline_context->timestamp=(long) current_time;
logline_context->link_counter=1;
/*
* first try to store the logline in all matching contexts
*/
for ( this_context=all_contexts; this_context != NULL;
this_context=this_context->next)
if ( re_search(this_context->match_regex, logline, strlen(logline),
0, strlen(logline), ®ex_submatches) >= 0 ) {
regex_submatches_num=this_context->match_regex->re_nsub;
if ( this_context->match_not_regex != NULL ) {
if ( re_search(this_context->match_not_regex, logline,
strlen(logline), 0, strlen(logline),
®ex_notmatches) == -1 ) {
add_to_context(this_context, logline_context);
}
}
else
add_to_context(this_context, logline_context);
}
/*
* now check if there is a matching rule for this logline
*/
for ( this_rule=all_rules; this_rule != NULL ; ) {
/* check if the logline matches the first rgex */
if ( re_search(this_rule->match_regex, logline, strlen(logline),
0, strlen(logline), ®ex_submatches) >= 0 ) {
regex_submatches_num=this_rule->match_regex->re_nsub;
this_rule_next=this_rule->next;
/* if we do have a not-match regex test it */
if ( this_rule->match_not_regex != NULL ) {
if ( re_search(this_rule->match_not_regex, logline,
strlen(logline), 0, strlen(logline),
®ex_notmatches) == -1 ) {
check_stop=1;
if ( this_rule->do_continue == 0 )
this_rule_next=NULL;
process_rule(this_rule);
}
}
else {
check_stop=1;
if ( this_rule->do_continue == 0 )
this_rule_next=NULL;
process_rule(this_rule);
}
if ( check_stop == 1 ) {
/* check for the stop_regex */
if ( this_rule->stop_regex != NULL ) {
if ( re_search(this_rule->stop_regex, logline, strlen(logline),
0, strlen(logline), ®ex_submatches) >= 0 ) {
/* if we do have a not-match stop-regex test it */
if ( this_rule->stop_not_regex != NULL ) {
if ( re_search(this_rule->stop_not_regex,
logline, strlen(logline), 0,
strlen(logline), ®ex_notmatches) == -1 )
unlink_rule(this_rule);
}
else
unlink_rule(this_rule);
}
}
check_stop=0;
}
this_rule=this_rule_next;
}
else
this_rule=this_rule->next;
}
logline_context->link_counter--;
/*
* free the new line if not used in any context
*/
destroy_context_line(logline_context);
return;
}
/*
* Parse statement starting with an identifier.
* Possibilities include:
* Assignment
* Procedure statement
*/
void
parse_identifier(TOKEN *first_token)
{
TOKEN token, next_token;
TOKEN param_token, attrib_token, type_token;
int token_class, next_token_class;
DECL *decl_list, *extra_decl_list;
PARAM_LIST *param_list, *param_ptr;
DECL_MEMBER *decl_ptr;
DECL_ID *decl_id;
BOOLEAN extern_proc, got_type, interrupt_proc;
char *tmp_text_ptr;
/* Check for label or procedure */
tmp_text_ptr = text_ptr;
token_class = get_token(&token);
if (token_class == LABEL) {
/* Determine if label or procedure definition */
next_token_class = get_token(&next_token);
if ((next_token_class == RESERVED) &&
(next_token.token_type == PROCEDURE)) {
/*
* Procedure - Check for parameter list
*/
param_list = NULL;
token_class = get_token(¶m_token);
if (token_class == LEFT_PAREN) {
/* Yes - get parameter list */
get_param_list(¶m_list);
/* Get token after parameter list */
token_class = get_token(&attrib_token);
} else
/* No param list - save as attribute */
token_copy(¶m_token, &attrib_token);
out_white_space(first_token);
extern_proc = FALSE;
interrupt_proc = FALSE;
got_type = (token_class == RESERVED) &&
(attrib_token.token_type >= BYTE) &&
(attrib_token.token_type <= SELECTOR);
if (got_type) {
/*
* Process [ <type> ]
*/
token_copy(&attrib_token, &type_token);
token_class = get_token(&attrib_token);
}
while (token_class == RESERVED) {
if (attrib_token.token_type == INTERRUPT) {
/*
* Process [ <interrupt> ]
*/
interrupt_proc = TRUE;
token_class = get_token(&attrib_token);
if (token_class == NUMERIC)
/* Interrupt number */
token_class = get_token(&attrib_token);
} else
/*
* Process [ EXTERNAL | { [ PUBLIC ] [ REENTRANT ] } ]
*/
if (attrib_token.token_type == EXTERNAL) {
out_str("extern");
out_must_white(&attrib_token);
extern_proc = TRUE;
token_class = get_token(&attrib_token);
} else
if ((attrib_token.token_type == PUBLIC) ||
(attrib_token.token_type == REENTRANT)) {
do {
if (attrib_token.token_type == PUBLIC) {
/* Ignore for now */
token_class = get_token(&attrib_token);
} else
if (attrib_token.token_type == REENTRANT) {
/* Ignore for now */
token_class = get_token(&attrib_token);
} else
break;
} while (token_class == RESERVED);
} else
break;
}
if (token_class != END_OF_LINE) {
parse_error("';' expected");
return;
}
if (interrupt_proc && !extern_proc)
parse_warning("INTERRUPT procedure declared");
/* Create declaration for procedure */
get_element_ptr(&decl_ptr);
get_var_ptr(&decl_ptr->name_list);
/* Type = PROCEDURE */
get_token_ptr(&decl_ptr->type);
token_copy(&next_token, decl_ptr->type);
/* Name = procedure name */
get_token_ptr(&decl_ptr->name_list->name);
token_copy(first_token, decl_ptr->name_list->name);
/* Flag if parameter list */
if (param_list)
decl_ptr->initialization = DATA;
/* Add it to context */
add_to_context(decl_ptr);
if (got_type) {
/* Output procedure type */
out_token_name(&type_token);
out_must_white(&type_token);
}
/* Output procedure name */
out_token_name(first_token);
if (extern_proc) {
out_str("()");
if (param_list)
/* Parse parameter declarations */
parse_param_list(param_list, &decl_list,
&extra_decl_list);
out_char(';');
/* Eat closing 'END [<proc name>];' */
token_class = get_token(&token);
if ((token_class != RESERVED) ||
(token.token_type != END)) {
parse_error("END expected");
return;
}
out_white_space(&token);
token_class = get_token(&token);
if (token_class == IDENTIFIER) {
token_class = get_token(&token);
}
if (token_class != END_OF_LINE) {
parse_error("';' expected");
}
return;
} else
if (param_list) {
out_token(¶m_token);
/* Output parameter list */
param_ptr = param_list;
while (param_ptr) {
out_token(¶m_ptr->param);
param_ptr = param_ptr->next_param;
if (param_ptr)
out_char(',');
}
out_char(')');
/* Parse parameter declarations */
parse_param_list(param_list, &decl_list,
&extra_decl_list);
/* Output declarations */
if (decl_list) {
out_decl(decl_list);
/* Add declarations to context */
add_decl_to_context(decl_list);
}
out_str("\n{"); /* } for dumb vi */
if (extra_decl_list) {
out_decl(extra_decl_list);
/* Add declarations to context */
add_decl_to_context(extra_decl_list);
}
/* Discard declarations */
free_decl(decl_list);
free_decl(extra_decl_list);
} else
/* No parameter list */
out_str("()\n{"); /* } for dumb vi */
/* Create new context */
new_context(PROCEDURE, first_token);
/* Parse statements to END */
parse_to_end();
/* Pop procedure context */
pop_context();
} else {
/*
* Label - add label name
*/
out_token(first_token);
/* Add colon */
out_token(&token);
/* Is this a defined label or a module? */
if (find_symbol(first_token, &decl_ptr, &decl_id)) {
if (decl_ptr->type->token_class == LABEL) {
/* Label - new context */
new_context(MODULE, first_token);
parse_statement(&next_token);
pop_context();
} else {
parse_error("Illegal label name");
return;
}
} else
parse_statement(&next_token);
}
return;
}
/* Assignment statement */
text_ptr = tmp_text_ptr;
token_copy(first_token, &token);
token_class = parse_variable(&token, &decl_ptr, &decl_id);
/* Check for multiple assignments */
while (token_class == COMMA) {
/* Print ' =' instead of ',' */
out_str(" =");
out_white_space(&token);
/* Get identifier part of next assignment variable */
token_class = get_token(&token);
if (token_class != IDENTIFIER) {
parse_error("Illegal assignment");
return;
}
/* Parse remainder of variable (if any) */
token_class = parse_variable(&token, &decl_ptr, &decl_id);
}
if (token_class == OPERATOR) {
if (token.token_type != EQUAL) {
parse_error("Illegal use of identifier");
return;
}
out_token(&token);
/* Check for POINTER assignment */
if (decl_ptr->type->token_type == POINTER) {
/* Yes - cast it */
out_str(" (");
out_str(TYPE_POINTER);
out_str(" *) ");
}
if (parse_expression(&token) != END_OF_LINE)
parse_error("';' expected");
else
out_token(&token);
return;
} else
if (token_class != LABEL) {
parse_error("Illegal use of identifier");
return;
}
}
