Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/unix/volume26/funnlweb/part18

Text File | 1993-04-10 | 71.8 KB | 2,160 lines

Newsgroups: comp.sources.unix
From: [e-mail] (Ross Williams)
Subject: v26i138: funnelweb - a tool for literate programming in C, Part18/20
Sender: [e-mail]
Approved: [e-mail]

Submitted-By: [e-mail] (Ross Williams)
Posting-Number: Volume 26, Issue 138
Archive-Name: funnelweb/part18

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 18 (of 20)."
# Contents:  sources/command.c
# Wrapped by [e-mail] on Sun Apr 11 11:00:33 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'sources/command.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'sources/command.c'\"
else
echo shar: Extracting \"'sources/command.c'\" \(69805 characters\)
sed "s/^X//" >'sources/command.c' <<'END_OF_FILE'
X/*##############################################################################
X
XFUNNNELWEB COPYRIGHT
X====================
XFunnelWeb is a literate-programming macro preprocessor.
X
Copyright (C) 1992 Ross N. Williams.
X
X   Ross N. Williams
X   [e-mail]
X   16 Lerwick Avenue, Hazelwood Park 5066, Australia.
X
This program is free software; you can redistribute it and/or modify
it under the terms of Version 2 of the GNU General Public License as
published by the Free Software Foundation.
X
This program is distributed WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See Version 2 of the GNU General Public License for more details.
X
You should have received a copy of Version 2 of the GNU General Public
License along with this program. If not, you can FTP the license from
prep.ai.mit.edu/pub/gnu/COPYING-2 or write to the Free Software
XFoundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
X
Section 2a of the license requires that all changes to this file be
recorded prominently in this file. Please record all changes here.
X
Programmers:
X   RNW  Ross N. Williams  [e-mail]
X
Changes:
X   07-May-1992  RNW  Program prepared for release under GNU GPL V2.
X
X##############################################################################*/
X
X
X/******************************************************************************/
X/*                                COMMAND.C                                   */
X/******************************************************************************/
X
X#include <ctype.h>
X#include "style.h"
X
X#include "analyse.h"
X#include "as.h"
X#include "command.h"
X#include "data.h"
X#include "dump.h"
X#include "lister.h"
X#include "memory.h"
X#include "mapper.h"
X#include "misc.h"
X#include "option.h"
X#include "parser.h"
X#include "scanner.h"
X#include "tangle.h"
X#include "weave.h"
X
X/******************************************************************************/
X
X/* Because FunnelWeb has so many options ,it is convenient to allow the user  */
X/* to construct a startup file. This is its name.                             */
X#define INITFILE "fwinit.fws"
X
X/******************************************************************************/
X
X/* Three variables hold options information in FunnelWeb.                     */
X/* 'p_comopt' holds the options conveyed by the original raw command line.      */
X/* 'p_defopt' holds the options that are default in the FunnelWeb shell.        */
X/* 'option' is global and holds the options that have been specified for the  */
X/*          current invocation of FunnelWeb proper.                           */
X/* 'option' is global so here we see only 'p_comopt' and 'p_defopt'.              */
LOCVAR op_t *p_comopt;  /* Initial command line options.                         */
LOCVAR op_t *p_defopt;  /* Default shell options.                                */
X
X/* The FunnelWeb shell interpreter has many different commands and it is      */
X/* worth them sharing the same basic command line scanner. These two          */
X/* variables hold the numer of arguments and a pointer to strings holding     */
X/* copies of each argument.                                                   */
X/* Note: The first argument is placed in arr_arg[0].                          */
X#define ARG_MAX 5
LOCVAR uword arg_num;
LOCVAR char *arg_arr[ARG_MAX+1]; /* Is this +1 necessary? */
X
X/* The FunnelWeb command interpreter allows 10 substitution strings.          */
X/* These strings are stored in the following array.                           */
X#define NUM_SUBS (10+26)        /* 0..9 and A..Z */
LOCVAR char *subval[NUM_SUBS];
X
LOCVAR ulong old_war;
LOCVAR ulong old_err;
LOCVAR ulong old_sev;
X
X/* The FunnelWeb script interpreter can echo (trace) each command before it   */
X/* executes it. Whether it does is determined by this variable.               */
LOCVAR bool tracing;
X
X/* If this variable is set to true then the interpreter will not abort if the */
X/* very next command (and that one only) generates an error or severe error.  */
LOCVAR bool noabort;
X
X/* If the following boolean is true, the interpreter skips lines until it     */
X/* hits the HERE command.                                                     */
LOCVAR bool skipping;
X
X/* The following variables count how many times DIFF is invoked and how many  */
X/* times it succeeded. This allows us to output a summary at the end of the   */
X/* processing of the test suite.                                              */
LOCVAR ulong difftotl = 0;
LOCVAR ulong diffsucc = 0;
X
X/******************************************************************************/
X
X/* Here are the prototypes for recursive or out-of-order functions.           */
LOCAL void interstr P_((char *));
LOCAL void do_set P_((char *));
X
X/******************************************************************************/
X
LOCAL char *sing P_((ulong,char *,char *));
LOCAL char *sing(num,sinstr,plustr)
X/* Return one or other string depending on whether first argument is singular.*/
ulong num;
char *sinstr;
char *plustr;
X{
X if (num==1)
X    return sinstr;
X else
X    return plustr;
X}
X
X/******************************************************************************/
X
LOCAL uword numpos P_((ulong,ulong,ulong));
LOCAL uword numpos(a,b,c)
X/* Returns the number of its arguments that are positive. */
ulong a,b,c;
X{
X uword result=0;
X if (a>0) result++;
X if (b>0) result++;
X if (c>0) result++;
X return result;
X}
X
X/******************************************************************************/
X
LOCAL void errsum P_((ulong,ulong,ulong,ulong));
LOCAL void errsum(fat,sev,err,war)
X/* Supply as arguments, the number of various kinds of diagnostics.           */
X/* Places in linet1 a string describing the diagnostics.                      */
ulong fat,sev,err,war;
X{
X char linet2[100];
X
X if (fat+sev+err+war==0)
X    {strcpy(linet1,"SUCCESS: No diagnostics."); return;}
X
X strcpy(linet1,"There ");
X
X /* "Was" or "were" depending on the plurality of highest level diagnostic. */
X      if (fat>0) strcat(linet1,sing(fat,"was","were"));
X else if (sev>0) strcat(linet1,sing(sev,"was","were"));
X else if (err>0) strcat(linet1,sing(err,"was","were"));
X else if (war>0) strcat(linet1,sing(war,"was","were"));
X else as_bomb("errsum: Error hierarchy failed!");
X
X strcat(linet1," ");
X
X /* Fatal errors. */
X if (fat>0)
X   {
X    sprintf(linet2,"%1lu Fatal error",fat); strcat(linet1,linet2);
X    strcat(linet1,sing(fat,"","s"));
X   }
X
X /* Joiner stuff. */
X if (fat>0 && numpos(sev,err,war)>=2)    strcat(linet1,", ");
X if (fat>0 && sev>0 && err==0 && war==0) strcat(linet1," and ");
X
X /* Severe errors. */
X if (sev>0)
X   {
X    sprintf(linet2,"%1lu Severe error",sev); strcat(linet1,linet2);
X    strcat(linet1,sing(sev,"","s"));
X   }
X
X /* Joiner stuff. */
X if (fat+sev>0 && err>0 && war >0) strcat(linet1,", ");
X if (fat+sev>0 && err>0 && war==0) strcat(linet1," and ");
X
X /* Errors. */
X if (err>0)
X   {
X    sprintf(linet2,"%1lu Error",err); strcat(linet1,linet2);
X    strcat(linet1,sing(err,"","s"));
X   }
X
X /* Joiner stuff. */
X if (fat+sev+err>0 && war>0) strcat(linet1," and ");
X
X /* Warnings. */
X if (war > 0)
X   {
X    sprintf(linet2,"%1lu Warning",war); strcat(linet1,linet2);
X    strcat(linet1,sing(war,"","s"));
X   }
X
X /* The final full stop! */
X strcat(linet1,".");
X}
X
X/******************************************************************************/
X
LOCAL void allocarg P_((void));
LOCAL void allocarg()
X/* Some compilers don't allow much room for statics and so it is necessary to */
X/* declare some variables as pointers and allocate them explicitly. This      */
X/* function allocates the command line argument array to point to strings.    */
X{
X uword i;
X for (i=0;i<=ARG_MAX;i++)
X    arg_arr[i]=(char *) mm_perm(sizeof(cl_t));
X
X /* Also initialize the substitution strings. */
X for (i=0;i<NUM_SUBS;i++)
X   {
X    subval[i]=(char *) mm_perm(sizeof(cl_t));
X    subval[i][0]=EOS;
X   }
X p_comopt=(p_op_t) mm_perm(sizeof(op_t));
X p_defopt=(p_op_t) mm_perm(sizeof(op_t));
X}
X
X/******************************************************************************/
X
LOCAL void zerdia P_((void));
LOCAL void zerdia()
X{
X old_war=num_war;
X old_err=num_err;
X old_sev=num_sev;
X num_sev=num_err=num_war=0;
X}
X
LOCAL void sumdia P_((void));
LOCAL void sumdia()
X{
X sum_sev+=num_sev;
X sum_err+=num_err;
X sum_war+=num_war;
X}
X
LOCAL void restdia P_((void));
LOCAL void restdia()
X{
X num_sev+=old_sev;
X num_err+=old_err;
X num_war+=old_war;
X}
X
X/******************************************************************************/
X
LOCAL void explode P_((char *));
LOCAL void explode(p)
X/* Parses the string p into a set of non-blank sequences. Copies each         */
X/* distinct run of non-blanks into successive values of arg_arr. Places the   */
X/* number of runs of non-blanks into arg_num. DOESN'T generate an error if    */
X/* there are too many arguments.                                              */
char *p;
X{
X arg_num=0;
X while (TRUE)
X   {
X    char *x;
X
X    /* Skip to the next argument. */
X    while (*p==' ') p++;
X
X    /* Exit if we have hit the end of the string. */
X    if (*p==EOS) break;
X
X    /* Exit if we are already full up with arguments. */
X    if (arg_num==ARG_MAX) break;
X
X    /* Copy the next argument. */
X    x=arg_arr[arg_num];
X    while (*p!=' ' && *p!=EOS) *x++ = *p++;
X    *x=EOS;
X    arg_num++;
X   }
X}
X
X/******************************************************************************/
X
LOCAL void dollsub P_((char *));
LOCAL void dollsub(p_comlin)
X/* Assumes that it's string argument is in a command line object. */
X/* Performs dollar substitutions. */
char *p_comlin;
X{
X char *p=p_comlin;
X cl_t  cl;
X char *t;
X
X t = &cl[0];
X
X /* Copy the unexpanded command line to the temporary from which we expand it */
X /* back from whence it came.                                                 */
X strcpy(t,p);
X
X /* Work through the unexpanded command line expanding. */
X while (*t != EOS)
X   {
X    /* Complain if there is not room for one more character. */
X    if ((p-p_comlin) == COMLINE_MAX) goto toobig;
X
X    /* If no dollar sign, no tricks. Just copy the character over. */
X    if (*t!='$') {*p++ = *t++; continue;}
X
X    /* We have seen a dollar sign. Move onto the next character. */
X    t++;
X
X    /* The only legal escapes are decimal digits, slash, and the dollar sign. */
X    if (!isdigit(*t) && !isupper(*t) && *t!='$' && *t!='/')
X      {
X       wl_sj("S: Illegal dollar subtitution sequence in command line.");
X       wl_sj("Legal sequences are $0..$9, $A..$Z, $/, and $$.");
X       num_sev++;
X       strcpy(p,t);
X       return;
X      }
X
X    /* A dollar escape is easy to process. */
X    if (*t=='$') {*p++ = *t++; continue;}
X
X    /* A slash escape is easy to process. */
X    if (*t=='/') {*p++ = FN_DELIM; t++; continue;}
X
X    /* Substitutions have to be expanded. */
X    if (isdigit(*t) || isupper(*t))
X      {
X       ubyte num;
X       char *q;
X       if (isdigit(*t))
X           num = *t-'0';
X       else
X           num = 10+(*t-'A');
X       as_cold(num<NUM_SUBS,"dollsub: num is too bug!");
X       q=subval[num];
X       if ((p-p_comlin)+strlen(subval[num]) > COMLINE_MAX) goto toobig;
X       while (*q!=EOS) *p++ = *q++;
X       t++;
X      }
X   }
X *p=EOS;
X return;
X
X toobig:
X    wl_sj("S: Expanded (i.e. after $1 etc) command line is too long.");
X    num_sev++;
X    strcpy(p,t);
X    return;
X}
X
X/******************************************************************************/
X
LOCAL void fwonerun P_((void));
LOCAL void fwonerun()
X/* Performs a single run of FunnelWeb proper, using the global variable       */
X/* 'options' as the input command line.                                       */
X{
X fn_t lisnam;
X
X /* The following clocks record the time taken by various parts of FunnelWeb.  */
X ck_t mappck;
X ck_t scanck;
X ck_t parsck;
X ck_t analck;
X ck_t dumpck;
X ck_t lstrck;
X ck_t tangck;
X ck_t weavck;
X ck_t totlck;
X
X /* Intialize/zero all the clocks. */
X ck_ini(&mappck);
X ck_ini(&scanck);
X ck_ini(&parsck);
X ck_ini(&analck);
X ck_ini(&dumpck);
X ck_ini(&lstrck);
X ck_ini(&tangck);
X ck_ini(&weavck);
X ck_ini(&totlck);
X
X /* Start the total time clock ticking. A total time clock is used to gather  */
X /* up the gaps between the invocations of the other clocks.                  */
X ck_start(&totlck);
X
X ck_start(&lstrck);
X
X /* Establish the listing file output stream. */
X strcpy(lisnam,"");             /* Start with an empty string.                */
X fn_ins(lisnam,option.op_f_s);  /* Insert input file name.                    */
X fn_ins(lisnam,".lis");         /* Insert constant extension.                 */
X fn_ins(lisnam,option.op_l_s);  /* Insert command line spec.                  */
X wf_ini(&f_l,option.op_l_b);    /* Initialize the stream.                     */
X wf_ope(&f_l,lisnam);           /* Create the file.                           */
X if (option.op_l_b && wf_err(&f_l))
X   {
X    sprintf(linet1,"S: Error creating listing file \"%s\".",lisnam);
X    wl_sj(linet1);
X    wl_sj("Aborting...");
X    num_sev++;
X    return;
X   }
X
X wl_l("FUNNELWEB LISTING FILE");
X wl_l("======================");
X wl_l("");
X
X /* Initialize the lister for this run. */
X lr_ini();
X
X ck_stop(&lstrck);
X
X /* Scanner comes first. */
X ck_start(&scanck);
X scanner(&mappck,&scanck);
X ck_stop(&scanck);
X
X /* Dump the line and token lists if requested. The scanner supplies sensible */
X /* lists even if it encounters errors, so there is no danger here.           */
X ck_start(&dumpck);
X if (option.op_b2_b) dm_lnls(&f_l);
X if (option.op_b3_b) dm_tkls(&f_l);
X ck_stop(&dumpck);
X
X /* Invoke the parser if there were no serious scanner errors. */
X if (num_sev+num_err==0)
X   {
X    ck_start(&parsck);
X    parser();
X    ck_stop(&parsck);
X    /* Only perform post parser dumps if the parser was run. */
X    ck_start(&dumpck);
X    if (option.op_b4_b) dm_matb(&f_l);
X    if (option.op_b5_b) dm_dcls(&f_l);
X    ck_stop(&dumpck);
X   }
X else
X   {
X    if (option.op_b4_b)
X       wl_l("Macro table dump skipped (Parser was not invoked).");
X    if (option.op_b5_b)
X       wl_l("Document list dump skipped (Parser was not invoked).");
X   }
X
X /* Invoke the macro structure analyser if still no errors. */
X if (num_sev+num_err==0)
X   {
X    ck_start(&analck);
X    analyse();
X    ck_stop(&analck);
X   }
X
X /* The scanner, parser, and analyser send errors to the lister package. */
X /* Send sorted listing to the listing file (and screen if desired).     */
X ck_start(&lstrck);
X if (option.op_l_b) lr_gen(&f_l,option.op_c_i);
X if (option.op_s_b) lr_gen(&f_s,option.op_s_i);
X if (option.op_s_b) lr_gen(&f_j,option.op_s_i);
X ck_stop(&lstrck);
X
X /* If the first stages went OK, invoke tangle and weave. */
X if (num_sev+num_err==0)
X   {
X    if (option.op_o_b)
X      {
X       ck_start(&tangck);
X       tangle();
X       ck_stop(&tangck);
X      }
X    if (option.op_t_b)
X      {
X       ck_start(&weavck);
X       weave();
X       ck_stop(&weavck);
X      }
X    /* Leave output lines from Tangle and Weave joined, but separate them */
X    /* from any further output.                                           */
X    if (option.op_t_b || option.op_o_b)
X       wl_sjl("");
X   }
X else
X   {
X    /* Otherwise tell the user that back-end phases will be skipped. */
X    if ( option.op_o_b ||  option.op_t_b)
X      {
X       if (num_sev+num_err==1)
X          wr_sjl("Error caused ");
X       else
X          wr_sjl("Errors caused ");
X      }
X    if ( option.op_o_b &&  option.op_t_b) wr_sjl("tangle and weave phases");
X    if ( option.op_o_b && !option.op_t_b) wr_sjl("tangle phase");
X    if (!option.op_o_b &&  option.op_t_b) wr_sjl("weave phase");
X    if ( option.op_o_b ||  option.op_t_b)
X       {wl_sjl(" to be skipped."); wl_sjl("");}
X   }
X
X ck_stop(&totlck);
X
X /* If requested write out a summary of the time taken. */
X if (option.op_b6_b)
X    dm_times(&f_l,
X             &mappck,&scanck,&parsck,&analck,
X             &dumpck,&lstrck,&tangck,&weavck,&totlck);
X
X /* Write out a line summarizing the diagnostics for this run. */
X errsum(0L,num_sev,num_err,num_war); wl_sjl(linet1);
X
X /* Close the listing file. */
X if (!option.op_l_b) goto finishoff;
X if (wf_err(&f_l))
X   {
X    wl_sj("S: Error writing to listing file. Aborting...");
X    num_sev++;
X    goto finishoff;
X   }
X wf_clo(&f_l);
X if (wf_err(&f_l))
X   {
X    wl_sj("S: Error flushing and closing listing file. Aborting...");
X    num_sev++;
X   }
X
X finishoff:
X /* VERY IMPORTANT: Ask the memory management package to free up all the      */
X /* temporary memory (allocated using mm_temp) that has been allocated. This  */
X /* ensures that the memory allocated for this FunnelWeb run will be recycled.*/
X mm_zapt();
X
X} /* End of fwonerun */
X
X/******************************************************************************/
X
LOCAL void do_absen P_((void));
LOCAL void do_absen ()
X{
X if (arg_num != 2)
X   {
X    wl_sj("S: The ABSENT command requires exactly one argument.");
X    num_sev++;
X    return;
X   }
X if (fexists(arg_arr[1]))
X   {
X    sprintf(linet1,"S: ABSENT found \"%s\".",arg_arr[1]);
X    wl_sj(linet1);
X    num_sev++;
X    return;
X   }
X}
X
X/******************************************************************************/
X
LOCAL void do_cody P_((void));
LOCAL void do_cody ()
X/* The CODIFY command takes an input text file and generates an output text   */
X/* file containing C code to write out the input text file. The need for this */
X/* command springs from the weaver. Experience with FunnelWeb showed that use */
X/* of a separate header file, to be included, while apparently sensible,      */
X/* caused no end of problems. In particular, problems with portably           */
X/* specifying where the header file should be found. In the end, it was       */
X/* decided that it would be better to write the header file out with the      */
X/* weave output. As the header file is quite long, it is best to automate the */
X/* process of converting the file from text to C code to write out the text.  */
X/* That is what the CODIFY command does.                                      */
X{
X FILE *file1;
X FILE *file2;
X
X#define MAXHACK 1000
X char hackline[MAXHACK+1];
X uword lineno;
X
X if (arg_num != 3)
X   {
X    wl_sj("S: The CODIFY command requires exactly two arguments.");
X    num_sev++;
X    return;
X   }
X
X /* Open the input file for text reading. */
X file1=fopen(arg_arr[1],"r");
X if (file1 == FOPEN_F)
X   {
X    wl_sj("S: Error opening the input file.");
X    num_sev++;
X    return;
X   }
X file2=fopen(arg_arr[2],"w");
X if (file2 == FOPEN_F)
X   {
X    fclose(file1);
X    wl_sj("S: Error creating the output file.");
X    num_sev++;
X    return;
X   }
X
X lineno=0;
X
X /* PROCESS A SINGLE LINE PER ITERATION. */
X while (TRUE)
X   {
X    uword linelength;
X    uword i;
X
X    /* Read in a line of input and terminate loop if there are no more lines. */
X    fgets(hackline,MAXHACK,file1);
X    if (ferror(file1))
X       {wl_sj("S: Error reading the input file.");num_sev++;return;}
X    if (feof(file1)) break;
X    lineno++;
X
X    /* Complain if the input line is too long. */
X    if (strlen(hackline)>81)
X      {
X       sprintf(linet1,"Line %lu of input file is too long.",
X               (ulong) strlen(hackline));
X       wl_sj(linet1);
X       wl_sj("The maximum allowable length is 80 characters.");
X       num_sev++;
X       return;
X      }
X
X    /* Write the start-of-line string. */
X    if (fputs(" WX(\"",file2) == FPUTS_F) goto write_failure;
X
X    /* Write out the line in sanitized form. */
X    linelength=strlen(hackline);
X    for (i=0;i<linelength;i++)
X      {
X       char ch = hackline[i];
X       if (ch==EOL)
X          ; /* Ignore this. */
X       else
X       if (ch=='\"')
X          {if (fputs("\\\"",file2) == FPUTS_F) goto write_failure;}
X       else
X       if (ch=='\\')
X          {if (fputs("\\\\",file2) == FPUTS_F) goto write_failure;}
X       else
X          {if (fputc(ch,file2) == FPUTC_F) goto write_failure;}
X      }
X
X    /* Write the end of line string. */
X    if (fputs("\");\n",file2) == FPUTS_F) goto write_failure;
X   }
X
X if (fflush(file2) != FFLUSH_S)
X    {wl_sj("S: Error flushing the output file.");num_sev++;return;}
X if (fclose(file1) == FCLOSE_F)
X   {wl_sj("S: Error closing the input file.");num_sev++;return;}
X if (fclose(file2) == FCLOSE_F)
X   {wl_sj("S: Error closing the output file.");num_sev++;return;}
X return;
X
X write_failure:
X    wl_sj("S: Error writing the output file.");num_sev++;return;
X}
X
X/******************************************************************************/
X
LOCAL void do_comp P_((void));
LOCAL void do_comp ()
X/* The compare command should have two arguments being file names. It         */
X/* compares the two files and raises a fatal error if they differ.            */
X{
X char *errstr;
X bool result;
X if (arg_num != 3)
X   {
X    wl_sj("S: COMPARE command must be given exactly two arguments.");
X    num_sev++;
X    return;
X   }
X errstr=eq_files(arg_arr[1],arg_arr[2],&result);
X if (errstr!=NULL)
X   {
X    wl_sj("S: COMPARE command ran into a problem:");
X    wl_sj(errstr);
X    num_sev++;
X    return;
X   }
X if (!result)
X   {
X    wl_sj("S: A comparison FAILED. Two files compared were not identical!");
X    sprintf(linet1,"   File1: \"%s\".",arg_arr[1]); wl_sj(linet1);
X    sprintf(linet1,"   File2: \"%s\".",arg_arr[2]); wl_sj(linet1);
X    wl_sj("   FunnelWeb has just FAILED a regression test.");
X    wl_sj("   You should now inspect the two files to see how the result of");
X    wl_sj("   this run of FunnelWeb differed from the \"correct answer\" in");
X    wl_sj("   the answer directory.");
X    num_sev++;
X    return;
X   }
X}
X
X/******************************************************************************/
X
LOCAL void do_defin P_((char *));
LOCAL void do_defin (p_comlin)
X/* The define command associates a string with a $n. */
char *p_comlin;
X{
X char *p;
X ubyte defnum;
X
X /* p is our scanning pointer and starts at the start of the command line. */
X p=p_comlin;
X
X /* Skip past the DEFINE command onto the second argument. */
X while ((*p!=' ') && (*p!=EOS)) p++;
X while (*p==' ') p++;
X
X /* There should be a single digit or upper case letter there. */
X if (!isdigit(*p) && !isupper(*p))
X   {wl_sj("S: The first argument to DEFINE must be a decimal digit or");
X    wl_sj("   upper case letter.");
X    wl_sj("   Example: define 3 \"A Walrus in Spain is a Walrus in Vain.\"");
X    num_sev++;return;}
X if (isdigit(*p))
X    defnum = *p-'0';
X else
X    defnum = 10+(*p-'A');
X as_cold(defnum<NUM_SUBS,"do_defin: num is too bug!");
X
X /* Move past the digit. */
X p++;
X
X /* Skip blanks to get to the next argument. */
X while (*p==' ') p++;
X
X /* Complain if there is no second argument. */
X if (*p==EOS)
X   {wl_sj("S: The DEFINE command expected a second argument.");
X    num_sev++; return;}
X
X /* Otherwise make sure that we have a double quoted string. */
X if (*p!='"' || *(p+1)==EOS || p[strlen(p)-1]!='"')
X   {wl_sj("S: Second argument to DEFINE must be in double quotes.");
X    num_sev++;return;}
X
X /* All is checked. Now it is safe to copy over the string. */
X p++;
X strcpy(subval[defnum],p);
X subval[defnum][strlen(subval[defnum])-1]=EOS;
X
X /* TRACE: All the definitions.
X {
X  ubyte i;
X  for (i=0;i<NUM_SUB;i++)
X     printf("$%u=\"%s\"\n",(unsigned) i,subval[i]);
X }
X */
X}
X
X/******************************************************************************/
X
LOCAL void do_diff P_((void));
X/* COMMAND FORMAT: diff file1 file2 logfile [abort]                           */
X/* This function/command performs a proper text differences on two files.     */
X/* This function is long and messy because of C's lack of nested functions.   */
X/* I don't want to create global variables here, and defining subfunctions    */
X/* that do not have access to the variables of this function would provoke    */
X/* too wide an interface to be worth the trouble. So it's code city.          */
X/* How I wish that I had FunnelWeb to help me write this function!            */
LOCAL void do_diff()
X{
X bool   diffabort;        /* TRUE iff we should abort if files are different. */
X bool   is_same  = FALSE; /* True iff files are proven to be the same.        */
X FILE  *logfile;          /* File to write result of comparison.              */
X bool   badwrite = FALSE; /* TRUE if we couldn't write to the logfile.        */
X char  *p_file1;          /* Pointer to mapping of first  file to compare.    */
X char  *p_file2;          /* Pointer to mapping of second file to compare.    */
X ulong  len_file1;        /* Number of bytes in mapping of first  file.       */
X ulong  len_file2;        /* Number of bytes in mapping of second file.       */
X char  *mess1;            /* Error message from mapper for first  file.       */
X char  *mess2;            /* Error message from mapper for second file.       */
X bool  is_image;          /* TRUE iff mapped images are identical.            */
X bool   anydiff = FALSE;  /* TRUE iff any differences detected during loop.   */
X
X /* Check that the number of arguments is correct. */
X if (arg_num < 4 || arg_num > 5)
X   {
X    wl_sj("S: The DIFF command must be given either 3 or 4 arguments.");
X    wl_sj("   Usage: diff f1 f2 logfile [abort]");
X    num_sev++;
X    return;
X   }
X
X /* Check that the fourth argument, if present, is legal. */
X diffabort=FALSE;
X if (arg_num == 5)
X    if (strcmp(arg_arr[4],"ABORT")==0 || strcmp(arg_arr[4],"abort")==0)
X       diffabort=TRUE;
X    else
X      {
X       wl_sj(
X          "S: The DIFF command's fourth argument, if present, must be ABORT.");
X       wl_sj("   Usage: diff f1 f2 logfile [abort]");
X       num_sev++;
X       return;
X      }
X
X /* Now open the log file to append result of compare. */
X logfile=fopen(arg_arr[3],"a");
X if (logfile == FOPEN_F)
X   {
X    wl_sj("S: DIFF: Error opening the log file (to append result of compare).");
X    num_sev++;
X    return;
X   }
X
X /* The following define simplifies writing to the log file. */
X#define LOGLINE {if (fputs(linet1,logfile) == FPUTS_F) badwrite=TRUE;}
X#define LOGSTR(STR) {if (fputs((STR),logfile) == FPUTS_F) badwrite=TRUE;}
X#define LOGCHAR(CH) {if (fputc((CH),logfile) == FPUTC_F) badwrite=TRUE;}
X
X /* Write the header for this comparison to the log file. */
X sprintf(linet1,"\n\n"                          ); LOGLINE;
X sprintf(linet1,"Comparing \"%s\"\n" ,arg_arr[1]); LOGLINE;
X sprintf(linet1,"     with \"%s\".\n",arg_arr[2]); LOGLINE;
X
X /* Now map in the two files to be compared.                                  */
X /* Once this is done, we MUST do a mm_zapt later or memory will leak.        */
X /* We attempt to map the second file, even if the first mapping has failed   */
X /* as, if the first file is absent, there is a good chance that the second   */
X /* is absent too, and it is useful to the user to know this.                 */
X mess1=map_file(arg_arr[1],&p_file1,&len_file1);
X mess2=map_file(arg_arr[2],&p_file2,&len_file2);
X if (mess1 != NULL)
X   {
X    sprintf(linet1,"Error mapping \"%s\".\n",arg_arr[1]); LOGLINE;
X    wr_sj("E: DIFF: "); wr_sj(linet1);
X    sprintf(linet1,"         %s\n",mess1); LOGLINE; wr_sj(linet1);
X    num_err++;
X   }
X if (mess2 != NULL)
X   {
X    sprintf(linet1,"Error mapping \"%s\".\n",arg_arr[2]); LOGLINE;
X    wr_sj("E: DIFF: "); wr_sj(linet1);
X    sprintf(linet1,"         %s\n",mess2); LOGLINE; wr_sj(linet1);
X    num_err++;
X   }
X if ((mess1 != NULL) || (mess2 != NULL))
X    goto frombadmap;
X
X /* At this point the two files to be compared are sitting in memory and we   */
X /* have a ready-for-writing log file. We are now ready to compare.           */
X
X /* First perform a binary image comparison as a check for later.             */
X /* We could do this later, but it is better to do this now, in case the      */
X /* complicated comparison code somehow corrupts one of the images.           */
X is_image= ((len_file1 == len_file2) &&
X            (memcmp(p_file1,p_file2,(size_t) len_file1) == 0));
X
X /* This anonymous block performs the actual comparison. */
X {
X  /* The comparison is performed by scrolling the two input files through two */
X  /* fixed-length line buffers (buf1 and buf2 - see below). To avoid copying, */
X  /* the buffers are made circular. Processing takes place by comparing the   */
X  /* first line of each buffer. If the line is the same, the buffers are      */
X  /* scrolled by one line. If they are different, then we have encountered a  */
X  /* DIFFERENCES SECTION and we have to compare lines near the top of the     */
X  /* buffers to find a match. When a match is found, each buffer is scrolled  */
X  /* down to its match point and processing continues.                        */
X
X/* LBUFSIZ is the number of number of lines that each buffer can hold.        */
X/*         Lines are indexed from [0,LBUFSIZ-1].                              */
X/*         WARNING: LBUFSIZ must be a power of two corresponding to WRAP(X).  */
X/*         WARNING: Totally different input files will provoke O(LBUFSIZ^2)   */
X/*                  checksum comparisons per LBUFSIZ input lines.             */
X/* WRAP(X) is a macro that performs wraparound of buffer indices.             */
X/* GAP     is the number of lines that have to match to end a diff section.   */
X/* MAXDIST is the maximum "distance" that is tested when matching.            */
X#define LBUFSIZ 64
X#define WRAP(X) ((X) & 0x3F)
X#define GAP     3
X#define MAXDIST (LBUFSIZ-GAP)
X
X/* The following macro compares two lines in the buffers.                     */
X/* The arguments are absolute buffer indices, not relative ones.              */
X/* We assume that checksums will mismatch more often than line lengths.       */
X#define COMPLINE(INDA,INDB) \
X   ((buf1[INDA].c_line == buf2[INDB].c_line) &&  \
X    (buf1[INDA].l_line == buf2[INDB].l_line) &&  \
X    (memcmp(buf1[INDA].p_line,buf2[INDB].p_line, \
X                (size_t) buf1[INDA].l_line)==0))
X
X  /* The two line buffers buf1 and buf2 (see below) don't actually store      */
X  /* lines. Instead they store line structures which store pointers to the    */
X  /* lines in the mapped images of the files. They also store the length of   */
X  /* each line, and a checksum of the line. The checksum is useful for        */
X  /* speeding up the comparisons between lines when processing a differences  */
X  /* section.                                                                 */
X  typedef
X     struct
X       {
X        char *p_line; /* Pointer to first byte in the line. */
X        ulong l_line; /* Number of bytes in the line.       */
X        uword c_line; /* Checksum of the line.              */
X       } line_t;
X
X  char   *p_next1 = p_file1;            /* Points to next line in file1.      */
X  char   *p_next2 = p_file2;            /* Points to next line in file2.      */
X  char   *p_post1 = p_file1+len_file1;  /* Byte following image of file1.     */
X  char   *p_post2 = p_file2+len_file2;  /* Byte following image of file2.     */
X  line_t buf1[LBUFSIZ];      /* Comparison buffer for first  file.            */
X  line_t buf2[LBUFSIZ];      /* Comparison buffer for second file.            */
X  ulong  buf1top = 0;        /* Index of first line in first  buffer.         */
X  ulong  buf2top = 0;        /* Index of first line in second buffer.         */
X  ulong  buf1fil = 0;        /* Number of lines in first  buffer.             */
X  ulong  buf2fil = 0;        /* Number of lines in second buffer.             */
X  ulong  topnum1 = 1;        /* Line number of first line of first buffer.    */
X  ulong  topnum2 = 1;        /* Line number of first line of second buffer.   */
X
X  /* The following loop compares the line(s) at the top of the two buffers    */
X  /* and processes (lines1,lines2) lines of each.                             */
X  while (TRUE)
X    {
X     ulong lines1; /* Lines of file1 processed during this loop iteration.    */
X     ulong lines2; /* Lines of file2 processed during this loop iteration.    */
X     ulong d,g;    /* Used in comparison loops.                               */
X
X     /* The first thing we do is to fill each buffer as full as possible. At  */
X     /* the end of the next two lumps of code, the only reason that a file's  */
X     /* is not full is that we have reached the end of the file.              */
X
X     /* Fill the first buffer as full as possible. */
X     while ((buf1fil < LBUFSIZ) && (p_next1 != p_post1))
X       {
X        ulong  ind   = WRAP(buf1top + buf1fil);
X        ulong  len   = 0;
X        uword  csum  = 0;
X        char  *p_lin = p_next1;
X        while (TRUE)
X          {
X           if (p_next1 == p_post1) break;
X           len++;
X           csum=(csum+*p_next1++) & 0xFFFF;
X           if (*(p_next1-1) == EOL) break;
X          }
X        buf1[ind].p_line = p_lin;
X        buf1[ind].l_line = len;
X        buf1[ind].c_line = csum;
X        buf1fil++;
X       }
X
X     /* Fill the second buffer as full as possible. */
X     while ((buf2fil < LBUFSIZ) && (p_next2 != p_post2))
X       {
X        ulong  ind   = WRAP(buf2top + buf2fil);
X        ulong  len   = 0;
X        uword  csum  = 0;
X        char  *p_lin = p_next2;
X        while (TRUE)
X          {
X           if (p_next2 == p_post2) break;
X           len++;
X           csum=(csum+*p_next2++) & 0xFFFF;
X           if (*(p_next2-1) == EOL) break;
X          }
X        buf2[ind].p_line = p_lin;
X        buf2[ind].l_line = len;
X        buf2[ind].c_line = csum;
X        buf2fil++;
X       }
X
X     /* If the buffers are empty then we must be at the end of each file. */
X     if (buf1fil==0 && buf2fil==0)
X        break;
X
X     /* Try to peel a pair of matching lines off the top of the buffer.       */
X     /* If we succeed, zip down to the end of the loop and flush them.        */
X     /* We can't integrate this code into the next part because the next part */
X     /* requires GAP matches, whereas here we require just one.               */
X     if ((buf1fil>0) && (buf2fil>0) && COMPLINE(buf1top,buf2top))
X       {lines1=lines2=1; goto flushlines;}
X
X     /* At this point, we know we have a differences section. */
X     anydiff=TRUE;
X
X     /* We now compare the top lines of the two buffers for a match. A match  */
X     /* is only considered to have been found if we match GAP consecutive     */
X     /* lines. The best match minimizes the DISTANCE which is the sum of the  */
X     /* offsets (lines1,lines2) (in lines) from the top of each buffer where  */
X     /* the match starts. Even better matches minimize abs(lines1-lines2) as  */
X     /* well. All these nested loops are to ensure that we search best first. */
X     for (d=1;d<=MAXDIST;d++)
X       {
X        /* Calculate half distance on the high side. */
X        long half = (d/2)+1;
X        long off;
X        long sign_v;
X        /* Explore up and down simultaneously from the halfway mark. */
X        for (off=0;off<=half;off++)
X           for (sign_v= -1;sign_v<2;sign_v+=2)
X             {
X              long x = half + sign_v*off;
X              /* The following test allows the above loops to be sloppy. */
X              if (0<=x && x<=d)
X                {
X                 lines1=x;
X                 lines2=d-lines1;
X                 /* We now know that we want to test at (lines1,lines2).  */
X                 /* So compare the GAP lines starting at those positions. */
X                 /* Note: lines1 and lines2, as well as being the number  */
X                 /* of lines processed, are also the offset to the first  */
X                 /* match line in our match gap.                          */
X                 for (g=0;g<GAP;g++)
X                   { /* Note: R for relative, A for absolute. */
X                    ulong t1r = lines1 + g;
X                    ulong t2r = lines2 + g;
X                    ulong t1a,t2a;
X
X                    /* If both files have run out at this point, it's a match!*/
X                    if ((t1r>=buf1fil) && (t2r>=buf2fil)) continue;
X
X                    /* If just one of the files has run out it's a mismatch.  */
X                    if ((t1r>=buf1fil) || (t2r>=buf2fil)) goto gapfail;
X
X                    /* We now know that we have two real lines. Compare them. */
X                    /* Variables are to avoid big nested macro expansions.    */
X                    t1a = WRAP(buf1top+t1r);
X                    t2a = WRAP(buf2top+t2r);
X                    if (!COMPLINE(t1a,t2a)) goto gapfail;
X                   }
X                 /* If we dropped out of the gap loop, we must have found     */
X                 /* GAP consecutive matches. So we can run off and write out  */
X                 /* the difference section.                                   */
X                 goto writediff;
X
X                 /* Here's where we jump if we found a mismatch during gap    */
X                 /* looping. All we do is try next pair of offsets.           */
X                 gapfail:;
X                } /* End sloppy if. */
X             } /* End for sign_v. */
X       } /* End for distance loop. */
X
X     /* If we got to here then we must have dropped out of the search loop    */
X     /* which means that there must have been no match at all between the     */
X     /* buffers. The only thing to do is to write out what we have as         */
X     /* a differences section.                                                */
X     lines1=buf1fil;
X     lines2=buf2fil;
X
X     /* Write out the differences section (lines1,lines2) to the log file. */
X     writediff:
X     { /* Begin writediff */
X      ulong i,j;
X      LOGSTR("\n");
X      LOGSTR("     +-----\n");
X      for (i=0;i<lines1;i++)
X        {
X         ulong nline = WRAP(buf1top+i);
X         sprintf(linet1,"%05lu|",(ulong) topnum1+i); LOGLINE;
X         for (j=0;j<buf1[nline].l_line;j++)
X            LOGCHAR(*(buf1[nline].p_line+j));
X        }
X      LOGSTR("     +-----\n");
X      for (i=0;i<lines2;i++)
X        {
X         ulong nline = WRAP(buf2top+i);
X         sprintf(linet1,"%05lu|",(ulong) topnum2+i); LOGLINE;
X         for (j=0;j<buf2[nline].l_line;j++)
X            LOGCHAR(*(buf2[nline].p_line+j));
X        }
X      LOGSTR("     +-----\n");
X     } /* End writediff. */
X
X     /* Flush from buffer however many lines we ended up processing. */
X     flushlines:
X     buf1top=WRAP(buf1top+lines1); topnum1+=lines1; buf1fil-=lines1;
X     buf2top=WRAP(buf2top+lines2); topnum2+=lines2; buf2fil-=lines2;
X
X    } /* End the while loop that runs through the two files. */
X } /* End of anonymous block for doing actual comparison. */
X
X /* The anydiff flag tells us if the loop found any difference sections. */
X is_same=!anydiff;
X
X /* Target position if we couldn't map in the input files earlier. */
X frombadmap:
X
X /* Release the memory allocated by the mapper for the input files. */
X /* Failure to do this will result in a memory leak!                */
X mm_zapt();
X
X /* If the two files are identical, tell the log file. */
X if (is_same)
X   LOGSTR("The two files are IDENTICAL.\n");
X
X /* Invalidate this test in the log file, if inconsistent (see later). */
X if (is_same != is_image)
X    LOGSTR("<<CONSISTENCY FAILURE: ABOVE COMPARISON INVALID>>\n");
X
X /* If we had problems with the log file at any stage, kick up a fuss now. */
X if (badwrite)
X   {wl_sj("S: DIFF: Error writing to log file."); num_sev++;}
X
X /* Close the log file. */
X if (fclose(logfile) == FCLOSE_F)
X   {wl_sj("S: DIFF: Error closing the log file."); num_sev++;}
X
X /* The above code is quite tricky and there is a chance that it contains     */
X /* bugs. So, as a safety check we compare the results from the binary memory */
X /* image comparison performed earlier and the more complicated text          */
X /* comparison above. If they differ, then it's time to go kaboom.            */
X if (is_image && !is_same)
X    as_bomb("do_diff: Image comparison succeeded, but text comparison failed.");
X if (!is_image && is_same)
X    as_bomb("do_diff: Image comparison failed, but text comparison succeeded.");
X
X /* If files are non-same and ABORT option is turned on, set severe status. */
X if (!is_same && diffabort)
X   {
X    wl_sj(
X     "S: DIFF: Files have not been proven identical, and ABORT option is on.");
X    num_sev++;
X   }
X
X /* Tell the console whether comparison succeeded. */
X if (is_same)
X    wl_sj("The two files are IDENTICAL.");
X else
X    wl_sj("The two files are DIFFERENT (see the differences file for the details).");
X
X /* Increment the difference summary counters. */
X difftotl++;
X if (is_same)
X    diffsucc++;
X}
X
X/******************************************************************************/
X
LOCAL void do_dsum P_((void));
LOCAL void do_dsum ()
X{
X sprintf(linet1,"Summary of Differences"); wl_sj(linet1);
X sprintf(linet1,"----------------------"); wl_sj(linet1);
X sprintf(linet1,"Identical = %lu.",(ulong)            diffsucc); wl_sj(linet1);
X sprintf(linet1,"Different = %lu.",(ulong) (difftotl-diffsucc)); wl_sj(linet1);
X sprintf(linet1,"Total     = %lu.",(ulong)            difftotl); wl_sj(linet1);
X}
X
X/******************************************************************************/
X
LOCAL void do_dzer P_((void));
LOCAL void do_dzer ()
X/* Zaps difference counters. */
X{
X difftotl = 0;
X diffsucc = 0;
X}
X
X/******************************************************************************/
X
LOCAL void do_eneo P_((void));
LOCAL void do_eneo ()
X{
X if (arg_num != 2)
X   {
X    wl_sj("S: The ENEO command must be given exactly one argument.");
X    num_sev++;
X    return;
X   }
X if (fexists(arg_arr[1]))
X    if (remove(arg_arr[1]) != REMOVE_S)
X      {
X       sprintf(linet1,"S: ENEO failed to delete \"%s\".",arg_arr[1]);
X       wl_sj(linet1);
X       num_sev++;
X       return;
X      }
X}
X
X/******************************************************************************/
X
LOCAL void do_exec P_((void));
LOCAL void do_exec ()
X{
X uword i;
X
X if (arg_num < 2)
X   {
X    wl_sj("S: The EXECUTE command requires at least one argument.");
X    num_sev++;
X    return;
X   }
X if (arg_num > 10)
X   {
X    wl_sj("S: The EXECUTE command can have at most nine arguments.");
X    num_sev++;
X    return;
X   }
X
X /* Zap all the numeric arguments. */
X for (i=0; i<10; i++)
X    subval[i][0]=EOS;
X
X /* Copy the arguments over to the $1 $2 etc substitution variables. */
X for (i=1;i<arg_num; i++)
X    strcpy(subval[i-1],arg_arr[i]);
X
X /* Run up a new FunnelWeb shell and interpret the file. */
X interstr(arg_arr[1]);
X}
X
X/******************************************************************************/
X
LOCAL void do_exist P_((void));
LOCAL void do_exist ()
X{
X if (arg_num != 2)
X   {
X    wl_sj("S: The EXISTS command requires exactly one argument.");
X    num_sev++;
X    return;
X   }
X if (!fexists(arg_arr[1]))
X   {
X    sprintf(linet1,"S: EXISTS failed to find \"%s\".",arg_arr[1]);
X    wl_sj(linet1);
X    num_sev++;
X    return;
X   }
X}
X
X/******************************************************************************/
X
LOCAL void do_fix P_((void));
LOCAL void do_fix ()
X/* When the test suite is moved from one machine to another, it is possible   */
X/* that at some stage it will be moved using a BINARY transfer rather than a  */
X/* text file transfer. The result is that the test files will contain lines   */
X/* terminated with a sequence of control characters that the local buffered   */
X/* IO library will not convert to '\n' upon reading in. The are a few         */
X/* solutions to this problem, but one of the most direct is to have a command */
X/* such as this one that can convert the file over.                           */
X/*                                                                            */
X/* Once we have identified an end of line, it is easy to write it out as we   */
X/* can just send a '\n' and the local buffered IO library will write the      */
X/* right codes for us. The tricky part is deciding what an EOL is in the      */
X/* input stream. Well, I could have made the control characters for the       */
X/* remote EOL a parameter of this command, but instead I decided to use a     */
X/* simple algorithm that should cover nearly all cases...                     */
X/* ALGORITHM: Parse the input into alternating blocks of control characters   */
X/* and non-control characters. Parse each block of control characters into    */
X/* subblocks by parsing it from left to right and starting a new subblock the */
X/* moment a character of the subblock currently being parsed appears again.   */
X/* This covers at least the following cases, and probably many more:          */
X/*    UNIX         LF                                                         */
X/*    MSDOS     CR LF                                                         */
X/*    Macintosh CR                                                            */
X{
X /* Erk! But I found out the hard way, it doesn't work on a VAX!              */
X /* I'm making this do nothing on a VAX rather than generate an error as I    */
X /* want the scripts to work silently on the VAX without modification.        */
X#if !VMS
X FILE *infile;     /* File variable for input file.                           */
X FILE *tmpfile;    /* File variable for temporary output file.                */
X char *p_target;   /* Name of final (target) output file.                     */
X STAVAR char *p_temp=NULL;   /* Name of temporary output file.                */
X
X bool  seen[256];  /* TRUE if char is in current control sequence.            */
X char  undo[256];  /* undo[0..length-1] contains current control sequence.    */
X uword length;     /* Number of control bytes in our buffer.                  */
X uword i;
X int status;
X
X /* Allocate the temporary file name if not already allocated. */
X if (p_temp==NULL) p_temp=(p_fn_t) mm_perm(sizeof(fn_t));
X
X /* We can take one or two arguments. One argument means that we should       */
X /* fix up the input file, leaving the result in the input file.              */
X if (arg_num != 2 && arg_num != 3)
X   {
X    wl_sj("S: The FIXEOLS command requires one or two filename arguments.");
X    num_sev++;
X    return;
X   }
X
X /* Change to two arguments if the input name is the same as output name. */
X if (arg_num==3 && strcmp(arg_arr[1],arg_arr[2])==0) arg_num=2;
X
X /* Work out what the target name is going to be. */
X p_target=(arg_num==2) ? arg_arr[1] : arg_arr[2];
X
X /* Generate a temporary filename for the output file. This is tricky because */
X /* on many machines, one cannot rename across devices or directories. This   */
X /* means that the temporary file has to be created in the same directory as  */
X /* the file that we are going to rename it to later (the target file).       */
X strcpy(p_temp,p_target);
X fn_ins(p_temp,fn_temp());
X
X /* Open the input file for BINARY reading. */
X infile=fopen(arg_arr[1],"rb");
X if (infile == FOPEN_F)
X   {
X    sprintf(linet1,"S: FIXEOLS: Error opening \"%s\".",arg_arr[1]);
X    wl_sj(linet1);
X    num_sev++;
X    return;
X   }
X
X /* Create the output file for TEXT writing. */
X tmpfile=fopen(p_temp,"w");
X if (tmpfile == FOPEN_F)
X   {
X    fclose(infile);
X    wl_sj("S: FIXEOLS: Error creating the temporary output file.");
X    num_sev++;
X    return;
X   }
X
X /* Initialialize the control character buffer to empty. */
X for (i=0;i<256;i++) seen[i]=FALSE;
X length=0;
X
X while (TRUE)
X   {
X    /* Read in the next character from the input file. */
X    char ch=getc(infile);
X    if (ferror(infile))
X       {wl_sj("S: FIXEOLS: Error reading the input file.");num_sev++;return;}
X    if (feof(infile)) break;
X
X    /* Does character terminate a non-empty buffer? If so, flush it. */
X    if (length>0 && (isascprn(ch) || seen[ch]))
X      {
X       if (fputc(EOL,tmpfile) == FPUTC_F) goto write_failure;
X       for (i=0;i<length;i++) seen[undo[i]]=FALSE;
X       length=0;
X      }
X
X    /* Now we can approach the character cleanly and freshly. */
X    if (isascprn(ch))
X       {if (fputc(ch,tmpfile) == FPUTC_F) goto write_failure;}
X    else
X       {undo[length++]=ch; seen[ch]=TRUE;}
X   }
X if (length>0)
X   {if (fputc(EOL,tmpfile) == FPUTC_F) goto write_failure;}
X
X if (fflush(tmpfile) != FFLUSH_S)
X    {wl_sj("S: FIXEOLS: Error flushing the temporary output file.");num_sev++;return;}
X if (fclose(infile) == FCLOSE_F)
X   {wl_sj("S: FIXEOLS: Error closing the input file.");num_sev++;return;}
X if (fclose(tmpfile) == FCLOSE_F)
X   {wl_sj("S: FIXEOLS: Error closing the temporary output file.");num_sev++;return;}
X
X /* If renaming to the input file, we have to delete the input file first. */
X if (arg_num==2)
X   {
X    status=remove(arg_arr[1]);
X    if (status != REMOVE_S)
X      {
X       wl_sj("S: FIXEOLS: Error deleting existing input file to replace it");
X       wl_sj("            with the temporary output file. Deleting temporary and aborting...");
X       remove(p_temp);
X       num_sev++;
X       return;
X      }
X   }
X
X /* Rename the temporary file to the target output file. */
X status=rename(p_temp,p_target);
X
X /* Do the error checking. */
X if (status != RENAME_S)
X   {
X    wl_sjl("S: FIXEOLS: Error renaming temporary output file to output file.");
X    sprintf(linet1,"Temporary file name was \"%s\".",p_temp);
X    wl_sjl(linet1);
X    sprintf(linet1,"Output    file name was \"%s\".",p_target);
X    wl_sjl(linet1);
X    wl_sjl("FunnelWeb will leave both files intact so you can look at them.");
X    num_sev++;
X    return;
X   }
X
X return;
X
X write_failure:
X    wl_sj("S: FIXEOLS: Error writing the output file.");num_sev++;return;
X#endif
X}
X
X/******************************************************************************/
X
LOCAL void do_fweb P_((char *));
LOCAL void do_fweb(p_cl)
X/* This function performs a single run of FunnelWeb proper. */
char *p_cl;
X{
X op_t saveop;
X
X /* Do set can do all the work for us. However, it operates on p_defopt so we */
X /* have to do some juggling.                                                 */
X ASSIGN(saveop,*p_defopt);
X do_set(p_cl);
X ASSIGN(option,*p_defopt);
X ASSIGN(*p_defopt,saveop);
X if (num_sev>0) return;
X
X /* do_set ensures that the user hasn't specified any action parameters such  */
X /* as +X and +K, but it necessarily doesn't check to make sure that the user */
X /* has actually specified an input file!                                     */
X if (!option.op_f_b)
X   {
X    wl_sj("S: No input file specified in FW command.");
X    num_sev++;
X    return;
X   }
X fwonerun();
X}
X
X/******************************************************************************/
X
LOCAL void do_help P_((void));
LOCAL void do_help()
X{
X uword messno;
X
X if (arg_num == 1)
X   {
X    hel_wri(wr_sj,HL_MEN);
X    return;
X   }
X if (arg_num > 2)
X   {
X    wl_sj("S: The HELP command takes at most one argument.");
X    num_sev++;
X    return;
X   }
X
X /* Translate message name to number. */
X
X messno=hel_num(arg_arr[1]);
X if (messno == HL_ERR)
X   {
X    wl_sj(
X   "S: Unrecognised help message name. Try just \"help\" for a list of names.");
X    num_sev++;
X    return;
X   }
X
X hel_wri(wr_sj,messno);
X}
X
X/******************************************************************************/
X
LOCAL void do_set(p_comlin)
X/* The SET command allows the user to specify default FunnelWeb options.      */
char *p_comlin;
X{
X op_t tmpopt;
X
X /* Experiment with temporary options, not the real thing. */
X ASSIGN(tmpopt,*p_defopt);
X
X /* Now execute the effect of the command line on 'p_defopt'. */
X if (!op_add(&tmpopt,p_comlin,wr_sj))
X   {
X    wl_s("This is a severe error (S). Aborting to FunnelWeb shell...");
X    num_sev++;
X    return;
X   }
X
X /* Now make sure that the user didn't specify an option to do with the       */
X /* entire FunnelWeb run and not just this invocation of FunnelWeb proper.    */
X if (tmpopt.op_j_b)
X   {
X    wl_s("S: You cannot invoke FunnelWeb with +J from the FunnelWeb shell.");
X    wl_s("   To create a journal file, exit FunnelWeb and reinvoke with \"fw +j\".");
X    wl_s("This is a severe error. Aborting to FunnelWeb shell...");
X    num_sev++;
X    return;
X   }
X if (tmpopt.op_x_b)
X   {
X    wl_s("S: You cannot invoke FunnelWeb with +X from the FunnelWeb shell.");
X    wl_s("Use the interactive command EXECUTE instead.");
X    wl_s("This is a severe error. Aborting to FunnelWeb shell...");
X    num_sev++;
X    return;
X   }
X if (tmpopt.op_k_b)
X   {
X    wl_s("S: You cannot invoke FunnelWeb with +K from the FunnelWeb shell.");
X    wl_s("This is a severe error. Aborting to FunnelWeb shell...");
X    num_sev++;
X    return;
X   }
X if (tmpopt.op_h_b)
X   {
X    wl_s("S: You cannot invoke FunnelWeb with +H from the FunnelWeb shell.");
X    wl_s("Use the interactive command HELP instead.");
X    wl_s("This is a severe error. Aborting to FunnelWeb shell...");
X    num_sev++;
X    return;
X   }
X
X /* If we get to here, the options must be OK so we can set them as default. */
X ASSIGN(*p_defopt,tmpopt);
X}
X
X/******************************************************************************/
X
LOCAL void do_show P_((void));
LOCAL void do_show()
X/* The SHOW command writes out the current options. */
X{
X if (arg_num != 1)
X   {
X    wl_sj("S: The SHOW command does not take arguments.");
X    num_sev++;
X    return;
X   }
X wl_sj("Here are the FunnelWeb command line options that are");
X wl_sj("current in this FunnelWeb session:");
X op_wri(p_defopt,wr_sj);
X}
X
X/******************************************************************************/
X
LOCAL void do_stat P_((void));
LOCAL void do_stat ()
X/* The status command checks the number of diagnostics generated by the run.  */
X{
X uword i;
X char *thing;
X ulong cnum;
X
X if (arg_num<1 || arg_num>4)
X   {
X    wl_sj("S: The STATUS command requires zero to three arguments.");
X    num_sev++;
X    return;
X   }
X
X /* Zero arguments just means write out status. */
X if (arg_num == 1)
X   {
X    sprintf(linet1,"Last command: Severes=%lu, Errors=%lu, Warnings=%lu.",
X            (ulong) old_sev, (ulong) old_err, (ulong) old_war);
X    wl_sj(linet1);
X    sprintf(linet1,"Totals      : Severes=%lu, Errors=%lu, Warnings=%lu.",
X            (ulong) sum_sev, (ulong) sum_err, (ulong) sum_war);
X    wl_sj(linet1);
X    return;
X   }
X
X /* More than one argument means CHECK status. */
X for (i=1;i<arg_num;i++)
X   {
X    char ch=toupper(arg_arr[i][0]);
X    unsigned num;
X    if (ch!='W' && ch!='E' && ch!='S')
X      {
X       sprintf(linet1,
X              "S: Argument %u of STATUS command has bad letter.",
X               (unsigned) i);
X       wl_sj(linet1);
X       wl_sj("Arguments must be of the form ('W'|'E'|'S')<decimalnumber>.");
X       num_sev++;
X       return;
X      }
X    if (sscanf(&arg_arr[i][1],"%u",&num) != 1)
X      {
X       sprintf(linet1,
X      "S: Argument %u of STATUS command has bad number.",
X               (unsigned) i);
X       wl_sj(linet1);
X       wl_sj("   Arguments must be of the form ('W'|'E'|'S')<decimalnumber>.");
X       num_sev++;
X       return;
X      }
X    switch(ch)
X      {
X       case 'W': cnum=old_war; thing="warnings"; break;
X       case 'E': cnum=old_err; thing="errors"  ; break;
X       case 'S': cnum=old_sev; thing="severes" ; break;
X       default : as_bomb("do_stat: case defaulted.");
X      }
X    if (cnum != num)
X      {
X       sprintf(linet1,
X       "S: STATUS command detected wrong number of %s.",thing);
X       wl_sj(linet1);
X       sprintf(linet1, "Specifed %s=%u, Actual %s=%u.",
X               thing,(unsigned) num,thing,(unsigned) cnum);
X       wl_sj(linet1);
X       num_sev++;
X      }
X   }
X}
X
X/******************************************************************************/
X
X
LOCAL void do_trace P_((void));
LOCAL void do_trace()
X{
X if (arg_num != 2) goto help;
X strupper(arg_arr[1]);
X if (strcmp(arg_arr[1],"OFF") == 0) {tracing=FALSE; return;}
X if (strcmp(arg_arr[1], "ON") == 0) {tracing=TRUE ; return;}
X
X help:
X    wl_sj("S: The TRACE command has two forms:");
X    wl_sj("      TRACE OFF");
X    wl_sj("      TRACE ON");
X    num_sev++;
X    return;
X}
X
X/******************************************************************************/
X
LOCAL void do_write P_((char *));
LOCAL void do_write(p)
char *p;
X{
X uword len;
X
X /* Skip over the main command and the following blanks. */
X while (*p!=' ' && *p!=EOS) p++;
X while (*p==' ') p++;
X
X /* Now make sure that the remaining string is delimited by double quotes.    */
X len=strlen(p);
X if ((*p != '\"') || (p[len-1] != '\"') || len<2)
X   {
X    wl_sj("W: The argument to WRITE should be delimited by double quotes.");
X    wl_sj(p);
X    num_war++;
X    return;
X   }
X
X /* Now temporarily hack out the quotes and write out the string. */
X p[len-1]=EOS;
X wl_sj(p+1);
X p[len-1]='\"';
X}
X
X/******************************************************************************/
X
LOCAL void do_writu P_((char *));
LOCAL void do_writu(p)
char *p;
X{
X uword len;
X
X /* Skip over the main command and the following blanks. */
X while (*p!=' ' && *p!=EOS) p++;
X while (*p==' ') p++;
X
X /* Now make sure that the remaining string is delimited by double quotes.    */
X len=strlen(p);
X if ((*p != '\"') || (p[len-1] != '\"') || len<2)
X   {
X    wl_sj("W: The argument to WRITEU should be delimited by double quotes.");
X    wl_sj(p);
X    num_war++;
X    return;
X   }
X
X /* Now temporarily hack out the quotes and write out the string. */
X p[len-1]=EOS;
X wl_sj(p+1);
X p[len-1]='\"';
X
X /* Now write out another line underlining the above. */
X {uword i; for (i=0;i<len-2;i++) wr_sj("-"); wl_sj("");}
X}
X
X/******************************************************************************/
X
LOCAL bool do_command P_((char *));
LOCAL bool do_command(p_command)
X/* Execute a single FunnelWeb shell command. */
char *p_command;
X{
X char *v;
X bool result=FALSE;
X
X zerdia();
X
X /* Check the command for non-printables. */
X {
X  char *s=p_command;
X  while (*s!=EOS)
X    {
X     if (!isascprn(*s))
X       {
X        sprintf(linet1,
X                "S: Command line has non-printable at column %u.",
X                (unsigned) (s-p_command)+1);
X        wl_sj(linet1);
X        num_sev++;
X        goto finished;
X       }
X     s++;
X    }
X }
X
X /* Perform substitutions. */
X dollsub(p_command); if (num_sev>0) goto finished;
X
X /* Ignore commands consisting entirely of blanks (or empty commands). */
X {
X  char *s=p_command;
X  while (*s==' ') s++;
X  if (*s==EOS) goto finished;
X }
X
X /* Reject command lines beginning with a blank. */
X if (p_command[0]==' ')
X   {
X    wl_sj("S: Leading blanks are not allowed in command lines.");
X    num_sev++;
X    goto finished;
X   }
X
X /* Ignore command lines commencing with the comment character. */
X if (p_command[0]=='!')
X    {restdia(); goto finished;}
X
X /* Parse the command line into arguments. */
X explode(p_command);
X
X /* Complain if there is no command verb. */
X as_cold(arg_num>0,"do_command: zero arguments!");
X
X /* It's convenient to have v pointing to verb. */
X v=arg_arr[0];
X
X /* Convert the verb to upper case. */
X strupper(v);
X
X
X /* Execute the verb. */
X
X if (strcmp(v,"HERE")==0) skipping=FALSE;
X else if (!skipping)
X      if (strcmp(v,"ABSENT"     )==0) do_absen();
X else if (strcmp(v,"CODIFY"     )==0) do_cody ();
X else if (strcmp(v,"COMPARE"    )==0) do_comp ();
X else if (strcmp(v,"DEFINE"     )==0) do_defin(&p_command[0]);
X else if (strcmp(v,"DIFF"       )==0) do_diff();
X else if (strcmp(v,"DIFFSUMMARY")==0) do_dsum();
X else if (strcmp(v,"DIFFZERO"   )==0) do_dzer();
X else if (strcmp(v,"ENEO"       )==0) do_eneo ();
X else if (strcmp(v,"EXECUTE"    )==0) do_exec ();
X else if (strcmp(v,"EXISTS"     )==0) do_exist();
X else if (strcmp(v,"FIXEOLS"    )==0) do_fix  ();
X else if (strcmp(v,"FW"         )==0) do_fweb (&p_command[0]);
X else if (strcmp(v,"HELP"       )==0) do_help ();
X else if (strcmp(v,"QUIT"       )==0) result=TRUE;
X else if (strcmp(v,"SET"        )==0) do_set  (&p_command[0]);
X else if (strcmp(v,"SHOW"       )==0) do_show ();
X else if (strcmp(v,"SKIPTO"     )==0) skipping=TRUE;
X else if (strcmp(v,"STATUS"     )==0) do_stat ();
X else if (strcmp(v,"TOLERATE"   )==0) noabort=TRUE;
X else if (strcmp(v,"TRACE"      )==0) do_trace();
X else if (strcmp(v,"WRITE"      )==0) do_write(&p_command[0]);
X else if (strcmp(v,"WRITEU"     )==0) do_writu(&p_command[0]);
X else
X   {
X    /* The following trace is likely to confuse beginners.        */
X    /* sprintf(linet1,"Expanded command line=\"%s\".",p_command); */
X    /* wl_sj(linet1);                                             */
X    wl_sj("S: Unknown command. Type HELP for a list of commands.");
X    num_sev++;
X    goto finished;
X   }
X
X finished:
X sumdia();
X return result;
X}
X
X/******************************************************************************/
X
LOCAL void interpret P_((FILE *,char *));
LOCAL void interpret(p_file,filnam)
X/* p_file must be a file opened for reading. The file's name must be supplied */
X/* in filnam for error reporting reasons. The function reads each line from   */
X/* the file and feeds it to the FunnelWeb interpreter command executer.       */
XFILE *p_file;
char *filnam;
X{
X ulong lineno=0;
X char *result;
X bool b;
X cl_t  comline;
X char *p_comline;
X
X p_comline = &comline[0];
X
X while (TRUE)
X   {
X    bool oldnoabort = noabort;
X    noabort=FALSE;
X
X    if (p_file == stdin || tracing)
X       wr_sj("FunnelWeb>");
X
X    result=fgets(p_comline,(int) COMLINE_MAX,p_file);
X    if (feof(p_file))
X      {
X       sprintf(linet1,"<End of Script File \"%s\">",filnam);
X      if (p_file == stdin || tracing)
X          wl_sj(linet1);
X       break;
X      }
X    if (ferror(p_file) || (result == FGETS_FE))
X      {
X       sprintf(linet1,"F: Error reading command file \"%s\".",filnam);
X       wl_sj(linet1);
X       wl_sj("Aborting...");
X       sum_fat++;
X       return;
X      }
X    if (p_file == stdin || tracing) wr_j(p_comline);
X    if (p_file != stdin && tracing) wr_s(p_comline);
X
X    lineno++;
X    if (strlen(p_comline)==COMLINE_MAX)
X      {
X       sprintf(linet1,"F: Line %lu of command file \"%s\" is too long.",
X                      (unsigned long) lineno,filnam);
X       wl_sj(linet1);
X       wl_sj("Aborting...");
X       sum_fat++;
X       return;
X      }
X    as_cold(p_comline[strlen(p_comline)-1]==EOL,"interpret: NO NEWLINE!");
X    p_comline[strlen(p_comline)-1]=EOS;
X    as_cold(strlen(p_comline)<COMLINE_MAX,"interpret: Filename too long.");
X
X    b=do_command(p_comline);
X    if (b) break;
X
X    if (sum_fat>0) break;
X    if ((p_file != stdin) && (num_sev+num_err>0) && !oldnoabort)
X      {
X       wl_sj("Error caused termination of FunnelWeb shellscript.");
X       break;
X      }
X   }
X}
X
X/******************************************************************************/
X
LOCAL void interstr(filnam)
X/* The 'interpret' function (above) interprets each line of a file already    */
X/* opened for reading. This function does a little more, opening and closing  */
X/* the file before and after calling 'interpret'.                             */
char *filnam;
X{
X FILE *p_file;
X fn_t fn;
X
X /* Set up a default of ".fws" as a file extension. */
X strcpy(&fn[0],".fws");
X
X /* Inherit the actual filename. */
X as_cold(strlen(filnam)<=FILENAME_MAX,"interstr: Filename blasted.");
X fn_ins(&fn[0],filnam);
X
X p_file=fopen(fn,"r");
X if (p_file == FOPEN_F)
X   {
X    sprintf(linet1,"S: Error opening command file \"%s\".",fn);
X    wl_sj(linet1);
X    sum_sev++;
X    return;
X   }
X
X interpret(p_file,&fn[0]); if (sum_fat>0) return;
X
X if (fclose(p_file) == FCLOSE_F)
X   {
X    sprintf(linet1,"F: Error closing command file \"%s\".",fn);
X    wl_sj(linet1);
X    wl_sj("Aborting...");
X    sum_fat++;
X    return;
X   }
X}
X
X/******************************************************************************/
X
LOCAL void chk_cline P_((void));
LOCAL void chk_cline()
X/* Checks to make sure that the command line specifies exactly one action.    */
X{
X uword countopt=0;
X
X /* Count the number of active action options are turned on. */
X if (p_comopt->op_f_b) countopt++;
X if (p_comopt->op_x_b) countopt++;
X if (p_comopt->op_k_b) countopt++;
X if (p_comopt->op_h_b) countopt++;
X
X if (countopt == 0)
X   {
X    wl_sj("Your command line does not specify an action.");
X    wl_sj("Here some common ways of invoking FunnelWeb.");
X    wl_sj("");
X    wl_sj("   fw filename          Tangle filename.web.");
X    wl_sj("   fw filename +t       Tangle and weave filename.web.");
X    wl_sj("   fw +k                Enter interactive mode.");
X    wl_sj("   fw +xfilename        Execute FunnelWeb shellscript filename.fws.");
X    wl_sj("   fw +h                Display help information about FunnelWeb.");
X    wl_sj("");
X    if (countopt == 0)
X       wl_sj("F: Aborting because command line does not specify an action.");
X    sum_fat++;
X   }
X}
X
X/******************************************************************************/
X
LOCAL void open_j P_((void));
LOCAL void open_j()
X/* Creates and opens the journal file. Note that the journal output stream is */
X/* established regardless of whether the user requested a journal file. The   */
X/* only difference is that if the user did not specify a journal file, the    */
X/* stream is created in error mode which means that it never actually writes. */
X{
X fn_t jname;
X
X /* Establish the journal file output stream. */
X strcpy(jname,"");                 /* Start with an empty string.             */
X fn_ins(jname,p_comopt->op_f_s);   /* Insert input file name.                 */
X fn_ins(jname,".jrn");             /* Insert file extension.                  */
X fn_ins(jname,p_comopt->op_j_s);   /* Insert command line spec.               */
X wf_ini(&f_j,p_comopt->op_j_b);    /* Initialize the stream.                  */
X wf_ope(&f_j,jname);            /* Create the file.                           */
X if (p_comopt->op_j_b && wf_err(&f_j))
X   {
X    sprintf(linet1,"F: Error creating journal file \"%s\".",jname);
X    wl_s(linet1);
X    wl_s("Aborting...");
X    sum_fat++;
X    return;
X   }
X}
X
X/******************************************************************************/
X
LOCAL void close_j P_((void));
LOCAL void close_j()
X/* Closes the journal file. */
X{
X if (!p_comopt->op_j_b) return;
X if (wf_err(&f_j))
X   {
X    wl_s("F: Error writing to journal file. Aborting...");
X    sum_fat++;
X    return;
X   }
X wf_clo(&f_j);
X if (wf_err(&f_j))
X   {
X    wl_s("F: Error flushing and closing journal file. Aborting...");
X    sum_fat++;
X    return;
X   }
X}
X
X/******************************************************************************/
X
LOCAL void cl_help P_((void));
LOCAL void cl_help ()
X{
X uword messno;
X
X /* Translate message name to number. This ought to work, as the options      */
X /* package is already have supposed to have cleared this argument as OK.     */
X messno=hel_num(p_comopt->op_h_s);
X as_cold(messno!=HL_ERR,"cl_help: Unknown help argument.");
X
X /* Write out the message. */
X hel_wri(wr_sj,messno);
X}
X
X/******************************************************************************/
X
XEXPORT void command(p_comline)
X/* Execute the top level command line. This is the place where we do all the  */
X/* "once per shell" things as opposed to the "once per run" things.           */
X/* If a fatal error occurs, the correct course of action here is to increment */
X/* sum_fat and return immediately. The main() function deals with delivering  */
X/* the correct return status to the operating system.                         */
char *p_comline;
X{
X old_war=old_err=old_sev=0;
X
X tracing=FALSE;
X noabort=FALSE;
X skipping=FALSE;
X
X /* Allocate space for command line arguments. */
X allocarg();
X
X /* Set up the standard output (stdout) screen (console) output stream. */
X wf_ini(&f_s,TRUE);
X wf_att(&f_s,stdout);
X
X /* Parse the command line and place the information in p_comopt-> */
X op_ini(p_comopt);
X if (!op_add(p_comopt,p_comline,wr_s))
X   {wr_s("F: Command line error. Aborting..."); sum_fat++; goto windup;}
X
X /* If the user asked for some peace and quiet by setting +Q, disable the     */
X /* console stream. Note: FunnelWeb main() always issues a message using a    */
X /* printf if any diagnostics have been generated.                            */
X if (p_comopt->op_q_b) wf_ini(&f_s,FALSE);
X
X /* Create and open the journal file. */
X open_j(); if (sum_fat>0) goto windup;
X
X wl_sj("FunnelWeb Version 3.0 (May 1992)");
X wl_sj("--------------------------------");
X wl_sj("Copyright (C) Ross Williams 1992. There is ABSOLUTELY NO WARRANTY.");
X wl_sj("You are welcome to distribute this software under certain conditions.");
X if (p_comopt->op_k_b)
X wl_sj("For more information, type HELP.");
X else
X wl_sj("For more information, use the +h (help) option (e.g. \"fw +h\").");
X wl_sj("");
X
X /* Ensure that the user has specified at least one action. */
X chk_cline(); if (sum_fat>0) goto windup;
X
X /* Establish the default options for the shell run (if any).                 */
X /* Get rid of any options not to do with a single run of FunnelWeb proper.   */
X ASSIGN(*p_defopt,*p_comopt);
X p_defopt->op_j_b=FALSE;
X p_defopt->op_x_b=FALSE;
X p_defopt->op_k_b=FALSE;
X
X /* In the absence of everything else, command line options are run options. */
X ASSIGN(option,*p_comopt);
X
X /* Execute initialization file if any. */
X if (fexists(INITFILE))
X    interstr(INITFILE);
X
X /* Execute the specified actions. */
X if (p_comopt->op_x_b) interstr(p_comopt->op_x_s);
X if (p_comopt->op_f_b) {zerdia(); fwonerun(); sumdia();}
X if (p_comopt->op_h_b) cl_help();
X if (p_comopt->op_k_b) interpret(stdin,"standard_input");
X
X /* If we weren't in onerun mode, give a grand summary of errors. */
X if (p_comopt->op_k_b || p_comopt->op_x_b)
X    {
X     wr_sj("Final diagnostics totals: ");
X     errsum(sum_fat,sum_sev,sum_err,sum_war);
X     wl_sj(linet1);
X    }
X
X /* Close the journal file. */
X close_j(); if (sum_fat>0) goto windup;
X
X /* Check for errors on the screen stream (standard output). */
X if (p_comopt->op_s_b && wf_err(&f_s))
X   {
X    /* No point in trying to write a message to the screen! */
X    /* But we can at least register a fatal error.          */
X    sum_fat++;
X   }
X
X windup:
X
X /* If the user has set +Q to turn off screen output and one or more          */
X /* diagnostics have been generated, we need to break through to warn the     */
X /* user.                                                                     */
X {
X  ulong sum_all=sum_fat+sum_sev+sum_err+sum_war;
X  if (p_comopt->op_q_b && sum_all>0)
X     {
X      errsum(sum_fat,sum_sev,sum_err,sum_war);
X      fprintf(stderr,"%s\n",linet1);
X     }
X }
X}
X
X/******************************************************************************/
X/*                             End of COMMAND.C                               */
X/******************************************************************************/
END_OF_FILE
if test 69805 -ne `wc -c <'sources/command.c'`; then
    echo shar: \"'sources/command.c'\" unpacked with wrong size!
fi
# end of 'sources/command.c'
fi
echo shar: End of archive 18 \(of 20\).
cp /dev/null ark18isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 20 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0