Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume3/trc/part6

Text File | 1986-11-30 | 26.6 KB | 1,138 lines

Newsgroups: mod.sources
Subject: TRC - expert system building tool (part 6 of 8)
Approved: [e-mail]

Mod.sources:  Volume 3, Issue 114
Submitted by: ihnp4!dicomed!ndsuvax!nckary (Daniel D. Kary)

: This is a shar archive.  Extract with sh, not csh.
: The rest of this file will extract:
: Makefile main.c main.h optimize.c
echo extracting - Makefile
sed 's/^X//' > Makefile << '!EOR!'
Xtrc : y.tab.o main.o output.o optimize.o p_out.o
X    cc y.tab.o main.o output.o optimize.o p_out.o -o trc
X
Xy.tab.o : y.tab.c   scanner.c main.h
X    cc -c y.tab.c
X
Xy.tab.c : parser
X    yacc parser
X
Xmain.o : main.c    main.h
X    cc -c main.c
X
Xoutput.o : output.c main.h
X    cc -c output.c
X
Xp_out.o : p_out.c main.h
X    cc -c p_out.c
X
Xoptimize.o : optimize.c main.h
X    cc -c optimize.c
!EOR!
echo extracting - main.c
sed 's/^X//' > main.c << '!EOR!'
X#include    <stdio.h>
X#include    <signal.h>
X#include     "main.h"
X#define        total_files    12
X
XFILE *fp[total_files];
Xchar *file_name[total_files] = {
X        "loop.h",
X        "loop.c",
X        "free.c",
X        "misc.c",
X        "search.c",
X        "add.c",
X        "dump.c",
X        "relink.c",
X        "backtrack.c",
X        "profile.c",
X        "zero.c",
X        "save.c"
X};
X
Xbus_error()
X{
X    fprintf(stderr,"%d: unable to recover from earlier errors\n", lineno);
X    exit(0);
X}
X
X
Xint next_label;
X
Xmain(argc, argv)
Xint argc;
Xchar *argv[];
X{
X    int i, j;
X    char s[512];
X
X    setbuf(stdout, NULL);
X    errors = pnum = total_tokens = 0;
X    tracing = profiling = backtracking = 0;
X    dumping = optimizing = recursing = 0;
X    pascal = saving = zeroing = 0;
X    next_label = lineno = 1;
X    prefix = "";
X    if(argc < 2){
X        fprintf(stderr,"usage: %s [options] file\n", argv[0]);
X        exit();
X    }
X    for(i = 1; i < (argc-1); i++){
X        j = 0;
X        while(argv[i][j]){
X            switch(argv[i][j]){
X            case '-': break;
X                case 'b': backtracking++;
X                      break;
X                case 'd': dumping++;
X                      break;
X                case 'p': profiling++;
X                      break;
X                case 'r': recursing++;
X                      break;
X                case 's': saving++;
X                      break;
X                case 't': tracing++;
X                      break;
X                case 'z': zeroing++;
X                      break;
X                case 'O': optimizing++;
X                      break;
X                case 'P': pascal++;
X                      break;
X                default: fprintf(stderr,"undefined flag (%c)\n",argv[i][1]);
X                     break;
X            }
X            j++;
X        }
X    }
X    if((freopen(argv[argc-1], "r", stdin)) == NULL){
X        fprintf(stderr,"unable to attach %s to the standard input\n", argv[argc-1]);
X        exit(0);
X    }
X    insert_init();                /* initialize this list */
X    signal(SIGBUS, bus_error);
X    yyparse();                /* parse the input */
X    rule_list = rule_list->next;        /* the first entry is just a place holder */
X    rule_list->prev = NULL;
X    nice_token_stuff();
X    if(errors){
X        fprintf(stderr,"no code produced due to errors in source\n");
X        exit();
X    }
X    if(pascal){
X        if(optimizing)
X        optimize();
X        p_translate();
X        exit();
X    }
X    for(i = 0; i < total_files; i++){
X        strcpy(s, prefix);
X        strcat(s, file_name[i]);
X        if((fp[i] = fopen(s,"w")) == NULL){
X            fprintf(stderr,"unable to open %s\n",s);
X            exit(0);
X        }
X        if(i){
X        fprintf(fp[i],"#include\t\"%sloop.h\"\n\n",prefix);
X        if(i > 1){
X            fprintf(fp[i],"extern int %stotal_tokens, %stoken[];\n", prefix, prefix);
X             fprintf(fp[i],"extern char *%stoken_name[];\n", prefix);
X             fprintf(fp[i],"extern int %srestoring;\n", prefix);
X            }
X        else{
X             fprintf(fp[i],"int %srestoring = 0;\n", prefix);
X        }
X        }
X    }
X    header = fp[0];
X    loop = fp[1];
X    fre = fp[2];
X    misc = fp[3];
X    search = fp[4];
X    add = fp[5];
X    dump = fp[6];
X    relink = fp[7];
X    backtrack = fp[8];
X    profile = fp[9];
X    zero = fp[10];
X    save = fp[11];
X    if(optimizing)
X        optimize();
X    translate();
X}
X
Xyyerror(s) char *s;{
X    return;
X}
X
Xyywrap(){
X    return(1);
X}
X
X
Xchar *gen_next_label()
X/* generate a unique rule label */
X{
X    int i, j;
X    char *r, *s, t[8];
X
X    /* an unlikely prefix */
X    s = "ZqWr_";
X    i = 0;
X    j = next_label++;
X    while(j){
X        t[i++] = '0' + (j % 10);
X        j = j/10;
X    }
X    t[i] = '\0';
X    r = (char *) malloc (i + 6);
X    strcpy(r, s);
X    strcat(r, t);
X    return(r);
X
X}
X
X
Xnice_token_stuff()
X/* remove superfluous stuff from the case list */
X{
X    struct def_list *d_temp;
X    struct data_type *dt_temp;
X    struct case_list *c_temp;
X
X    d_temp = token_list;
X    while(d_temp){
X        dt_temp = d_temp->data_types;
X        while(dt_temp){
X        if(dt_temp->elts){
X            while((dt_temp->elts) && (dt_temp->elts->used == 0))
X            dt_temp->elts= dt_temp->elts->next;
X            c_temp = dt_temp->elts;
X            while(c_temp){
X                if((c_temp->next) && (c_temp->next->used == 0))
X                c_temp->next = c_temp->next->next;
X                c_temp = c_temp->next;
X            }
X        }
X        dt_temp = dt_temp->next;
X        }
X        d_temp = d_temp->next;
X    }
X}
X
X
Xbuild_case_list()
X/* search the token_list for possible cross compare items */
X{
X    int i;
X    struct def_list *d_temp, *d_temp2;
X    struct data_type *dt_temp, *dt_temp2;
X    struct case_list *c_temp, *c_temp2;
X
X    d_temp = token_list;
X    while(d_temp){
X        dt_temp = d_temp->data_types;
X        while(dt_temp){
X            i = 1;
X            dt_temp2 = d_temp->data_types;
X        while(dt_temp2){
X            if((dt_temp != dt_temp2) && (dt_temp->type == dt_temp2->type)){
X                if(dt_temp->elts){
X                c_temp->next = (struct case_list *) malloc(sizeof(struct case_list));
X                c_temp = c_temp->next;
X                }
X                else{
X                dt_temp->elts = (struct case_list *) malloc(sizeof(struct case_list));
X                c_temp = dt_temp->elts;
X                }
X                c_temp->next = NULL;
X                c_temp->name = dt_temp2->name;
X                c_temp->id   = i++;
X                c_temp->used = 0;
X            }
X            dt_temp2 = dt_temp2->next;
X        }
X        dt_temp = dt_temp->next;
X        }
X        d_temp = d_temp->next;
X    }
X}
X
Xcmp_type(object, elt1, elt2)
X/* compare the types of elt1 and elt2 to see if they match */
Xchar *object, *elt1, *elt2;
X{
X    struct def_list *d_temp;
X    struct data_type *dt_temp;
X    struct case_list *c_temp;
X
X    d_temp = token_list;
X    while(d_temp){
X        if(strcmp(object, d_temp->name) == 0){
X        dt_temp = d_temp->data_types;
X        while(dt_temp){
X            if(strcmp(elt1, dt_temp->name) == 0){
X            c_temp = dt_temp->elts;
X            while(c_temp){
X                if(strcmp(elt2, c_temp->name) == 0)
X                return(1);    /* the types are equal */
X                else
X                c_temp = c_temp->next;
X            }
X            return(-1);        /* the types are different */
X            }
X            dt_temp = dt_temp->next;
X        }
X        return(-1);            /* the types were not found */
X        }
X        d_temp = d_temp->next;
X    }
X}
X
X
Xinsert_label(s)
X/* insert the label of a rule into the name_list */
Xchar *s;
X{
X    struct list *temp;
X
X    if(! first_label)
X        first_label = s;
X    temp = (struct list *) malloc(sizeof(struct list));
X    temp->name = s;
X    if(name_list)
X        temp->next = name_list;
X    else
X        temp->next = NULL;
X    name_list = temp;
X    rule_list->label = s;
X}
X
X
Xinsert_token(s)
X/* insert the name of an object into the token_list */
Xchar *s;
X{
X    struct def_list *temp, *temp2;
X
X    if(token_list){            /* if the list is not nil */
X        temp = token_list;
X        while(temp){        /* search for duplicates */
X        if(strcmp(s, temp->name) == 0){
X            fprintf(stderr,"%d: duplicate declaration  -> %s\n",lineno, s);
X            errors++;
X            return(0);
X        }
X        temp = temp->next;
X        }
X    }
X    temp = (struct def_list *) malloc(sizeof(struct def_list));
X    temp->name = s;
X    temp->data_types = data_list;
X    temp->next = NULL;
X    total_tokens++;
X    data_list = NULL;
X    temp2 = token_list;
X    if(temp2){
X        while(temp2->next)
X        temp2 = temp2->next;
X        temp2->next = temp;
X    }
X    else
X        token_list = temp;
X}
X
X
Xinsert_fields(element, value, free_name, type, index)
X/* insert a fields structure into the current object in the init list */
Xchar *element, *value, *free_name;
Xint  type, index;
X{
X    struct fields *temp;
X    struct match *temp2;
X
X    temp2 = rule_list->complex;
X    temp = (struct fields *) malloc(sizeof(struct fields));
X    temp->empty = 0;
X    temp->object = NULL;
X    if(free_name)
X        while(temp2){
X            if(strcmp(temp2->free_name, free_name) == 0){
X            temp->empty  = temp2->empty;
X            temp->object = temp2->object;
X            temp2 = NULL;
X            }
X            else temp2 = temp2->next;
X        }
X    temp->index     = index;
X    temp->element   = element;
X    temp->value     = value;
X    temp->type      = type;
X    temp->next      = init_list->items;
X    init_list->items = temp;
X}
X
X
Xinsert_init()
X/* insert an empty structure in the stm initialization list */
X{
X    struct init *temp;
X
X    temp = (struct init *) malloc(sizeof(struct init));
X    temp->count  = 0;
X    temp->object = NULL;
X    temp->next   = NULL;
X    temp->items  = NULL;
X    if(init_list){
X        temp->next = init_list;
X        init_list = temp;
X    }
X    else init_list = temp;
X}
X
X
Xinsert_count(n)
X/* initialize count in init_list */
Xint n;
X{
X    init_list->count = n;
X}
X
X
Xinsert_rule()
X/* insert an empty structure in the list of rules */
X{
X    struct rule *temp;
X
X    temp = (struct rule *) malloc(sizeof(struct rule));
X    temp->recurs = 0;
X    temp->prev   = NULL;
X    temp->opt    = NULL;
X    temp->label  = NULL;
X    temp->search = (int *) calloc(total_tokens , sizeof(int));
X    temp->mark   = (int *) calloc(total_tokens , sizeof(int));
X    if(rule_list){
X        temp->next = rule_list;
X        rule_list->prev = temp;
X        rule_list = temp;
X    }
X    else{
X        temp->next = NULL;
X        rule_list = temp;
X    }
X}
X
X
Xfind_name(s)
X/* test to see if a rule label has already been used */
Xchar *s;
X{
X    struct list *temp;
X
X
X    temp = name_list;
X    while(temp){
X        if(strcmp(s, temp->name) == 0){
X        return(-1);
X        }
X        temp = temp->next;
X    }
X    return(0);
X}
X
Xfind_token(s)
X/* test to see if an object name has already been used */
Xchar *s;
X{
X    int i;
X    struct def_list *temp;
X
X    i = 0;
X    temp = token_list;
X    while(temp){
X        if(strcmp(s, temp->name) == 0){
X        return(i);
X        }
X        temp = temp->next;
X        i++;
X    }
X    return(-1);
X}
X
X
Xadd_struct(s,i)
X/* add a structure to define an object to the data_list */
Xchar *s;
Xint i;
X{
X    struct data_type *a, *b;
X
X    /* first check for duplicate definitions */
X    a = data_list;
X    while(a){
X        if(strcmp(s, a->name) == 0)
X        return(-1);
X        a = a->next;
X    }
X    /* add the new element to the list */
X    a = (struct data_type *) malloc(sizeof(struct data_type));
X    a->name = s;
X    a->type = i;
X    a->elts = NULL;
X    a->next = NULL;
X    if(data_list){
X        b = data_list;
X        while(b->next != NULL)
X        b = b->next;
X        b->next = a;
X    }
X    else
X        data_list = a;
X    return(2);
X}
X
X
Xappend_code(s)
X/* append a line of C code to a temporary buffer */
Xchar *s;
X{
X    struct list *a, *b;
X
X    a = (struct list *) malloc(sizeof(struct list));
X    a->name = s;
X    a->next = NULL;
X    if(temp_c_code){
X        b = temp_c_code;
X        while(b->next != NULL)
X        b = b->next;
X        b->next = a;
X    }
X    else
X        temp_c_code = a;
X}
X
X
Xopt(s)
Xchar *s;
X{
X    rule_list->opt = s;
X}
X
X
Xdo_header()
X/* copy the temporary C code to the header */
X{
X    header_code = temp_c_code;
X    temp_c_code = NULL;
X}
X
X
Xdo_trailer()
X/* copy the temporary C code to the trailer */
X{
X    trailer_code = temp_c_code;
X    temp_c_code = NULL;
X}
X
X
Xdo_init_list(s)
X/* add an object to the list of objects to be initialized */
Xchar *s;
X{
X    int found;
X    struct fields *temp;
X    struct def_list *d_temp;
X    struct data_type *dt_temp, *dt_temp2;
X
X    if(init_list->items){
X        d_temp = token_list;
X        while(strcmp(d_temp->name, s) != 0)
X        d_temp = d_temp->next;
X        temp = init_list->items;
X        while(temp){
X        found = 0;
X        dt_temp = d_temp->data_types;
X        while(dt_temp){
X            if(strcmp(dt_temp->name, temp->element) == 0){
X            dt_temp2 = dt_temp;
X            dt_temp = NULL; found = 1;
X            }
X            if(dt_temp) dt_temp = dt_temp->next;
X        }
X        if(found == 0){
X            fprintf(stderr,"%d: %s is not an element of %s\n",lineno,
X                  temp->element, s);
X            errors++;
X        }
X        else if((temp->type >= 0) && (temp->type <= 2)){
X            if(temp->type != dt_temp2->type){
X            fprintf(stderr,"%d: types of element (%s) and value (%s) do not match\n", lineno, temp->element, temp->value);
X            errors++;
X            }
X        }
X        temp = temp->next;
X        }
X    }
X    init_list->object = s;
X}
X
X
Xdo_code()
X/* copy the temporary C code to the current rule's action part */
X{
X    rule_list->c_code = temp_c_code;
X    temp_c_code = NULL;
X}
X
X
Xdo_mark(s)
X/* MARK an object */
Xchar *s;
X{
X    int i;
X
X    i = find_token(s);
X    if(i < 0) {
X        return(0);
X    }
X    rule_list->mark[i]++;
X    return(1);
X}
X
X
Xmark_free(free_name)
X/* mark an object by name */
Xchar *free_name;
X{
X    struct match *temp;
X
X    temp = rule_list->complex;
X    while(temp){
X        if(strcmp(free_name, temp->free_name) == 0){
X        if(temp->empty){
X            fprintf(stderr,"%d: can't MARK an EMPTY object\n", lineno);
X            errors++;
X        }
X        else{
X            temp->mark = 1;
X        }
X        return(1);
X        }
X        temp = temp->next;
X    }
X    return(0);
X}
X
Xfind_free(free_name)
X/* determine if free_name is a declared free variable */
Xchar *free_name;
X{
X    struct match *temp;
X
X    temp = rule_list->complex;
X    while(temp){
X        if(strcmp(free_name, temp->free_name) == 0)
X        return(temp->index);
X        temp = temp->next;
X    }
X    return(-1);
X}
X
X
Xmatch_type(object, o_elt, free_name, f_elt)
X/* check to see if the types match */
Xchar *object, *o_elt, *free_name, *f_elt;
X{
X    int type;
X    struct match *temp;
X    struct def_list *temp2, *temp4;
X    struct data_type *temp3, *temp5;
X
X    temp = rule_list->complex;
X    while(temp){
X        if(strcmp(free_name, temp->free_name) == 0){
X        temp2 = token_list;
X        while(temp2){
X            if(strcmp(temp->object, temp2->name) == 0){
X            temp3 = temp2->data_types;
X            while(temp3){
X                if(strcmp(temp3->name, f_elt) == 0){
X                type = temp3->type;
X                temp4 = token_list;
X                while(temp4){
X                    if(strcmp(temp4->name, object) == 0){
X                    temp5 = temp4->data_types;
X                    while(temp5){
X                        if(strcmp(temp5->name, o_elt) == 0){
X                        if(type == temp5->type){
X                            if(strcmp(temp->object, object))
X                                return(1);
X                            else
X                            return(2);
X                            }
X                        else
X                            return(0);
X                        }
X                        temp5 = temp5->next;
X                    }
X                    return(0);
X                    }
X                    temp4 = temp4->next;
X                }
X                return(0);
X                }
X                temp3 = temp3->next;
X            }
X            return(0);
X            }
X            temp2 = temp2->next;
X        }
X        return(0);
X        }
X        temp = temp->next;
X    }
X    return(0);
X}
X
X
Xadd_count(n)
X/* add the count of how many objects to search
X   to the rule's situation part */
Xint n;
X{
X    struct match *temp;
X
X    if((rule_list->complex) && (n > 1)){
X        temp = rule_list->complex;
X        while(temp->next)
X        temp = temp->next;
X        temp->count = n;
X    }
X}
X
X
Xadd_test_code()
X/* insert C language code in the situation part */
X{
X    struct match *temp;
X
X        if(rule_list->complex){        /* not the first match in a rule */
X            temp = rule_list->complex;
X            while(temp->next)
X            temp = temp->next;
X            temp->next = (struct match *) malloc(sizeof(struct match));
X            temp = temp->next;
X        }
X        else{                /* first match in a rule */
X            rule_list->complex = (struct match *) malloc(sizeof(struct match));
X            temp = rule_list->complex;
X        }
X        temp->tests = NULL;
X        temp->next = NULL;
X        temp->object = NULL;
X        temp->free_name = NULL;
X        temp->empty = 0;
X        temp->mark  = 0;
X        temp->index = 0;
X        temp->count = 1;
X        temp->c_code = temp_c_code;
X        temp_c_code = NULL;
X}
X
X
Xadd_test(object, element, relop, value, type, free_name, index, empty)
X/*
Xadd data needed for complex matching to rule structure
Xobject is the name of the object class this test applies to
Xelement is the name of the element of the object this test applies to
Xrelop is the relational operator used in the test
Xvalue is the value to test against
Xtype is the data type of the element
Xfree_name is the name of the free variable associated with this object (if any)
Xindex is the array index of the free variable this test will assign to
Xempty - boolean: is this an empty test?
X*/
Xchar *object, *element, *value, *free_name;
Xint relop, type, index;
X{
X    struct match *temp;
X    struct test *temp2;
X    struct def_list *d_temp;
X    struct data_type *dt_temp;
X    struct case_list *c_temp;
X
X    if(current_match == NULL){        /* the first test in a match */
X        if(rule_list->complex){        /* not the first match in a rule */
X            temp = rule_list->complex;
X            while(temp->next)
X            temp = temp->next;
X            temp->next = (struct match *) malloc(sizeof(struct match));
X            temp = temp->next;
X        }
X        else{                /* first match in a rule */
X            rule_list->complex = (struct match *) malloc(sizeof(struct match));
X            temp = rule_list->complex;
X        }
X        temp->tests = NULL;
X        temp->next = NULL;
X        temp->object = object;
X        temp->free_name = free_name;
X        temp->index = index;
X        temp->c_code = NULL;
X        temp->count = 1;
X        temp->mark  = 0;
X        temp->empty = empty;
X        current_match = temp;
X    }
X    temp = current_match;
X    if(strcmp(temp->object, object) != 0){
X        fprintf(stderr,"%d: objects in a complex test must match\n",lineno);
X        errors++;
X        return(0);
X    }
X    if(temp->tests){
X        temp2 = temp->tests;
X        while(temp2->next)
X        temp2 = temp2->next;
X        temp2->next = (struct test *) malloc(sizeof(struct test));
X        temp2 = temp2->next;
X    }
X    else{
X        temp->tests = (struct test *) malloc(sizeof(struct test));
X        temp2 = temp->tests;
X    }
X    temp2->element = element;
X    temp2->relop = relop;
X    temp2->free_name = free_name;
X    temp2->value = value;
X    temp2->type = type;
X    temp2->next = NULL;
X    temp2->id = 0;
X    if(strcmp(object, free_name) == 0){
X        d_temp = token_list;
X        while(d_temp){
X        if(strcmp(object, d_temp->name) == 0){
X            dt_temp = d_temp->data_types;
X            while(dt_temp){
X            if(strcmp(element, dt_temp->name) == 0){
X                c_temp = dt_temp->elts;
X                while(c_temp){
X                if(strcmp(value, c_temp->name) == 0){
X                    c_temp->used = 1;
X                    temp2->id = c_temp->id;
X                    return;
X                }
X                c_temp = c_temp->next;
X                }
X            }
X            dt_temp = dt_temp->next;
X            }
X        }
X        d_temp = d_temp->next;
X        }
X    }
X}
X
X
Xsearch_structs(object, element)
X/*
Xsearch the list of structures for 'object', see if it has a field 'element'
Xreturn -1 if 'object' is not found, data type of 'element' if it is found.
X*/
Xchar *object, *element;
X{
X    struct def_list *temp;
X    struct data_type *temp2;
X
X    temp = token_list;
X    while(temp){
X        if((strcmp(temp->name, object)) == 0){
X        temp2 = temp->data_types;
X        while(temp2){
X            if((strcmp(temp2->name,element)) == 0){
X                return(temp2->type);
X            }
X            temp2 = temp2->next;
X        }
X        return(-1);
X        }
X        temp = temp->next;
X    }
X    return(-1);
X}
!EOR!
echo extracting - main.h
sed 's/^X//' > main.h << '!EOR!'
X#include    <stdio.h>
X
Xstruct list{
X        char *name;
X        struct list *next;
X} *name_list, *temp_c_code, *header_code, *trailer_code, *label_list;
X
Xstruct case_list{
X        char *name;    /* name of the element */
X        int id;        /* case identifier */
X        int used;    /* is this case ever used? */
X        struct case_list *next;
X};
X
Xstruct data_type{
X        int type;    /* -1 = free variable */
X                /*  0 = integer */
X                /*  1 = floating */
X                /*  2 = string */
X                /*  3 = pointer */
X        char *name;    /*  name of the element */
X        struct case_list *elts;    /* elements that may be compared */
X        struct data_type *next;
X} *data_list;
X
Xstruct def_list{                /* list of defined objects */
X        char *name;            /* the name of the object */
X        struct data_type *data_types;    /* pointer to the element list */
X        struct def_list *next;        /* next object in the list */
X} *token_list;
X
X
Xstruct test{                /* one test in a complex match */
X        char *element;        /* the element of the object to test */
X        int  relop;        /* relational operators are bit encoded
X                       < = >
X                       0 0 0    0   No Match
X                       0 0 1    1   >
X                       0 1 0    2   =
X                       0 1 1    3   >=
X                       1 0 0    4   <
X                       1 0 1    5   !=
X                       1 1 0    6   <=
X                       1 1 1    7   Match Any
X                    */
X        char *free_name;    /* name of free var */
X        char *value;        /* the value to test for */
X        int  type;        /* the data type of the element */
X        int  id;        /* case id for self tests */
X        struct test *next;    /* pointer to the next one in the list */
X} *current_test;
X
X
Xstruct match{                /* description of a complex matching */
X        char *object;        /* the object to test */
X        char *free_name;    /* name of free var attached to the object */
X        int index;        /* initial array index of this free variable */
X        int count;        /* number of times to repeat this test */
X        int mark;        /* boolean: mark this object? */
X        int empty;        /* boolean: is this an empty test? */
X        struct list *c_code;    /* C code included in the situation */
X        struct test *tests;    /* the list of tests for this match */
X        struct match *next;    /* pointer to the next one in the list */
X} *current_match;
X
X
Xstruct rule {                /* facts needed to generate code */
X                    /* one per rule */
X        char *label;        /* label of this rule */
X        char *opt;        /* optimization - goto this label */
X        int  recurs;        /* boolean indicates recursive search */
X        int *search;        /* items to search for in stm */
X        int *mark;        /* items to remove from stm */
X        struct init *add;    /* items to add to stm */
X        struct list *c_code;    /* code to execute if this rule fires */
X        struct match *complex;    /* complex matching list */
X        struct rule *next;
X        struct rule *prev;
X} *rule_list;
X
Xstruct fields {
X        char *object;        /* the name of the object to be init */
X        char *element;        /* the name of the element to be init */
X        char *value;        /* the value to be assigned to the element */
X        int index;        /* the array index of this free variable */
X        int type;        /* the type of the element */
X        int empty;        /* boolean: is this an empty test? */
X        struct fields *next;    /* the next element of this object to be initialized */
X};
X
Xstruct init {                /* stm initialization */
X        char *object;        /* the name of the object to be initialized */
X        int count;        /* number of reps of this item */
X        struct fields *items;    /* list of fields to initialize */
X        struct init *next;    /* next object in list */
X} *init_list, *init_list2;
X
X
Xint total_tokens,            /* total number of objects declared */
X    pnum,                 /* current production */
X    *stm,                 /* array of number of each object type
X                       to MARK or ADD */
X    *current_free,             /* index of the current free variable
X                       for each object type */
X    *max_free,                 /* maximum number of free variables
X                       needed for each object type */
X    *current_empty,             /* index of the current empty variable
X                       for each object type */
X    *max_empty,                /* maximum number of empty variables
X                       needed for each object type */
X    errors,                 /* count of errors detected */
X    backtracking,            /* boolean to indicate if the user wants
X                       to generate backtracking code */
X    profiling,                /* boolean to indicate if the user wants
X                       to generate profiling code */
X    tracing,                /* boolean to indicate if the user wants
X                       to generate tracing code */
X    dumping,                /* boolean to indicate if the user wants
X                       to generate code to dump stm*/
X    optimizing,                /* boolean to indicate if the user wants
X                       to invoke the loop optimizer */
X    recursing,                /* boolean to indicate if the user wants
X                       recursive searches to be the default */
X    saving,                /* boolean to indicate if the user wants
X                       to generate code to save STM*/
X    zeroing,                /* boolean to indicate if the user wants
X                       to generate code to zero STM*/
X    pascal,                /* boolean to indicate if the user wants
X                       to generate pascal instead of C*/
X    lineno;                /* line number of input file */
X
Xchar *first_label,            /* label of the first rule in LTM */
X     *prefix;                    /* prefix for all objects */
X
XFILE  *header, *fre, *misc, *search,    /* output files */
X    *add, *dump, *loop, *relink,    /* purposes are obvious */
X    *backtrack, *profile, *zero, *save;
X
!EOR!
echo extracting - optimize.c
sed 's/^X//' > optimize.c << '!EOR!'
X#include    "main.h"
X
Xoptimize()
X/* optimize the goto statements that will be generated for loop.c */
X{
X    struct rule *r_const, *r_temp, *r_temp2;
X    struct match *m_temp;
X    struct test *t_temp;
X    struct init *i_temp;
X    int i;
X
X    /* find the end of the rule list */
X    /* since rules are inserted, the first rule is at the end of the list */
X    r_const = rule_list;
X    while(r_const->next != NULL)
X        r_const = r_const->next;
X
X    /* scan the rule list from the end */
X    /* mark all rules with tests that do not check elements as recursive */
X    r_temp = r_const;
X    while(r_temp){
X        if(r_temp->recurs == 0){
X        i = 1;
X        m_temp = r_temp->complex;
X        if(m_temp == NULL){
X            r_temp->recurs = 111;
X        }
X        while(m_temp && i){
X            if(m_temp->tests){
X            t_temp = m_temp->tests;
X            while(t_temp)
X                if(t_temp->element){
X                i = 0;
X                t_temp = NULL;
X                }
X                else
X                t_temp = t_temp->next;
X            }
X            if(i){
X            if(m_temp->next == NULL){
X                r_temp->recurs = 111;
X            }
X            }
X            m_temp = m_temp->next;
X        }
X        }
X        r_temp = r_temp->prev;
X    }
X
X    /* scan the rule list for rules that have not been hand optimized */
X    /* optimize these rules by scanning for the first rule that could */
X    /* possibly fire after the given rule */
X    r_temp = r_const;
X    while(r_temp){
X        if(r_temp->opt == NULL){
X        r_temp2 = r_const;
X        while(r_temp2){
X            r_temp->opt = r_temp2->label;
X            if(r_temp2->complex == NULL){
X            r_temp2 = NULL;
X            }
X            else if(strcmp(r_temp->label, r_temp2->label) == 0){
X            r_temp2 = NULL;
X            }
X            else{
X                /* NOT tests first */
X                for(i = 0; i < total_tokens; i++){
X                if(r_temp2->search[i] < 0){
X                    if(r_temp->mark[i] > 0){
X                    r_temp2 = NULL;
X                    goto next_rule;
X                    }
X                    i_temp = r_temp->add;
X                    while(i_temp){
X                    if(find_token(i_temp->object) == i)
X                        goto next_rule;
X                    i_temp = i_temp->next;
X                    }
X                }
X                }
X                m_temp = r_temp2->complex;
X                while(m_temp){
X                i = find_token(m_temp->object);
X                    /* ADD test for all rules */
X                i_temp = r_temp->add;
X                while(i_temp){
X                    if(strcmp(i_temp->object, m_temp->object) == 0){
X                    r_temp2 = NULL;
X                    m_temp  = NULL;
X                    i_temp  = NULL;
X                    }
X                    else
X                    i_temp = i_temp->next;
X                }
X                /* MARK test for non recursive rules */
X                if((r_temp2)
X                && (r_temp->recurs == 0)
X                && (r_temp->mark[i])){
X                    r_temp2 = NULL;
X                    m_temp  = NULL;
X                }
X                else{
X                    if(m_temp) {
X                    m_temp = m_temp->next;
X                    }
X                }
X                }
X            }
X            next_rule:
X            if(r_temp2 != NULL){
X            r_temp2 = r_temp2->prev;
X            }
X        }
X        }
X        r_temp = r_temp->prev;
X    }
X
X    /* unmark rules temporarily marked as recursive */
X    r_temp = r_const;
X    while(r_temp){
X        if(r_temp->recurs == 111)
X        r_temp->recurs = 0;
X        r_temp = r_temp->prev;
X    }
X}
!EOR!