From decwrl!lll-winken!uunet!allbery Sun Mar 25 18:43:12 PST 1990
Article 1447 of comp.sources.misc:
Path: decwrl!lll-winken!uunet!allbery
From: thaw@ucbvax.Berkeley.EDU@pixar.UUCP (Tom Williams)
Newsgroups: comp.sources.misc
Subject: v11i072: Gnuplot 2.0 - 7 of 14
Message-ID: <82366@uunet.UU.NET>
Date: 26 Mar 90 00:12:11 GMT
Sender: allbery@uunet.UU.NET
Organization: Pixar -- Marin County, California
Lines: 2148
Approved: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc)

Posting-number: Volume 11, Issue 72
Submitted-by: thaw@ucbvax.Berkeley.EDU@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!info-gnuplot@sun.com).
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!info-gnuplot@sun.com).
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!info-gnuplot@sun.com).
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 lotto@wjh12.UUCP 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!info-gnuplot@sun.com).
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!info-gnuplot@sun.com).
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!info-gnuplot@sun.com).
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