Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume11/gnuplot2/part07

Text File | 1990-03-25 | 48.4 KB | 2,157 lines

Newsgroups: comp.sources.misc
organization: Pixar -- Marin County, California
subject: v11i072: Gnuplot 2.0 - 7 of 14
From: [e-mail]@pixar.UUCP (Tom Williams)
Sender: [e-mail] (Brandon S. Allbery - comp.sources.misc)

Posting-number: Volume 11, Issue 72
Submitted-by: [e-mail]@pixar.UUCP (Tom Williams)
Archive-name: gnuplot2/part07

This is gnuplot.sh07

--- CUT HERE ---
#! /bin/sh
echo x - misc.c
sed 's/^X//' >misc.c <<'*-*-END-of-misc.c-*-*'
X/* GNUPLOT - misc.c */
X/*
X * Copyright (C) 1986, 1987, 1990   Thomas Williams, Colin Kelley
X *
X * Permission to use, copy, and distribute this software and its
X * documentation for any purpose with or without fee is hereby granted,
X * provided that the above copyright notice appear in all copies and
X * that both that copyright notice and this permission notice appear
X * in supporting documentation.
X *
X * Permission to modify the software is granted, but not the right to
X * distribute the modified code.  Modifications are to be distributed
X * as patches to released version.
X *
X * This software  is provided "as is" without express or implied warranty.
X *
X *
X * AUTHORS
X *
X *   Original Software:
X *     Thomas Williams,  Colin Kelley.
X *
X *   Gnuplot 2.0 additions:
X *       Russell Lang, Dave Kotz, John Campbell.
X *
X * send your comments or suggestions to (pixar![e-mail]).
X *
X */
X
X#include <stdio.h>
X#include <math.h>
X#include "plot.h"
X#include "setshow.h"
X#include "help.h"
X#ifdef __TURBOC__
X#include <graphics.h>
X#endif
X
Xextern int c_token;
Xextern char replot_line[];
Xextern struct at_type at;
Xextern struct ft_entry ft[];
Xextern struct udft_entry *first_udf;
Xextern struct udvt_entry *first_udv;
X
Xextern struct at_type *temp_at();
X
Xextern BOOLEAN interactive;
Xextern char *infile_name;
Xextern int inline_num;
X
X/* State information for load_file(), to recover from errors
X * and properly handle recursive load_file calls
X */
Xtypedef struct lf_state_struct LFS;
Xstruct lf_state_struct {
X    FILE *fp;                /* file pointer for load file */
X    char *name;            /* name of file */
X    BOOLEAN interactive;        /* value of interactive flag on entry */
X    int inline_num;            /* inline_num on entry */
X    LFS *prev;                /* defines a stack */
X} *lf_head = NULL;            /* NULL if not in load_file */
X
Xstatic BOOLEAN lf_pop();
Xstatic void lf_push();
X
X/*
X * instead of <strings.h>
X */
Xextern int strcmp();
X
X
X/*
X * cp_free() releases any memory which was previously malloc()'d to hold
X *   curve points.
X */
Xcp_free(cp)
Xstruct curve_points *cp;
X{
X    if (cp) {
X        cp_free(cp->next_cp);
X        if (cp->title)
X            free((char *)cp->title);
X        free((char *)cp);
X    }
X}
X
X
X
Xsave_functions(fp)
XFILE *fp;
X{
Xregister struct udft_entry *udf = first_udf;
X
X    if (fp) {
X        while (udf) {
X            if (udf->definition)
X                fprintf(fp,"%s\n",udf->definition);
X            udf = udf->next_udf;
X        }
X        (void) fclose(fp);
X    } else
X        os_error("Cannot open save file",c_token);
X}
X
X
Xsave_variables(fp)
XFILE *fp;
X{
Xregister struct udvt_entry *udv = first_udv->next_udv;    /* skip pi */
X
X    if (fp) {
X        while (udv) {
X            if (!udv->udv_undef) {
X                fprintf(fp,"%s = ",udv->udv_name);
X                disp_value(fp,&(udv->udv_value));
X                (void) putc('\n',fp);
X            }
X            udv = udv->next_udv;
X        }
X        (void) fclose(fp);
X    } else
X        os_error("Cannot open save file",c_token);
X}
X
X
Xsave_all(fp)
XFILE *fp;
X{
Xregister struct udft_entry *udf = first_udf;
Xregister struct udvt_entry *udv = first_udv->next_udv;    /* skip pi */
X
X    if (fp) {
X        save_set_all(fp);
X        while (udf) {
X            if (udf->definition)
X                fprintf(fp,"%s\n",udf->definition);
X            udf = udf->next_udf;
X        }
X        while (udv) {
X            if (!udv->udv_undef) {
X                fprintf(fp,"%s = ",udv->udv_name);
X                disp_value(fp,&(udv->udv_value));
X                (void) putc('\n',fp);
X            }
X            udv = udv->next_udv;
X        }
X        fprintf(fp,"%s\n",replot_line);
X        (void) fclose(fp);
X    } else
X        os_error("Cannot open save file",c_token);
X}
X
X
Xsave_set(fp)
XFILE *fp;
X{
X    if (fp) {
X        save_set_all(fp);
X        (void) fclose(fp);
X    } else
X        os_error("Cannot open save file",c_token);
X}
X
X
Xsave_set_all(fp)
XFILE *fp;
X{
Xstruct text_label *this_label;
Xstruct arrow_def *this_arrow;
X    fprintf(fp,"set terminal %s\n", term_tbl[term].name);
X    fprintf(fp,"set output %s\n",strcmp(outstr,"STDOUT")? outstr : "" );
X    fprintf(fp,"set %sclip points\n", (clip_points)? "" : "no");
X    fprintf(fp,"set %sclip one\n", (clip_lines1)? "" : "no");
X    fprintf(fp,"set %sclip two\n", (clip_lines2)? "" : "no");
X    fprintf(fp,"set dummy %s\n",dummy_var);
X    fprintf(fp,"set format x \"%s\"\n", xformat);
X    fprintf(fp,"set format y \"%s\"\n", yformat);
X    fprintf(fp,"set %sgrid\n", (grid)? "" : "no");
X    switch (key) {
X        case -1 :
X            fprintf(fp,"set key\n");
X            break;
X        case 0 :
X            fprintf(fp,"set nokey\n");
X            break;
X        case 1 :
X            fprintf(fp,"set key %g,%g\n",key_x,key_y);
X            break;
X    }
X    fprintf(fp,"set nolabel\n");
X    for (this_label = first_label; this_label != NULL;
X            this_label = this_label->next) {
X        fprintf(fp,"set label %d \"%s\" at %g,%g ",
X               this_label->tag,
X               this_label->text, this_label->x, this_label->y);
X        switch(this_label->pos) {
X            case LEFT :
X                fprintf(fp,"left");
X                break;
X            case CENTRE :
X                fprintf(fp,"centre");
X                break;
X            case RIGHT :
X                fprintf(fp,"right");
X                break;
X        }
X        fputc('\n',fp);
X    }
X    fprintf(fp,"set noarrow\n");
X    for (this_arrow = first_arrow; this_arrow != NULL;
X            this_arrow = this_arrow->next) {
X        fprintf(fp,"set arrow %d from %g,%g to %g,%g\n",
X               this_arrow->tag,
X               this_arrow->sx, this_arrow->sy,
X               this_arrow->ex, this_arrow->ey);
X    }
X    if ((!log_x)||(!log_y))
X        fprintf(fp,"set nologscale xy\n");
X    if (log_x||log_y)
X        fprintf(fp,"set logscale %c%c\n",
X            log_x ? 'x' : ' ', log_y ? 'y' : ' ');
X    fprintf(fp,"set offsets %g, %g, %g, %g\n",loff,roff,toff,boff);
X    fprintf(fp,"set %spolar\n", (polar)? "" : "no");
X    fprintf(fp,"set samples %d\n",samples);
X    fprintf(fp,"set size %g,%g\n",xsize,ysize);
X    fprintf(fp,"set data style ");
X    switch (data_style) {
X        case LINES: fprintf(fp,"lines\n"); break;
X        case POINTS: fprintf(fp,"points\n"); break;
X        case IMPULSES: fprintf(fp,"impulses\n"); break;
X        case LINESPOINTS: fprintf(fp,"linespoints\n"); break;
X        case DOTS: fprintf(fp,"dots\n"); break;
X    }
X    fprintf(fp,"set function style ");
X    switch (func_style) {
X        case LINES: fprintf(fp,"lines\n"); break;
X        case POINTS: fprintf(fp,"points\n"); break;
X        case IMPULSES: fprintf(fp,"impulses\n"); break;
X        case LINESPOINTS: fprintf(fp,"linespoints\n"); break;
X        case DOTS: fprintf(fp,"dots\n"); break;
X    }
X    fprintf(fp,"set tics %s\n", (tic_in)? "in" : "out");
X     save_tics(fp, xtics, 'x', &xticdef);
X     save_tics(fp, ytics, 'y', &yticdef);
X    fprintf(fp,"set title \"%s\"\n",title);
X    fprintf(fp,"set xlabel \"%s\"\n",xlabel);
X    fprintf(fp,"set xrange [%g : %g]\n",xmin,xmax);
X    fprintf(fp,"set ylabel \"%s\"\n",ylabel);
X    fprintf(fp,"set yrange [%g : %g]\n",ymin,ymax);
X    fprintf(fp,"set %s %c%c\n",
X        (autoscale_y||autoscale_x) ? "autoscale" : "noautoscale",
X        autoscale_x ? 'x' : ' ', autoscale_y ? 'y' : ' ');
X    fprintf(fp,"set zero %g\n",zero);
X}
X
Xsave_tics(fp, onoff, axis, tdef)
X    FILE *fp;
X    BOOLEAN onoff;
X    char axis;
X    struct ticdef *tdef;
X{
X    if (onoff) {
X       fprintf(fp,"set %ctics", axis);
X       switch(tdef->type) {
X          case TIC_COMPUTED: {
X             break;
X          }
X          case TIC_SERIES: {
X             fprintf(fp, " %g,%g,%g", tdef->def.series.start,
X                    tdef->def.series.incr, tdef->def.series.end);
X             break;
X          }
X          case TIC_USER: {
X             register struct ticmark *t;
X             fprintf(fp, " (");
X             for (t = tdef->def.user; t != NULL; t=t->next) {
X                if (t->label)
X                  fprintf(fp, "\"%s\" ", t->label);
X                if (t->next)
X                  fprintf(fp, "%g, ", t->position);
X                else
X                  fprintf(fp, "%g", t->position);
X             }
X             fprintf(fp, ")");
X             break;
X          }
X       }
X       fprintf(fp, "\n");
X    } else {
X       fprintf(fp,"set no%ctics\n", axis);
X    }
X}
X
Xload_file(fp, name)
X    FILE *fp;
X    char *name;
X{
X    register int len;
X    extern char input_line[];
X
X    int start, left;
X    int more;
X    int stop = FALSE;
X
X    lf_push(fp);            /* save state for errors and recursion */
X
X    if (fp == (FILE *)NULL) {
X       char errbuf[BUFSIZ];
X       (void) sprintf(errbuf, "Cannot open load file '%s'", name);
X       os_error(errbuf, c_token);
X    } else {
X       /* go into non-interactive mode during load */
X       /* will be undone below, or in load_file_error */
X       interactive = FALSE;
X       inline_num = 0;
X       infile_name = name;
X
X       while (!stop) {        /* read all commands in file */
X          /* read one command */
X          left = MAX_LINE_LEN;
X          start = 0;
X          more = TRUE;
X
X          while (more) {
X             if (fgets(&(input_line[start]), left, fp) == NULL) {
X                stop = TRUE; /* EOF in file */
X                input_line[start] = '\0';
X                more = FALSE;
X             } else {
X                inline_num++;
X                len = strlen(input_line) - 1;
X                if (input_line[len] == '\n') { /* remove any newline */
X                    input_line[len] = '\0';
X                    /* Look, len was 1-1 = 0 before, take care here! */
X                    if (len > 0) --len;
X                } else if (len+1 >= left)
X                  int_error("Input line too long",NO_CARET);
X
X                if (input_line[len] == '\\') { /* line continuation */
X                    start = len;
X                    left -= len;
X                } else
X                  more = FALSE;
X             }
X          }
X
X          if (strlen(input_line) > 0) {
X             screen_ok = FALSE;    /* make sure command line is
X                               echoed on error */
X             do_line();
X          }
X       }
X    }
X
X    /* pop state */
X    (void) lf_pop();        /* also closes file fp */
X}
X
X/* pop from load_file state stack */
Xstatic BOOLEAN                /* FALSE if stack was empty */
Xlf_pop()                    /* called by load_file and load_file_error */
X{
X    LFS *lf;
X
X    if (lf_head == NULL)
X     return(FALSE);
X    else {
X       lf = lf_head;
X       if (lf->fp != (FILE *)NULL)
X        (void) fclose(lf->fp);
X       interactive = lf->interactive;
X       inline_num = lf->inline_num;
X       infile_name = lf->name;
X       lf_head = lf->prev;
X       free((char *)lf);
X       return(TRUE);
X    }
X}
X
X/* push onto load_file state stack */
X/* essentially, we save information needed to undo the load_file changes */
Xstatic void
Xlf_push(fp)            /* called by load_file */
X    FILE *fp;
X{
X    LFS *lf;
X
X    lf = (LFS *)alloc(sizeof(LFS), (char *)NULL);
X    if (lf == (LFS *)NULL) {
X       if (fp != (FILE *)NULL)
X        (void) fclose(fp);        /* it won't be otherwise */
X       int_error("not enough memory to load file", c_token);
X    }
X
X    lf->fp = fp;            /* save this file pointer */
X    lf->name = infile_name;    /* save current name */
X    lf->interactive = interactive;    /* save current state */
X    lf->inline_num = inline_num; /* save current line number */
X    lf->prev = lf_head;        /* link to stack */
X    lf_head = lf;
X}
X
Xload_file_error()            /* called from main */
X{
X    /* clean up from error in load_file */
X    /* pop off everything on stack */
X    while(lf_pop())
X     ;
X}
X
X/* find char c in string str; return p such that str[p]==c;
X * if c not in str then p=strlen(str)
X */
Xint
Xinstring(str, c)
X    char *str;
X    char c;
X{
X    int pos = 0;
X
X    while (str != NULL && *str != '\0' && c != *str) {
X       str++;
X       pos++;
X    }
X    return (pos);
X}
X
Xshow_functions()
X{
Xregister struct udft_entry *udf = first_udf;
X
X    fprintf(stderr,"\n\tUser-Defined Functions:\n");
X
X    while (udf) {
X        if (udf->definition)
X            fprintf(stderr,"\t%s\n",udf->definition);
X        else
X            fprintf(stderr,"\t%s is undefined\n",udf->udf_name);
X        udf = udf->next_udf;
X    }
X}
X
X
Xshow_at()
X{
X    (void) putc('\n',stderr);
X    disp_at(temp_at(),0);
X}
X
X
Xdisp_at(curr_at, level)
Xstruct at_type *curr_at;
Xint level;
X{
Xregister int i, j;
Xregister union argument *arg;
X
X    for (i = 0; i < curr_at->a_count; i++) {
X        (void) putc('\t',stderr);
X        for (j = 0; j < level; j++)
X            (void) putc(' ',stderr);    /* indent */
X
X            /* print name of instruction */
X
X        fputs(ft[(int)(curr_at->actions[i].index)].f_name,stderr);
X        arg = &(curr_at->actions[i].arg);
X
X            /* now print optional argument */
X
X        switch(curr_at->actions[i].index) {
X          case PUSH:    fprintf(stderr," %s\n", arg->udv_arg->udv_name);
X                    break;
X          case PUSHC:    (void) putc(' ',stderr);
X                    disp_value(stderr,&(arg->v_arg));
X                    (void) putc('\n',stderr);
X                    break;
X          case PUSHD:    fprintf(stderr," %s dummy\n",
X                      arg->udf_arg->udf_name);
X                    break;
X          case CALL:    fprintf(stderr," %s", arg->udf_arg->udf_name);
X                    if (arg->udf_arg->at) {
X                        (void) putc('\n',stderr);
X                        disp_at(arg->udf_arg->at,level+2); /* recurse! */
X                    } else
X                        fputs(" (undefined)\n",stderr);
X                    break;
X          case JUMP:
X          case JUMPZ:
X          case JUMPNZ:
X          case JTERN:
X                    fprintf(stderr," +%d\n",arg->j_arg);
X                    break;
X          default:
X                    (void) putc('\n',stderr);
X        }
X    }
X}
X
X
X/* alloc:
X * allocate memory
X * This is a protected version of malloc. It causes an int_error
X * if there is not enough memory, but first it tries FreeHelp()
X * to make some room, and tries again. If message is NULL, we
X * allow NULL return. Otherwise, we handle the error, using the
X * message to create the int_error string.
X */
X
Xchar *
Xalloc(size, message)
X    unsigned int size;                /* # of bytes */
X    char *message;            /* description of what is being allocated */
X{
X    char *p;                /* the new allocation */
X    char errbuf[100];        /* error message string */
X    extern char *malloc();
X
X    p = malloc(size);
X    if (p == (char *)NULL) {
X#ifndef VMS
X       FreeHelp();            /* out of memory, try to make some room */
X#endif
X
X       p = malloc(size);        /* try again */
X       if (p == (char *)NULL) {
X          /* really out of memory */
X          if (message != NULL) {
X             (void) sprintf(errbuf, "out of memory for %s", message);
X             int_error(errbuf, NO_CARET);
X             /* NOTREACHED */
X          }
X          /* else we return NULL */
X       }
X    }
X
X    return(p);
X}
*-*-END-of-misc.c-*-*
echo x - eval.c
sed 's/^X//' >eval.c <<'*-*-END-of-eval.c-*-*'
X/* GNUPLOT - eval.c */
X/*
X * Copyright (C) 1986, 1987, 1990   Thomas Williams, Colin Kelley
X *
X * Permission to use, copy, and distribute this software and its
X * documentation for any purpose with or without fee is hereby granted,
X * provided that the above copyright notice appear in all copies and
X * that both that copyright notice and this permission notice appear
X * in supporting documentation.
X *
X * Permission to modify the software is granted, but not the right to
X * distribute the modified code.  Modifications are to be distributed
X * as patches to released version.
X *
X * This software  is provided "as is" without express or implied warranty.
X *
X *
X * AUTHORS
X *
X *   Original Software:
X *     Thomas Williams,  Colin Kelley.
X *
X *   Gnuplot 2.0 additions:
X *       Russell Lang, Dave Kotz, John Campbell.
X *
X * send your comments or suggestions to (pixar![e-mail]).
X *
X */
X
X#include <stdio.h>
X#include "plot.h"
X
Xextern int c_token;
Xextern struct ft_entry ft[];
Xextern struct udvt_entry *first_udv;
Xextern struct udft_entry *first_udf;
Xextern struct at_type at;
Xextern struct lexical_unit token[];
X
Xstruct value *integer();
X
X
X
Xstruct udvt_entry *
Xadd_udv(t_num)  /* find or add value and return pointer */
Xint t_num;
X{
Xregister struct udvt_entry **udv_ptr = &first_udv;
X
X    /* check if it's already in the table... */
X
X    while (*udv_ptr) {
X        if (equals(t_num,(*udv_ptr)->udv_name))
X            return(*udv_ptr);
X        udv_ptr = &((*udv_ptr)->next_udv);
X    }
X
X    *udv_ptr = (struct udvt_entry *)
X      alloc((unsigned int)sizeof(struct udvt_entry), "value");
X    (*udv_ptr)->next_udv = NULL;
X    copy_str((*udv_ptr)->udv_name,t_num);
X    (*udv_ptr)->udv_value.type = INT;    /* not necessary, but safe! */
X    (*udv_ptr)->udv_undef = TRUE;
X    return(*udv_ptr);
X}
X
X
Xstruct udft_entry *
Xadd_udf(t_num)  /* find or add function and return pointer */
Xint t_num; /* index to token[] */
X{
Xregister struct udft_entry **udf_ptr = &first_udf;
X
X    while (*udf_ptr) {
X        if (equals(t_num,(*udf_ptr)->udf_name))
X            return(*udf_ptr);
X        udf_ptr = &((*udf_ptr)->next_udf);
X    }
X     *udf_ptr = (struct udft_entry *)
X      alloc((unsigned int)sizeof(struct udft_entry), "function");
X    (*udf_ptr)->next_udf = (struct udft_entry *) NULL;
X    (*udf_ptr)->definition = NULL;
X    (*udf_ptr)->at = NULL;
X    copy_str((*udf_ptr)->udf_name,t_num);
X    (void) integer(&((*udf_ptr)->dummy_value), 0);
X    return(*udf_ptr);
X}
X
X
Xunion argument *
Xadd_action(sf_index)
Xenum operators sf_index;        /* index of p-code function */
X{
X    if (at.a_count >= MAX_AT_LEN)
X        int_error("action table overflow",NO_CARET);
X    at.actions[at.a_count].index = sf_index;
X    return(&(at.actions[at.a_count++].arg));
X}
X
X
Xint standard(t_num)  /* return standard function index or 0 */
X{
Xregister int i;
X    for (i = (int)SF_START; ft[i].f_name != NULL; i++) {
X        if (equals(t_num,ft[i].f_name))
X            return(i);
X    }
X    return(0);
X}
X
X
X
Xexecute_at(at_ptr)
Xstruct at_type *at_ptr;
X{
Xregister int i,index,count,offset;
X
X    count = at_ptr->a_count;
X    for (i = 0; i < count;) {
X        index = (int)at_ptr->actions[i].index;
X        offset = (*ft[index].func)(&(at_ptr->actions[i].arg));
X        if (is_jump(index))
X            i += offset;
X        else
X            i++;
X    }
X}
X
X/*
X
X 'ft' is a table containing C functions within this program.
X
X An 'action_table' contains pointers to these functions and arguments to be
X passed to them.
X
X at_ptr is a pointer to the action table which must be executed (evaluated)
X
X so the iterated line exectues the function indexed by the at_ptr and
X passes the address of the argument which is pointed to by the arg_ptr
X
X*/
*-*-END-of-eval.c-*-*
echo x - parse.c
sed 's/^X//' >parse.c <<'*-*-END-of-parse.c-*-*'
X/* GNUPLOT - parse.c */
X/*
X * Copyright (C) 1986, 1987, 1990   Thomas Williams, Colin Kelley
X *
X * Permission to use, copy, and distribute this software and its
X * documentation for any purpose with or without fee is hereby granted,
X * provided that the above copyright notice appear in all copies and
X * that both that copyright notice and this permission notice appear
X * in supporting documentation.
X *
X * Permission to modify the software is granted, but not the right to
X * distribute the modified code.  Modifications are to be distributed
X * as patches to released version.
X *
X * This software  is provided "as is" without express or implied warranty.
X *
X *
X * AUTHORS
X *
X *   Original Software:
X *     Thomas Williams,  Colin Kelley.
X *
X *   Gnuplot 2.0 additions:
X *       Russell Lang, Dave Kotz, John Campbell.
X *
X * send your comments or suggestions to (pixar![e-mail]).
X *
X */
X
X#include <stdio.h>
X#include <setjmp.h>
X#include <signal.h>
X#include <errno.h>
X#include "plot.h"
X
X#ifndef vms
X#ifndef __ZTC__
Xextern int errno;
X#endif
X#endif
X
Xextern int num_tokens,c_token;
Xextern struct lexical_unit token[];
Xextern char c_dummy_var[];            /* name of current dummy variable */
Xextern struct udft_entry *dummy_func;    /* pointer to dummy variable's func */
X
Xstruct value *pop(),*integer(),*complex();
Xstruct at_type *temp_at(), *perm_at();
Xstruct udft_entry *add_udf();
Xstruct udvt_entry *add_udv();
Xunion argument *add_action();
X
Xstruct at_type at;
Xstatic jmp_buf fpe_env;
X
X#define dummy (struct value *) 0
X
X#ifdef __TURBOC__
Xvoid fpe()
X#else
X#ifdef __ZTC__
Xvoid fpe(an_int)
Xint an_int;
X#else
Xfpe()
X#endif
X#endif
X{
X#ifdef PC    /* thanks to [e-mail] for telling us about this  */
X    _fpreset();
X#endif
X    (void) signal(SIGFPE, fpe);
X    undefined = TRUE;
X    longjmp(fpe_env, TRUE);
X}
X
X
Xevaluate_at(at_ptr,val_ptr)
Xstruct at_type *at_ptr;
Xstruct value *val_ptr;
X{
X    undefined = FALSE;
X    errno = 0;
X    reset_stack();
X    if (setjmp(fpe_env))
X        return;                /* just bail out */
X    (void) signal(SIGFPE, fpe);    /* catch core dumps on FPEs */
X
X    execute_at(at_ptr);
X
X    (void) signal(SIGFPE, SIG_DFL);
X
X    if (errno == EDOM || errno == ERANGE) {
X        undefined = TRUE;
X    } else {
X        (void) pop(val_ptr);
X        check_stack();
X    }
X}
X
X
Xstruct value *
Xconst_express(valptr)
Xstruct value *valptr;
X{
Xregister int tkn = c_token;
X    if (END_OF_COMMAND)
X        int_error("constant expression required",c_token);
X    evaluate_at(temp_at(),valptr);    /* run it and send answer back */
X    if (undefined) {
X        int_error("undefined value",tkn);
X    }
X    return(valptr);
X}
X
X
Xstruct at_type *
Xtemp_at()    /* build a static action table and return its pointer */
X{
X    at.a_count = 0;        /* reset action table !!! */
X    express();
X    return(&at);
X}
X
X
X/* build an action table, put it in dynamic memory, and return its pointer */
X
Xstruct at_type *
Xperm_at()
X{
Xregister struct at_type *at_ptr;
Xregister unsigned int len;
X
X    (void) temp_at();
X    len = sizeof(struct at_type) -
X        (MAX_AT_LEN - at.a_count)*sizeof(struct at_entry);
X    at_ptr = (struct at_type *) alloc(len, "action table");
X     (void) memcpy(at_ptr,&at,len);
X    return(at_ptr);
X}
X
X
X#ifdef NOCOPY
X/*
X * cheap and slow version of memcpy() in case you don't have one
X */
Xmemcpy(dest,src,len)
Xchar *dest,*src;
Xunsigned int len;
X{
X    while (len--)
X        *dest++ = *src++;
X}
X#endif /* NOCOPY */
X
X
Xexpress()  /* full expressions */
X{
X    xterm();
X    xterms();
X}
X
Xxterm()  /* ? : expressions */
X{
X    aterm();
X    aterms();
X}
X
X
Xaterm()
X{
X    bterm();
X    bterms();
X}
X
X
Xbterm()
X{
X    cterm();
X    cterms();
X}
X
X
Xcterm()
X{
X    dterm();
X    dterms();
X}
X
X
Xdterm()
X{
X    eterm();
X    eterms();
X}
X
X
Xeterm()
X{
X    fterm();
X    fterms();
X}
X
X
Xfterm()
X{
X    gterm();
X    gterms();
X}
X
X
Xgterm()
X{
X    hterm();
X    hterms();
X}
X
X
Xhterm()
X{
X    unary(); /* - things */
X    iterms(); /* * / % */
X}
X
X
Xfactor()
X{
Xregister int value;
X
X    if (equals(c_token,"(")) {
X        c_token++;
X        express();
X        if (!equals(c_token,")"))
X            int_error("')' expected",c_token);
X        c_token++;
X    }
X    else if (isnumber(c_token)) {
X        convert(&(add_action(PUSHC)->v_arg),c_token);
X        c_token++;
X    }
X    else if (isletter(c_token)) {
X        if ((c_token+1 < num_tokens)  && equals(c_token+1,"(")) {
X            value = standard(c_token);
X            if (value) {    /* it's a standard function */
X                c_token += 2;
X                express();
X                if (!equals(c_token,")"))
X                    int_error("')' expected",c_token);
X                c_token++;
X                (void) add_action(value);
X            }
X            else {
X                value = c_token;
X                c_token += 2;
X                express();
X                if (!equals(c_token,")"))
X                    int_error("')' expected",c_token);
X                c_token++;
X                add_action(CALL)->udf_arg = add_udf(value);
X            }
X        }
X        else {
X            if (equals(c_token,c_dummy_var)) {
X                c_token++;
X                add_action(PUSHD)->udf_arg = dummy_func;
X            }
X            else {
X                add_action(PUSH)->udv_arg = add_udv(c_token);
X                c_token++;
X            }
X        }
X    } /* end if letter */
X    else
X        int_error("invalid expression ",c_token);
X
X    /* add action code for ! (factorial) operator */
X    while (equals(c_token,"!")) {
X        c_token++;
X        (void) add_action(FACTORIAL);
X    }
X    /* add action code for ** operator */
X    if (equals(c_token,"**")) {
X            c_token++;
X            unary();
X            (void) add_action(POWER);
X    }
X
X}
X
X
X
Xxterms()
X{  /* create action code for ? : expressions */
X
X    if (equals(c_token,"?")) {
X        register int savepc1, savepc2;
X        register union argument *argptr1,*argptr2;
X        c_token++;
X        savepc1 = at.a_count;
X        argptr1 = add_action(JTERN);
X        express();
X        if (!equals(c_token,":"))
X            int_error("expecting ':'",c_token);
X        c_token++;
X        savepc2 = at.a_count;
X        argptr2 = add_action(JUMP);
X        argptr1->j_arg = at.a_count - savepc1;
X        express();
X        argptr2->j_arg = at.a_count - savepc2;
X    }
X}
X
X
Xaterms()
X{  /* create action codes for || operator */
X
X    while (equals(c_token,"||")) {
X        register int savepc;
X        register union argument *argptr;
X        c_token++;
X        savepc = at.a_count;
X        argptr = add_action(JUMPNZ);    /* short-circuit if already TRUE */
X        aterm();
X        argptr->j_arg = at.a_count - savepc;/* offset for jump */
X        (void) add_action(BOOL);
X    }
X}
X
X
Xbterms()
X{ /* create action code for && operator */
X
X    while (equals(c_token,"&&")) {
X        register int savepc;
X        register union argument *argptr;
X        c_token++;
X        savepc = at.a_count;
X        argptr = add_action(JUMPZ);    /* short-circuit if already FALSE */
X        bterm();
X        argptr->j_arg = at.a_count - savepc;/* offset for jump */
X        (void) add_action(BOOL);
X    }
X}
X
X
Xcterms()
X{ /* create action code for | operator */
X
X    while (equals(c_token,"|")) {
X        c_token++;
X        cterm();
X        (void) add_action(BOR);
X    }
X}
X
X
Xdterms()
X{ /* create action code for ^ operator */
X
X    while (equals(c_token,"^")) {
X        c_token++;
X        dterm();
X        (void) add_action(XOR);
X    }
X}
X
X
Xeterms()
X{ /* create action code for & operator */
X
X    while (equals(c_token,"&")) {
X        c_token++;
X        eterm();
X        (void) add_action(BAND);
X    }
X}
X
X
Xfterms()
X{ /* create action codes for == and != operators */
X
X    while (TRUE) {
X        if (equals(c_token,"==")) {
X            c_token++;
X            fterm();
X            (void) add_action(EQ);
X        }
X        else if (equals(c_token,"!=")) {
X            c_token++;
X            fterm();
X            (void) add_action(NE);
X        }
X        else break;
X    }
X}
X
X
Xgterms()
X{ /* create action code for < > >= or <= operators */
X
X    while (TRUE) {
X        /* I hate "else if" statements */
X        if (equals(c_token,">")) {
X            c_token++;
X            gterm();
X            (void) add_action(GT);
X        }
X        else if (equals(c_token,"<")) {
X            c_token++;
X            gterm();
X            (void) add_action(LT);
X        }
X        else if (equals(c_token,">=")) {
X            c_token++;
X            gterm();
X            (void) add_action(GE);
X        }
X        else if (equals(c_token,"<=")) {
X            c_token++;
X            gterm();
X            (void) add_action(LE);
X        }
X        else break;
X    }
X
X}
X
X
X
Xhterms()
X{ /* create action codes for + and - operators */
X
X    while (TRUE) {
X            if (equals(c_token,"+")) {
X                c_token++;
X                hterm();
X                (void) add_action(PLUS);
X            }
X            else if (equals(c_token,"-")) {
X                c_token++;
X                hterm();
X                (void) add_action(MINUS);
X            }
X            else break;
X    }
X}
X
X
Xiterms()
X{ /* add action code for * / and % operators */
X
X    while (TRUE) {
X            if (equals(c_token,"*")) {
X                c_token++;
X                unary();
X                (void) add_action(MULT);
X            }
X            else if (equals(c_token,"/")) {
X                c_token++;
X                unary();
X                (void) add_action(DIV);
X            }
X            else if (equals(c_token,"%")) {
X                c_token++;
X                unary();
X                (void) add_action(MOD);
X            }
X            else break;
X    }
X}
X
X
Xunary()
X{ /* add code for unary operators */
X    if (equals(c_token,"!")) {
X        c_token++;
X        unary();
X        (void) add_action(LNOT);
X    }
X    else if (equals(c_token,"~")) {
X        c_token++;
X        unary();
X        (void) add_action(BNOT);
X    }
X    else if (equals(c_token,"-")) {
X        c_token++;
X        unary();
X        (void) add_action(UMINUS);
X    }
X    else
X        factor();
X}
*-*-END-of-parse.c-*-*
echo x - plot.c
sed 's/^X//' >plot.c <<'*-*-END-of-plot.c-*-*'
X/* GNUPLOT - plot.c */
X/*
X * Copyright (C) 1986, 1987, 1990   Thomas Williams, Colin Kelley
X *
X * Permission to use, copy, and distribute this software and its
X * documentation for any purpose with or without fee is hereby granted,
X * provided that the above copyright notice appear in all copies and
X * that both that copyright notice and this permission notice appear
X * in supporting documentation.
X *
X * Permission to modify the software is granted, but not the right to
X * distribute the modified code.  Modifications are to be distributed
X * as patches to released version.
X *
X * This software  is provided "as is" without express or implied warranty.
X *
X *
X * AUTHORS
X *
X *   Original Software:
X *     Thomas Williams,  Colin Kelley.
X *
X *   Gnuplot 2.0 additions:
X *       Russell Lang, Dave Kotz, John Campbell.
X *
X * send your comments or suggestions to (pixar![e-mail]).
X *
X */
X
X#include <stdio.h>
X#include <setjmp.h>
X#include <signal.h>
X#include "plot.h"
X#include "setshow.h"
X#ifdef MSDOS
X#include <io.h>
X#endif
X#ifdef vms
X#include <unixio.h>
X#endif
X#ifdef __TURBOC__
X#include <graphics.h>
X#endif
X
Xextern char *getenv(),*strcat(),*strcpy(),*strncpy();
X
Xextern char input_line[];
Xextern int c_token;
Xextern FILE *outfile;
Xextern int term;
X
XBOOLEAN interactive = TRUE;    /* FALSE if stdin not a terminal */
Xchar *infile_name = NULL;    /* name of command file; NULL if terminal */
X
X#ifndef STDOUT
X#define STDOUT 1
X#endif
X
Xjmp_buf env;
X
Xstruct value *integer(),*complex();
X
X
Xextern f_push(),f_pushc(),f_pushd(),f_call(),f_lnot(),f_bnot(),f_uminus()
X    ,f_lor(),f_land(),f_bor(),f_xor(),f_band(),f_eq(),f_ne(),f_gt(),f_lt(),
X    f_ge(),f_le(),f_plus(),f_minus(),f_mult(),f_div(),f_mod(),f_power(),
X    f_factorial(),f_bool(),f_jump(),f_jumpz(),f_jumpnz(),f_jtern();
X
Xextern f_real(),f_imag(),f_arg(),f_conjg(),f_sin(),f_cos(),f_tan(),f_asin(),
X    f_acos(),f_atan(),f_sinh(),f_cosh(),f_tanh(),f_int(),f_abs(),f_sgn(),
X    f_sqrt(),f_exp(),f_log10(),f_log(),f_besj0(),f_besj1(),f_besy0(),f_besy1(),
X#ifdef GAMMA
X    f_gamma(),
X#endif
X    f_floor(),f_ceil();
X
X
Xstruct ft_entry ft[] = {    /* built-in function table */
X
X/* internal functions: */
X    {"push", f_push},    {"pushc", f_pushc},    {"pushd", f_pushd},
X    {"call", f_call},    {"lnot", f_lnot},    {"bnot", f_bnot},
X    {"uminus", f_uminus},                    {"lor", f_lor},
X    {"land", f_land},    {"bor", f_bor},        {"xor", f_xor},
X    {"band", f_band},    {"eq", f_eq},        {"ne", f_ne},
X    {"gt", f_gt},        {"lt", f_lt},        {"ge", f_ge},
X    {"le", f_le},        {"plus", f_plus},    {"minus", f_minus},
X    {"mult", f_mult},    {"div", f_div},        {"mod", f_mod},
X    {"power", f_power}, {"factorial", f_factorial},
X    {"bool", f_bool},    {"jump", f_jump},    {"jumpz", f_jumpz},
X    {"jumpnz",f_jumpnz},{"jtern", f_jtern},
X
X/* standard functions: */
X    {"real", f_real},    {"imag", f_imag},    {"arg", f_arg},
X    {"conjg", f_conjg}, {"sin", f_sin},        {"cos", f_cos},
X    {"tan", f_tan},        {"asin", f_asin},    {"acos", f_acos},
X    {"atan", f_atan},    {"sinh", f_sinh},    {"cosh", f_cosh},
X    {"tanh", f_tanh},    {"int", f_int},        {"abs", f_abs},
X    {"sgn", f_sgn},        {"sqrt", f_sqrt},    {"exp", f_exp},
X    {"log10", f_log10},    {"log", f_log},        {"besj0", f_besj0},
X    {"besj1", f_besj1},    {"besy0", f_besy0},    {"besy1", f_besy1},
X#ifdef GAMMA
X     {"gamma", f_gamma},
X#endif
X    {"floor", f_floor},    {"ceil", f_ceil},
X    {NULL, NULL}
X};
X
Xstatic struct udvt_entry udv_pi = {NULL, "pi",FALSE};
X                                    /* first in linked list */
Xstruct udvt_entry *first_udv = &udv_pi;
Xstruct udft_entry *first_udf = NULL;
X
X
X
X#ifdef vms
X
X#define HOME "sys$login:"
X
X#else /* vms */
X#ifdef MSDOS
X
X#define HOME "GNUPLOT"
X
X#else /* MSDOS */
X
X#define HOME "HOME"
X
X#endif /* MSDOS */
X#endif /* vms */
X
X#ifdef unix
X#define PLOTRC ".gnuplot"
X#else
X#define PLOTRC "gnuplot.ini"
X#endif
X
X#ifdef __TURBOC__
Xvoid tc_interrupt()
X#else
Xinter()
X#endif
X{
X#ifdef MSDOS
X#ifdef __TURBOC__
X    (void) signal(SIGINT, tc_interrupt);
X#else
X    void ss_interrupt();
X    (void) signal(SIGINT, ss_interrupt);
X#endif
X#else  /* MSDOS */
X    (void) signal(SIGINT, inter);
X#endif  /* MSDOS */
X    (void) signal(SIGFPE, SIG_DFL);    /* turn off FPE trapping */
X    if (term && term_init)
X        (*term_tbl[term].text)();    /* hopefully reset text mode */
X    (void) fflush(outfile);
X    (void) putc('\n',stderr);
X    longjmp(env, TRUE);        /* return to prompt */
X}
X
X
Xmain(argc, argv)
X    int argc;
X    char **argv;
X{
X/* Register the Borland Graphics Interface drivers. If they have been */
X/* included by the linker.                                            */
X#ifdef __TURBOC__
Xregisterbgidriver(CGA_driver);
Xregisterbgidriver(EGAVGA_driver);
Xregisterbgidriver(Herc_driver);
X#endif
X
X    setbuf(stderr,(char *)NULL);
X    outfile = stdout;
X    (void) complex(&udv_pi.udv_value, Pi, 0.0);
X
X     interactive = FALSE;
X     init_terminal();        /* can set term type if it likes */
X
X     interactive = isatty(fileno(stdin));
X     if (argc > 1)
X      interactive = FALSE;
X
X     if (interactive)
X      show_version();
X
X    if (!setjmp(env)) {
X        /* first time */
X        interrupt_setup();
X        load_rcfile();
X
X        if (interactive && term != 0)    /* not unknown */
X         fprintf(stderr, "\nTerminal type set to '%s'\n",
X                term_tbl[term].name);
X    } else {
X        /* come back here from int_error() */
X        load_file_error();    /* if we were in load_file(), cleanup */
X#ifdef vms
X        /* after catching interrupt */
X        /* VAX stuffs up stdout on SIGINT while writing to stdout,
X          so reopen stdout. */
X        if (outfile = stdout) {
X           if ( (stdout = freopen("SYS$OUTPUT","w",stdout))  == NULL) {
X              /* couldn't reopen it so try opening it instead */
X              if ( (stdout = fopen("SYS$OUTPUT","w"))  == NULL) {
X                 /* don't use int_error here - causes infinite loop! */
X                 fprintf(stderr,"Error opening SYS$OUTPUT as stdout\n");
X              }
X           }
X           outfile = stdout;
X        }
X#endif                    /* VMS */
X        if (!interactive)
X         done(IO_ERROR);            /* exit on non-interactive error */
X    }
X
X     if (argc > 1) {
X        /* load filenames given as arguments */
X        while (--argc > 0) {
X           ++argv;
X           c_token = NO_CARET; /* in case of file not found */
X           load_file(fopen(*argv,"r"), *argv);
X        }
X    } else {
X        /* take commands from stdin */
X        while(TRUE)
X         com_line();
X    }
X
X     done(IO_SUCCESS);
X}
X
X/* Set up to catch interrupts */
Xinterrupt_setup()
X{
X#ifdef MSDOS
X#ifdef __TURBOC__
X        (void) signal(SIGINT, tc_interrupt);    /* go there on interrupt char */
X#else
X        void ss_interrupt();
X        save_stack();                /* work-around for MSC 4.0/MSDOS 3.x bug */
X        (void) signal(SIGINT, ss_interrupt);
X#endif
X#else /* MSDOS */
X        (void) signal(SIGINT, inter);    /* go there on interrupt char */
X#endif /* MSDOS */
X}
X
X
X/* Look for a gnuplot start-up file */
Xload_rcfile()
X{
X    register FILE *plotrc;
X    static char home[80];
X    static char rcfile[sizeof(PLOTRC)+80];
X
X    /* Look for a gnuplot init file in . or home directory */
X#ifdef vms
X    (void) strcpy(home,HOME);
X#else
X    (void) strcat(strcpy(home,getenv(HOME)),"/");
X#endif                    /* vms */
X    (void) strcpy(rcfile, PLOTRC);
X    plotrc = fopen(rcfile,"r");
X    if (plotrc == (FILE *)NULL) {
X       (void) sprintf(rcfile, "%s%s", home, PLOTRC);
X       plotrc = fopen(rcfile,"r");
X    }
X    if (plotrc)
X     load_file(plotrc, rcfile);
X}
*-*-END-of-plot.c-*-*
echo x - scanner.c
sed 's/^X//' >scanner.c <<'*-*-END-of-scanner.c-*-*'
X/* GNUPLOT - scanner.c */
X/*
X * Copyright (C) 1986, 1987, 1990   Thomas Williams, Colin Kelley
X *
X * Permission to use, copy, and distribute this software and its
X * documentation for any purpose with or without fee is hereby granted,
X * provided that the above copyright notice appear in all copies and
X * that both that copyright notice and this permission notice appear
X * in supporting documentation.
X *
X * Permission to modify the software is granted, but not the right to
X * distribute the modified code.  Modifications are to be distributed
X * as patches to released version.
X *
X * This software  is provided "as is" without express or implied warranty.
X *
X *
X * AUTHORS
X *
X *   Original Software:
X *     Thomas Williams,  Colin Kelley.
X *
X *   Gnuplot 2.0 additions:
X *       Russell Lang, Dave Kotz, John Campbell.
X *
X * send your comments or suggestions to (pixar![e-mail]).
X *
X */
X
X#include <stdio.h>
X#include <ctype.h>
X#include "plot.h"
X
X#ifdef vms
X
X#include stdio
X#include descrip
X#include errno
X
X#define MAILBOX "PLOT$MAILBOX"
X#define pclose(f) fclose(f)
X
X#endif /* vms */
X
X
X#define isident(c) (isalnum(c) || (c) == '_')
X
X#ifndef STDOUT
X#define STDOUT 1
X#endif
X
X#define LBRACE '{'
X#define RBRACE '}'
X
X#define APPEND_TOKEN {token[t_num].length++; current++;}
X
X#define SCAN_IDENTIFIER while (isident(expression[current + 1]))\
X                APPEND_TOKEN
X
Xextern struct lexical_unit token[MAX_TOKENS];
X
Xstatic int t_num;    /* number of token I'm working on */
X
Xchar *strcat(), *strcpy(), *strncpy();
X
X/*
X * scanner() breaks expression[] into lexical units, storing them in token[].
X *   The total number of tokens found is returned as the function value.
X *   Scanning will stop when '\0' is found in expression[], or when token[]
X *     is full.
X *
X *     Scanning is performed by following rules:
X *
X *        Current char    token should contain
X *     -------------    -----------------------
X *        1.  alpha        all following alpha-numerics
X *        2.  digit        0 or more following digits, 0 or 1 decimal point,
X *                          0 or more digits, 0 or 1 'e' or 'E',
X *                          0 or more digits.
X *        3.  ^,+,-,/        only current char
X *            %,~,(,)
X *            [,],;,:,
X *            ?,comma
X *        4.  &,|,=,*        current char; also next if next is same
X *        5.  !,<,>        current char; also next if next is =
X *        6.  ", '        all chars up until matching quote
X *        7.  #          this token cuts off scanning of the line (DFK).
X *
X *        white space between tokens is ignored
X */
Xscanner(expression)
Xchar expression[];
X{
Xregister int current;    /* index of current char in expression[] */
Xregister int quote;
Xchar brace;
X
X    for (current = t_num = 0;
X        t_num < MAX_TOKENS && expression[current] != '\0';
X        current++) {
Xagain:
X        if (isspace(expression[current]))
X            continue;                        /* skip the whitespace */
X        token[t_num].start_index = current;
X        token[t_num].length = 1;
X        token[t_num].is_token = TRUE;    /* to start with...*/
X
X        if (expression[current] == '`') {
X            substitute(&expression[current],MAX_LINE_LEN - current);
X            goto again;
X        }
X        if (isalpha(expression[current])) {
X            SCAN_IDENTIFIER;
X        } else if (isdigit(expression[current]) || expression[current] == '.'){
X            token[t_num].is_token = FALSE;
X            token[t_num].length = get_num(&expression[current]);
X            current += (token[t_num].length - 1);
X        } else if (expression[current] == LBRACE) {
X            token[t_num].is_token = FALSE;
X            token[t_num].l_val.type = CMPLX;
X            if ((sscanf(&expression[++current],"%lf , %lf %c",
X                &token[t_num].l_val.v.cmplx_val.real,
X                &token[t_num].l_val.v.cmplx_val.imag,
X                &brace) != 3) || (brace != RBRACE))
X                    int_error("invalid complex constant",t_num);
X            token[t_num].length += 2;
X            while (expression[++current] != RBRACE) {
X                token[t_num].length++;
X                if (expression[current] == '\0')            /* { for vi % */
X                    int_error("no matching '}'", t_num);
X            }
X        } else if (expression[current] == '\'' || expression[current] == '\"'){
X            token[t_num].length++;
X            quote = expression[current];
X            while (expression[++current] != quote) {
X                if (!expression[current]) {
X                    expression[current] = quote;
X                    expression[current+1] = '\0';
X                    break;
X                } else
X                    token[t_num].length++;
X            }
X        } else switch (expression[current]) {
X             case '#':        /* DFK: add comments to gnuplot */
X                  goto endline; /* ignore the rest of the line */
X            case '^':
X            case '+':
X            case '-':
X            case '/':
X            case '%':
X            case '~':
X            case '(':
X            case ')':
X            case '[':
X            case ']':
X            case ';':
X            case ':':
X            case '?':
X            case ',':
X                break;
X            case '&':
X            case '|':
X            case '=':
X            case '*':
X                if (expression[current] == expression[current + 1])
X                    APPEND_TOKEN;
X                break;
X            case '!':
X            case '<':
X            case '>':
X                if (expression[current + 1] == '=')
X                    APPEND_TOKEN;
X                break;
X            default:
X                int_error("invalid character",t_num);
X            }
X        ++t_num;    /* next token if not white space */
X    }
X
Xendline:                    /* comments jump here to ignore line */
X
X/* Now kludge an extra token which points to '\0' at end of expression[].
X   This is useful so printerror() looks nice even if we've fallen off the
X   line. */
X
X        token[t_num].start_index = current;
X        token[t_num].length = 0;
X    return(t_num);
X}
X
X
Xget_num(str)
Xchar str[];
X{
Xdouble atof();
Xregister int count = 0;
Xlong atol();
Xregister long lval;
X
X    token[t_num].is_token = FALSE;
X    token[t_num].l_val.type = INT;        /* assume unless . or E found */
X    while (isdigit(str[count]))
X        count++;
X    if (str[count] == '.') {
X        token[t_num].l_val.type = CMPLX;
X        while (isdigit(str[++count]))    /* swallow up digits until non-digit */
X            ;
X        /* now str[count] is other than a digit */
X    }
X    if (str[count] == 'e' || str[count] == 'E') {
X        token[t_num].l_val.type = CMPLX;
X/* modified if statement to allow + sign in exponent
X   rjl 26 July 1988 */
X        count++;
X        if (str[count] == '-' || str[count] == '+')
X            count++;
X        if (!isdigit(str[count])) {
X            token[t_num].start_index += count;
X            int_error("expecting exponent",t_num);
X        }
X        while (isdigit(str[++count]))
X            ;
X    }
X    if (token[t_num].l_val.type == INT) {
X         lval = atol(str);
X        if ((token[t_num].l_val.v.int_val = lval) != lval)
X            int_error("integer overflow; change to floating point",t_num);
X    } else {
X        token[t_num].l_val.v.cmplx_val.imag = 0.0;
X        token[t_num].l_val.v.cmplx_val.real = atof(str);
X    }
X    return(count);
X}
X
X
X#ifdef MSDOS
X
X#ifdef __ZTC__
Xsubstitute(char *str,int max)
X#else
Xsubstitute()
X#endif
X{
X    int_error("substitution not supported by MS-DOS!",t_num);
X}
X
X#else /* MSDOS */
X
Xsubstitute(str,max)            /* substitute output from ` ` */
Xchar *str;
Xint max;
X{
Xregister char *last;
Xregister int i,c;
Xregister FILE *f;
XFILE *popen();
Xstatic char pgm[MAX_LINE_LEN+1],output[MAX_LINE_LEN+1];
X
X#ifdef vms
Xint chan;
Xstatic $DESCRIPTOR(pgmdsc,pgm);
Xstatic $DESCRIPTOR(lognamedsc,MAILBOX);
X#endif /* vms */
X
X    i = 0;
X    last = str;
X    while (*(++last) != '`') {
X        if (*last == '\0')
X            int_error("unmatched `",t_num);
X        pgm[i++] = *last;
X    }
X    pgm[i] = '\0';        /* end with null */
X    max -= strlen(last);    /* max is now the max length of output sub. */
X
X#ifdef vms
X      pgmdsc.dsc$w_length = i;
X       if (!((vaxc$errno = sys$crembx(0,&chan,0,0,0,0,&lognamedsc)) & 1))
X           os_error("sys$crembx failed",NO_CARET);
X
X       if (!((vaxc$errno = lib$spawn(&pgmdsc,0,&lognamedsc,&1)) & 1))
X           os_error("lib$spawn failed",NO_CARET);
X
X       if ((f = fopen(MAILBOX,"r")) == NULL)
X           os_error("mailbox open failed",NO_CARET);
X#else /* vms */
X      if ((f = popen(pgm,"r")) == NULL)
X          os_error("popen failed",NO_CARET);
X#endif /* vms */
X
X    i = 0;
X    while ((c = getc(f)) != EOF) {
X        output[i++] = ((c == '\n') ? ' ' : c);    /* newlines become blanks*/
X        if (i == max) {
X            (void) pclose(f);
X            int_error("substitution overflow", t_num);
X        }
X    }
X    (void) pclose(f);
X    if (i + strlen(last) > max)
X        int_error("substitution overflowed rest of line", t_num);
X    (void) strncpy(output+i,last+1,MAX_LINE_LEN-i);
X                                    /* tack on rest of line to output */
X    (void) strcpy(str,output);                /* now replace ` ` with output */
X    screen_ok = FALSE;
X}
X#endif /* MS-DOS */
*-*-END-of-scanner.c-*-*
echo x - standard.c
sed 's/^X//' >standard.c <<'*-*-END-of-standard.c-*-*'
X/* GNUPLOT - standard.c */
X/*
X * Copyright (C) 1986, 1987, 1990   Thomas Williams, Colin Kelley
X *
X * Permission to use, copy, and distribute this software and its
X * documentation for any purpose with or without fee is hereby granted,
X * provided that the above copyright notice appear in all copies and
X * that both that copyright notice and this permission notice appear
X * in supporting documentation.
X *
X * Permission to modify the software is granted, but not the right to
X * distribute the modified code.  Modifications are to be distributed
X * as patches to released version.
X *
X * This software  is provided "as is" without express or implied warranty.
X *
X *
X * AUTHORS
X *
X *   Original Software:
X *     Thomas Williams,  Colin Kelley.
X *
X *   Gnuplot 2.0 additions:
X *       Russell Lang, Dave Kotz, John Campbell.
X *
X * send your comments or suggestions to (pixar![e-mail]).
X *
X */
X
X#include <math.h>
X#include <stdio.h>
X#include "plot.h"
X
X#ifdef vms
X#include <errno.h>
X#else
Xextern int errno;
X#endif /* vms */
X
X
Xextern struct value stack[STACK_DEPTH];
Xextern int s_p;
X
Xstruct value *pop(), *complex(), *integer();
X
Xdouble magnitude(), angle(), real(), imag();
X
X
Xf_real()
X{
Xstruct value a;
X    push( complex(&a,real(pop(&a)), 0.0) );
X}
X
Xf_imag()
X{
Xstruct value a;
X    push( complex(&a,imag(pop(&a)), 0.0) );
X}
X
Xf_arg()
X{
Xstruct value a;
X    push( complex(&a,angle(pop(&a)), 0.0) );
X}
X
Xf_conjg()
X{
Xstruct value a;
X    (void) pop(&a);
X    push( complex(&a,real(&a),-imag(&a) ));
X}
X
Xf_sin()
X{
Xstruct value a;
X    (void) pop(&a);
X    push( complex(&a,sin(real(&a))*cosh(imag(&a)), cos(real(&a))*sinh(imag(&a))) );
X}
X
Xf_cos()
X{
Xstruct value a;
X    (void) pop(&a);
X    push( complex(&a,cos(real(&a))*cosh(imag(&a)), -sin(real(&a))*sinh(imag(&a))));
X}
X
Xf_tan()
X{
Xstruct value a;
Xregister double den;
X    (void) pop(&a);
X    if (imag(&a) == 0.0)
X        push( complex(&a,tan(real(&a)),0.0) );
X    else {
X        den = cos(2*real(&a))+cosh(2*imag(&a));
X        if (den == 0.0) {
X            undefined = TRUE;
X            push( &a );
X        }
X        else
X            push( complex(&a,sin(2*real(&a))/den, sinh(2*imag(&a))/den) );
X    }
X}
X
Xf_asin()
X{
Xstruct value a;
Xregister double alpha, beta, x, y;
X    (void) pop(&a);
X    x = real(&a); y = imag(&a);
X    if (y == 0.0) {
X        if (fabs(x) > 1.0) {
X            undefined = TRUE;
X            push(complex(&a,0.0, 0.0));
X        } else
X            push( complex(&a,asin(x),0.0) );
X    } else {
X        beta  = sqrt((x + 1)*(x + 1) + y*y)/2 - sqrt((x - 1)*(x - 1) + y*y)/2;
X        alpha = sqrt((x + 1)*(x + 1) + y*y)/2 + sqrt((x - 1)*(x - 1) + y*y)/2;
X        push( complex(&a,asin(beta), log(alpha + sqrt(alpha*alpha-1))) );
X    }
X}
X
Xf_acos()
X{
Xstruct value a;
Xregister double alpha, beta, x, y;
X    (void) pop(&a);
X    x = real(&a); y = imag(&a);
X    if (y == 0.0) {
X        if (fabs(x) > 1.0) {
X            undefined = TRUE;
X            push(complex(&a,0.0, 0.0));
X        } else
X            push( complex(&a,acos(x),0.0) );
X    } else {
X        alpha = sqrt((x + 1)*(x + 1) + y*y)/2 + sqrt((x - 1)*(x - 1) + y*y)/2;
X        beta  = sqrt((x + 1)*(x + 1) + y*y)/2 - sqrt((x - 1)*(x - 1) + y*y)/2;
X        push( complex(&a,acos(beta), log(alpha + sqrt(alpha*alpha-1))) );
X    }
X}
X
Xf_atan()
X{
Xstruct value a;
Xregister double x, y;
X    (void) pop(&a);
X    x = real(&a); y = imag(&a);
X    if (y == 0.0)
X        push( complex(&a,atan(x), 0.0) );
X    else if (x == 0.0 && fabs(y) == 1.0) {
X        undefined = TRUE;
X        push(complex(&a,0.0, 0.0));
X    } else
X        push( complex(&a,atan(2*x/(1-x*x-y*y)),
X                log((x*x+(y+1)*(y+1))/(x*x+(y-1)*(y-1)))/4) );
X}
X
Xf_sinh()
X{
Xstruct value a;
X    (void) pop(&a);
X    push( complex(&a,sinh(real(&a))*cos(imag(&a)), cosh(real(&a))*sin(imag(&a))) );
X}
X
Xf_cosh()
X{
Xstruct value a;
X    (void) pop(&a);
X    push( complex(&a,cosh(real(&a))*cos(imag(&a)), sinh(real(&a))*sin(imag(&a))) );
X}
X
Xf_tanh()
X{
Xstruct value a;
Xregister double den;
X    (void) pop(&a);
X    den = cosh(2*real(&a)) + cos(2*imag(&a));
X    push( complex(&a,sinh(2*real(&a))/den, sin(2*imag(&a))/den) );
X}
X
Xf_int()
X{
Xstruct value a;
X    push( integer(&a,(int)real(pop(&a))) );
X}
X
X
Xf_abs()
X{
Xstruct value a;
X    (void) pop(&a);
X    switch (a.type) {
X        case INT:
X            push( integer(&a,abs(a.v.int_val)) );
X            break;
X        case CMPLX:
X            push( complex(&a,magnitude(&a), 0.0) );
X    }
X}
X
Xf_sgn()
X{
Xstruct value a;
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            push( integer(&a,(a.v.int_val > 0) ? 1 :
X                    (a.v.int_val < 0) ? -1 : 0) );
X            break;
X        case CMPLX:
X            push( integer(&a,(a.v.cmplx_val.real > 0.0) ? 1 :
X                    (a.v.cmplx_val.real < 0.0) ? -1 : 0) );
X            break;
X    }
X}
X
X
Xf_sqrt()
X{
Xstruct value a;
Xregister double mag, ang;
X    (void) pop(&a);
X    mag = sqrt(magnitude(&a));
X    if (imag(&a) == 0.0 && real(&a) < 0.0)
X        push( complex(&a,0.0,mag) );
X    else
X    {
X        if ( (ang = angle(&a)) < 0.0)
X            ang += 2*Pi;
X        ang /= 2;
X        push( complex(&a,mag*cos(ang), mag*sin(ang)) );
X    }
X}
X
X
Xf_exp()
X{
Xstruct value a;
Xregister double mag, ang;
X    (void) pop(&a);
X    mag = exp(real(&a));
X    ang = imag(&a);
X    push( complex(&a,mag*cos(ang), mag*sin(ang)) );
X}
X
X
Xf_log10()
X{
Xstruct value a;
Xregister double l10;;
X    (void) pop(&a);
X    l10 = log(10.0);    /***** replace with a constant! ******/
X    push( complex(&a,log(magnitude(&a))/l10, angle(&a)/l10) );
X}
X
X
Xf_log()
X{
Xstruct value a;
X    (void) pop(&a);
X    push( complex(&a,log(magnitude(&a)), angle(&a)) );
X}
X
X
Xf_besj0()    /* j0(a) = sin(a)/a */
X{
Xstruct value a;
X    a = top_of_stack;
X    f_sin();
X    push(&a);
X    f_div();
X}
X
X
Xf_besj1()    /* j1(a) = sin(a)/(a**2) - cos(a)/a */
X{
Xstruct value a;
X    a = top_of_stack;
X    f_sin();
X    push(&a);
X    push(&a);
X    f_mult();
X    f_div();
X    push(&a);
X    f_cos();
X    push(&a);
X    f_div();
X    f_minus();
X}
X
X
Xf_besy0()    /* y0(a) = -cos(a)/a */
X{
Xstruct value a;
X    a = top_of_stack;
X    f_cos();
X    push(&a);
X    f_div();
X    f_uminus();
X}
X
X
Xf_besy1()    /* y1(a) = -cos(a)/(a**2) - sin(a)/a */
X{
Xstruct value a;
X
X    a = top_of_stack;
X    f_cos();
X    push(&a);
X    push(&a);
X    f_mult();
X    f_div();
X    push(&a);
X    f_sin();
X    push(&a);
X    f_div();
X    f_plus();
X    f_uminus();
X}
X
X
Xf_floor()
X{
Xstruct value a;
X
X    (void) pop(&a);
X    switch (a.type) {
X        case INT:
X            push( integer(&a,(int)floor((double)a.v.int_val)));
X            break;
X        case CMPLX:
X            push( complex(&a,floor(a.v.cmplx_val.real),
X                floor(a.v.cmplx_val.imag)) );
X    }
X}
X
X
Xf_ceil()
X{
Xstruct value a;
X
X    (void) pop(&a);
X    switch (a.type) {
X        case INT:
X            push( integer(&a,(int)ceil((double)a.v.int_val)));
X            break;
X        case CMPLX:
X            push( complex(&a,ceil(a.v.cmplx_val.real), ceil(a.v.cmplx_val.imag)) );
X    }
X}
X
X#ifdef GAMMA
X
Xf_gamma()
X{
Xextern int signgam;
Xregister double y;
Xstruct value a;
X
X    y = gamma(real(pop(&a)));
X    if (y > 88.0) {
X        undefined = TRUE;
X        push( integer(&a,0) );
X    }
X    else
X        push( complex(&a,signgam * exp(y),0.0) );
X}
X
X#endif /* GAMMA */
*-*-END-of-standard.c-*-*
exit