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 / EXPPP.C < prev    next >
C/C++ Source or Header  |  1994-07-21  |  45KB  |  2,099 lines
  1. #include <stdio.h>
  2. #include <memory.h>
  3. #include <malloc.h>
  4. #include <stdlib.h>
  5. #ifdef __STDC__
  6. #include <stdarg.h>
  7. #else
  8. #include <varargs.h>
  9. #endif
  10.  
  11. /*extern char *sys_errlist[];
  12. int errno;  */
  13.  
  14. #include <expbasic.h>
  15. #include <express.h>
  16. #include <exppp.h>
  17.  
  18. void ALGscope_out(Scope s, int level);
  19. void ENTITYattrs_out(Linked_List attributes,int derived,int level);
  20. void ENTITY_out(Entity e,int level);
  21. void ENTITYinverse_out(Linked_List attrs,int level);
  22. void ENTITYunique_out(Linked_List u,int level);
  23. int  EXPRlength(Expression e);
  24. void EXPRop_out(struct Op_Subexpression *oe,int paren);
  25. void EXPRop_string(char *buffer,struct Op_Subexpression *oe);
  26. void EXPRop1_out(struct Op_Subexpression *eo,char *opcode,int paren);
  27. void EXPRop2_out(struct Op_Subexpression *eo,char *opcode,int paren,int pad);
  28. void EXPR_out(Expression expr,int paren);
  29. void EXPRbounds_out(TypeBody tb);
  30. void FUNC_out(Function fn,int level);
  31. void LOOPout(struct Loop *loop,int level);
  32. void PROC_out(Procedure p,int level);
  33. void REFout(Dictionary refdict,Linked_List reflist,char *type,int level);
  34. void RULE_out(Rule r,int level);
  35. void SCOPEalgs_out(Scope s,int level);
  36. void SCOPEconsts_out(Scope s,int level);
  37. void SCOPEentities_out(Scope s,int level);
  38. void SCOPElocals_out(Scope s,int level);
  39. void SCOPEtypes_out(Scope s, int level);
  40. void STMT_out(Statement s,int level);
  41. void STMTlist_out(Linked_List stmts,int level);
  42. void TYPE_out(Type t, int level);
  43. void TYPE_head_out(Type t,int level);
  44. void TYPE_body_out(Type t, int level);
  45. void TYPEunique_or_optional_out(TypeBody tb);
  46. void WHERE_out(Linked_List wheres,int level);
  47.  
  48. static Error ERROR_select_empty;
  49.  
  50. int exppp_nesting_indent = 2;        /* default nesting indent */
  51. int exppp_continuation_indent = 4;    /* default nesting indent for */
  52.                     /* continuation lines */
  53. int exppp_linelength = 75;        /* leave some slop for closing */
  54.                     /* parens.  \n is not included in */
  55.                     /* this count either */
  56.  
  57. int indent2;        /* where continuation lines start */
  58. int curpos;        /* current line position (1 is first position) */
  59.  
  60. #define NOLEVEL -1    /* unused-level indicator */
  61.  
  62. char *exppp_output_filename = (char *)0;    /* if this is set, override */
  63.             /* default output filename */
  64. char filename[1000];    /* output file name */
  65. Symbol error_sym;    /* only used when printing errors */
  66.  
  67.  
  68.  
  69. int exppp_alphabetize = false;
  70.  
  71. int exppp_terse = false;
  72.  
  73. int exppp_reference_info = false;    /* if true, add commentary */
  74.                     /* about where things came from */
  75.  
  76. int exppp_rmpp = true;
  77. char rmfilename[] = "rmpp";
  78. FILE *rm;
  79.  
  80. char *rmheader[] = {
  81. "# This file was generated by exppp (an EXPRESS Pretty Printer)"    ,
  82. "# written at the National Institute of Standards and Technology"    ,
  83. "# by Don Libes, February 19, 1993."                    ,
  84. ""                                    ,
  85. "# Run this script from the shell to remove any files created by"    ,
  86. "# the last run of exppp."                        ,
  87. ""                                    ,
  88. 0};
  89.  
  90. FILE *exppp_fp = stdout;        /* output file */
  91. char *exppp_buf = 0;        /* output buffer */
  92. int exppp_maxbuflen = 0;        /* size of expppbuf */
  93. int exppp_buflen = 0;        /* remaining space in expppbuf */
  94. char *exppp_bufp = 0;        /* pointer to write position in expppbuf */
  95.                 /* should usually be pointing to a "\0" */
  96.  
  97. /* count newlines in a string */
  98. int
  99. count_newlines(s)
  100. char *s;
  101. {
  102.     int count = 0;
  103.     for (;*s;s++) {
  104.         if (*s == '\n') count++;
  105.     }
  106.     return count;
  107. }
  108.  
  109. void
  110. exp_output(char *buf, int len)
  111. {
  112.     FILE *fp = (exppp_fp?exppp_fp:stdout);
  113.  
  114.     error_sym.line += count_newlines(buf);
  115.  
  116.     if (exppp_buf) {
  117.         /* output to string */
  118.         if (len > exppp_buflen) {
  119.             /* should provide flag to enable complaint */
  120.             /* for now, just ignore */
  121.             return;
  122.         }
  123.         memcpy(exppp_bufp,buf,len+1);
  124.         exppp_bufp += len;
  125.         exppp_buflen -= len;
  126.     } else {
  127.         /* output to file */
  128.         fwrite(buf,1,len,fp);
  129.     }
  130. }
  131.  
  132. void
  133. #ifdef __STDC__
  134. wrap(char *fmt, ...)
  135. {
  136. #else
  137. wrap(va_alist)
  138. va_dcl
  139. {
  140.     char *fmt;
  141. #endif
  142.     FILE *f = exppp_fp;
  143.     char *p;
  144.     char buf[10000];
  145.     int len;
  146.     va_list args;
  147. #ifdef __STDC__
  148.     va_start(args,fmt);
  149. #else
  150.     va_start(args);
  151.     fmt = va_arg(args,char *);
  152. #endif
  153.  
  154.     vsprintf(buf,fmt,args);
  155.     len = strlen(buf);
  156.  
  157.     /* 1st condition checks if string cant fit into current line */
  158.     /* 2nd condition checks if string cant fit into any line */
  159.     /* I.e., if we still can't fit after indenting, don't bother to */
  160.     /* go to newline, just print a long line */
  161.     if (( (curpos + len) > exppp_linelength) &&
  162.         ((indent2 + len) < exppp_linelength)) {
  163.         /* move to new continuation line */
  164.         char line[1000];
  165.         sprintf(line,"\n%*s",indent2,"");
  166.         exp_output(line,1+indent2);
  167.  
  168.         curpos = indent2;        /* reset current position */
  169.     }
  170.  
  171.     exp_output(buf,len);
  172.  
  173.     if (len) {
  174.         /* reset cur position based on last newline seen */
  175.         if (0 == (p = strrchr(buf,'\n'))) {
  176.             curpos += len;
  177.         } else {
  178.             curpos = len + buf - p;
  179.         }
  180.     }
  181. }
  182.  
  183. void
  184. #ifdef __STDC__
  185. raw(char *fmt, ...)
  186. {
  187. #else
  188. raw(va_alist)
  189. va_dcl
  190. {
  191.     char *fmt;
  192. #endif
  193.     FILE *f = exppp_fp;
  194.     char *p;
  195.     char buf[10000];
  196.     int len;
  197.     va_list args;
  198. #ifdef __STDC__
  199.     va_start(args,fmt);
  200. #else
  201.     va_start(args);
  202.     fmt = va_arg(args,char *);
  203. #endif
  204.  
  205.     vsprintf(buf,fmt,args);
  206.     len = strlen(buf);
  207.  
  208.     exp_output(buf,len);
  209.  
  210.     if (len) {
  211.         /* reset cur position based on last newline seen */
  212.         if (0 == (p = strrchr(buf,'\n'))) {
  213.             curpos += len;
  214.         } else {
  215.             curpos = len + buf - p;
  216.         }
  217.     }
  218. }
  219.  
  220. void
  221. exppp_init()
  222. {
  223.     static int first_time = true;
  224.  
  225.     if (!first_time) return;
  226.     first_time = false;
  227.  
  228.     ERROR_select_empty = ERRORcreate(
  229. "select type %s has no members",SEVERITY_ERROR);
  230. }
  231.  
  232. void
  233. EXPRESSout(Express e)
  234. {
  235.     Schema s;
  236.     DictionaryEntry de;
  237.     char **hp; 
  238.     int dummy=0;
  239.  
  240.     exppp_init();
  241.  
  242.     if (exppp_rmpp) {
  243.         if (!(rm = fopen(rmfilename,"w"))) {
  244.             ERRORreport(ERROR_file_unwriteable,rmfilename,sys_errlist[errno]);
  245.             return;
  246.         }
  247.  
  248.         for (hp=rmheader;*hp;hp++) {
  249.             fprintf(rm,"%s\n",*hp);
  250.         }
  251.         fprintf(rm,"rm -f");
  252.     }
  253.  
  254.     DICTdo_init(e->symbol_table,&de);
  255.     while (0 != (s = (Schema)DICTdo(&de))) {
  256.         (void) SCHEMAout(s);
  257.     }
  258.  
  259.     if (exppp_rmpp) {
  260.         fprintf(rm," %s\n",rmfilename);
  261.  
  262.         /* owner+group executable, readable to world */
  263.         if (dummy=32) {
  264.             fprintf(stderr,"%s: could not mark %s executable (%s)\n",
  265.                 EXPRESSprogram_name,rmfilename,sys_errlist[errno]);
  266.             return;
  267.         }
  268.     }
  269. }
  270.  
  271. void
  272. exppp_ref_info(Symbol *s)
  273. {
  274.     if (exppp_reference_info) {
  275.         raw("--info %s %s %d\n",s->name,s->filename,s->line);
  276.     }
  277. }
  278.  
  279. /* normally all non-schema objects start out by printing a newline */
  280. /* however, this is undesirable when printing out single objects */
  281. /* use this variable to avoid it */
  282. static int first_line = true;        /* if first line */
  283.  
  284. static void
  285. first_newline()
  286. {
  287.     if (first_line) first_line = false;
  288.     else raw("\n");
  289. }
  290.  
  291. char *        /* returns name of file written to in static storage */
  292. SCHEMAout(Schema s)
  293. {
  294. #define BUFSIZE        80
  295.     char buf[BUFSIZE];
  296.     char expheader[BUFSIZE];    
  297.     char *p;
  298.     FILE *f;
  299.     int level = 0;
  300.     char **hp;
  301.     int described = false;
  302.  
  303.     if (exppp_output_filename) strcpy(filename,exppp_output_filename);
  304.     else {
  305.         /* since we have to generate a filename, make sure we don't */
  306.         /* overwrite a valuable file */
  307.  
  308.         sprintf(filename,"%s.exp",s->symbol.name);
  309.  
  310.         if (0 != (f = fopen(filename,"r"))) {
  311.             fgets(buf,BUFSIZE,f);
  312.             if (0 != (p = strchr(buf,'\n'))) *p = '\0';
  313.             /*if (streq(buf,expheader[0])) {
  314.                 unlink(filename);
  315.             } else {
  316.                 fprintf(stderr,"%s: %s already exists and appears to be hand-written\n",
  317.                     EXPRESSprogram_name,filename);
  318.                 strcat(bp,".pp");
  319.                 strcat(filename,".pp");
  320.                 fprintf(stderr,"%s: writing schema file %s instead\n",
  321.                     EXPRESSprogram_name,filename);
  322.                 described = true;
  323.             }  */
  324.         }
  325.         fclose(f);
  326.     }
  327.     error_sym.filename = filename;
  328.  
  329.     if (!described && !exppp_terse) {
  330.         fprintf(stdout,"%s: writing schema file %s\n",EXPRESSprogram_name,filename);
  331.     }
  332.     if (!(exppp_fp = f = fopen(filename,"w"))) {
  333.         ERRORreport(ERROR_file_unwriteable,filename,sys_errlist[errno]);
  334.         return 0;
  335.     }
  336.  
  337.     if (exppp_rmpp && rm) fprintf(rm," %s",filename);
  338.  
  339.     error_sym.line = 1;
  340.     for (hp=expheader;*hp;hp++) {
  341.         raw("%s\n",*hp);
  342.     }
  343.  
  344.     first_newline();
  345.  
  346.     raw("SCHEMA %s;\n",s->symbol.name);
  347.  
  348.     if (  s->u.schema->usedict || s->u.schema->uselist
  349.        || s->u.schema->refdict || s->u.schema->reflist) raw("\n");
  350.  
  351.     REFout(s->u.schema->usedict,s->u.schema->uselist,"USE",level+exppp_nesting_indent);
  352.     REFout(s->u.schema->refdict,s->u.schema->reflist,"REFERENCE",level+exppp_nesting_indent);
  353.  
  354.     SCOPEconsts_out(s,level+exppp_nesting_indent);
  355.     SCOPEtypes_out(s,level+exppp_nesting_indent);
  356.     SCOPEentities_out(s,level+exppp_nesting_indent);
  357.     SCOPEalgs_out(s,level+exppp_nesting_indent);
  358.  
  359.     raw("\nEND_SCHEMA; -- %s\n",s->symbol.name);
  360.  
  361.     fclose(exppp_fp);
  362.  
  363.     return filename;
  364. }
  365.  
  366. void
  367. REFout(Dictionary refdict,Linked_List reflist,char *type,int level)
  368. {
  369.     Dictionary dict;
  370.     DictionaryEntry de;
  371.     struct Rename *r;
  372.     Linked_List list;
  373.  
  374.     LISTdo(reflist,s,Schema)
  375.         raw("%s FROM %s;\n",type,s->symbol.name);
  376.     LISTod
  377.  
  378.     if (!refdict) return;
  379.     dict = DICTcreate(10);
  380.  
  381.     /* sort each list by schema */
  382.  
  383.     /* step 1: for each entry, store it in a schema-specific list */
  384.     DICTdo_init(refdict,&de);
  385.     while (0 != (r = (struct Rename *)DICTdo(&de))) {
  386.         Linked_List list;
  387.  
  388.         list = (Linked_List)DICTlookup(dict,r->schema->symbol.name);
  389.         if (!list) {
  390.             list = LISTcreate();
  391.             DICTdefine(dict,r->schema->symbol.name,list,
  392.                 (Symbol *)0,OBJ_UNKNOWN);
  393.         }
  394.         LISTadd(list,r);
  395.     }
  396.  
  397.     /* step 2: for each list, print out the renames */
  398.     level = 6;    /* no special reason, feels good */
  399.     indent2 = level + exppp_continuation_indent;
  400.     DICTdo_init(dict,&de);
  401.     while (0 != (list = (Linked_List)DICTdo(&de))) {
  402.         int first_time = true;
  403.         LISTdo(list,r,struct Rename *)
  404.             if (first_time) {
  405.                 raw("%s FROM %s\n",type,r->schema->symbol.name);
  406.             } else {
  407.                 /* finish previous line */
  408.                 raw(",\n");
  409.             }
  410.  
  411.             if (first_time) {
  412.                 raw("%*s(",level,"");
  413.                 first_time = false;
  414.             } else {
  415.                 raw("%*s ",level,"");
  416.             }
  417.             raw(r->old->name);
  418.             if (r->old != r->new) {
  419.                 wrap(" AS %s",r->new->name);
  420.             }
  421.         LISTod
  422.         raw(");\n");
  423.     }
  424.     HASHdestroy(dict);
  425. }
  426.  
  427. void
  428. ALGscope_out(Scope s, int level)
  429. {
  430.     SCOPEtypes_out(s,level);
  431.     SCOPEentities_out(s,level);
  432.     SCOPEalgs_out(s,level);
  433.  
  434.     SCOPEconsts_out(s,level);
  435.     SCOPElocals_out(s,level);
  436. }
  437.  
  438. void
  439. SCOPEadd_inorder(Linked_List list,Scope s)
  440. {
  441.     Link k = 0;
  442.  
  443.     LISTdo_links(list,link)
  444.         if (0 > strcmp(
  445.                 SCOPEget_name(s),
  446.                 SCOPEget_name((Type)(link->data)))) {
  447.             k = link;
  448.             break;
  449.         }
  450.     LISTod
  451.  
  452.     LISTadd_before(list,k,(Generic)s);
  453. }
  454.  
  455. /* print the rules in a scope */
  456. void
  457. SCOPErules_out(Scope s,int level)
  458. {
  459.     Rule r;
  460.     DictionaryEntry de;
  461.  
  462.     if (exppp_alphabetize == false) {
  463.         DICTdo_type_init(s->symbol_table,&de,OBJ_RULE);
  464.         while (0 != (r = (Rule)DICTdo(&de))) {
  465.             RULE_out(r,level);
  466.         }
  467.     } else {
  468.         Linked_List alpha = LISTcreate();
  469.  
  470.         DICTdo_type_init(s->symbol_table,&de,OBJ_RULE);
  471.         while (0 != (r = (Rule)DICTdo(&de))) {
  472.             SCOPEadd_inorder(alpha,r);
  473.         }
  474.  
  475.         LISTdo(alpha,r,Rule)
  476.             RULE_out(r,level);
  477.         LISTod
  478.  
  479.         LISTfree(alpha);
  480.     }
  481.  
  482. }
  483.  
  484. /* print the functions in a scope */
  485. void
  486. SCOPEfuncs_out(Scope s,int level)
  487. {
  488.     Function f;
  489.     DictionaryEntry de;
  490.  
  491.     if (exppp_alphabetize == false) {
  492.         DICTdo_type_init(s->symbol_table,&de,OBJ_FUNCTION);
  493.         while (0 != (f = (Function)DICTdo(&de))) {
  494.             FUNC_out(f,level);
  495.         }
  496.     } else {
  497.         Linked_List alpha = LISTcreate();
  498.  
  499.         DICTdo_type_init(s->symbol_table,&de,OBJ_FUNCTION);
  500.         while (0 != (f = (Function)DICTdo(&de))) {
  501.             SCOPEadd_inorder(alpha,f);
  502.         }
  503.  
  504.         LISTdo(alpha,f,Function)
  505.             FUNC_out(f,level);
  506.         LISTod
  507.  
  508.         LISTfree(alpha);
  509.     }
  510.  
  511. }
  512.  
  513. /* print the procs in a scope */
  514. void
  515. SCOPEprocs_out(Scope s,int level)
  516. {
  517.     Procedure p;
  518.     DictionaryEntry de;
  519.  
  520.     if (exppp_alphabetize == false) {
  521.         DICTdo_type_init(s->symbol_table,&de,OBJ_PROCEDURE);
  522.         while (0 != (p = (Procedure)DICTdo(&de))) {
  523.             PROC_out(p,level);
  524.         }
  525.     } else {
  526.         Linked_List alpha = LISTcreate();
  527.  
  528.         DICTdo_type_init(s->symbol_table,&de,OBJ_PROCEDURE);
  529.         while (0 != (p = (Procedure)DICTdo(&de))) {
  530.             SCOPEadd_inorder(alpha,p);
  531.         }
  532.  
  533.         LISTdo(alpha,p,Procedure)
  534.             PROC_out(p,level);
  535.         LISTod
  536.  
  537.         LISTfree(alpha);
  538.     }
  539.  
  540. }
  541.  
  542. /* print the algorithms in a scope */
  543. void
  544. SCOPEalgs_out(Scope s,int level)
  545. {
  546.     /* Supplementary Directivies 2.1.1 requires rules to be separated */
  547.     /* might as well separate funcs and procs, too */
  548.     SCOPErules_out(s,level);
  549.     SCOPEfuncs_out(s,level);
  550.     SCOPEprocs_out(s,level);
  551. }
  552.  
  553. void
  554. RULE_out(Rule r,int level)
  555. {
  556.     int i = 0;
  557.  
  558.     first_newline();
  559.     exppp_ref_info(&r->symbol);
  560.  
  561.     raw("%*sRULE %s FOR (",level,"",r->symbol.name);
  562.  
  563.     LISTdo(r->u.rule->parameters,p,Variable)
  564.         i++;
  565.         if (i != 1) raw(", ");
  566.         wrap(p->name->symbol.name);
  567.     LISTod
  568.     raw(");\n");
  569.  
  570.     ALGscope_out(r,level+exppp_nesting_indent);
  571.     STMTlist_out(r->u.rule->body,level+exppp_nesting_indent);
  572.     raw("\n");
  573.     WHERE_out(RULEget_where(r),level);
  574.  
  575.     raw("\n%*sEND_RULE; -- %s\n",level,"",r->symbol.name);
  576. }
  577.  
  578. /* last arg is not terminated with ; or \n */
  579. void
  580. ALGargs_out(Linked_List args,int level)
  581. {
  582.     Type previoustype = 0;
  583.     indent2 = level + exppp_continuation_indent;
  584.  
  585.     /* combine adjacent parameters that have the same type */
  586.  
  587.     LISTdo(args,v,Variable)
  588.         if (previoustype != v->type) {
  589.             if (previoustype) {
  590.                 wrap(":");
  591.                 TYPE_head_out(previoustype,NOLEVEL);
  592.                 raw(";\n");
  593.             }
  594.             raw("%*s",level,"");
  595.             EXPR_out(VARget_name(v),0);
  596.         } else {
  597.             raw(", ");
  598.             EXPR_out(VARget_name(v),0);
  599.         }
  600.         previoustype = v->type;
  601.     LISTod
  602.  
  603.     wrap(":");
  604.     TYPE_head_out(previoustype,NOLEVEL);
  605. }
  606.  
  607. void
  608. FUNC_out(Function fn,int level)
  609. {
  610.     if (fn->u.func->builtin) return;
  611.  
  612.     first_newline();
  613.     exppp_ref_info(&fn->symbol);
  614.  
  615.     raw("%*sFUNCTION %s",level,"",fn->symbol.name);
  616.     if (fn->u.func->parameters) {
  617.         raw("(\n");
  618.         ALGargs_out(fn->u.func->parameters,level+strlen("FUNCTION     "));
  619.         raw("\n%*s)",level+exppp_continuation_indent,"");
  620.     }
  621.     raw(":");
  622.  
  623.     indent2 = curpos + exppp_continuation_indent;
  624.     TYPE_head_out(fn->u.func->return_type,NOLEVEL);
  625.     raw(";\n");
  626.  
  627.     ALGscope_out(fn,level+exppp_nesting_indent);
  628.     STMTlist_out(fn->u.proc->body,level+exppp_nesting_indent);
  629.  
  630.     raw("\n%*sEND_FUNCTION; -- %s\n",level,"",fn->symbol.name);
  631. }
  632. void
  633. PROC_out(Procedure p,int level)
  634. {
  635.     if (p->u.proc->builtin) return;
  636.  
  637.     first_newline();
  638.     exppp_ref_info(&p->symbol);
  639.  
  640.     raw("%*sPROCEDURE %s(\n",level,"",p->symbol.name);
  641.  
  642.     ALGargs_out(p->u.proc->parameters,level+strlen("PROCEDURE     "));
  643.  
  644.     raw("*%s);\n",level+exppp_nesting_indent,"");
  645.  
  646.     ALGscope_out(p,level+exppp_nesting_indent);
  647.     STMTlist_out(p->u.proc->body,level+exppp_nesting_indent);
  648.  
  649.     raw("\n%*sEND_PROCEDURE; -- %s\n",level,"",p->symbol.name);
  650. }
  651.  
  652. void
  653. SCOPEconsts_out(Scope s,int level)
  654. {
  655.     Variable v;
  656.     DictionaryEntry de;
  657.     int max_indent = 0;
  658.     Dictionary d = s->symbol_table;
  659.  
  660.     DICTdo_type_init(d,&de,OBJ_VARIABLE);
  661.     while (0 != (v = (Variable)DICTdo(&de))) {
  662.         if (!v->flags.constant) continue;
  663.         if (strlen(v->name->symbol.name) > max_indent)
  664.             max_indent = strlen(v->name->symbol.name);
  665.     }
  666.  
  667.     if (!max_indent) return;
  668.  
  669.     first_newline();
  670.  
  671.     raw("%*sCONSTANT\n",level,"");
  672.  
  673.     indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;
  674.  
  675.     DICTdo_type_init(d,&de,OBJ_VARIABLE);
  676.     while (0 != (v = (Variable)DICTdo(&de))) {
  677.         if (!v->flags.constant) continue;
  678.  
  679.         /* print attribute name */
  680.         raw("%*s%-*s :",level,"",
  681.             max_indent,v->name->symbol.name);
  682.  
  683.         /* print attribute type */
  684.         if (VARget_optional(v)) wrap(" OPTIONAL");
  685.         TYPE_head_out(v->type,NOLEVEL);
  686.  
  687.         if (v->initializer) {
  688.             wrap(" := ");
  689.             EXPR_out(v->initializer,0);
  690.         }
  691.  
  692.         raw(";\n");
  693.     }
  694.         
  695.     raw("%*sEND_CONSTANT;\n",level,"");
  696. }
  697.  
  698. void
  699. SCOPElocals_out(Scope s,int level)
  700. {
  701.     Variable v;
  702.     DictionaryEntry de;
  703.     int max_indent = 0;
  704.     Dictionary d = s->symbol_table;
  705.  
  706.     DICTdo_type_init(d,&de,OBJ_VARIABLE);
  707.     while (0 != (v = (Variable)DICTdo(&de))) {
  708.         if (v->flags.constant) continue;
  709.         if (v->flags.parameter) continue;
  710.         if (strlen(v->name->symbol.name) > max_indent)
  711.             max_indent = strlen(v->name->symbol.name);
  712.     }
  713.  
  714.     if (!max_indent) return;
  715.  
  716.     first_newline();
  717.  
  718.     raw("%*sLOCAL\n",level,"");
  719.     indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;
  720.  
  721.     DICTdo_type_init(d,&de,OBJ_VARIABLE);
  722.     while (0 != (v = (Variable)DICTdo(&de))) {
  723.         if (v->flags.constant) continue;
  724.         if (v->flags.parameter) continue;
  725.  
  726.         /* print attribute name */
  727.         raw("%*s%-*s :",level+exppp_nesting_indent,"",
  728.             max_indent,v->name->symbol.name);
  729.  
  730.         /* print attribute type */
  731.         if (VARget_optional(v)) wrap(" OPTIONAL");
  732.         TYPE_head_out(v->type,NOLEVEL);
  733.  
  734.         if (v->initializer) {
  735.             wrap(" := ");
  736.             EXPR_out(v->initializer,0);
  737.         }
  738.  
  739.         raw(";\n");
  740.     }
  741.         
  742.     raw("%*sEND_LOCAL;\n",level,"");
  743. }
  744.  
  745. void LOOPout(struct Loop *loop,int level)
  746. {
  747.     Variable v;
  748.  
  749.     raw("%*sREPEAT",level,"");
  750.  
  751.     /* increment */
  752. /*    if (loop->scope->u.incr) {*/
  753.     if (loop->scope) {
  754.         DictionaryEntry de;
  755.  
  756.         DICTdo_init(loop->scope->symbol_table,&de);
  757.         v = (Variable)DICTdo(&de);
  758.         wrap(" %s := ",v->name->symbol.name);
  759.         EXPR_out(loop->scope->u.incr->init,0);
  760.         wrap(" TO ");
  761.         EXPR_out(loop->scope->u.incr->end,0);
  762.         wrap(" BY ");    /* parser always forces a "by" expr */
  763.         EXPR_out(loop->scope->u.incr->increment,0);
  764.     }
  765.  
  766.     /* while */
  767.     if (loop->while_expr) {
  768.         wrap(" WHILE ");
  769.         EXPR_out(loop->while_expr,0);
  770.     }
  771.  
  772.     /* until */
  773.     if (loop->until_expr) {
  774.         wrap(" UNTIL ");
  775.         EXPR_out(loop->until_expr,0);
  776.     }
  777.  
  778.     raw(";\n");
  779.  
  780.     STMTlist_out(loop->statements,level+exppp_nesting_indent);
  781.  
  782.     raw("%*sEND_REPEAT;\n",level,"");
  783. }
  784.  
  785. void
  786. CASEout(struct Case_Statement *c,int level)
  787. {
  788.     int len;
  789.     char *string;
  790.     int max_indent;
  791.  
  792.     raw("%*sCASE ",level,"");
  793.     EXPR_out(c->selector,0);
  794.     wrap(" OF\n");
  795.  
  796.     /* pass 1: calculate length of longest label */
  797.     max_indent = 0;
  798.     LISTdo(c->cases,ci,Case_Item)
  799.         LISTdo(ci->labels,label,Expression)
  800.             if (label) {
  801.                 len = EXPRlength(label);
  802.             } else {
  803.                 len = strlen("OTHERWISE");
  804.             }
  805.             if (len > max_indent)
  806.                 max_indent = len;
  807.         LISTod
  808.     LISTod
  809.  
  810.     level += exppp_nesting_indent;
  811.  
  812.     /* pass 2: print them */
  813.     LISTdo(c->cases,ci,Case_Item)
  814.         LISTdo(ci->labels,label,Expression)
  815.             /* print label(s) */
  816.             indent2 = level + exppp_continuation_indent;
  817.             raw("%*s",level,"");
  818.             if (label) {
  819.                 EXPR_out(label,0);
  820.             } else {
  821.                 raw("OTHERWISE");
  822.             }
  823.  
  824.             raw("%*s : ",level+max_indent - curpos,"");
  825.  
  826.             /* print action */
  827.             STMT_out(ci->action,level+exppp_nesting_indent);
  828.         LISTod
  829.     LISTod
  830.  
  831.     raw("%*sEND_CASE;\n",level,"");
  832. }
  833.  
  834. void
  835. STMT_out(Statement s,int level)
  836. {
  837.     int first_time = true;
  838.  
  839.     if (!s) {    /* null statement */
  840.         raw("%*s;\n",level,"");
  841.         return;
  842.     }
  843.  
  844.     indent2 = level + exppp_continuation_indent;
  845.  
  846.     switch (s->type) {
  847.     case STMT_ASSIGN:
  848.         raw("%*s",level,"");
  849.         EXPR_out(s->u.assign->lhs,0);
  850.         wrap(" := ");
  851.         EXPR_out(s->u.assign->rhs,0);
  852.         raw(";\n",level,"");
  853.         break;
  854.     case STMT_CASE:
  855.         CASEout(s->u.Case,level);
  856.         break;
  857.     case STMT_COMPOUND:
  858.         raw("%*sBEGIN\n",level,"");
  859.         STMTlist_out(s->u.compound->statements,level+exppp_nesting_indent);
  860.         raw("%*sEND;\n",level,"");
  861.         break;
  862.     case STMT_COND:
  863.         raw("%*sIF ",level,"");
  864.         EXPR_out(s->u.cond->test,0);
  865.         wrap(" THEN\n");
  866.         STMTlist_out(s->u.cond->code,level+exppp_nesting_indent);
  867.         if (s->u.cond->otherwise) {
  868.             raw("%*sELSE\n",level,"");
  869.             STMTlist_out(s->u.cond->otherwise,level+exppp_nesting_indent);
  870.         }
  871.         raw("%*sEND_IF;\n",level,"");
  872.         break;
  873.     case STMT_LOOP:
  874.         LOOPout(s->u.loop,level);
  875.         break;
  876.     case STMT_PCALL:
  877.         raw("%*s%s(",level,"",s->symbol.name);
  878.         LISTdo(s->u.proc->parameters,p,Expression)
  879.             if (first_time) first_time = false;
  880.             else raw(",");
  881.             EXPR_out(p,0);
  882.         LISTod
  883.         raw(");\n");
  884.         break;
  885.     case STMT_RETURN:
  886.         raw("%*sRETURN",level,"");
  887.         if (s->u.ret->value) {
  888.             wrap("(");
  889.             EXPR_out(s->u.ret->value,0);
  890.             raw(")");
  891.         }
  892.         raw(";\n");
  893.         break;
  894.     case STMT_ALIAS:
  895.         raw("%*sALIAS %s for %s;\n",level,"",s->symbol.name,
  896. /* should be generalized reference */
  897.             s->u.alias->variable->name->symbol.name);
  898.         STMTlist_out(s->u.alias->statements,level+exppp_nesting_indent);
  899.         raw("%*sEND_ALIAS; -- %s\n",level,"",s->symbol.name);
  900.         break;
  901.     case STMT_SKIP:
  902.         raw("%*sSKIP;\n",level,"");
  903.         break;
  904.     case STMT_ESCAPE:
  905.         raw("%*sESCAPE;\n",level,"");
  906.         break;
  907.     }
  908. }
  909.  
  910. void STMTlist_out(Linked_List stmts,int level)
  911. {
  912.     LISTdo(stmts,stmt,Statement)
  913.         STMT_out(stmt,level);
  914.     LISTod
  915. }
  916.  
  917. /* print all entities in a scope */
  918. void
  919. SCOPEentities_out(Scope s,int level)
  920. {
  921.     Entity e;
  922.     DictionaryEntry de;
  923.  
  924.     if (exppp_alphabetize == false) {
  925.         DICTdo_type_init(s->symbol_table,&de,OBJ_ENTITY);
  926.         while (0 != (e = (Entity)DICTdo(&de))) {
  927.             ENTITY_out(e,level);
  928.         }
  929.     } else {
  930.         Linked_List alpha = LISTcreate();
  931.  
  932.         DICTdo_type_init(s->symbol_table,&de,OBJ_ENTITY);
  933.         while (0 != (e = (Entity)DICTdo(&de))) {
  934.             SCOPEadd_inorder(alpha,e);
  935.         }
  936.  
  937.         LISTdo(alpha,e,Entity)
  938.             ENTITY_out(e,level);
  939.         LISTod
  940.  
  941.         LISTfree(alpha);
  942.     }
  943. }
  944.  
  945. void
  946. SUBTYPEout(Expression e)
  947. {
  948.     /* language insists on having parens around entity names */
  949.     /* even if there is only one, but if the expression is */
  950.     /* complex, EXPRout will add on its own parens */
  951. /*    if (TYPEis_expression(e->type)) {*/
  952.         raw("(");
  953. /*    }*/
  954.  
  955.     EXPR_out(e,0);
  956.  
  957. /*    if (TYPEis_expression(e->type)) {*/
  958.         raw(")");
  959. /*    }*/
  960. }
  961.  
  962. #define EXPLICIT 0
  963. #define DERIVED 1
  964.  
  965. void
  966. ENTITY_out(Entity e,int level)
  967. {
  968.     int first_time = true;
  969.  
  970.     first_newline();
  971.     exppp_ref_info(&e->symbol);
  972.  
  973.     raw("%*sENTITY %s",level,"",e->symbol.name);
  974.  
  975.     level += exppp_nesting_indent;
  976.     indent2 = level + exppp_continuation_indent;
  977.  
  978.     if (ENTITYget_abstract(e)) {
  979.         if (e->u.entity->subtype_expression) {
  980.             raw("\n%*sABSTRACT SUPERTYPE OF ",level,"");
  981.             SUBTYPEout(e->u.entity->subtype_expression);
  982.         } else {
  983.             raw("\n%*sABSTRACT SUPERTYPE",level,"");
  984.         }
  985.     } else {
  986.         if (e->u.entity->subtype_expression) {
  987.             raw("\n%*sSUPERTYPE OF ",level,"");
  988.             SUBTYPEout(e->u.entity->subtype_expression);
  989.         }
  990.     }
  991.  
  992.     if (e->u.entity->supertype_symbols) {
  993.         raw("\n%*sSUBTYPE OF (",level,"");
  994.  
  995.         LISTdo(e->u.entity->supertype_symbols,s,Symbol *)
  996.             if (first_time) {
  997.                 first_time = false;
  998.             } else {
  999.                 raw(", ");
  1000.             }
  1001.             wrap(s->name);
  1002.         LISTod
  1003.         raw(")");
  1004.     }
  1005.  
  1006.     raw(";\n");
  1007.  
  1008. #if 0
  1009.     /* add a little more space before entities if sub or super appears */
  1010.     if (e->u.entity->supertype_symbols || e->u.entity->subtype_expression) {
  1011.         raw("\n");
  1012.     }
  1013. #endif
  1014.  
  1015.     ENTITYattrs_out(e->u.entity->attributes,EXPLICIT,level);
  1016.     ENTITYattrs_out(e->u.entity->attributes,DERIVED,level);
  1017.     ENTITYinverse_out(e->u.entity->attributes,level);
  1018.     ENTITYunique_out(e->u.entity->unique,level);
  1019.     WHERE_out(TYPEget_where(e),level);
  1020.  
  1021.     level -= exppp_nesting_indent;
  1022.     raw("%*sEND_ENTITY; -- %s\n",level,"",e->symbol.name);
  1023. }
  1024.  
  1025. void
  1026. ENTITYunique_out(Linked_List u,int level)
  1027. {
  1028.     int i;
  1029.     int max_indent;
  1030.     Symbol *sym;
  1031.     int length;
  1032.  
  1033.     if (!u) return;
  1034.  
  1035.     raw("%*sUNIQUE\n",level,"");
  1036.  
  1037.     /* pass 1 */
  1038.     max_indent = 0;
  1039.     LISTdo(u,list,Linked_List)
  1040.         if (0 != (sym = (Symbol *)LISTget_first(list))) {
  1041.             length = strlen(sym->name);
  1042.             if (length > max_indent) max_indent = length;
  1043.         }
  1044.     LISTod
  1045.  
  1046.     level += exppp_nesting_indent;
  1047.     indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;
  1048.  
  1049.     LISTdo(u,list,Linked_List)
  1050.         i = 0;
  1051.         LISTdo(list,v,Variable)
  1052.             i++;
  1053.             if (i == 1) {
  1054.                 /* print label if present */
  1055.                 if (v) {
  1056.                     raw("%*s%-*s : ",level,"",
  1057.                         max_indent,((Symbol *)v)->name);
  1058.                 } else {
  1059.                     raw("%*s%-*s   ",level,"",
  1060.                         max_indent,"");
  1061.                 }
  1062.             } else {
  1063.                 if (i > 2) raw(", ");
  1064.                 EXPR_out(v->name,0);
  1065.             }
  1066.         LISTod
  1067.         raw(";\n");
  1068.     LISTod
  1069. }
  1070.  
  1071. void
  1072. ENTITYinverse_out(Linked_List attrs,int level)
  1073. {
  1074.     int length;
  1075.  
  1076.     int max_indent;
  1077.  
  1078.     /* pass 1: calculate length of longest attr name */
  1079.     max_indent = 0;
  1080.     LISTdo(attrs,v,Variable)
  1081.         if (v->inverse_symbol) {
  1082.             length = strlen(v->name->symbol.name);
  1083.             if (length > max_indent) max_indent = length;
  1084.         }
  1085.     LISTod
  1086.  
  1087.     if (max_indent == 0) return;
  1088.     raw("%*sINVERSE\n",level,"");
  1089.     level += exppp_nesting_indent;
  1090.     indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;
  1091.  
  1092.     /* pass 2: print them */
  1093.     LISTdo(attrs,v,Variable)
  1094.         if (v->inverse_symbol) {
  1095.             /* print attribute name */
  1096.             raw("%*s%-*s :",level,"",
  1097.                 max_indent,v->name->symbol.name);
  1098.  
  1099.             /* print attribute type */
  1100.             if (VARget_optional(v)) wrap(" OPTIONAL");
  1101.             TYPE_head_out(v->type,NOLEVEL);
  1102.  
  1103.             raw(" FOR ");
  1104.  
  1105.             wrap(v->inverse_attribute->name->symbol.name);
  1106.  
  1107.             raw(";\n");
  1108.         }
  1109.     LISTod
  1110. }
  1111.  
  1112. void
  1113. ENTITYattrs_out(Linked_List attrs,int derived,int level)
  1114. {
  1115.     int length;
  1116.  
  1117.     int max_indent;
  1118.  
  1119.     /* pass 1: calculate length of longest attr name */
  1120.     max_indent = 0;
  1121.     LISTdo(attrs,v,Variable)
  1122.         if (v->inverse_symbol) continue;
  1123.         if ((derived && v->initializer) ||
  1124.            (!derived && !v->initializer)) {
  1125.             length = EXPRlength(v->name);
  1126.             if (length > max_indent) max_indent = length;
  1127.         }
  1128.     LISTod
  1129.  
  1130.     if (max_indent == 0) return;
  1131.     if (derived) raw("%*sDERIVE\n",level,"");
  1132.     level += exppp_nesting_indent;
  1133.     indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;
  1134.  
  1135.     /* pass 2: print them */
  1136.     LISTdo(attrs,v,Variable)
  1137.         if (v->inverse_symbol) continue;
  1138.         if ((derived && v->initializer) ||
  1139.            (!derived && !v->initializer)) {
  1140.             /* print attribute name */
  1141.             raw("%*s",level,"");
  1142.             EXPR_out(v->name,0);
  1143.             raw("%*s :",level+max_indent+1 - curpos,"");
  1144.  
  1145.             /* print attribute type */
  1146.             if (VARget_optional(v)) wrap(" OPTIONAL");
  1147.             TYPE_head_out(v->type,NOLEVEL);
  1148.  
  1149.             if (derived && v->initializer) {
  1150.                 wrap(" := ");
  1151.                 EXPR_out(v->initializer,0);
  1152.             }
  1153.  
  1154.             raw(";\n");
  1155.         }
  1156.     LISTod
  1157. }
  1158.  
  1159. void
  1160. WHERE_out(Linked_List wheres,int level)
  1161. {
  1162.     int max_indent;
  1163.     if (!wheres) return;
  1164.  
  1165.     raw("%*s%s",level,"","WHERE\n");
  1166.     level += exppp_nesting_indent;
  1167.  
  1168.     /* pass 1: calculate length of longest label */
  1169.     max_indent = 0;
  1170.     LISTdo(wheres,w,Where)
  1171.         if (w->label) {
  1172.             if (strlen(w->label->name) > max_indent)
  1173.                 max_indent = strlen(w->label->name);
  1174.         }
  1175.     LISTod
  1176.  
  1177.     indent2 = level + max_indent + strlen(": ") + exppp_continuation_indent;
  1178.  
  1179.     /* pass 2: now print labels and exprs */
  1180.     LISTdo(wheres,w,Where)
  1181.         if (w->label) {
  1182.             raw("%*s%-*s: ",level,"",max_indent,w->label->name);
  1183.         } else {
  1184.             /* no label */
  1185.             raw("%*s%-*s  ",level,"",max_indent,"");
  1186.         }
  1187.         EXPR_out(w->expr,0); /*,max_indent);*/
  1188.         raw(";\n");
  1189.     LISTod
  1190. }
  1191.  
  1192. /* print all types in a scope */
  1193. void
  1194. SCOPEtypes_out(Scope s, int level)
  1195. {
  1196.     DictionaryEntry de;
  1197.     Type t;
  1198.  
  1199.     if (exppp_alphabetize == false) {
  1200.         DICTdo_type_init(s->symbol_table,&de,OBJ_TYPE);
  1201.         while (0 != (t = (Type)DICTdo(&de))) {
  1202.             TYPE_out(t,level);
  1203.         }
  1204.     } else {
  1205.         Linked_List alpha = LISTcreate();
  1206.  
  1207.         DICTdo_type_init(s->symbol_table,&de,OBJ_TYPE);
  1208.         while (0 != (t = (Type)DICTdo(&de))) {
  1209.             SCOPEadd_inorder(alpha,t);
  1210.         }
  1211.  
  1212.         LISTdo(alpha,t,Type)
  1213.             TYPE_out(t,level);
  1214.         LISTod
  1215.  
  1216.         LISTfree(alpha);
  1217.     }
  1218. }
  1219.  
  1220. /* print a type definition.  I.e., a TYPE statement */
  1221. void
  1222. TYPE_out(Type t, int level)
  1223. {
  1224.     first_newline();
  1225.     exppp_ref_info(&t->symbol);
  1226.  
  1227.     raw("%*sTYPE %s =",level,"",t->symbol.name);
  1228.     if (TYPEget_head(t)) {
  1229.         wrap(" %s",TYPEget_name(TYPEget_head(t)));
  1230.     } else {
  1231.         TYPE_body_out(t,level+exppp_nesting_indent);
  1232.     }        
  1233.  
  1234.     raw(";\n");
  1235.  
  1236.     WHERE_out(t->where,level);
  1237.  
  1238.     raw("%*sEND_TYPE; -- %s\n",level,"",t->symbol.name);
  1239. }
  1240.  
  1241. /* prints type description (preceded by a space).  I.e., the type of an */
  1242. /* attribute or other object */
  1243. void
  1244. TYPE_head_out(Type t,int level)
  1245. {
  1246.     if (t->symbol.name) {
  1247.         wrap(" %s",t->symbol.name);
  1248.     } else {
  1249.         TYPE_body_out(t,level);
  1250.     }
  1251. }
  1252.  
  1253. void TYPEunique_or_optional_out(TypeBody tb)
  1254. {
  1255.     if (tb->flags.unique)    wrap(" UNIQUE");
  1256.     if (tb->flags.optional)    wrap(" OPTIONAL");
  1257. }
  1258.  
  1259. void
  1260. TYPE_body_out(Type t, int level)
  1261. {
  1262.     int first_time = true;
  1263.  
  1264.     Expression expr;
  1265.     DictionaryEntry de;
  1266.  
  1267.     TypeBody tb = TYPEget_body(t);
  1268.  
  1269.     switch (tb->type) {
  1270.     case integer_:        wrap(" INTEGER");    break;
  1271.     case real_:        wrap(" REAL");    break;
  1272.     case string_:        wrap(" STRING");    break;
  1273.     case binary_:        wrap(" BINARY");    break;
  1274.     case boolean_:        wrap(" BOOLEAN");    break;
  1275.     case logical_:        wrap(" LOGICAL");    break;
  1276.     case number_:        wrap(" NUMBER");    break;
  1277.     case entity_:        wrap(" %s",tb->entity->symbol.name);
  1278.                 break;
  1279.     case aggregate_:
  1280.     case array_:
  1281.     case bag_:
  1282.     case set_:
  1283.     case list_:
  1284.         switch (tb->type) {
  1285.         /* ignore the aggregate bounds for now */
  1286.         case aggregate_:    wrap(" AGGREGATE");
  1287.                     if (tb->tag) {
  1288.                         wrap(":%s",tb->tag->symbol.name);
  1289.                     }
  1290.                     wrap(" OF");
  1291.                     break;
  1292.  
  1293.         case array_:        wrap(" ARRAY");
  1294.                     EXPRbounds_out(tb);
  1295.                     wrap(" OF");
  1296.                     TYPEunique_or_optional_out(tb);
  1297.                     break;
  1298.  
  1299.         case bag_:        wrap(" BAG");
  1300.                     EXPRbounds_out(tb);
  1301.                     wrap(" OF");
  1302.                     break;
  1303.  
  1304.         case set_:        wrap(" SET");
  1305.                     EXPRbounds_out(tb);
  1306.                     wrap(" OF");
  1307.                     break;
  1308.  
  1309.         case list_:        wrap(" LIST");
  1310.                     EXPRbounds_out(tb);
  1311.                     wrap(" OF");
  1312.                     TYPEunique_or_optional_out(tb);
  1313.                     break;
  1314.         }
  1315.  
  1316.         TYPE_head_out(tb->base,level);
  1317.         break;
  1318.     case enumeration_:
  1319.         wrap(" ENUMERATION OF\n");
  1320.         DICTdo_type_init(t->symbol_table,&de,OBJ_EXPRESSION);
  1321.         while (0 != (expr = (Expression)DICTdo(&de))) {
  1322.  
  1323.             /* finish line from previous enum item */
  1324.             if (!first_time) raw(",\n");
  1325.  
  1326.             /* start new enum item */
  1327.             if (first_time) {
  1328.                 raw("%*s(",level,"");
  1329.                 first_time = false;
  1330.             } else {
  1331.                 raw("%*s ",level,"");
  1332.             }
  1333.             raw(expr->symbol.name);
  1334.         }
  1335.         raw(")");
  1336.         break;
  1337.     case select_:
  1338.         wrap(" SELECT\n");
  1339.         LISTdo(tb->list,type,Type)
  1340.             /* finish line from previous entity */
  1341.             if (!first_time) raw(",\n");
  1342.  
  1343.             /* start new entity */
  1344.             if (first_time) {
  1345.                 raw("%*s(",level,"");
  1346.                 first_time = false;
  1347.             } else {
  1348.                 raw("%*s ",level,"");
  1349.             }
  1350.             raw(type->symbol.name);
  1351.         LISTod
  1352.  
  1353.         /* if empty, force a left paren */
  1354.         if (first_time) {
  1355.             ERRORreport_with_symbol(ERROR_select_empty,&error_sym,t->symbol.name);
  1356.             raw("%*s(",level,"");
  1357.         }
  1358.         raw(")");
  1359.         break;
  1360.     case generic_:
  1361.         wrap(" GENERIC");
  1362.         if (tb->tag) {
  1363.             wrap(":%s",tb->tag->symbol.name);
  1364.         }
  1365.         break;
  1366.     default:    wrap(" (* unknown type %d *)",tb->type);
  1367.     }
  1368.  
  1369.     if (tb->precision) {
  1370.         wrap(" (");
  1371.         EXPR_out(tb->precision,0);
  1372.         raw(")");
  1373.     }
  1374.     if (tb->flags.fixed)    wrap(" FIXED");
  1375. }
  1376.  
  1377. void
  1378. EXPRbounds_out(TypeBody tb)
  1379. {
  1380.     if (!tb->upper) return;
  1381.  
  1382.     wrap(" [");
  1383.     EXPR_out(tb->lower,0);
  1384.     wrap(":");
  1385.     EXPR_out(tb->upper,0);
  1386.     raw("]");
  1387. }
  1388.  
  1389. /* if paren == 1, parens are added to prevent possible rebind by */
  1390.         /* higher-level context */
  1391. /* if paren == 0, then parens may be omitted without consequence */
  1392. void
  1393. EXPR_out(Expression e,int paren)
  1394. {
  1395.     int i;    /* trusty temporary */
  1396.  
  1397.     switch (TYPEis(e->type)) {
  1398.     case integer_:
  1399.         if (e == LITERAL_INFINITY) {
  1400.             wrap("?");
  1401.         } else {    
  1402.             wrap("%d",e->u.integer);
  1403.         }
  1404.         break;
  1405.     case real_:
  1406.         if (e == LITERAL_PI) {
  1407.             wrap("PI");
  1408.         } else if (e == LITERAL_E) {
  1409.             wrap("E");
  1410.         } else {
  1411.             wrap("%g",e->u.real);
  1412.         }
  1413.         break;
  1414.     case binary_:
  1415.         wrap("%%%s",e->u.binary);    /* put "%" back */
  1416.         break;
  1417.     case logical_:
  1418.     case boolean_:
  1419.         switch (e->u.logical) {
  1420.         case Ltrue:  wrap("TRUE");       break;
  1421.         case Lfalse: wrap("FALSE");   break;
  1422.         default:     wrap("UNKNOWN"); break;
  1423.         }
  1424.         break;
  1425.     case string_:
  1426.         if (TYPEis_encoded(e->type)) {
  1427.             wrap("\"%s\"",e->symbol.name);
  1428.         } else {
  1429.             wrap("'%s'",e->symbol.name);
  1430.         }
  1431.         break;
  1432.     case entity_:
  1433.     case identifier_:
  1434.     case attribute_:
  1435.     case enumeration_:
  1436.         wrap("%s",e->symbol.name);
  1437.         break;
  1438.     case query_:
  1439.         wrap("QUERY ( %s <* ",e->u.query->local->name->symbol.name);
  1440.         EXPR_out(e->u.query->aggregate,1);
  1441.         wrap(" | ");
  1442.         EXPR_out(e->u.query->expression,1);
  1443.         raw(" )");
  1444.         break;
  1445.     case self_:
  1446.         wrap("SELF");
  1447.         break;
  1448.     case funcall_:
  1449.         wrap("%s(",e->symbol.name);
  1450.         i = 0;
  1451.         LISTdo(e->u.funcall.list,arg,Expression)
  1452.             i++;
  1453.             if (i != 1) raw(",");
  1454.             EXPR_out(arg,0);
  1455.         LISTod
  1456.         raw(")");
  1457.         break;
  1458.     case op_:
  1459.         EXPRop_out(&e->e,paren);
  1460.         break;
  1461.     case aggregate_:
  1462.         wrap("[");
  1463.         i = 0;
  1464.         LISTdo(e->u.list,arg,Expression)
  1465.             i++;
  1466.             if (i!= 1) raw(",");
  1467.             EXPR_out(arg,0);
  1468.         LISTod
  1469.         raw("]");
  1470.         break;
  1471.     case oneof_:
  1472.         wrap("ONEOF (");
  1473.  
  1474.         i = 0;
  1475.         LISTdo(e->u.list,arg,Expression)
  1476.             i++;
  1477.             if (i != 1) raw(",");
  1478.             EXPR_out(arg,0);
  1479.         LISTod
  1480.  
  1481.         raw(")");
  1482.         break;
  1483.     default:
  1484.         wrap("unknown expression, type %d",TYPEis(e->type));
  1485.     }
  1486. }
  1487.  
  1488. #define PAD    1
  1489. #define NOPAD    0
  1490.  
  1491. /* print expression that has op and operands */
  1492. void
  1493. EXPRop_out(struct Op_Subexpression *oe,int paren)
  1494. {
  1495.     switch (oe->op_code) {
  1496.     case OP_AND:
  1497.     case OP_ANDOR:
  1498.     case OP_OR:
  1499.     case OP_CONCAT:
  1500.     case OP_EQUAL:
  1501.     case OP_EXP:
  1502.     case OP_GREATER_EQUAL:
  1503.     case OP_GREATER_THAN:
  1504.     case OP_IN:
  1505.     case OP_INST_EQUAL:
  1506.     case OP_INST_NOT_EQUAL:
  1507.     case OP_LESS_EQUAL:
  1508.     case OP_LESS_THAN:
  1509.     case OP_LIKE:
  1510.     case OP_MOD:
  1511.     case OP_NOT_EQUAL:
  1512.     case OP_PLUS:
  1513.     case OP_TIMES:
  1514.     case OP_XOR:
  1515.             EXPRop2_out(oe,(char *)0,paren,PAD);    break;
  1516.     case OP_NOT:    EXPRop1_out(oe,"NOT ",paren);        break;
  1517.     case OP_REAL_DIV:
  1518.     case OP_DIV:    EXPRop2_out(oe,"/",paren,PAD);        break;
  1519.     case OP_MINUS:    EXPRop2_out(oe,"-",paren,PAD);        break;
  1520.     case OP_DOT:    EXPRop2_out(oe,".",paren,NOPAD);    break;
  1521.     case OP_GROUP:    EXPRop2_out(oe,"\\",paren,NOPAD);    break;
  1522.     case OP_NEGATE:    EXPRop1_out(oe,"-",paren);        break;
  1523.     case OP_ARRAY_ELEMENT:
  1524.             EXPR_out(oe->op1,1);
  1525.             wrap("[");
  1526.             EXPR_out(oe->op2,0);
  1527.             raw("]");                break;
  1528.     case OP_SUBCOMPONENT:
  1529.             EXPR_out(oe->op1,1);
  1530.             wrap("[");
  1531.             EXPR_out(oe->op2,0);
  1532.             wrap(":");
  1533.             EXPR_out(oe->op3,0);
  1534.             raw("]");                break;
  1535.     default:
  1536.     wrap("(* unknown op-expression *)");
  1537.     }
  1538. }
  1539.  
  1540. void
  1541. EXPRop2_out(struct Op_Subexpression *eo,char *opcode,int paren,int pad)
  1542. {
  1543.     if (pad && paren) wrap("(");
  1544.     EXPR_out(eo->op1,1);
  1545.     if (pad) raw(" ");
  1546.     wrap("%s",(opcode?opcode:EXPop_table[eo->op_code].token));
  1547.     if (pad) wrap(" ");
  1548.     EXPR_out(eo->op2,1);
  1549.     if (pad && paren) raw(")");
  1550. }
  1551.  
  1552. /* Print out a one-operand operation.  If there were more than two of these */
  1553. /* I'd generalize it to do padding, but it's not worth it. */
  1554. void
  1555. EXPRop1_out(struct Op_Subexpression *eo,char *opcode,int paren)
  1556. {
  1557.     if (paren) wrap("(");
  1558.     wrap("%s",opcode);
  1559.     EXPR_out(eo->op1,1);
  1560.     if (paren) raw(")");
  1561. }
  1562.  
  1563. int
  1564. EXPRop_length(struct Op_Subexpression *oe)
  1565. {
  1566.     switch (oe->op_code) {
  1567.     case OP_DOT:
  1568.     case OP_GROUP:
  1569.         return(1+EXPRlength(oe->op1)
  1570.             +EXPRlength(oe->op2));
  1571.     default:
  1572.         fprintf(stdout,"EXPRop_length: unknown op-expression");
  1573.     }
  1574.     return 0;
  1575. }
  1576.  
  1577. /* returns printable representation of expression rather than printing it */
  1578. /* originally only used for general references, now being expanded to handle */
  1579. /* any kind of expression */
  1580. /* contains fragment of string, adds to it */
  1581. void
  1582. EXPRstring(char *buffer,Expression e)
  1583. {
  1584.     int i;
  1585.  
  1586.     switch (TYPEis(e->type)) {
  1587.     case integer_:
  1588.         if (e == LITERAL_INFINITY) strcpy(buffer,"?");
  1589.         else sprintf(buffer,"%d",e->u.integer);
  1590.         break;
  1591.     case real_:
  1592.         if (e == LITERAL_PI) {
  1593.             strcpy(buffer,"PI");
  1594.         } else if (e == LITERAL_E) {
  1595.             strcpy(buffer,"E");
  1596.         } else {
  1597.             sprintf(buffer,"%g",e->u.real);
  1598.         }
  1599.         break;
  1600.     case binary_:
  1601.         sprintf(buffer,"%%%s",e->u.binary);    /* put "%" back */
  1602.         break;
  1603.     case logical_:
  1604.     case boolean_:
  1605.         switch (e->u.logical) {
  1606.         case Ltrue:  strcpy(buffer,"TRUE");       break;
  1607.         case Lfalse: strcpy(buffer,"FALSE");   break;
  1608.         default:     strcpy(buffer,"UNKNOWN"); break;
  1609.         }
  1610.         break;
  1611.     case string_:
  1612.         if (TYPEis_encoded(e->type)) {
  1613.             sprintf(buffer,"\"%s\"",e->symbol.name);
  1614.         } else {
  1615.             sprintf(buffer,"'%s'",e->symbol.name);
  1616.         }
  1617.         break;
  1618.     case entity_:
  1619.     case identifier_:
  1620.     case attribute_:
  1621.     case enumeration_:
  1622.         strcpy(buffer,e->symbol.name);
  1623.         break;
  1624.     case query_:
  1625.         sprintf(buffer,"QUERY ( %s <* ",e->u.query->local->name->symbol.name);
  1626.         EXPRstring(buffer+strlen(buffer),e->u.query->aggregate);
  1627.         strcat(buffer," | ");
  1628.         EXPRstring(buffer+strlen(buffer),e->u.query->expression);
  1629.         strcat(buffer," )");
  1630.         break;
  1631.     case self_:
  1632.         strcpy(buffer,"SELF");
  1633.         break;
  1634.     funcall_:
  1635.         sprintf(buffer,"%s(",e->symbol.name);
  1636.         i = 0;
  1637.         LISTdo(e->u.funcall.list,arg,Expression)
  1638.             i++;
  1639.             if (i != 1) strcat(buffer,",");
  1640.             EXPRstring(buffer+strlen(buffer),arg);
  1641.         LISTod
  1642.         strcat(buffer,")");
  1643.         break;
  1644.  
  1645.     case op_:
  1646.         EXPRop_string(buffer,&e->e);
  1647.         break;
  1648.     aggregate_:
  1649.         strcpy(buffer,"[");
  1650.         i = 0;
  1651.         LISTdo(e->u.list,arg,Expression)
  1652.             i++;
  1653.             if (i!= 1) strcat(buffer,",");
  1654.             EXPRstring(buffer+strlen(buffer),arg);
  1655.         LISTod
  1656.         strcat(buffer,"]");
  1657.         break;
  1658.     case oneof_:
  1659.         strcpy(buffer,"ONEOF (");
  1660.  
  1661.         i = 0;
  1662.         LISTdo(e->u.list,arg,Expression)
  1663.             i++;
  1664.             if (i != 1) strcat(buffer,",");
  1665.             EXPRstring(buffer+strlen(buffer),arg);
  1666.         LISTod
  1667.  
  1668.         strcat(buffer,")");
  1669.         break;
  1670.     default:
  1671.         sprintf(buffer,"EXPRstring: unknown expression, type %d",TYPEis(e->type),buffer);
  1672.         fprintf(stderr,buffer);
  1673.     }
  1674. }
  1675.  
  1676. void
  1677. EXPRop_string(char *buffer,struct Op_Subexpression *oe)
  1678. {
  1679.     EXPRstring(buffer,oe->op1);
  1680.     switch (oe->op_code) {
  1681.     case OP_DOT:
  1682.         strcat(buffer,".");
  1683.         break;
  1684.     case OP_GROUP:
  1685.         strcat(buffer,"\\");
  1686.         break;
  1687.     default:
  1688.         strcat(buffer,"(* unknown op-expression *)");
  1689.     }
  1690.     EXPRstring(buffer+strlen(buffer),oe->op2);
  1691. }
  1692.  
  1693. /* returns length of printable representation of expression w.o. printing it */
  1694. int
  1695. EXPRlength(Expression e)
  1696. {
  1697.     char buffer[10000];
  1698.  
  1699.     *buffer = '\0';
  1700.     EXPRstring(buffer,e);
  1701.     return(strlen(buffer));
  1702. }
  1703.  
  1704.  
  1705. /* Interfacing Definitions */
  1706.  
  1707. #define BIGBUFSIZ    100000
  1708. static old_curpos;
  1709. static old_lineno;
  1710. static int string_func_in_use = false;
  1711. static int file_func_in_use = false;
  1712.  
  1713. /* return 0 if successful */
  1714. static int
  1715. prep_buffer(char *buf,int len)
  1716. {
  1717.     /* this should never happen */
  1718.     if (string_func_in_use) {
  1719.         fprintf(stderr,"cannot generate EXPRESS string representations recursively!\n");
  1720.         return 1;
  1721.     }
  1722.     string_func_in_use = true;
  1723.  
  1724.     exppp_buf = exppp_bufp = buf;
  1725.     exppp_buflen = exppp_maxbuflen = len;
  1726.  
  1727.     *exppp_bufp = '\0';
  1728.     old_curpos = curpos;
  1729.     curpos = 1;
  1730.     old_lineno = 1;
  1731.  
  1732.     first_line = true;
  1733.  
  1734.     return 0;
  1735. }
  1736.  
  1737. /* return length of string */
  1738. static int
  1739. finish_buffer()
  1740. {
  1741.     exppp_buf = 0;
  1742.     curpos = old_curpos;
  1743.     error_sym.line = old_lineno;
  1744.     string_func_in_use = false;
  1745.     return 1+exppp_maxbuflen - exppp_buflen;
  1746. }
  1747.  
  1748. /* return 0 if successful */
  1749. static int
  1750. prep_string()
  1751. {
  1752.     /* this should never happen */
  1753.     if (string_func_in_use) {
  1754.         fprintf(stderr,"cannot generate EXPRESS string representations recursively!\n");
  1755.         return 1;
  1756.     }
  1757.     string_func_in_use = true;
  1758.     exppp_bufp = malloc(BIGBUFSIZ);
  1759.     exppp_buf = exppp_bufp;
  1760.     if (!exppp_buf) {
  1761.         fprintf(stderr,"failed to allocate exppp buffer\n");
  1762.         return 1;
  1763.     }
  1764.     exppp_maxbuflen = BIGBUFSIZ;
  1765.     exppp_buflen = exppp_maxbuflen;
  1766.  
  1767.     *exppp_bufp = '\0';
  1768.     old_curpos = curpos;
  1769.     old_lineno = error_sym.line;
  1770.     curpos = 1;
  1771.  
  1772.     first_line = true;
  1773.  
  1774.     return 0;
  1775. }
  1776.  
  1777. static char *
  1778. finish_string()
  1779. {
  1780.     char *b = realloc(exppp_buf,1+exppp_maxbuflen-exppp_buflen);
  1781.  
  1782.     if (b == 0) {
  1783.         fprintf(stderr,"failed to reallocate exppp buffer\n");
  1784.         return 0;
  1785.     }
  1786.     exppp_buf = 0;
  1787.     curpos = old_curpos;
  1788.     error_sym.line = old_lineno;
  1789.  
  1790.     string_func_in_use = false;
  1791.     return b;
  1792. }
  1793.  
  1794. static FILE *oldfp;
  1795.  
  1796. static void
  1797. prep_file()
  1798. {
  1799.     /* this can only happen if user calls output func while suspended */
  1800.     /* inside another output func both called from debugger */
  1801.     if (file_func_in_use) {
  1802.         fprintf(stderr,"cannot print EXPRESS representations recursively!\n");
  1803.     }
  1804.     file_func_in_use = true;
  1805.  
  1806.     /* temporarily change file to stdout and print */
  1807.     /* This avoids messing up any printing in progress */
  1808.     oldfp = exppp_fp;
  1809.     exppp_fp = stdout;
  1810.     curpos = 1;
  1811. }
  1812.  
  1813. static void
  1814. finish_file() {
  1815.     exppp_fp = oldfp;        /* reset back to original file */
  1816.     file_func_in_use = false;
  1817. }
  1818.  
  1819. static char *placeholder = "placeholder";
  1820.  
  1821. char *
  1822. ENTITYto_string(Entity e)
  1823. {
  1824.     if (prep_string()) return placeholder;
  1825.     ENTITY_out(e,0);
  1826.     return (finish_string());
  1827. }
  1828.  
  1829. /* return length of buffer used */
  1830. int
  1831. ENTITYto_buffer(Entity e,char *buffer,int length)
  1832. {
  1833.     if (prep_buffer(buffer,length)) return -1;
  1834.     ENTITY_out(e,0);
  1835.     return(finish_buffer());
  1836. }
  1837.  
  1838. void
  1839. ENTITYout(Entity e)
  1840. {
  1841.     prep_file();
  1842.     ENTITY_out(e,0);
  1843.     finish_file();
  1844. }
  1845.  
  1846. char *
  1847. EXPRto_string(Expression e)
  1848. {
  1849.     if (prep_string()) return placeholder;
  1850.     EXPR_out(e,0);
  1851.     return (finish_string());
  1852. }
  1853.  
  1854. /* return length of buffer used */
  1855. int
  1856. EXPRto_buffer(Expression e,char *buffer,int length)
  1857. {
  1858.     if (prep_buffer(buffer,length)) return -1;
  1859.     EXPR_out(e,0);
  1860.     return(finish_buffer());
  1861. }
  1862.  
  1863. void
  1864. EXPRout(Expression e)
  1865. {
  1866.     prep_file();
  1867.     EXPR_out(e,0);
  1868.     finish_file();
  1869. }
  1870.  
  1871. char *
  1872. FUNCto_string(Function f)
  1873. {
  1874.     if (prep_string()) return placeholder;
  1875.     FUNC_out(f,0);
  1876.     return (finish_string());
  1877. }
  1878.  
  1879. /* return length of buffer used */
  1880. int
  1881. FUNCto_buffer(Function e,char *buffer,int length)
  1882. {
  1883.     if (prep_buffer(buffer,length)) return -1;
  1884.     FUNC_out(e,0);
  1885.     return(finish_buffer());
  1886. }
  1887.  
  1888. void
  1889. FUNCout(Function f)
  1890. {
  1891.     prep_file();
  1892.     FUNC_out(f,0);
  1893.     finish_file();
  1894. }
  1895.  
  1896. char *
  1897. PROCto_string(Procedure p)
  1898. {
  1899.     if (prep_string()) return placeholder;
  1900.     PROC_out(p,0);
  1901.     return (finish_string());
  1902. }
  1903.  
  1904. /* return length of buffer used */
  1905. int
  1906. PROCto_buffer(Procedure e,char *buffer,int length)
  1907. {
  1908.     if (prep_buffer(buffer,length)) return -1;
  1909.     PROC_out(e,0);
  1910.     return(finish_buffer());
  1911. }
  1912.  
  1913. void
  1914. PROCout(Procedure p)
  1915. {
  1916.     prep_file();
  1917.     PROC_out(p,0);
  1918.     finish_file();
  1919. }
  1920.  
  1921. char *
  1922. RULEto_string(Rule r)
  1923. {
  1924.     if (prep_string()) return placeholder;
  1925.     RULE_out(r,0);
  1926.     return (finish_string());
  1927. }
  1928.  
  1929. /* return length of buffer used */
  1930. int
  1931. RULEto_buffer(Rule e,char *buffer,int length)
  1932. {
  1933.     if (prep_buffer(buffer,length)) return -1;
  1934.     RULE_out(e,0);
  1935.     return(finish_buffer());
  1936. }
  1937.  
  1938. void
  1939. RULEout(Rule r)
  1940. {
  1941.     prep_file();
  1942.     RULE_out(r,0);
  1943.     finish_file();
  1944. }
  1945.  
  1946. char *
  1947. SCHEMAref_to_string(Schema s)
  1948. {
  1949.     if (prep_string()) return placeholder;
  1950.     REFout(s->u.schema->usedict,s->u.schema->uselist,"USE",0);
  1951.     REFout(s->u.schema->refdict,s->u.schema->reflist,"REFERENCE",0);
  1952.     return (finish_string());
  1953. }
  1954.  
  1955. /* return length of buffer used */
  1956. int
  1957. SCHEMAref_to_buffer(Schema s,char *buffer,int length)
  1958. {
  1959.     if (prep_buffer(buffer,length)) return -1;
  1960.     REFout(s->u.schema->usedict,s->u.schema->uselist,"USE",0);
  1961.     REFout(s->u.schema->refdict,s->u.schema->reflist,"REFERENCE",0);
  1962.     return(finish_buffer());
  1963. }
  1964.  
  1965. void
  1966. SCHEMAref_out(Schema s)
  1967. {
  1968.     prep_file();
  1969.     REFout(s->u.schema->usedict,s->u.schema->uselist,"USE",0);
  1970.     REFout(s->u.schema->refdict,s->u.schema->reflist,"REFERENCE",0);
  1971.     finish_file();
  1972. }
  1973.  
  1974. char *
  1975. STMTto_string(Statement s)
  1976. {
  1977.     if (prep_string()) return placeholder;
  1978.     STMT_out(s,0);
  1979.     return (finish_string());
  1980. }
  1981.  
  1982. /* return length of buffer used */
  1983. int
  1984. STMTto_buffer(Statement s,char *buffer,int length)
  1985. {
  1986.     if (prep_buffer(buffer,length)) return -1;
  1987.     STMT_out(s,0);
  1988.     return(finish_buffer());
  1989. }
  1990.  
  1991. void
  1992. STMTout(Statement s)
  1993. {
  1994.     prep_file();
  1995.     STMT_out(s,0);
  1996.     finish_file();
  1997. }
  1998.  
  1999. char *
  2000. TYPEto_string(Type t)
  2001. {
  2002.     if (prep_string()) return placeholder;
  2003.     TYPE_out(t,0);
  2004.     return (finish_string());
  2005. }
  2006.  
  2007. /* return length of buffer used */
  2008. int
  2009. TYPEto_buffer(Type t,char *buffer,int length)
  2010. {
  2011.     if (prep_buffer(buffer,length)) return -1;
  2012.     TYPE_out(t,0);
  2013.     return(finish_buffer());
  2014. }
  2015.  
  2016. void
  2017. TYPEout(Type t)
  2018. {
  2019.     prep_file();
  2020.     TYPE_out(t,0);
  2021.     finish_file();
  2022. }
  2023.  
  2024. char *
  2025. TYPEhead_to_string(Type t)
  2026. {
  2027.     if (prep_string()) return placeholder;
  2028.     TYPE_head_out(t,0);
  2029.     return (finish_string());
  2030. }
  2031.  
  2032. /* return length of buffer used */
  2033. int
  2034. TYPEhead_to_buffer(Type t,char *buffer,int length)
  2035. {
  2036.     if (prep_buffer(buffer,length)) return -1;
  2037.     TYPE_out(t,0);
  2038.     return(finish_buffer());
  2039. }
  2040.  
  2041. void
  2042. TYPEhead_out(Type t)
  2043. {
  2044.     prep_file();
  2045.     TYPE_head_out(t,0);
  2046.     finish_file();
  2047. }
  2048.  
  2049. char *
  2050. TYPEbody_to_string(Type t)
  2051. {
  2052.     if (prep_string()) return placeholder;
  2053.     TYPE_body_out(t,0);
  2054.     return (finish_string());
  2055. }
  2056.  
  2057. /* return length of buffer used */
  2058. int
  2059. TYPEbody_to_buffer(Type t,char *buffer,int length)
  2060. {
  2061.     if (prep_buffer(buffer,length)) return -1;
  2062.     TYPE_body_out(t,0);
  2063.     return(finish_buffer());
  2064. }
  2065.  
  2066. void
  2067. TYPEbody_out(Type t)
  2068. {
  2069.     prep_file();
  2070.     TYPE_body_out(t,0);
  2071.     finish_file();
  2072. }
  2073.  
  2074. char *
  2075. WHEREto_string(Linked_List w)
  2076. {
  2077.     if (prep_string()) return placeholder;
  2078.     WHERE_out(w,0);
  2079.     return (finish_string());
  2080. }
  2081.  
  2082. /* return length of buffer used */
  2083. int
  2084. WHEREto_buffer(Linked_List w,char *buffer,int length)
  2085. {
  2086.     if (prep_buffer(buffer,length)) return -1;
  2087.     WHERE_out(w,0);
  2088.     return(finish_buffer());
  2089. }
  2090.  
  2091. void
  2092. WHEREout(Linked_List w)
  2093. {
  2094.     prep_file();
  2095.     WHERE_out(w,0);
  2096.     finish_file();
  2097. }
  2098.  
  2099.