home *** CD-ROM | disk | FTP | other *** search
/ ftptest.leeds.ac.uk / 2015.02.ftptest.leeds.ac.uk.tar / ftptest.leeds.ac.uk / bionet / CAE-GROUP / SCL-WIN3x / FED_PLUS.EXE / EXPRESS.C < prev    next >
C/C++ Source or Header  |  1994-07-23  |  22KB  |  814 lines
  1. static char rcsid[] = "";
  2.  
  3. /************************************************************************
  4. ** Express package manager.
  5. ************************************************************************/
  6.  
  7. /*
  8.  * This code was developed with the support of the United States Government,
  9.  * and is not subject to copyright.
  10.  *
  11.  * $Log: express.c,v $
  12.  * Revision 1.12  1994/05/11  19:51:24  libes
  13.  * numerous fixes
  14.  *
  15.  * Revision 1.11  1993/10/15  18:48:48  libes
  16.  * CADDETC certified
  17.  *
  18.  * Revision 1.9  1993/02/22  21:45:06  libes
  19.  * fix pass print bug
  20.  *
  21.  * Revision 1.8  1993/02/16  03:19:56  libes
  22.  * added unwriteable error
  23.  *
  24.  * Revision 1.7  1993/01/19  22:44:17  libes
  25.  * *** empty log message ***
  26.  *
  27.  * Revision 1.6  1992/09/16  18:19:14  libes
  28.  * fixed bug in EXPRESS_PATH searching
  29.  *
  30.  * Revision 1.5  1992/08/27  23:38:35  libes
  31.  * removed redundant call to initialize much of EXPRESS
  32.  * rewrote schema-rename-connect to use fifo instead of dictionary
  33.  * fixed smashing of file names by new schema files
  34.  *
  35.  * Revision 1.4  1992/08/18  17:13:43  libes
  36.  * rm'd extraneous error messages
  37.  *
  38.  * Revision 1.3  1992/06/08  18:06:57  libes
  39.  * prettied up interface to print_objects_when_running
  40.  *
  41.  * Revision 1.2  1992/05/31  08:35:51  libes
  42.  * multiple files
  43.  *
  44.  * Revision 1.1  1992/05/28  03:55:04  libes
  45.  * Initial revision
  46.  *
  47.  */
  48.  
  49. #define    EXPRESS_C
  50. #include "conf.h"
  51. #include "basic.h"
  52. #include <ctype.h>
  53. //#include <pwd.h>
  54. #include <stdlib.h>
  55. #include <setjmp.h>
  56.                    
  57. #include "express.h"
  58. #include "resolve.h"
  59. #include "stack.h"
  60. #include "scope.h"
  61.  
  62. extern FILE *yyin;
  63. extern Express yyresult;
  64.  
  65. static Error ERROR_ref_nonexistent;
  66. static Error ERROR_tilde_expansion_failed;
  67. static Error ERROR_schema_not_in_own_schema_file;
  68.  
  69. extern Linked_List PARSEnew_schemas;
  70.  
  71. static Express PARSERrun PROTO((char *,FILE *));
  72. void yynewparse();
  73.  
  74. char *EXPRESSversion(void)
  75. {
  76.     return("Express Language, DIS (N151), August 31, 1992");
  77. }
  78.  
  79. int
  80. EXPRESS_fail(Express model)
  81. {
  82.     ERRORflush_messages();
  83.  
  84.     if (EXPRESSfail) return((*EXPRESSfail)(model));
  85.  
  86.     fprintf(stderr,"Errors in input\n");
  87.     return 1;
  88. }
  89.  
  90. int
  91. EXPRESS_succeed(Express model)
  92. {
  93.     if (EXPRESSsucceed) return((*EXPRESSsucceed)(model));
  94.  
  95.     fprintf(stderr,"No errors in input\n");
  96.     return 0;
  97. }
  98.  
  99. Symbol *
  100. EXPRESS_get_symbol(Generic e)
  101. {
  102.     return(&((Express)e)->symbol);
  103. }
  104.  
  105. Express
  106. EXPRESScreate()
  107. {
  108.     Express model = SCOPEcreate(OBJ_EXPRESS);
  109.     model->u.express = (struct Express *)calloc(1,sizeof(struct Express));
  110.     return model;
  111. }
  112.  
  113. #define MAX_SCHEMA_FILENAME_SIZE    256
  114. typedef struct Dir {
  115.     char full[MAX_SCHEMA_FILENAME_SIZE];
  116.     char *leaf;
  117. } Dir;
  118.  
  119. /* expand ~ in-place, blindly assuming argument has extra space */
  120. /* if translation is valid, return original address, else return 0 */
  121. /* note: returns result in static buffer! */
  122. /* assume arg begins at first char past tilde */
  123. static
  124. char *
  125. tilde_translate(char *name)
  126. {
  127.     static char output[1024];
  128.     char *pwd;
  129.     char *new;
  130.     char *slash;
  131.  
  132.     /* we'll need to put back string beginning at slash+1 */
  133.     slash = strchr(name,'/');
  134.     if (slash) *slash = '\0';
  135.  
  136.     /*         "~"                  "~/"       */
  137.     if ((name[0] == '\0') || (name == slash)) {
  138.         /* get our own home dir */
  139.         new = getenv("HOME");
  140.     } else {
  141.         /* "~name" */
  142.         pwd = name;
  143.         new = name;
  144.     }
  145.     if (!new) {
  146.         ERRORreport(ERROR_tilde_expansion_failed,name-1);
  147.         return(0);
  148.     }
  149.     if (slash) {
  150.         sprintf(output,"%s/%s",new,slash+1);
  151.     } else {
  152.         strcpy(output,new);
  153.     }
  154.     return output;
  155. }
  156.  
  157.  
  158. static void
  159. EXPRESS_PATHinit() {
  160.     char *p;
  161.     Dir *dir;
  162.     int done = 0;
  163.  
  164.     EXPRESS_path = LISTcreate();
  165.     p = getenv("EXPRESS_PATH");
  166.     if (!p) {
  167.         /* if no EXPRESS_PATH, search current directory anyway */
  168.         dir = (Dir *)malloc(sizeof(Dir));
  169.         dir->leaf = dir->full;
  170.         LISTadd(EXPRESS_path,(Generic)dir);
  171.     } else {
  172.         while (!done) {
  173.             char *start;    /* start of current dir */
  174.             int length;    /* length of dir */
  175.             char *slash;    /* last slash in dir */
  176.             char save;    /* place to character from where we */
  177.                     /* temporarily null terminate */
  178.  
  179.             /* get next directory */
  180.             while (isspace(*p)) p++;
  181.             if (*p == '\0') break;
  182.             start = p;
  183.  
  184.             /* find the end of the directory */
  185.             while (*p != '\0' && !isspace(*p)) p++;
  186.             if (*p == 0) done = 1;
  187.             else {
  188.                 save = *p;
  189.                 *p = '\0';
  190.             }
  191.             p++;    /* leave p after terminating null */
  192.  
  193.             dir = (Dir *)malloc(sizeof(Dir));
  194.  
  195.             /* if it's just ".", make it as if it was */
  196.             /* just "" to make error messages cleaner */
  197.             if (streq(".",start)) {
  198.                 dir->leaf = dir->full;
  199.                 LISTadd(EXPRESS_path,(Generic)dir);
  200.                 *(p-1) = save;    /* put char back where */
  201.                         /* temp null was */
  202.                 continue;
  203.             }
  204.  
  205.             /* if does not begin with a tilde */
  206.             if (start[0] != '~') length = (p-1) - start;
  207.             else {
  208.                 start = tilde_translate(start+1);
  209.                 if (!start) break;
  210.                 length = strlen(start);
  211.             }
  212.  
  213.             /* if slash present at end, don't add another */
  214.             slash = strrchr(start,'/');
  215.             if (slash && (slash[1] == '\0')) {
  216.                 strcpy(dir->full,start);
  217.                 dir->leaf = dir->full + length;
  218.             } else {
  219.                 sprintf(dir->full,"%s/",start);
  220.                 dir->leaf = dir->full + length + 1;
  221.             }
  222.             LISTadd(EXPRESS_path,(Generic)dir);
  223.  
  224.             *(p-1) = save; /* put char back where temp null was */
  225.         }
  226.     }
  227. }
  228.  
  229. /*
  230. ** Procedure:    EXPRESSinitialize
  231. ** Parameters:    -- none --
  232. ** Returns:    void
  233. ** Description:    Initialize the Express package.
  234. */
  235.  
  236. void
  237. EXPRESSinitialize(void)
  238. {
  239.     Function
  240.         func_abs,    func_acos,    func_asin,    func_atan,
  241.         func_blength,
  242.         func_cos,    func_exists,    func_exp,    func_format,
  243.         func_hibound,    func_hiindex,    func_length,    func_lobound,
  244.         func_log,    func_log10,    func_log2,    func_loindex,
  245.         func_odd,    func_rolesof,    func_sin,    func_sizeof,
  246.         func_sqrt,    func_tan,    func_typeof,
  247.         func_value;
  248.     Procedure
  249.         proc_insert,    proc_remove;
  250.  
  251.     _MEMinitialize();
  252.     ERRORinitialize();
  253.     OBJinitialize();
  254.  
  255.     HASHinitialize();    /* comes first - used by just about everything else! */
  256.     DICTinitialize();
  257.     LISTinitialize();    /* ditto */
  258.     ERRORinitialize_after_LIST();
  259.     STACKinitialize();
  260.  
  261.     RESOLVEinitialize();
  262.  
  263.     SYMBOLinitialize();
  264.  
  265.     SCOPEinitialize();
  266.     TYPEinitialize();    /* cannot come before SCOPEinitialize */
  267.     VARinitialize();
  268.  
  269.     ALGinitialize();
  270.     ENTITYinitialize();
  271.     SCHEMAinitialize();
  272.  
  273.     CASE_ITinitialize();
  274.     EXPinitialize();
  275. /*    LOOP_CTLinitialize();*/
  276.     STMTinitialize();
  277.  
  278.     SCANinitialize();
  279.  
  280.     EXPRESSbuiltins = DICTcreate(35);
  281. #define funcdef(x,y,c,r) \
  282.             x = ALGcreate(OBJ_FUNCTION);\
  283.             x->symbol.name = y;\
  284.             x->u.func->pcount = c; \
  285.             x->u.func->return_type = r; \
  286.             x->u.func->builtin = true; \
  287.             resolved_all(x); \
  288.             DICTdefine(EXPRESSbuiltins,y,(Generic)x,0,OBJ_FUNCTION);
  289. #define procdef(x,y,c)    x = ALGcreate(OBJ_PROCEDURE);\
  290.             x->symbol.name = y;\
  291.             x->u.proc->pcount = c; \
  292.             x->u.proc->builtin = true; \
  293.             resolved_all(x); \
  294.             DICTdefine(EXPRESSbuiltins,y,(Generic)x,0,OBJ_PROCEDURE);
  295.     /* third arg is # of parameters */
  296.  
  297.     /* eventually everything should be data-driven, but for now */
  298.     /* uppercase def's are global to allow passing necessary information */
  299.     /* into resolver */
  300.     procdef(proc_insert, KW_INSERT,    3);
  301.     procdef(proc_remove, KW_REMOVE,    2);
  302.  
  303.     funcdef(func_abs,    KW_ABS,    1,Type_Number);
  304.     funcdef(func_acos,   KW_ACOS,    1,Type_Real);
  305.     funcdef(func_asin,   KW_ASIN,    1,Type_Real);
  306.     funcdef(func_atan,   KW_ATAN,    2,Type_Real);
  307.     funcdef(func_blength,KW_BLENGTH,1,Type_Integer);
  308.     funcdef(func_cos,    KW_COS,    1,Type_Real);
  309.     funcdef(func_exists, KW_EXISTS,    1,Type_Boolean);
  310.     funcdef(func_exp,    KW_EXP,    1,Type_Real);
  311.     funcdef(func_format, KW_FORMAT,    2,Type_String);
  312.     funcdef(func_hibound,KW_HIBOUND,1,Type_Integer);
  313.     funcdef(func_hiindex,KW_HIINDEX,1,Type_Integer);
  314.     funcdef(func_length, KW_LENGTH,    1,Type_Integer);
  315.     funcdef(func_lobound,KW_LOBOUND,1,Type_Integer);
  316.     funcdef(func_log,    KW_LOG,    1,Type_Real);
  317.     funcdef(func_log10,  KW_LOG10,    1,Type_Real);
  318.     funcdef(func_log2,   KW_LOG2,    1,Type_Real);
  319.     funcdef(func_loindex,KW_LOINDEX,1,Type_Integer);
  320.     funcdef(FUNC_NVL,    KW_NVL,    2,Type_Generic);
  321.     funcdef(func_odd,    KW_ODD,    1,Type_Logical);
  322.     funcdef(func_rolesof,KW_ROLESOF,1,Type_Set_Of_String);
  323.     funcdef(func_sin,    KW_SIN,    1,Type_Real);
  324.     funcdef(func_sizeof, KW_SIZEOF,    1,Type_Integer);
  325.     funcdef(func_sqrt,   KW_SQRT,    1,Type_Real);
  326.     funcdef(func_tan,    KW_TAN,    1,Type_Real);
  327.     funcdef(func_typeof, KW_TYPEOF,    1,Type_Set_Of_String);
  328.     funcdef(FUNC_USEDIN,    KW_USEDIN,    2,Type_Set_Of_Generic);
  329.     funcdef(func_value,    KW_VALUE,    1,Type_Number);
  330.  
  331.     ERROR_bail_out =
  332.     ERRORcreate("Aborting due to internal error(s)", SEVERITY_DUMP);
  333.     ERROR_syntax =
  334.     ERRORcreate("%s in %s %s", SEVERITY_EXIT);
  335.     /* i.e., "syntax error in procedure foo" */
  336.     ERROR_ref_nonexistent = ERRORcreate(
  337. "USE/REF of non-existent object (%s in schema %s)", SEVERITY_ERROR);
  338.     ERROR_tilde_expansion_failed = ERRORcreate(
  339. "Tilde expansion for %s failed in EXPRESS_PATH environment variable",SEVERITY_ERROR);
  340.     ERROR_schema_not_in_own_schema_file = ERRORcreate(
  341. "Schema %s was not found in its own schema file (%s)",SEVERITY_ERROR);
  342.     ERROR_file_unreadable = ERRORcreate(
  343. "Could not read file %s: %s",SEVERITY_ERROR);
  344.     ERROR_file_unwriteable = ERRORcreate(
  345. "Could not write file %s: %s",SEVERITY_ERROR);
  346.     OBJcreate(OBJ_EXPRESS,EXPRESS_get_symbol,"express file",OBJ_UNUSED_BITS);
  347.  
  348.     ERRORcreate_warning("unknown_subtype",ERROR_unknown_subtype);
  349.  
  350.     EXPRESS_PATHinit(); /* note, must follow defn of errors it needs! */
  351. }
  352.  
  353. /*
  354. ** Procedure:    EXPRESSparse
  355. ** Parameters:    FILE* file    - Express source file to parse
  356. ** Returns:    Express        - resulting Working Form model
  357. ** Description:    Parse an Express source file into the Working Form.
  358. */
  359. void
  360. EXPRESSparse(Express model,FILE *fp, char *filename)
  361. {
  362.     //extern char* sys_errlist[];
  363.     /*extern int errno; */
  364.  
  365.     yyresult = model;
  366.  
  367.     if (!fp) fp = fopen(filename,"r");
  368.     if (!fp) {
  369.         /* go down path looking for file */
  370.         LISTdo(EXPRESS_path, dir, Dir *)
  371.             sprintf(dir->leaf,"%s",filename);
  372.             if (0 != (fp = fopen(dir->full,"r"))) {
  373.                 filename = dir->full;
  374.                 break;
  375.             }
  376.         LISTod
  377.     }
  378.  
  379.     if (!fp) {
  380.         ERRORreport(ERROR_file_unreadable,filename,sys_errlist[errno]);
  381.         return;
  382.     }
  383.  
  384.     if (filename) {
  385.         char *dot   = strrchr(filename,'.');
  386.         char *slash = strrchr(filename,'/');
  387.  
  388.         /* get beginning of basename */
  389.         char *start = slash?(slash+1):filename;
  390.  
  391.         int length = strlen(start);
  392.  
  393.         /* drop .exp suffix if present */
  394.         if (dot && streq(dot,".exp")) length -= 4;
  395.  
  396.         model->u.express->basename = (char *)malloc(length + 1);
  397.         memcpy(model->u.express->basename,filename,length);
  398.         model->u.express->basename[length] = '\0';
  399.  
  400.         /* get new copy of filename to avoid being smashed */
  401.         /* by subsequent lookups on EXPRESS_path */
  402.         model->u.express->filename = SCANstrdup(filename);
  403.         filename = model->u.express->filename;
  404.     }
  405.  
  406.     PARSEnew_schemas = LISTcreate();
  407.     PARSERrun(filename,model->u.express->file = fp);
  408. }
  409.  
  410. static
  411. /* start parsing a new schema file */
  412. Express
  413. PARSERrun(char *filename,FILE *fp)
  414. {
  415.     extern int exp_yyparse();
  416.     extern void SCAN_lex_init PROTO((char *,FILE *));
  417.  
  418.     if (print_objects_while_running & OBJ_PASS_BITS) {
  419.         fprintf(stderr,"parse (pass 0)\n",EXPRESSpass);
  420.     }
  421.  
  422.     if (print_objects_while_running & OBJ_SCHEMA_BITS) {
  423.         fprintf(stderr,"parse: %s (schema file)\n",filename);
  424.     }
  425.  
  426.     yyin = fp;
  427.     yynewparse();
  428.     SCAN_lex_init(filename,fp);
  429.     if (exp_yyparse() != 0) {
  430.         ERRORreport(ERROR_bail_out);
  431.         /* free model and model->u.express */
  432.         return 0;
  433.     }
  434.     EXPRESSpass = 1;
  435.     return yyresult;
  436. }
  437.  
  438. static void RENAMEresolve(Rename *r);
  439.  
  440. /* find the final object to which a rename points */
  441. /* i.e., follow chain of USEs or REFs */
  442. /* sets DICT_type */
  443. Generic
  444. SCOPEfind_for_rename(Scope schema,char *name,enum rename_type type)
  445. {
  446.     Generic result;
  447.     Rename *rename;
  448.  
  449.     /* object can only appear in top level symbol table */
  450.     /* OR in another rename clause */
  451.  
  452.     result = DICTlookup(schema->symbol_table,name);
  453.     if (result) return result;
  454.  
  455.     /* Occurs in a fully USE'd schema? */
  456.     LISTdo(schema->u.schema->uselist,schema,Schema)
  457.         /* follow chain'd USEs */
  458.         result = SCOPEfind_for_rename(schema,name,use);
  459.         if (result) return(result);
  460.     LISTod;
  461.  
  462.     /* Occurs in a partially USE'd schema? */
  463.     rename = (Rename *)DICTlookup(schema->u.schema->usedict,name);
  464.     if (rename) {
  465.         RENAMEresolve(rename);
  466.         DICT_type = rename->type;
  467.         return(rename->object);
  468.     }
  469.  
  470.     if (type == ref) return(0);
  471.  
  472.     /* Occurs in a fully REF'd schema? */
  473.     LISTdo(schema->u.schema->reflist,schema,Schema)
  474.         result = SCOPEfind_for_rename(schema,name,ref);
  475.         if (result) return result;
  476.         else continue;    /* try another schema */
  477.     LISTod;
  478.  
  479.     /* Occurs in a partially REF'd schema? */
  480.     rename = (Rename *)DICTlookup(schema->u.schema->refdict,name);
  481.     if (rename) {
  482.         RENAMEresolve(rename);
  483.         DICT_type = rename->type;
  484.         return(rename->object);
  485.     }
  486.  
  487.     return 0;
  488. }    
  489.  
  490. static void
  491. RENAMEresolve(Rename *r)
  492. {
  493.     Generic remote;
  494.  
  495. /*    if (is_resolved_rename_raw(r->old)) return;*/
  496.     if (r->object) return;
  497.  
  498.     if (is_resolve_failed_raw(r->old)) return;
  499.  
  500.     if (is_resolve_in_progress_raw(r->old)) {
  501.         ERRORreport_with_symbol(ERROR_circular_reference,
  502.             r->old,r->old->name);
  503.             resolve_failed_raw(r->old);
  504.             return;
  505.     }
  506.     resolve_in_progress_raw(r->old);
  507.  
  508.     remote = SCOPEfind_for_rename(r->schema,r->old->name,r->rename_type);
  509.     if (remote == 0) {
  510.         ERRORreport_with_symbol(ERROR_ref_nonexistent,r->old,
  511.             r->old->name,r->schema->symbol.name);
  512.         resolve_failed_raw(r->old);
  513.     } else {
  514.         r->object = remote;
  515.         r->type = DICT_type;
  516. /*        resolve_rename_raw(r->old);*/
  517.     }
  518.     resolve_not_in_progress_raw(r->old);
  519. }
  520.  
  521. Schema
  522. EXPRESSfind_schema(Dictionary modeldict,char *name)
  523. {
  524.     Schema s;
  525.     FILE *fp;
  526.     char *src, *dest;
  527.     char lower[MAX_SCHEMA_FILENAME_SIZE];    /* avoid lowerizing original */
  528.  
  529.     if (print_objects_while_running & OBJ_SCHEMA_BITS) {
  530.         fprintf(stderr,"pass %d: %s (schema reference)\n",
  531.             EXPRESSpass,name);
  532.     }
  533.  
  534.     s = (Schema)DICTlookup(modeldict,name);
  535.     if (s) {
  536. #if 0
  537.         if (print_objects_while_running & OBJ_SCHEMA_BITS) {
  538.             fprintf(stderr,"pass %d: (found schema %s in model already)\n");
  539.         }
  540. #endif
  541.         return s;
  542.     }
  543.  
  544.     dest = lower;
  545.     for (src = name;*src;src++) *dest++ = tolower(*src);
  546.     *dest = '\0';
  547.  
  548.     /* go down path looking for file */
  549.     LISTdo(EXPRESS_path, dir, Dir *)
  550.         sprintf(dir->leaf,"%s.exp",lower);
  551.         if (print_objects_while_running & OBJ_SCHEMA_BITS) {
  552.             fprintf(stderr,"pass %d: %s (schema file?)\n",
  553.                 EXPRESSpass,dir->full);
  554.         }
  555.         fp = fopen(dir->full,"r");
  556.         if (fp) {
  557.             Express express;
  558.  
  559.             if (print_objects_while_running & OBJ_SCHEMA_BITS) {
  560.                 fprintf(stderr,"pass %d: %s (schema file found)\n",
  561.                     EXPRESSpass,dir->full);
  562.             }
  563.  
  564.             express = PARSERrun(SCANstrdup(dir->full),fp);
  565.             if (express) {
  566.                 s = (Schema)DICTlookup(modeldict,name);
  567.             }
  568.             if (s) return s;
  569.             ERRORreport(ERROR_schema_not_in_own_schema_file,
  570.                 name,dir->full);
  571.             return 0;
  572.         } else {
  573.             /*extern int errno; */
  574.  
  575.             if (print_objects_while_running & OBJ_SCHEMA_BITS) {
  576.                 fprintf(stderr,"pass %d: %s (schema file not found), errno = %d\n",EXPRESSpass,dir->full,errno);
  577.             }
  578.         }
  579.     LISTod
  580.     return 0;
  581. }
  582.  
  583.  
  584. /* make the initial connections from one schema to another */
  585. /* dictated by USE/REF clauses that use dictionaries, i.e., */
  586. /* because of partial schema references */
  587. static void
  588. connect_schema_dicts(Dictionary modeldict, Schema schema, Dictionary dict)
  589. {
  590.     DictionaryEntry fg;
  591.     Rename *r;
  592.  
  593.     DICTdo_init(dict,&fg);
  594.     while (0 != (r = (Rename *)DICTdo(&fg))) {
  595.         r->schema = EXPRESSfind_schema(modeldict,r->schema_sym->name);
  596.         if (!r->schema) {
  597.             ERRORreport_with_symbol(ERROR_undefined_schema,r->schema_sym,r->schema_sym->name);
  598.             resolve_failed_raw(r->old);
  599.             resolve_failed(schema);
  600.         }
  601.     }
  602. }
  603. /* same as above, except for full schemas */
  604. static void
  605. connect_schema_lists(Dictionary modeldict,Schema schema,Linked_List schema_list)
  606. {
  607.     Symbol *sym;
  608.     Schema ref_schema;
  609.  
  610.     /* translate symbols to schemas */
  611.     LISTdo_links(schema_list, list)
  612.         sym = (Symbol *)list->data;
  613.         ref_schema = EXPRESSfind_schema(modeldict,sym->name);
  614.         if (!ref_schema) {
  615.             ERRORreport_with_symbol(ERROR_undefined_schema,sym,sym->name);
  616.             resolve_failed(schema);
  617.             list->data = 0;
  618.         } else list->data = (Generic)ref_schema;
  619.     LISTod
  620. }
  621.  
  622.  
  623. /*
  624. ** Procedure:    EXPRESSresolve
  625. ** Parameters:    Express model    - Working Form model to resolve
  626. ** Returns:    void
  627. ** Description:    Perform symbol resolution on a loosely-coupled WF.
  628. */
  629.  
  630. void
  631. EXPRESSresolve(Express model)
  632. {
  633.     /* resolve multiple schemas.  Schemas will be resolved here or when */
  634.     /* they are first encountered by a use/reference clause, whichever */
  635.     /* comes first - DEL */
  636.  
  637.     Schema schema;
  638.     DictionaryEntry de, fg;    /* imaginative, eh? */
  639.     Rename *r;
  640.  
  641.     jmp_buf env;
  642.     if (setjmp(env)) return;
  643.     ERRORsafe(env);
  644.  
  645.     EXPRESSpass++;
  646.     if (print_objects_while_running & OBJ_PASS_BITS) {
  647.         fprintf(stderr,"pass %d\n",EXPRESSpass);
  648.     }
  649.  
  650.     /* connect the real schemas to all the rename clauses */
  651.  
  652.     /* we may be adding new schemas (to dictionary) as we traverse it, */
  653.     /* so to avoid confusing dictionary, use a list as a fifo.  I.e., */
  654.     /* add news schemas to end, drop old ones off the front as we */
  655.     /* process them. */
  656.  
  657.     LISTdo(PARSEnew_schemas,schema,Schema)
  658.         if (print_objects_while_running & OBJ_SCHEMA_BITS) {
  659.             fprintf(stdout,"pass %d: %s (schema)\n",EXPRESSpass,schema->symbol.name);
  660.         }
  661.  
  662.         if (schema->u.schema->usedict)
  663.             connect_schema_dicts(model->symbol_table,
  664.                     schema,schema->u.schema->usedict);
  665.         if (schema->u.schema->refdict)
  666.             connect_schema_dicts(model->symbol_table,
  667.                     schema,schema->u.schema->refdict);
  668.         connect_schema_lists(model->symbol_table,
  669.             schema,schema->u.schema->uselist);
  670.         connect_schema_lists(model->symbol_table,
  671.             schema,schema->u.schema->reflist);
  672.     LISTod
  673.  
  674.     LISTfree(PARSEnew_schemas);
  675.     PARSEnew_schemas = 0;    /* just in case */
  676.  
  677.     EXPRESSpass++;
  678.     if (print_objects_while_running & OBJ_PASS_BITS) {
  679.         fprintf(stderr,"pass %d\n",EXPRESSpass);
  680.     }
  681.  
  682.     /* connect the object in each rename clause to the real object */
  683.     DICTdo_type_init(model->symbol_table,&de,OBJ_SCHEMA);
  684.     while (0 != (schema = (Schema)DICTdo(&de))) {
  685.         if (is_not_resolvable(schema)) continue;
  686.  
  687.         if (print_objects_while_running & OBJ_SCHEMA_BITS) {
  688.             fprintf(stdout,"pass %d: %s (schema)\n",EXPRESSpass,
  689.                 schema->symbol.name);
  690.         }
  691.  
  692.         if (schema->u.schema->usedict) {
  693.             DICTdo_init(schema->u.schema->usedict,&fg);
  694.             while (0 != (r = (Rename *)DICTdo(&fg))) {
  695.                 RENAMEresolve(r);
  696.             }                
  697.         }
  698.         if (schema->u.schema->refdict) {
  699.             DICTdo_init(schema->u.schema->refdict,&fg);
  700.             while (0 != (r = (Rename *)DICTdo(&fg))) {
  701.                 RENAMEresolve(r);
  702.             }
  703.         }
  704.     }
  705.  
  706.     EXPRESSpass++;
  707.     if (print_objects_while_running & OBJ_PASS_BITS) {
  708.         fprintf(stderr,"pass %d\n",EXPRESSpass);
  709.     }
  710.  
  711.     DICTdo_type_init(model->symbol_table,&de,OBJ_SCHEMA);
  712.     while (0 != (schema = (Schema)DICTdo(&de))) {
  713.         if (is_not_resolvable(schema)) continue;
  714.         SCOPEresolve_subsupers(schema);
  715.     }
  716.     if (ERRORoccurred) ERRORunsafe();
  717.  
  718.     EXPRESSpass++;
  719.     if (print_objects_while_running & OBJ_PASS_BITS) {
  720.         fprintf(stderr,"pass %d\n",EXPRESSpass);
  721.     }
  722.  
  723.     SCOPEresolve_types(model);
  724.     if (ERRORoccurred) ERRORunsafe();
  725.  
  726.     EXPRESSpass++;
  727.     if (print_objects_while_running & OBJ_PASS_BITS) {
  728.         fprintf(stderr,"pass %d\n",EXPRESSpass);
  729.     }
  730.  
  731.     SCOPEresolve_expressions_statements(model);
  732.     if (ERRORoccurred) ERRORunsafe();
  733.  
  734.     /* mark everything resolved if possible */
  735.     DICTdo_init(model->symbol_table,&de);
  736.     while (0 != (schema = (Schema)DICTdo(&de))) {
  737.         if (is_resolvable(schema)) resolved_all(schema);
  738.     }
  739. }
  740.  
  741. #if 0
  742. void
  743. EXPRESSdump_schema(Schema schema)
  744. {
  745.     Linked_List list,list2,ref;
  746.     Dictionary dict;
  747.     DictionaryEntry de;
  748.     
  749.     printf("SCHEMA %s\n", SCHEMAget_name(schema));
  750.     list = SCOPEget_types(schema);
  751.     printf("  Types:\n");
  752.     LISTdo(list, s, Symbol *)
  753.     printf("    %s\n", SYMBOLget_name(s));
  754.     LISTod;
  755.     list = SCOPEget_entities(schema);
  756.     printf("  Entities:\n");
  757.     LISTdo(list, s, Symbol)
  758.     printf("    %s\n", SYMBOLget_name(s));
  759.     LISTod;
  760.  
  761. /* N14 Dump USE and REFERENCE lists */
  762.     list = SCOPEget_uses(schema);
  763.     printf("  Use:\n");
  764.     LISTdo(list, use, Linked_List)
  765.         printf("   Schema: %s\n", SYMBOLget_name(LISTget_first(use)));
  766.         list2 = LISTget_second(use);
  767.         LISTdo(list2, use_exp, Expression);
  768.             printf("   %s AS %s\n",
  769.                 SYMBOLget_name(BIN_EXPget_first_operand(use_exp)),
  770.                 SYMBOLget_name(BIN_EXPget_second_operand(use_exp)));
  771.         LISTod;
  772.     LISTod;
  773.     
  774.     dict = SCOPEget_references(schema);
  775.     printf("  Reference:\n");
  776.     DICTdo_init(dict,&de);
  777.     while (ref = (Linked_List)DICTdo(&de))
  778.       {
  779.       printf("    %s\n", SYMBOLget_name(LISTget_first(ref)));
  780.           list2 = LISTget_second(ref);
  781.       LISTdo(list2, ref_exp, Expression);
  782.             printf("   %s AS %s\n",
  783.                 SYMBOLget_name(BIN_EXPget_first_operand(ref_exp)),
  784.                 SYMBOLget_name(BIN_EXPget_second_operand(ref_exp)));
  785.           LISTod;
  786.       }
  787.     
  788.     printf("END_SCHEMA\n");
  789.  
  790. /* N14 Nested schemas obsolete
  791.     list = SCOPEget_schemata(schema);
  792.     LISTdo(list, s, Schema)
  793.     EXPRESSdump_schema(s);
  794.     LISTod; */
  795.  
  796. }
  797.  
  798. /*
  799. ** Procedure:    EXPRESSdump_model
  800. ** Parameters:    Express model    - Express model to dump
  801. ** Returns:    void
  802. ** Description:    Dumps an Express model to stderr.
  803. */
  804.  
  805. /*ARGUSED*/
  806. void
  807. EXPRESSdump_model(Express model)
  808. {
  809. /* should make dump_model and dump_modelS! - DEL */
  810. /*    EXPRESSdump_schema(model->schema);*/
  811. }
  812.  
  813. #endif /*0*/
  814.