home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / plot / 3dplot02.arc / 3DPLOT.C next >
C/C++ Source or Header  |  1989-08-02  |  349KB  |  8,816 lines
  1. #include <stdio.h>
  2. #include <ctype.h>
  3. #include <process.h>
  4. #include <graphics.h>
  5. #include <stdlib.h>
  6. #include <string.h>
  7. #include <alloc.h>
  8. #include <math.h>
  9. #include <time.h>
  10. #include <conio.h>
  11. #include <dos.h>
  12.  
  13. #define TRUE 1
  14. #define FALSE 0
  15.  
  16. typedef struct text
  17.           {
  18.             int           length;
  19.             unsigned char *value;
  20.           } *text_ptr;
  21.  
  22. typedef struct value_header
  23.            {
  24.              char       type;
  25.              union
  26.                {
  27.                  int      *boolean;
  28.                  FILE     **dataset;
  29.                  long     *integer;
  30.                  double   *real;
  31.                  text_ptr string;
  32.                }        value_ptr;
  33.            } *value_header_ptr;
  34.  
  35. typedef struct queue_node
  36.                  {
  37.                    value_header_ptr  argument_header_ptr;
  38.                    struct queue_node *next;
  39.                  } *queue_node_ptr;
  40.  
  41. typedef struct variable
  42.                  {
  43.                    char             *name;
  44.                    queue_node_ptr   subscripts;
  45.                    value_header_ptr variable_value_header_ptr;
  46.                    struct variable  *predecessor_ptr;
  47.                    struct variable  *smaller_successor_ptr;
  48.                    struct variable  *larger_successor_ptr;
  49.                  } *variable_ptr;
  50.  
  51. typedef struct prime_rec
  52.           {
  53.             float  x;
  54.             float  y;
  55.             float  z;
  56.             struct prime_rec *right;
  57.             struct prime_rec *down;
  58.             struct prime_rec *lesser_x;
  59.             struct prime_rec *greater_x;
  60.           } *prime_rec_ptr;
  61.  
  62. typedef struct up_rec
  63.           {
  64.             prime_rec_ptr up;
  65.             struct up_rec *next;
  66.             struct up_rec *previous;
  67.           } *up_rec_ptr;
  68.  
  69. static value_header_ptr abs_header_ptr(queue_node_ptr,char *,int);
  70. static value_header_ptr add_terms(value_header_ptr,value_header_ptr);
  71. static void             adjust_perspective(prime_rec_ptr,prime_rec_ptr *,
  72.                          prime_rec_ptr *,double,double,double,double,double);
  73. static value_header_ptr and_factors(value_header_ptr,value_header_ptr);
  74. static value_header_ptr atan_header_ptr(queue_node_ptr,char *,int);
  75. static value_header_ptr boolean_comparison(value_header_ptr,char *,
  76.                          value_header_ptr);
  77. static value_header_ptr char_header_ptr(queue_node_ptr,char *,int);
  78. static value_header_ptr concatenate_terms(value_header_ptr,value_header_ptr);
  79. static value_header_ptr copy_of_arguments(value_header_ptr);
  80. static queue_node_ptr   copy_of_queue(queue_node_ptr);
  81. static value_header_ptr copy_of_subscripts(value_header_ptr);
  82. static value_header_ptr cos_header_ptr(queue_node_ptr,char *,int);
  83. static value_header_ptr dataset_comparison(value_header_ptr,char *,
  84.                          value_header_ptr);
  85. static value_header_ptr date_header_ptr(queue_node_ptr,char *,int);
  86. static value_header_ptr divide_factors(value_header_ptr,value_header_ptr);
  87. static value_header_ptr endfile_header_ptr(queue_node_ptr,char *,int);
  88. static void             evaluate_and_transform(double,double,double,double,int,
  89.                          int,double,double,prime_rec_ptr *,prime_rec_ptr *,
  90.                          prime_rec_ptr *,double *,double *,double *,double *,
  91.                          double *);
  92. static value_header_ptr exec_header_ptr(queue_node_ptr,char *,int);
  93. static value_header_ptr exp_header_ptr(queue_node_ptr,char *,int);
  94. static double           f(double,double);
  95. static value_header_ptr factor_header_ptr(int);
  96. static value_header_ptr false_header_ptr(queue_node_ptr,char *,int);
  97. static value_header_ptr float_header_ptr(queue_node_ptr,char *,int);
  98. static void             free_value(value_header_ptr);
  99.        void             free_variables(void);
  100. static value_header_ptr function_header_ptr(int);
  101.        void             get_boolean_variable(char *,int *,int *);
  102.        void             get_buffer(char *);
  103. static void             get_comparison_operator(char *);
  104. static void             get_factor_operator(char *);
  105.        void             get_integer_variable(char *,long *,int *);
  106.        void             get_real_variable(char *,double *,int *);
  107. static void             get_source_char(void);
  108.        void             get_string_variable(char *,char *,int,int *);
  109. static void             get_term_operator(char *);
  110. static void             get_token(void);
  111. static value_header_ptr getchar_header_ptr(queue_node_ptr,char *,int);
  112. static value_header_ptr getint_header_ptr(queue_node_ptr,char *,int);
  113. static value_header_ptr getreal_header_ptr(queue_node_ptr,char *,int);
  114. static value_header_ptr getstring_header_ptr(queue_node_ptr,char *,int);
  115. static value_header_ptr index_header_ptr(queue_node_ptr,char *,int);
  116. static void             input_domain(double *,double *,double *,double *);
  117. static void             input_num_divisions(int *,int *);
  118. static void             input_rotation(double *);
  119. static void             input_tilt(double *);
  120. static value_header_ptr integer_comparison(value_header_ptr,char *,
  121.                          value_header_ptr);
  122. static void             interpret_assignment(int,queue_node_ptr);
  123.        void             interpret_buffer(void);
  124. static void             interpret_do(int);
  125. static value_header_ptr interpret_expression(int);
  126. static void             interpret_if(int);
  127. static void             interpret_procedure(int,queue_node_ptr);
  128. static void             interpret_statement(int);
  129. static value_header_ptr length_header_ptr(queue_node_ptr,char *,int);
  130. static value_header_ptr lineno_header_ptr(queue_node_ptr,char *,int);
  131. static value_header_ptr log_header_ptr(queue_node_ptr,char *,int);
  132.        void             main(void);
  133. static value_header_ptr mod_header_ptr(queue_node_ptr,char *,int);
  134. static value_header_ptr multiply_factors(value_header_ptr,value_header_ptr);
  135. static value_header_ptr new_boolean_header_ptr(void);
  136. static value_header_ptr new_dataset_header_ptr(void);
  137. static value_header_ptr new_integer_header_ptr(void);
  138. static value_header_ptr new_real_header_ptr(void);
  139. static value_header_ptr new_string_header_ptr(unsigned);
  140. static value_header_ptr open_header_ptr(queue_node_ptr,char *,int);
  141. static value_header_ptr or_terms(value_header_ptr,value_header_ptr);
  142. static value_header_ptr ord_header_ptr(queue_node_ptr,char *,int);
  143. static void             perform_close(int,queue_node_ptr);
  144. static void             perform_clrscr(int,queue_node_ptr);
  145. static void             perform_print(int,queue_node_ptr);
  146. static void             perform_putcrlf(int,queue_node_ptr);
  147. static void             perform_troff(int,queue_node_ptr);
  148. static void             perform_tron(int,queue_node_ptr);
  149. static value_header_ptr pi_header_ptr(queue_node_ptr,char *,int);
  150. static int              pli_strcmp(text_ptr,text_ptr);
  151. static void             pli_strcpy(text_ptr,text_ptr);
  152. static void             plot(prime_rec_ptr,double,double,double,double,
  153.                          int,int);
  154. static value_header_ptr real_comparison(value_header_ptr,char *,
  155.                          value_header_ptr);
  156. static value_header_ptr repeat_header_ptr(queue_node_ptr,char *,int);
  157.        void             set_boolean_variable(char *,int);
  158.        void             set_integer_variable(char *,long);
  159.        void             set_real_variable(char *,double);
  160.        void             set_string_variable(char *,char *);
  161. static value_header_ptr simple_expression_header_ptr(int);
  162. static value_header_ptr sin_header_ptr(queue_node_ptr,char *,int);
  163. static value_header_ptr sqr_header_ptr(queue_node_ptr,char *,int);
  164. static value_header_ptr sqrt_header_ptr(queue_node_ptr,char *,int);
  165. static value_header_ptr str_header_ptr(queue_node_ptr,char *,int);
  166. static value_header_ptr string_comparison(value_header_ptr,char *,
  167.                          value_header_ptr);
  168. static value_header_ptr string_header_ptr(int);
  169. static value_header_ptr substr_header_ptr(queue_node_ptr,char *,int);
  170. static value_header_ptr subtract_terms(value_header_ptr,value_header_ptr);
  171. static value_header_ptr sysin_header_ptr(queue_node_ptr,char *,int);
  172. static value_header_ptr sysprint_header_ptr(queue_node_ptr,char *,int);
  173. static value_header_ptr term_header_ptr(int);
  174. static value_header_ptr time_header_ptr(queue_node_ptr,char *,int);
  175. static value_header_ptr translate_header_ptr(queue_node_ptr,char *,int);
  176. static long             tree_balancer(long);
  177. static value_header_ptr true_header_ptr(queue_node_ptr,char *,int);
  178. static value_header_ptr trunc_header_ptr(queue_node_ptr,char *,int);
  179. static value_header_ptr unsigned_integer_header_ptr(void);
  180. static value_header_ptr unsigned_number_header_ptr(int);
  181. static value_header_ptr upper_header_ptr(queue_node_ptr,char *,int);
  182. static int              variable_comparison(char *,queue_node_ptr,char *,
  183.                          queue_node_ptr);
  184. static value_header_ptr variable_header_ptr(char *,int,queue_node_ptr);
  185. static value_header_ptr verify_header_ptr(queue_node_ptr,char *,int);
  186.  
  187. static int          fatal_error = 0;
  188. static char         file_name [256];
  189. static char         identifier [256];
  190. static char         source_buffer [16384];
  191. static char         source_char;
  192. static long         source_column_num;
  193. static int          source_eof;
  194. FILE                *source_file;
  195. static int          source_index;
  196. static long         source_line_num;
  197. static char         source_token [256];
  198. static unsigned char substitute [256] =
  199.          {
  200.            0x8d,0x8f,0x47,0xba,0xcc,0x12,0x09,0x74,
  201.            0xcb,0xf3,0xb4,0x88,0xf8,0xd1,0x08,0x4c,
  202.            0xa1,0x32,0x48,0x98,0xbd,0xaa,0xea,0xa2,
  203.            0x28,0xbc,0x66,0xe8,0xf4,0x5a,0x83,0x46,
  204.            0xa4,0x0e,0x3b,0x3e,0x14,0x4d,0x1c,0x0a,
  205.            0x92,0xfd,0x79,0xa8,0x67,0x41,0xe3,0x70,
  206.            0xc2,0x56,0xdd,0x6c,0xbb,0x38,0x17,0xc1,
  207.            0xae,0xb7,0x60,0x43,0x9e,0x34,0x22,0x7b,
  208.            0xe6,0x61,0x54,0xa0,0x00,0xcf,0xd0,0x64,
  209.            0xab,0x93,0xb6,0x86,0xee,0xdb,0x8e,0xb8,
  210.            0x6f,0xb2,0x57,0xd5,0xe9,0x85,0x0d,0x5d,
  211.            0x18,0xd9,0x82,0x6e,0x94,0x2b,0xb1,0xda,
  212.            0x2d,0x0f,0x90,0xed,0xde,0x95,0x4b,0xf1,
  213.            0x3d,0x3c,0x6b,0x2a,0xc9,0x21,0xfc,0xdf,
  214.            0x16,0x3a,0x9d,0x7f,0x37,0xbf,0xc7,0x9a,
  215.            0x25,0x49,0x0c,0xb9,0x91,0x03,0x97,0x35,
  216.            0x39,0x2c,0x63,0x62,0x1e,0x73,0x7e,0xa3,
  217.            0x45,0x71,0x44,0x40,0x9f,0xe2,0x13,0x3f,
  218.            0x68,0xc6,0xc4,0xfa,0x4a,0x07,0x58,0x23,
  219.            0xa5,0x4e,0x27,0x10,0x7c,0xd2,0x84,0x26,
  220.            0x76,0xac,0x55,0xad,0x5e,0xe7,0x5b,0x04,
  221.            0xd4,0xd7,0x89,0x96,0x0b,0x72,0xff,0xca,
  222.            0xc0,0x6a,0x8a,0xfe,0x5c,0x99,0x01,0xd6,
  223.            0x1f,0xdc,0xa7,0x78,0xf6,0x50,0x1b,0xe5,
  224.            0xec,0x42,0x8b,0x36,0xcd,0x75,0x59,0x30,
  225.            0x1d,0xe1,0x2e,0xbe,0x77,0xc5,0xb3,0xf2,
  226.            0x11,0x52,0x53,0xe4,0x87,0x15,0x2f,0xf5,
  227.            0x1a,0xb0,0x5f,0x9c,0xa6,0x69,0x05,0x7a,
  228.            0xf7,0x6d,0xb5,0x24,0x81,0x80,0x9b,0xce,
  229.            0x33,0xf9,0x65,0x19,0xeb,0xd3,0x31,0xef,
  230.            0x20,0xf0,0x51,0x7d,0xa9,0x8c,0x02,0xaf,
  231.            0x29,0xc3,0xc8,0xe0,0xfb,0xd8,0x4f,0x06
  232.          };
  233. static int          trace;
  234. static variable_ptr variable_head = NULL;
  235.  
  236. void main(void)
  237.   {
  238.     int           error_code;
  239.     int           file_index;
  240.     int           finished;
  241.     int           graphics_driver;
  242.     int           graphics_mode;
  243.     int           max_y_out;
  244.     int           max_z_out;
  245.     int           num_x_divisions;
  246.     int           num_y_divisions;
  247.     prime_rec_ptr prime_cornor;
  248.     prime_rec_ptr prime_head;
  249.     prime_rec_ptr prime_ptr;
  250.     prime_rec_ptr prime_tail;
  251.     char          response;
  252.     double        rotation;
  253.     double        tilt;
  254.     double        x_max;
  255.     double        x_min;
  256.     double        x_prime_max;
  257.     double        y_max;
  258.     double        y_min;
  259.     double        y_prime_max;
  260.     double        y_prime_min;
  261.     double        z_prime_max;
  262.     double        z_prime_min;
  263.  
  264.  /*    See BGIOBJ in the Turbo C 2.0 User Guide for instructions
  265.     on modifying GRAPHICS.LIB to include Turbo BGI files */
  266.     registerfarbgidriver(CGA_driver_far);
  267.     registerfarbgidriver(EGAVGA_driver_far);
  268.     registerfarbgidriver(Herc_driver_far);
  269.     registerfarbgidriver(ATT_driver_far);
  270.     registerfarbgidriver(PC3270_driver_far);
  271.     registerfarbgidriver(IBM8514_driver_far);
  272.     detectgraph(&graphics_driver,&graphics_mode);
  273.     error_code=graphresult();
  274.     if (error_code != 0)
  275.       printf("Fatal error:  %s\n",grapherrormsg(error_code));
  276.     else
  277.       {
  278.         initgraph(&graphics_driver,&graphics_mode,"");
  279.         max_y_out=getmaxx();
  280.         max_z_out=getmaxy();
  281.         closegraph();
  282.         printf("                             Three Dimensional Plot\n");
  283.         printf("\n\n\n");
  284.         printf("File name (without extension)?  ");
  285.         scanf("%s",&file_name[0]);
  286.         file_index=strlen(&file_name[0]);
  287.         strcat(&file_name[0],".INI");
  288.         printf("Initializing function...\n");
  289.         get_buffer(&file_name[0]);
  290.         if (! fatal_error)
  291.           interpret_buffer();
  292.         if (! fatal_error)
  293.           {
  294.             file_name[++file_index]='X';
  295.             file_name[++file_index]='Y';
  296.             file_name[++file_index]='Z';
  297.             get_buffer(&file_name[0]);
  298.           }
  299.         if (! fatal_error)
  300.           {
  301.             input_domain(&x_min,&x_max,&y_min,&y_max);
  302.             input_num_divisions(&num_x_divisions,&num_y_divisions);
  303.             finished=FALSE;
  304.             prime_head=NULL;
  305.             while ((! fatal_error) && (! finished))
  306.               {
  307.                 input_rotation(&rotation);
  308.                 input_tilt(&tilt);
  309.                 printf(
  310.                  "After the plot is displayed, press some key to continue.\n");
  311.                 printf("Evaluating function...\n");
  312.                 evaluate_and_transform(x_min,x_max,y_min,y_max,num_x_divisions,
  313.                  num_y_divisions,rotation,tilt,&prime_cornor,&prime_head,
  314.                  &prime_tail,&x_prime_max,&y_prime_min,&y_prime_max,
  315.                  &z_prime_min,&z_prime_max);
  316.                 if (! fatal_error)
  317.                   {
  318.                     printf("Adjusting perspective...\n");
  319.                     adjust_perspective(prime_cornor,&prime_head,&prime_tail,
  320.                      x_prime_max,y_prime_min,y_prime_max,z_prime_min,
  321.                      z_prime_max);
  322.                   }
  323.                 if (! fatal_error)
  324.                   {
  325.                     initgraph(&graphics_driver,&graphics_mode,"");
  326.                     plot(prime_tail,y_prime_min,y_prime_max,z_prime_min,
  327.                      z_prime_max,max_y_out,max_z_out);
  328.                     response=getch();
  329.                     closegraph();
  330.                     printf(
  331.                      "                             Three Dimensional Plot\n");
  332.                     printf("\n\n\n");
  333.                     printf("Again (y or n)?  ");
  334.                     response=getch();
  335.                     if ((response != 'Y') && (response != 'y'))
  336.                       finished=TRUE;
  337.                     else
  338.                       printf("\n");
  339.                     while (prime_head != NULL)
  340.                       {
  341.                         prime_ptr=prime_head->greater_x;
  342.                         free((char *) prime_head);
  343.                         prime_head=prime_ptr;
  344.                       }
  345.                   }
  346.               }
  347.             free_variables();
  348.           }
  349.       }
  350.     return;
  351.   }
  352.  
  353. static double f(x,y)
  354.   double x;
  355.   double y;
  356.     {
  357.       double z;
  358.  
  359.       z=0.0;
  360.       set_real_variable("x",x);
  361.       set_real_variable("y",y);
  362.       set_real_variable("z",z);
  363.       interpret_buffer();
  364.       if (! fatal_error)
  365.         get_real_variable("z",&z,&fatal_error);
  366.       return(z);
  367.     }
  368.  
  369. static void input_domain(x_min,x_max,y_min,y_max)
  370.   double *x_min;
  371.   double *x_max;
  372.   double *y_min;
  373.   double *y_max;
  374.     {
  375.       printf("Smallest value for x?  ");
  376.       scanf("%lf",x_min);
  377.       printf("Largest value for x?  ");
  378.       scanf("%lf",x_max);
  379.       printf("Smallest value for y?  ");
  380.       scanf("%lf",y_min);
  381.       printf("Largest value for y?  ");
  382.       scanf("%lf",y_max);
  383.       return;
  384.     }
  385.  
  386. static void input_num_divisions(num_x_divisions,num_y_divisions)
  387.   int *num_x_divisions;
  388.   int *num_y_divisions;
  389.     {
  390.       do
  391.         {
  392.           printf("Number of divisions for x?  ");
  393.           scanf("%d",num_x_divisions);
  394.           if (*num_x_divisions < 1)
  395.             printf("? there must be at least 1 division\n");
  396.         }
  397.       while (*num_x_divisions < 1);
  398.       do
  399.         {
  400.           printf("Number of divisions for y?  ");
  401.           scanf("%d",num_y_divisions);
  402.           if (*num_y_divisions < 1)
  403.             printf("? there must be at least 1 division\n");
  404.         }
  405.       while (*num_y_divisions < 1);
  406.       return;
  407.     }
  408.  
  409. static void input_rotation(rotation)
  410.   double *rotation;
  411.     {
  412.       printf("Rotation about the z-axis (degrees)?  ");
  413.       scanf("%lf",rotation);
  414.       return;
  415.     }
  416.  
  417. static void input_tilt(tilt)
  418.   double *tilt;
  419.     {
  420.       printf("Tilt about the resulting y-axis (degrees)?  ");
  421.       scanf("%lf",tilt);
  422.       return;
  423.     }
  424.  
  425. static void evaluate_and_transform(x_min,x_max,y_min,y_max,num_x_divisions,
  426.  num_y_divisions,rotation,tilt,prime_cornor,prime_head,prime_tail,x_prime_max,
  427.  y_prime_min,y_prime_max,z_prime_min,z_prime_max)
  428.   double        x_min;
  429.   double        x_max;
  430.   double        y_min;
  431.   double        y_max;
  432.   int           num_x_divisions;
  433.   int           num_y_divisions;
  434.   double        rotation;
  435.   double        tilt;
  436.   prime_rec_ptr *prime_cornor;
  437.   prime_rec_ptr *prime_head;
  438.   prime_rec_ptr *prime_tail;
  439.   double        *x_prime_max;
  440.   double        *y_prime_min;
  441.   double        *y_prime_max;
  442.   double        *z_prime_min;
  443.   double        *z_prime_max;
  444.     {
  445.       double        cos_rotation;
  446.       double        cos_tilt;
  447.       double        delta_x;
  448.       double        delta_y;
  449.       prime_rec_ptr last_prime_ptr;
  450.       prime_rec_ptr prime_ptr;
  451.       double        radians;
  452.       double        radians_per_degree;
  453.       prime_rec_ptr left;
  454.       double        sin_rotation;
  455.       double        sin_tilt;
  456.       up_rec_ptr    up_head;
  457.       up_rec_ptr    up_ptr;
  458.       up_rec_ptr    up_tail;
  459.       double        x;
  460.       int           x_division_num;
  461.       double        y;
  462.       int           y_division_num;
  463.       double        x_rotated;
  464.       double        z;
  465.  
  466.       radians_per_degree=atan(1.0)/45.0;
  467.       radians=tilt*radians_per_degree;
  468.       cos_tilt=cos(radians);
  469.       sin_tilt=sin(radians);
  470.       radians=rotation*radians_per_degree;
  471.       cos_rotation=cos(radians);
  472.       sin_rotation=sin(radians);
  473.       z=f(x_min,y_min);
  474.       x_rotated=x_min*cos_rotation+y_min*sin_rotation;
  475.       *y_prime_min=-x_min*sin_rotation+y_min*cos_rotation;
  476.       *z_prime_min=-x_rotated*sin_tilt+z*cos_tilt;
  477.       *x_prime_max=x_rotated*cos_tilt+z*sin_tilt;
  478.       *y_prime_max=*y_prime_min;
  479.       *z_prime_max=*z_prime_min;
  480.       last_prime_ptr=NULL;
  481.       delta_x=(double) num_x_divisions;
  482.       delta_x=(x_max-x_min)/delta_x;
  483.       delta_y=(double) num_y_divisions;
  484.       delta_y=(y_max-y_min)/delta_y;
  485.       up_head=NULL;
  486.       up_tail=NULL;
  487.       for (y_division_num=1;
  488.        ((! fatal_error) && (y_division_num <= num_y_divisions));
  489.        y_division_num++)
  490.         {
  491.           if ((up_ptr=(struct up_rec *) malloc(
  492.            (unsigned) sizeof(struct up_rec))) == NULL)
  493.             {
  494.               fatal_error=TRUE;
  495.               printf("? out of memory\n");
  496.             }
  497.           else
  498.             {
  499.               up_ptr->up=NULL;
  500.               if (up_head == NULL)
  501.                 {
  502.                   up_head=up_ptr;
  503.                   up_ptr->previous=NULL;
  504.                 }
  505.               else
  506.                 {
  507.                   up_tail->next=up_ptr;
  508.                   up_ptr->previous=up_tail;
  509.                 }
  510.               up_ptr->next=NULL;
  511.               up_tail=up_ptr;
  512.             }
  513.         }
  514.       x=x_min;
  515.       for (x_division_num=1;
  516.        ((! fatal_error) && (x_division_num <= num_x_divisions));
  517.        x_division_num++)
  518.         {
  519.           left=NULL;
  520.           up_ptr=up_head;
  521.           y=y_min;
  522.           for (y_division_num=1;
  523.            ((! fatal_error) && (y_division_num <= num_y_divisions));
  524.            y_division_num++)
  525.             {
  526.               z=f(x,y);
  527.               if ((prime_ptr=(struct prime_rec *) malloc(
  528.                (unsigned) sizeof(struct prime_rec))) == NULL)
  529.                 {
  530.                   fatal_error=TRUE;
  531.                   printf("? out of memory\n");
  532.                 }
  533.               else
  534.                 {
  535.                   if (left != NULL)
  536.                     left->right=prime_ptr;
  537.                   if (up_ptr->up != NULL)
  538.                     (up_ptr->up)->down=prime_ptr;
  539.                   x_rotated=x*cos_rotation+y*sin_rotation;
  540.                   prime_ptr->y=(float) (-x*sin_rotation+y*cos_rotation);
  541.                   prime_ptr->x=(float) (x_rotated*cos_tilt+z*sin_tilt);
  542.                   prime_ptr->z=(float) (-x_rotated*sin_tilt+z*cos_tilt);
  543.                   if ((double) (prime_ptr->x) > *x_prime_max)
  544.                     *x_prime_max=(double) (prime_ptr->x);
  545.                   if ((double) (prime_ptr->y) < *y_prime_min)
  546.                     *y_prime_min=(double) (prime_ptr->y);
  547.                   if ((double) (prime_ptr->y) > *y_prime_max)
  548.                     *y_prime_max=(double) (prime_ptr->y);
  549.                   if ((double) (prime_ptr->z) < *z_prime_min)
  550.                     *z_prime_min=(double) (prime_ptr->z);
  551.                   if ((double) (prime_ptr->z) > *z_prime_max)
  552.                     *z_prime_max=(double) (prime_ptr->z);
  553.                   prime_ptr->lesser_x=NULL;
  554.                   if (last_prime_ptr == NULL)
  555.                     {
  556.                       *prime_tail=prime_ptr;
  557.                       *prime_cornor=prime_ptr;
  558.                       prime_ptr->greater_x=NULL;
  559.                     }
  560.                   else
  561.                     {
  562.                       (*prime_head)->lesser_x=prime_ptr;
  563.                       prime_ptr->greater_x=*prime_head;
  564.                     }
  565.                   *prime_head=prime_ptr;
  566.                   left=prime_ptr;
  567.                   up_ptr->up=prime_ptr;
  568.                   up_ptr=up_ptr->next;
  569.                   last_prime_ptr=prime_ptr;
  570.                   y+=delta_y;
  571.                 }
  572.             }
  573.           left->right=NULL;
  574.           x+=delta_x;
  575.         }
  576.       while ((! fatal_error) && (up_head != NULL))
  577.         {
  578.           (up_head->up)->down=NULL;
  579.           up_ptr=up_head->next;
  580.           free((char *) up_head);
  581.           up_head=up_ptr;
  582.         }
  583.     }
  584.  
  585. static void adjust_perspective(prime_cornor,prime_head,prime_tail,
  586.  x_prime_max,y_prime_min,y_prime_max,z_prime_min,z_prime_max)
  587.   prime_rec_ptr prime_cornor;
  588.   prime_rec_ptr *prime_head;
  589.   prime_rec_ptr *prime_tail;
  590.   double        x_prime_max;
  591.   double        y_prime_min;
  592.   double        y_prime_max;
  593.   double        z_prime_min;
  594.   double        z_prime_max;
  595.     {
  596.       double        delta_x;
  597.       double        delta_y;
  598.       double        delta_z;
  599.       int           finished;
  600.       prime_rec_ptr last_prime_ptr;
  601.       prime_rec_ptr left;
  602.       prime_rec_ptr new_prime_head;
  603.       prime_rec_ptr new_prime_ptr;
  604.       prime_rec_ptr new_prime_tail;
  605.       prime_rec_ptr next_prime_row;
  606.       prime_rec_ptr prime_column;
  607.       prime_rec_ptr prime_ptr;
  608.       prime_rec_ptr prime_row;
  609.       up_rec_ptr    up_head;
  610.       up_rec_ptr    up_ptr;
  611.       up_rec_ptr    up_tail;
  612.       double        x_eye;
  613.       double        y_center;
  614.       double        z_center;
  615.  
  616.       if ((y_prime_max-y_prime_min) > (z_prime_max-z_prime_min))
  617.         x_eye=2.0*(y_prime_max-y_prime_min)+x_prime_max;
  618.       else
  619.         x_eye=2.0*(z_prime_max-z_prime_min)+x_prime_max;
  620.       if (x_eye != x_prime_max)
  621.         {
  622.           up_head=NULL;
  623.           up_tail=NULL;
  624.           prime_column=prime_cornor;
  625.           while ((! fatal_error) && (prime_column != NULL))
  626.             {
  627.               if ((up_ptr=(struct up_rec *) malloc(
  628.                (unsigned) sizeof(struct up_rec))) == NULL)
  629.                 {
  630.                   fatal_error=TRUE;
  631.                   printf("? out of memory\n");
  632.                 }
  633.               else
  634.                 {
  635.                   up_ptr->up=NULL;
  636.                   if (up_head == NULL)
  637.                     {
  638.                       up_head=up_ptr;
  639.                       up_ptr->previous=NULL;
  640.                     }
  641.                   else
  642.                     {
  643.                       up_tail->next=up_ptr;
  644.                       up_ptr->previous=up_tail;
  645.                     }
  646.                   up_ptr->next=NULL;
  647.                   up_tail=up_ptr;
  648.                   prime_column=prime_column->right;
  649.                 }
  650.             }
  651.           y_center=(y_prime_max+y_prime_min)/2.0;
  652.           z_center=(z_prime_max+z_prime_min)/2.0;
  653.           last_prime_ptr=NULL;
  654.           new_prime_head=NULL;
  655.           new_prime_tail=NULL;
  656.           prime_row=prime_cornor;
  657.           while (prime_row != NULL)
  658.             {
  659.               left=NULL;
  660.               up_ptr=up_head;
  661.               next_prime_row=prime_row->down;
  662.               prime_column=prime_row;
  663.               while (prime_column != NULL)
  664.                 {
  665.                   if ((new_prime_ptr=(struct prime_rec *) malloc(
  666.                    (unsigned) sizeof(struct prime_rec))) == NULL)
  667.                     {
  668.                       fatal_error=TRUE;
  669.                       printf("? out of memory\n");
  670.                     }
  671.                   else
  672.                     {
  673.                       if (left != NULL)
  674.                         left->right=new_prime_ptr;
  675.                       if (up_ptr->up != NULL)
  676.                         (up_ptr->up)->down=new_prime_ptr;
  677.                       delta_x=(prime_column->x)-x_eye;
  678.                       delta_y=(prime_column->y)-y_center;
  679.                       delta_z=(prime_column->z)-z_center;
  680.                       new_prime_ptr->x
  681.                        =sqrt(delta_x*delta_x+delta_y*delta_y+delta_z*delta_z);
  682.                       new_prime_ptr->y=y_center
  683.                        +((prime_column->y)-y_center)*(x_eye-x_prime_max)
  684.                        /(x_eye-(prime_column->x));
  685.                       new_prime_ptr->z=z_center
  686.                        +((prime_column->z)-z_center)*(x_eye-x_prime_max)
  687.                        /(x_eye-(prime_column->x));
  688.                       if (last_prime_ptr == NULL)
  689.                         {
  690.                           new_prime_head=new_prime_ptr;
  691.                           new_prime_tail=new_prime_ptr;
  692.                           new_prime_ptr->lesser_x=NULL;
  693.                           new_prime_ptr->greater_x=NULL;
  694.                         }
  695.                       else
  696.                         if (new_prime_ptr->x < last_prime_ptr->x)
  697.                           {
  698.                             finished=FALSE;
  699.                             while (! finished)
  700.                               {
  701.                                 last_prime_ptr=last_prime_ptr->lesser_x;
  702.                                 if (last_prime_ptr == NULL)
  703.                                   finished=TRUE;
  704.                                 else
  705.                                   {
  706.                                     if (new_prime_ptr->x >= last_prime_ptr->x)
  707.                                       finished=TRUE;
  708.                                   }
  709.                               }
  710.                             new_prime_ptr->lesser_x=last_prime_ptr;
  711.                             if (last_prime_ptr == NULL)
  712.                               {
  713.                                 new_prime_head->lesser_x=new_prime_ptr;
  714.                                 new_prime_ptr->greater_x=new_prime_head;
  715.                                 new_prime_head=new_prime_ptr;
  716.                               }
  717.                             else
  718.                               {
  719.                                 new_prime_ptr->greater_x
  720.                                  =last_prime_ptr->greater_x;
  721.                                 (last_prime_ptr->greater_x)->lesser_x
  722.                                  =new_prime_ptr;
  723.                                 last_prime_ptr->greater_x=new_prime_ptr;
  724.                               }
  725.                           }
  726.                         else
  727.                           {
  728.                             finished=FALSE;
  729.                             while (! finished)
  730.                               {
  731.                                 last_prime_ptr=last_prime_ptr->greater_x;
  732.                                 if (last_prime_ptr == NULL)
  733.                                   finished=TRUE;
  734.                                 else
  735.                                   {
  736.                                     if (new_prime_ptr->x <= last_prime_ptr->x)
  737.                                       finished=TRUE;
  738.                                   }
  739.                               }
  740.                             new_prime_ptr->greater_x=last_prime_ptr;
  741.                             if (last_prime_ptr == NULL)
  742.                               {
  743.                                 new_prime_tail->greater_x=new_prime_ptr;
  744.                                 new_prime_ptr->lesser_x=new_prime_tail;
  745.                                 new_prime_tail=new_prime_ptr;
  746.                               }
  747.                             else
  748.                               {
  749.                                 new_prime_ptr->lesser_x
  750.                                  =last_prime_ptr->lesser_x;
  751.                                 (last_prime_ptr->lesser_x)->greater_x
  752.                                  =new_prime_ptr;
  753.                                 last_prime_ptr->lesser_x=new_prime_ptr;
  754.                               }
  755.                           }
  756.                       left=new_prime_ptr;
  757.                       up_ptr->up=new_prime_ptr;
  758.                       up_ptr=up_ptr->next;
  759.                       last_prime_ptr=new_prime_ptr;
  760.                       prime_ptr=prime_column->right;
  761.                       free((char *) prime_column);
  762.                       prime_column=prime_ptr;
  763.                     }
  764.                 }
  765.               left->right=NULL;
  766.               prime_row=next_prime_row;
  767.             }
  768.           *prime_head=new_prime_head;
  769.           *prime_tail=new_prime_tail;
  770.           while ((! fatal_error) && (up_head != NULL))
  771.             {
  772.               (up_head->up)->down=NULL;
  773.               up_ptr=up_head->next;
  774.               free((char *) up_head);
  775.               up_head=up_ptr;
  776.             }
  777.         }
  778.     }
  779.  
  780. static void plot(prime_tail,y_prime_min,y_prime_max,z_prime_min,
  781.  z_prime_max,max_y_out,max_z_out)
  782.   prime_rec_ptr prime_tail;
  783.   double        y_prime_min;
  784.   double        y_prime_max;
  785.   double        z_prime_min;
  786.   double        z_prime_max;
  787.   int           max_y_out;
  788.   int           max_z_out;
  789.     {
  790.       double        aspect_y;
  791.       double        aspect_z;
  792.       double        aspect_ratio;
  793.       int           box [8];
  794.       double        pixels_per_unit;
  795.       prime_rec_ptr prime_ptr;
  796.       int           y_aspect;
  797.       double        y_offset;
  798.       double        y_out_max;
  799.       int           z_aspect;
  800.       double        z_offset;
  801.       double        z_out_max;
  802.  
  803.       getaspectratio(&y_aspect,&z_aspect);
  804.       aspect_y=(double) y_aspect;
  805.       aspect_z=(double) z_aspect;
  806.       aspect_ratio=aspect_z/aspect_y;
  807.       y_out_max=(double) max_y_out;
  808.       z_out_max=(double) max_z_out;
  809.       if (aspect_ratio*z_out_max*(y_prime_max-y_prime_min)
  810.        > y_out_max*(z_prime_max-z_prime_min))
  811.         {
  812.           pixels_per_unit
  813.            =y_out_max/(aspect_ratio*(y_prime_max-y_prime_min));
  814.           y_offset=0.0;
  815.           z_offset
  816.            =-(z_out_max-pixels_per_unit*(z_prime_max-z_prime_min))/2.0;
  817.         }
  818.       else
  819.         if (aspect_ratio*z_out_max*(y_prime_max-y_prime_min)
  820.          < y_out_max*(z_prime_max-z_prime_min))
  821.           {
  822.             pixels_per_unit=z_out_max/(z_prime_max-z_prime_min);
  823.             y_offset=(y_out_max
  824.              -aspect_ratio*pixels_per_unit*(y_prime_max-y_prime_min))
  825.              /2.0;
  826.             z_offset=0.0;
  827.           }
  828.         else  /* plot degenerates to a single point */
  829.           {
  830.             pixels_per_unit=1.0;
  831.             y_offset=y_out_max/2.0;
  832.             z_offset=-z_out_max/2.0;
  833.           }
  834.       setcolor(getmaxcolor());
  835.       setfillstyle(SOLID_FILL,0);
  836.       setlinestyle(SOLID_LINE,0,NORM_WIDTH);
  837.       prime_ptr=prime_tail;
  838.       while (prime_ptr != NULL)
  839.         {
  840.           if (prime_ptr->right != NULL)
  841.             {
  842.               if (prime_ptr->down != NULL)
  843.                 {
  844.                   box[0]=(int) (y_offset+pixels_per_unit
  845.                    *aspect_ratio*(((double) (prime_ptr->y))-y_prime_min));
  846.                   box[1]=(int) (z_offset+z_out_max
  847.                    -pixels_per_unit
  848.                    *(((double) (prime_ptr->z))-z_prime_min));
  849.                   box[2]=(int) (y_offset+pixels_per_unit
  850.                    *aspect_ratio*(((double) (prime_ptr->right)->y)-y_prime_min));
  851.                   box[3]=(int) (z_offset+z_out_max
  852.                    -pixels_per_unit
  853.                    *(((double) (prime_ptr->right)->z)-z_prime_min));
  854.                   box[6]=(int) (y_offset+pixels_per_unit
  855.                    *aspect_ratio*(((double) (prime_ptr->down)->y)-y_prime_min));
  856.                   box[7]=(int) (z_offset+z_out_max
  857.                    -pixels_per_unit
  858.                    *(((double) (prime_ptr->down)->z)-z_prime_min));
  859.                   box[4]=(int) (y_offset+pixels_per_unit
  860.                    *aspect_ratio
  861.                    *(((double) ((prime_ptr->down)->right)->y)-y_prime_min));
  862.                   box[5]=(int) (z_offset+z_out_max
  863.                    -pixels_per_unit
  864.                    *(((double) ((prime_ptr->down)->right)->z)-z_prime_min));
  865.                   fillpoly(4,&box[0]);
  866.                 }
  867.             }
  868.           prime_ptr=prime_ptr->lesser_x;
  869.         }
  870.     }
  871.  
  872. void get_buffer(file_name)
  873.   char *file_name;
  874.     {
  875.       int source_file_size;
  876.  
  877.       if ((source_file=fopen(file_name,"rb")) == NULL)
  878.         {
  879.           fatal_error=TRUE;
  880.           printf("Fatal error:  cannot open %s for input.\n",
  881.            file_name);
  882.         }
  883.       else
  884.         {
  885.           source_file_size=fread(&source_buffer[0],1,16384,source_file);
  886.           fclose(source_file);
  887.           if (source_file_size == 16384)
  888.             {
  889.               fatal_error=TRUE;
  890.               printf(
  891.                "Fatal error:  %s exceeds 16383 bytes in length.\n",
  892.                file_name);
  893.             }
  894.           else
  895.             source_buffer[source_file_size]=(char) 26;
  896.         }
  897.       return;
  898.     }
  899.  
  900. void interpret_buffer()
  901.     {
  902.       source_char=' ';
  903.       source_eof=FALSE;
  904.       source_line_num=(long) 1;
  905.       source_column_num=(long) 0;
  906.       source_index=-1;
  907.       while ((! source_eof) && (! fatal_error))
  908.         {
  909.           get_token();
  910.           if (source_token[0] != ' ')
  911.             interpret_statement(TRUE);
  912.         }
  913.       return;
  914.     }
  915.  
  916. void free_variables()
  917.   {
  918.     int            bypass_smaller_name;
  919.     variable_ptr   current_ptr;
  920.     int            finished;
  921.     int            larger_predecessor_found;
  922.     queue_node_ptr new_queue_head;
  923.     variable_ptr   previous_ptr;
  924.     queue_node_ptr queue_head;
  925.  
  926.     if (variable_head != NULL)
  927.       {
  928.         current_ptr=variable_head;
  929.         finished=FALSE;
  930.         bypass_smaller_name=FALSE;
  931.         do
  932.           {
  933.             if (! bypass_smaller_name)
  934.               while ((*current_ptr).smaller_successor_ptr != NULL)
  935.                 current_ptr=(*current_ptr).smaller_successor_ptr;
  936.             free_value((*current_ptr).variable_value_header_ptr);
  937.             if ((*current_ptr).larger_successor_ptr != NULL)
  938.               {
  939.                 current_ptr=(*current_ptr).larger_successor_ptr;
  940.                 bypass_smaller_name=FALSE;
  941.               }
  942.             else
  943.               {
  944.                 larger_predecessor_found=FALSE;
  945.                 do
  946.                   {
  947.                     if ((*current_ptr).predecessor_ptr == NULL)
  948.                       finished=TRUE;
  949.                     else
  950.                       {
  951.                         previous_ptr=current_ptr;
  952.                         current_ptr=(*previous_ptr).predecessor_ptr;
  953.                         if (variable_comparison((*current_ptr).name,
  954.                          (*current_ptr).subscripts,(*previous_ptr).name,
  955.                          (*previous_ptr).subscripts) > 0)
  956.                           larger_predecessor_found=TRUE;
  957.                         free((*previous_ptr).name);
  958.                         queue_head=(*previous_ptr).subscripts;
  959.                         while (queue_head != NULL)
  960.                           {
  961.                             new_queue_head=(*queue_head).next;
  962.                             free_value((*queue_head).argument_header_ptr);
  963.                             free((char *) queue_head);
  964.                             queue_head=new_queue_head;
  965.                           }
  966.                         free((char *) previous_ptr);
  967.                       }
  968.                   }
  969.                while ((! finished) && (! larger_predecessor_found));
  970.                bypass_smaller_name=TRUE;
  971.               }
  972.           }
  973.         while (! finished);
  974.         free((*variable_head).name);
  975.         queue_head=(*variable_head).subscripts;
  976.         while (queue_head != NULL)
  977.           {
  978.             new_queue_head=(*queue_head).next;
  979.             free_value((*queue_head).argument_header_ptr);
  980.             free((char *) queue_head);
  981.             queue_head=new_queue_head;
  982.           }
  983.         free((char *) variable_head);
  984.       }
  985.     return;
  986.   }
  987.  
  988. static void get_source_char()
  989.   {
  990.     if (source_eof)
  991.       source_char=' ';
  992.     else
  993.       {
  994.         do
  995.           {
  996.             source_char=source_buffer[++source_index];
  997.             if (source_char != (char) 26)
  998.               {
  999.                 if (source_char == (char) 13)
  1000.                   {
  1001.                     source_line_num++;
  1002.                     source_column_num=(long) 0;
  1003.                   }
  1004.                 else
  1005.                   {
  1006.                     if (source_char != (char) 10)
  1007.                       {
  1008.                         if (source_char == '\t')
  1009.                           source_char=' ';
  1010.                         source_column_num++;
  1011.                       }
  1012.                   }
  1013.               }
  1014.           }
  1015.         while ((source_char != (char) 26)
  1016.         &&     ((source_char == (char) 13) || (source_char == (char) 10)));
  1017.         source_eof=(source_char == (char) 26);
  1018.         if (source_eof) source_char=' ';
  1019.       }
  1020.     return;
  1021.   }
  1022.  
  1023. static void get_token()
  1024.   {
  1025.     static   int  asterisk_found;
  1026.     static   int  eating_spaces;
  1027.     static   int  slash_found;
  1028.     static   int  slash_index;
  1029.     register int  token_index;
  1030.  
  1031.     eating_spaces=TRUE;
  1032.     while (eating_spaces)
  1033.       {
  1034.         while ((source_char == ' ')
  1035.         &&     (! source_eof))
  1036.           get_source_char();
  1037.         if (source_char == '/')
  1038.           {
  1039.             slash_index=source_index;
  1040.             get_source_char();
  1041.             if (source_char == '*')
  1042.               {
  1043.                 asterisk_found=FALSE;
  1044.                 slash_found=FALSE;
  1045.                 while ((! source_eof)
  1046.                 &&     ((! asterisk_found) || (! slash_found)))
  1047.                   {
  1048.                     get_source_char();
  1049.                     if (asterisk_found)
  1050.                       if (source_char == '/')
  1051.                         slash_found=TRUE;
  1052.                       else
  1053.                         asterisk_found=FALSE;
  1054.                     else
  1055.                       {
  1056.                         if (source_char == '*')
  1057.                           asterisk_found=TRUE;
  1058.                       }
  1059.                   }
  1060.                 if (source_eof)
  1061.                   eating_spaces=FALSE;
  1062.                 else
  1063.                   get_source_char();
  1064.               }
  1065.             else
  1066.               {
  1067.                 source_index=slash_index;
  1068.                 source_char=source_buffer[source_index];
  1069.                 eating_spaces=FALSE;
  1070.               }
  1071.           }
  1072.         else
  1073.           eating_spaces=FALSE;
  1074.       }
  1075.     if (isalpha((int) source_char))
  1076.       {
  1077.         token_index=0;
  1078.         while ((isalnum((int) source_char) || (source_char == '_'))
  1079.         &&     (! source_eof))
  1080.           {
  1081.             if (token_index < 255)
  1082.               source_token[token_index++]=(char) toupper((int) source_char);
  1083.             get_source_char();
  1084.           }
  1085.         source_token[token_index]='\0';
  1086.       }
  1087.     else
  1088.       {
  1089.         source_token[0]=source_char;
  1090.         source_token[1]='\0';
  1091.         get_source_char();
  1092.       }
  1093.     return;
  1094.   }
  1095.  
  1096. static void free_value(header_ptr)
  1097.   value_header_ptr header_ptr;
  1098.     {
  1099.       if (header_ptr != NULL)
  1100.         {
  1101.           switch ((*header_ptr).type)
  1102.             {
  1103.               case 'B':
  1104.                 free((char *) (*header_ptr).value_ptr.boolean);
  1105.                 break;
  1106.               case 'D':
  1107.                 free((char *) (*header_ptr).value_ptr.dataset);
  1108.                 break;
  1109.               case 'I':
  1110.                 free((char *) (*header_ptr).value_ptr.integer);
  1111.                 break;
  1112.               case 'R':
  1113.                 free((char *) (*header_ptr).value_ptr.real);
  1114.                 break;
  1115.               default:
  1116.                 free((*((*header_ptr).value_ptr.string)).value);
  1117.                 free((char *) (*header_ptr).value_ptr.string);
  1118.                 break;
  1119.             }
  1120.          free((char *) header_ptr);
  1121.         }
  1122.       return;
  1123.     }
  1124.  
  1125. static value_header_ptr new_boolean_header_ptr()
  1126.   {
  1127.     value_header_ptr result_header_ptr;
  1128.  
  1129.     if ((result_header_ptr=(struct value_header *)
  1130.      malloc((unsigned) sizeof(struct value_header))) == NULL)
  1131.       {
  1132.         fatal_error=TRUE;
  1133.         result_header_ptr=NULL;
  1134.         printf("Fatal error:  out of memory at ");
  1135.         printf("line %ld, column %ld.\n",
  1136.          source_line_num,source_column_num);
  1137.       }
  1138.     else
  1139.       {
  1140.         (*result_header_ptr).type='B';
  1141.         if (((*result_header_ptr).value_ptr.boolean=(int *)
  1142.          malloc((unsigned) sizeof(int))) == NULL)
  1143.           {
  1144.             fatal_error=TRUE;
  1145.             free((char *) result_header_ptr);
  1146.             result_header_ptr=NULL;
  1147.             printf("Fatal error:  out of memory at ");
  1148.             printf("line %ld, column %ld.\n",
  1149.              source_line_num,source_column_num);
  1150.           }
  1151.         else
  1152.           *((*result_header_ptr).value_ptr.boolean)=TRUE;
  1153.       }
  1154.     return(result_header_ptr);
  1155.   }
  1156.  
  1157. static value_header_ptr new_dataset_header_ptr()
  1158.   {
  1159.     value_header_ptr result_header_ptr;
  1160.  
  1161.     if ((result_header_ptr=(struct value_header *)
  1162.      malloc((unsigned) sizeof(struct value_header))) == NULL)
  1163.       {
  1164.         fatal_error=TRUE;
  1165.         result_header_ptr=NULL;
  1166.         printf("Fatal error:  out of memory at ");
  1167.         printf("line %ld, column %ld.\n",
  1168.          source_line_num,source_column_num);
  1169.       }
  1170.     else
  1171.       {
  1172.         (*result_header_ptr).type='D';
  1173.         if (((*result_header_ptr).value_ptr.dataset=(FILE **)
  1174.          malloc((unsigned) sizeof(FILE *))) == NULL)
  1175.           {
  1176.             fatal_error=TRUE;
  1177.             free((char *) result_header_ptr);
  1178.             result_header_ptr=NULL;
  1179.             printf("Fatal error:  out of memory at ");
  1180.             printf("line %ld, column %ld.\n",
  1181.              source_line_num,source_column_num);
  1182.           }
  1183.         else
  1184.           *((*result_header_ptr).value_ptr.dataset)=NULL;
  1185.       }
  1186.     return(result_header_ptr);
  1187.   }
  1188.  
  1189. static value_header_ptr new_integer_header_ptr()
  1190.   {
  1191.     value_header_ptr result_header_ptr;
  1192.  
  1193.     if ((result_header_ptr=(struct value_header *)
  1194.      malloc((unsigned) sizeof(struct value_header))) == NULL)
  1195.       {
  1196.         fatal_error=TRUE;
  1197.         result_header_ptr=NULL;
  1198.         printf("Fatal error:  out of memory at ");
  1199.         printf("line %ld, column %ld.\n",
  1200.          source_line_num,source_column_num);
  1201.       }
  1202.     else
  1203.       {
  1204.         (*result_header_ptr).type='I';
  1205.         if (((*result_header_ptr).value_ptr.integer=(long *)
  1206.          malloc((unsigned) sizeof(long))) == NULL)
  1207.           {
  1208.             fatal_error=TRUE;
  1209.             free((char *) result_header_ptr);
  1210.             result_header_ptr=NULL;
  1211.             printf("Fatal error:  out of memory at ");
  1212.             printf("line %ld, column %ld.\n",
  1213.              source_line_num,source_column_num);
  1214.           }
  1215.         else
  1216.           *((*result_header_ptr).value_ptr.integer)=0;
  1217.       }
  1218.     return(result_header_ptr);
  1219.   }
  1220.  
  1221. static value_header_ptr new_real_header_ptr()
  1222.   {
  1223.     value_header_ptr result_header_ptr;
  1224.  
  1225.     if ((result_header_ptr=(struct value_header *)
  1226.      malloc((unsigned) sizeof(struct value_header))) == NULL)
  1227.       {
  1228.         fatal_error=TRUE;
  1229.         result_header_ptr=NULL;
  1230.         printf("Fatal error:  out of memory at ");
  1231.         printf("line %ld, column %ld.\n",
  1232.          source_line_num,source_column_num);
  1233.       }
  1234.     else
  1235.       {
  1236.         (*result_header_ptr).type='R';
  1237.         if (((*result_header_ptr).value_ptr.real=(double *)
  1238.          malloc((unsigned) sizeof(double))) == NULL)
  1239.           {
  1240.             fatal_error=TRUE;
  1241.             free((char *) result_header_ptr);
  1242.             result_header_ptr=NULL;
  1243.             printf("Fatal error:  out of memory at ");
  1244.             printf("line %ld, column %ld.\n",
  1245.              source_line_num,source_column_num);
  1246.           }
  1247.         else
  1248.           *((*result_header_ptr).value_ptr.real)=0.0;
  1249.       }
  1250.     return(result_header_ptr);
  1251.   }
  1252.  
  1253. static value_header_ptr new_string_header_ptr(string_length)
  1254.   unsigned string_length;
  1255.     {
  1256.       value_header_ptr result_header_ptr;
  1257.  
  1258.       if (string_length > (unsigned) 32767)
  1259.         {
  1260.           fatal_error=TRUE;
  1261.           result_header_ptr=NULL;
  1262.           printf(
  1263.         "Fatal error:  string length exceeds 32767 at line %ld, column %ld.\n",
  1264.            source_line_num,source_column_num);
  1265.         }
  1266.       else
  1267.         if ((result_header_ptr=(struct value_header *)
  1268.          malloc((unsigned) sizeof(struct value_header))) == NULL)
  1269.           {
  1270.             fatal_error=TRUE;
  1271.             result_header_ptr=NULL;
  1272.             printf("Fatal error:  out of memory at ");
  1273.             printf("line %ld, column %ld.\n",
  1274.              source_line_num,source_column_num);
  1275.           }
  1276.         else
  1277.           {
  1278.             (*result_header_ptr).type='S';
  1279.             if (((*result_header_ptr).value_ptr.string=(struct text *)
  1280.              malloc((unsigned) sizeof(struct text))) == NULL)
  1281.               {
  1282.                 fatal_error=TRUE;
  1283.                 result_header_ptr=NULL;
  1284.                 printf("Fatal error:  out of memory at ");
  1285.                 printf("line %ld, column %ld.\n",
  1286.                  source_line_num,source_column_num);
  1287.               }
  1288.             else
  1289.               {
  1290.                 (*((*result_header_ptr).value_ptr.string)).length
  1291.                  =string_length;
  1292.                 if (((*((*result_header_ptr).value_ptr.string)).value=
  1293.                  (unsigned char *) malloc((unsigned) (1+string_length)))
  1294.                  == NULL)
  1295.                   {
  1296.                     fatal_error=TRUE;
  1297.                     free((char *) result_header_ptr);
  1298.                     result_header_ptr=NULL;
  1299.                     printf("Fatal error:  out of memory at ");
  1300.                     printf("line %ld, column %ld.\n",
  1301.                      source_line_num,source_column_num);
  1302.                   }
  1303.                 else
  1304.                   *((*((*result_header_ptr).value_ptr.string)).value)
  1305.                    =(unsigned char) '\0';
  1306.               }
  1307.           }
  1308.       return(result_header_ptr);
  1309.     }
  1310.  
  1311. static int pli_strcmp(string_1,string_2)
  1312.   text_ptr string_1;
  1313.   text_ptr string_2;
  1314.     {
  1315.       unsigned char char_1;
  1316.       unsigned char char_2;
  1317.       register int  char_index;
  1318.       unsigned char *char_ptr_1;
  1319.       unsigned char *char_ptr_2;
  1320.       int           length_1;
  1321.       int           length_2;
  1322.       int           result;
  1323.  
  1324.       result=0;
  1325.       char_index=0;
  1326.       char_ptr_1=(*string_1).value;
  1327.       char_ptr_2=(*string_2).value;
  1328.       length_1=(*string_1).length;
  1329.       length_2=(*string_2).length;
  1330.       while ((result == 0)
  1331.       &&     (char_index < length_1)
  1332.       &&     (char_index < length_2))
  1333.          {
  1334.            char_1=*char_ptr_1;
  1335.            char_2=*char_ptr_2;
  1336.            if (char_1 < char_2)
  1337.              result=-1;
  1338.            else
  1339.              if (char_1 > char_2)
  1340.                result=1;
  1341.              else
  1342.                {
  1343.                  char_index++;
  1344.                  char_ptr_1++;
  1345.                  char_ptr_2++;
  1346.                }
  1347.         }
  1348.       char_2=(unsigned char) ' ';
  1349.       while ((result == 0)
  1350.       &&     (char_index < length_1))
  1351.         {
  1352.           char_1=*char_ptr_1;
  1353.           if (char_1 < char_2)
  1354.             result=-1;
  1355.           else
  1356.             if (char_1 > char_2)
  1357.               result=1;
  1358.             else
  1359.               {
  1360.                 char_index++;
  1361.                 char_ptr_1++;
  1362.               }
  1363.         }
  1364.       char_1=(unsigned char) ' ';
  1365.       while ((result == 0)
  1366.       &&     (char_index < length_2))
  1367.         {
  1368.           char_2=*char_ptr_2;
  1369.           if (char_1 < char_2)
  1370.             result=-1;
  1371.           else
  1372.             if (char_1 > char_2)
  1373.               result=1;
  1374.             else
  1375.               {
  1376.                 char_index++;
  1377.                 char_ptr_2++;
  1378.               }
  1379.         }
  1380.       return(result);
  1381.     }
  1382.  
  1383. static void pli_strcpy(string_1,string_2)
  1384.   text_ptr string_1;
  1385.   text_ptr string_2;
  1386.     {
  1387.       register int  char_index;
  1388.       unsigned char *char_ptr_1;
  1389.       unsigned char *char_ptr_2;
  1390.       int           string_length;
  1391.  
  1392.       char_ptr_1=(*string_1).value;
  1393.       char_ptr_2=(*string_2).value;
  1394.       string_length=(*string_2).length;
  1395.       for (char_index=0; char_index < string_length; char_index++)
  1396.         {
  1397.           *char_ptr_1=*char_ptr_2;
  1398.           char_ptr_1++;
  1399.           char_ptr_2++;
  1400.         }
  1401.       *char_ptr_1=(unsigned char) '\0';
  1402.       return;
  1403.     }
  1404.  
  1405. static value_header_ptr string_header_ptr(evaluate)
  1406.   int evaluate;
  1407.     {
  1408.       value_header_ptr new_result_header_ptr;
  1409.       value_header_ptr result_header_ptr;
  1410.       int              string_index;
  1411.       unsigned         string_length;
  1412.       int              string_terminated;
  1413.  
  1414.       string_index=-1;
  1415.       string_length=(unsigned) 0;
  1416.       result_header_ptr=new_string_header_ptr((unsigned) 0);
  1417.       string_terminated=FALSE;
  1418.       while ((! fatal_error) && (! string_terminated) && (! source_eof))
  1419.         {
  1420.           get_source_char();
  1421.           if (source_char == '\'')
  1422.             {
  1423.               get_source_char();
  1424.               if (source_char == '\'')
  1425.                 {
  1426.                   string_length++;
  1427.                   new_result_header_ptr=new_string_header_ptr(string_length);
  1428.                   if (! fatal_error)
  1429.                     {
  1430.                       pli_strcpy((*new_result_header_ptr).value_ptr.string,
  1431.                        (*result_header_ptr).value_ptr.string);
  1432.                       string_index++;
  1433.                       (*((*new_result_header_ptr).value_ptr.string)).value[
  1434.                        string_index]=(unsigned char) source_char;
  1435.                       (*((*new_result_header_ptr).value_ptr.string)).value[
  1436.                        string_length]=(unsigned char) '\0';
  1437.                       free_value(result_header_ptr);
  1438.                       result_header_ptr=new_result_header_ptr;
  1439.                     }
  1440.                 }
  1441.               else
  1442.                 string_terminated=TRUE;
  1443.             }
  1444.           else
  1445.             {
  1446.               string_length++;
  1447.               new_result_header_ptr=new_string_header_ptr(string_length);
  1448.               if (! fatal_error)
  1449.                 {
  1450.                   pli_strcpy((*new_result_header_ptr).value_ptr.string,
  1451.                    (*result_header_ptr).value_ptr.string);
  1452.                   string_index++;
  1453.                   (*((*new_result_header_ptr).value_ptr.string)).value[
  1454.                    string_index]=(unsigned char) source_char;
  1455.                   (*((*new_result_header_ptr).value_ptr.string)).value[
  1456.                    string_length]=(unsigned char) '\0';
  1457.                   free_value(result_header_ptr);
  1458.                   result_header_ptr=new_result_header_ptr;
  1459.                 }
  1460.             }
  1461.         }
  1462.       if (! evaluate)
  1463.         {
  1464.           free_value(result_header_ptr);
  1465.           result_header_ptr=NULL;
  1466.         }
  1467.       return(result_header_ptr);
  1468.     }
  1469.  
  1470. static long tree_balancer(argument)
  1471.   long argument;
  1472.     {
  1473.       union
  1474.         {
  1475.           struct
  1476.             {
  1477.               unsigned char number_1;
  1478.               unsigned char number_2;
  1479.               unsigned char number_3;
  1480.               unsigned char number_4;
  1481.             } byte;
  1482.           struct
  1483.             {
  1484.               unsigned int number_01 : 1;
  1485.               unsigned int number_02 : 1;
  1486.               unsigned int number_03 : 1;
  1487.               unsigned int number_04 : 1;
  1488.               unsigned int number_05 : 1;
  1489.               unsigned int number_06 : 1;
  1490.               unsigned int number_07 : 1;
  1491.               unsigned int number_08 : 1;
  1492.               unsigned int number_09 : 1;
  1493.               unsigned int number_10 : 1;
  1494.               unsigned int number_11 : 1;
  1495.               unsigned int number_12 : 1;
  1496.               unsigned int number_13 : 1;
  1497.               unsigned int number_14 : 1;
  1498.               unsigned int number_15 : 1;
  1499.               unsigned int number_16 : 1;
  1500.               unsigned int number_17 : 1;
  1501.               unsigned int number_18 : 1;
  1502.               unsigned int number_19 : 1;
  1503.               unsigned int number_20 : 1;
  1504.               unsigned int number_21 : 1;
  1505.               unsigned int number_22 : 1;
  1506.               unsigned int number_23 : 1;
  1507.               unsigned int number_24 : 1;
  1508.               unsigned int number_25 : 1;
  1509.               unsigned int number_26 : 1;
  1510.               unsigned int number_27 : 1;
  1511.               unsigned int number_28 : 1;
  1512.               unsigned int number_29 : 1;
  1513.               unsigned int number_30 : 1;
  1514.               unsigned int number_31 : 1;
  1515.               unsigned int number_32 : 1;
  1516.             } bit;
  1517.         } intermediate;
  1518.       union
  1519.         {
  1520.           long       signed_long;
  1521.           struct
  1522.             {
  1523.               unsigned char number_1;
  1524.               unsigned char number_2;
  1525.               unsigned char number_3;
  1526.               unsigned char number_4;
  1527.             } byte;
  1528.           struct
  1529.             {
  1530.               unsigned int number_01 : 1;
  1531.               unsigned int number_02 : 1;
  1532.               unsigned int number_03 : 1;
  1533.               unsigned int number_04 : 1;
  1534.               unsigned int number_05 : 1;
  1535.               unsigned int number_06 : 1;
  1536.               unsigned int number_07 : 1;
  1537.               unsigned int number_08 : 1;
  1538.               unsigned int number_09 : 1;
  1539.               unsigned int number_10 : 1;
  1540.               unsigned int number_11 : 1;
  1541.               unsigned int number_12 : 1;
  1542.               unsigned int number_13 : 1;
  1543.               unsigned int number_14 : 1;
  1544.               unsigned int number_15 : 1;
  1545.               unsigned int number_16 : 1;
  1546.               unsigned int number_17 : 1;
  1547.               unsigned int number_18 : 1;
  1548.               unsigned int number_19 : 1;
  1549.               unsigned int number_20 : 1;
  1550.               unsigned int number_21 : 1;
  1551.               unsigned int number_22 : 1;
  1552.               unsigned int number_23 : 1;
  1553.               unsigned int number_24 : 1;
  1554.               unsigned int number_25 : 1;
  1555.               unsigned int number_26 : 1;
  1556.               unsigned int number_27 : 1;
  1557.               unsigned int number_28 : 1;
  1558.               unsigned int number_29 : 1;
  1559.               unsigned int number_30 : 1;
  1560.               unsigned int number_31 : 1;
  1561.               unsigned int number_32 : 1;
  1562.             } bit;
  1563.         } result;
  1564.       register int round;
  1565.  
  1566.       result.signed_long=argument;
  1567.       for (round=1; round <= 8; round++)
  1568.         {
  1569.           intermediate.bit.number_01=result.bit.number_04;
  1570.           intermediate.bit.number_02=result.bit.number_29;
  1571.           intermediate.bit.number_03=result.bit.number_06;
  1572.           intermediate.bit.number_04=result.bit.number_09;
  1573.           intermediate.bit.number_05=result.bit.number_26;
  1574.           intermediate.bit.number_06=result.bit.number_25;
  1575.           intermediate.bit.number_07=result.bit.number_16;
  1576.           intermediate.bit.number_08=result.bit.number_15;
  1577.           intermediate.bit.number_09=result.bit.number_24;
  1578.           intermediate.bit.number_10=result.bit.number_31;
  1579.           intermediate.bit.number_11=result.bit.number_02;
  1580.           intermediate.bit.number_12=result.bit.number_18;
  1581.           intermediate.bit.number_13=result.bit.number_32;
  1582.           intermediate.bit.number_14=result.bit.number_03;
  1583.           intermediate.bit.number_15=result.bit.number_20;
  1584.           intermediate.bit.number_16=result.bit.number_30;
  1585.           intermediate.bit.number_17=result.bit.number_08;
  1586.           intermediate.bit.number_18=result.bit.number_27;
  1587.           intermediate.bit.number_19=result.bit.number_13;
  1588.           intermediate.bit.number_20=result.bit.number_11;
  1589.           intermediate.bit.number_21=result.bit.number_01;
  1590.           intermediate.bit.number_22=result.bit.number_17;
  1591.           intermediate.bit.number_23=result.bit.number_10;
  1592.           intermediate.bit.number_24=result.bit.number_05;
  1593.           intermediate.bit.number_25=result.bit.number_07;
  1594.           intermediate.bit.number_26=result.bit.number_14;
  1595.           intermediate.bit.number_27=result.bit.number_19;
  1596.           intermediate.bit.number_28=result.bit.number_23;
  1597.           intermediate.bit.number_29=result.bit.number_21;
  1598.           intermediate.bit.number_30=result.bit.number_28;
  1599.           intermediate.bit.number_31=result.bit.number_12;
  1600.           intermediate.bit.number_32=result.bit.number_22;
  1601.           result.byte.number_1=substitute[intermediate.byte.number_1];
  1602.           result.byte.number_2=substitute[intermediate.byte.number_2];
  1603.           result.byte.number_3=substitute[intermediate.byte.number_3];
  1604.           result.byte.number_4=substitute[intermediate.byte.number_4];
  1605.         }
  1606.       return(result.signed_long);
  1607.     }
  1608.  
  1609. static int variable_comparison(name_1,queue_head_1,name_2,queue_head_2)
  1610.   char           *name_1;
  1611.   queue_node_ptr queue_head_1;
  1612.   char           *name_2;
  1613.   queue_node_ptr queue_head_2;
  1614.     {
  1615.       int       boolean_1;
  1616.       int       boolean_2;
  1617.       union  {
  1618.                FILE *file_ptr;
  1619.                long address;
  1620.              }  dataset_1;
  1621.       union  {
  1622.                FILE *file_ptr;
  1623.                long address;
  1624.              }  dataset_2;
  1625.       long      integer_1;
  1626.       long      integer_2;
  1627.       double    real_1;
  1628.       double    real_2;
  1629.       int       result;
  1630.       char      type_1;
  1631.       char      type_2;
  1632.  
  1633.       result=strcmp(name_1,name_2);
  1634.       if (result == 0)
  1635.         {
  1636.           while ((result == 0)
  1637.           &&     (queue_head_1 != NULL)
  1638.           &&     (queue_head_2 != NULL))
  1639.             {
  1640.               type_1=(*((*queue_head_1).argument_header_ptr)).type;
  1641.               type_2=(*((*queue_head_2).argument_header_ptr)).type;
  1642.               if (type_1 < type_2)
  1643.                 result=-1;
  1644.               else
  1645.                 if (type_1 > type_2)
  1646.                   result=1;
  1647.                 else
  1648.                   switch (type_1)
  1649.                     {
  1650.                       case 'B':
  1651.                         boolean_1=*((*((*queue_head_1).argument_header_ptr)).
  1652.                          value_ptr.boolean);
  1653.                         boolean_2=*((*((*queue_head_2).argument_header_ptr)).
  1654.                          value_ptr.boolean);
  1655.                         if (boolean_1)
  1656.                           {
  1657.                             if (! boolean_2)
  1658.                               result=1;
  1659.                           }
  1660.                         else
  1661.                           {
  1662.                             if (boolean_2)
  1663.                               result=-1;
  1664.                           }
  1665.                         break;
  1666.                       case 'D':
  1667.                         dataset_1.file_ptr
  1668.                          =*((*((*queue_head_1).argument_header_ptr)).
  1669.                          value_ptr.dataset);
  1670.                         dataset_2.file_ptr
  1671.                          =*((*((*queue_head_2).argument_header_ptr)).
  1672.                          value_ptr.dataset);
  1673.                         if (dataset_1.address < dataset_2.address)
  1674.                           result=-1;
  1675.                         else
  1676.                           {
  1677.                             if (dataset_1.address > dataset_2.address)
  1678.                               result=1;
  1679.                           }
  1680.                         break;
  1681.                       case 'I':
  1682.                         integer_1=*((*((*queue_head_1).argument_header_ptr)).
  1683.                          value_ptr.integer);
  1684.                         integer_2=*((*((*queue_head_2).argument_header_ptr)).
  1685.                          value_ptr.integer);
  1686.                         if (integer_1 < integer_2)
  1687.                           result=-1;
  1688.                         else
  1689.                           {
  1690.                             if (integer_1 > integer_2)
  1691.                               result=1;
  1692.                           }
  1693.                         break;
  1694.                       case 'R':
  1695.                         real_1=*((*((*queue_head_1).argument_header_ptr)).
  1696.                          value_ptr.real);
  1697.                         real_2=*((*((*queue_head_2).argument_header_ptr)).
  1698.                          value_ptr.real);
  1699.                         if (real_1 < real_2)
  1700.                           result=-1;
  1701.                         else
  1702.                           {
  1703.                             if (real_1 > real_2)
  1704.                               result=1;
  1705.                           }
  1706.                         break;
  1707.                       default:
  1708.                         result=pli_strcmp(
  1709.                          (*((*queue_head_1).argument_header_ptr)).
  1710.                          value_ptr.string,
  1711.                          (*((*queue_head_2).argument_header_ptr)).
  1712.                          value_ptr.string);
  1713.                         break;
  1714.                     }
  1715.               queue_head_1=(*queue_head_1).next;
  1716.               queue_head_2=(*queue_head_2).next;
  1717.             }
  1718.           if (result == 0)
  1719.             {
  1720.               if (queue_head_1 == NULL)
  1721.                 {
  1722.                   if (queue_head_2 != NULL)
  1723.                     result=-1;
  1724.                 }
  1725.               else
  1726.                 {
  1727.                   if (queue_head_2 == NULL)
  1728.                     result=1;
  1729.                 }
  1730.             }
  1731.         }
  1732.       return(result);
  1733.     }
  1734.  
  1735. static value_header_ptr copy_of_arguments(argument_header_ptr)
  1736.  value_header_ptr argument_header_ptr;
  1737.   {
  1738.     value_header_ptr result_header_ptr;
  1739.  
  1740.     if (argument_header_ptr == NULL)
  1741.       result_header_ptr=NULL;
  1742.     else
  1743.       switch ((*argument_header_ptr).type)
  1744.         {
  1745.           case 'B':
  1746.             result_header_ptr=new_boolean_header_ptr();
  1747.             if (! fatal_error)
  1748.              *((*(result_header_ptr)).value_ptr.boolean)
  1749.               =*((*argument_header_ptr).value_ptr.boolean);
  1750.             break;
  1751.           case 'D':
  1752.             result_header_ptr=new_dataset_header_ptr();
  1753.             if (! fatal_error)
  1754.              *((*(result_header_ptr)).value_ptr.dataset)
  1755.               =*((*argument_header_ptr).value_ptr.dataset);
  1756.             break;
  1757.           case 'I':
  1758.             result_header_ptr=new_integer_header_ptr();
  1759.             if (! fatal_error)
  1760.              *((*(result_header_ptr)).value_ptr.integer)
  1761.               =*((*argument_header_ptr).value_ptr.integer);
  1762.             break;
  1763.           case 'R':
  1764.             result_header_ptr=new_real_header_ptr();
  1765.             if (! fatal_error)
  1766.              *((*(result_header_ptr)).value_ptr.real)
  1767.               =*((*argument_header_ptr).value_ptr.real);
  1768.             break;
  1769.           default:
  1770.             result_header_ptr
  1771.              =new_string_header_ptr((unsigned)
  1772.              (*((*argument_header_ptr).value_ptr.string)).length);
  1773.             if (! fatal_error)
  1774.              pli_strcpy((*(result_header_ptr)).value_ptr.string,
  1775.               (*argument_header_ptr).value_ptr.string);
  1776.             break;
  1777.         }
  1778.     return(result_header_ptr);
  1779.   }
  1780.  
  1781. static value_header_ptr copy_of_subscripts(argument_header_ptr)
  1782.  value_header_ptr argument_header_ptr;
  1783.   {
  1784.     value_header_ptr result_header_ptr;
  1785.  
  1786.     if (argument_header_ptr == NULL)
  1787.       result_header_ptr=NULL;
  1788.     else
  1789.       switch ((*argument_header_ptr).type)
  1790.         {
  1791.           case 'B':
  1792.             result_header_ptr=new_boolean_header_ptr();
  1793.             if (! fatal_error)
  1794.              *((*(result_header_ptr)).value_ptr.boolean)
  1795.               =*((*argument_header_ptr).value_ptr.boolean);
  1796.             break;
  1797.           case 'D':
  1798.             result_header_ptr=new_dataset_header_ptr();
  1799.             if (! fatal_error)
  1800.              *((*(result_header_ptr)).value_ptr.dataset)
  1801.               =*((*argument_header_ptr).value_ptr.dataset);
  1802.             break;
  1803.           case 'I':
  1804.             result_header_ptr=new_integer_header_ptr();
  1805.             if (! fatal_error)
  1806.              *((*(result_header_ptr)).value_ptr.integer)
  1807.               =tree_balancer(*((*argument_header_ptr).value_ptr.integer));
  1808.             break;
  1809.           case 'R':
  1810.             result_header_ptr=new_real_header_ptr();
  1811.             if (! fatal_error)
  1812.              *((*(result_header_ptr)).value_ptr.real)
  1813.               =*((*argument_header_ptr).value_ptr.real);
  1814.             break;
  1815.           default:
  1816.             result_header_ptr
  1817.              =new_string_header_ptr((unsigned)
  1818.              (*((*argument_header_ptr).value_ptr.string)).length);
  1819.             if (! fatal_error)
  1820.              pli_strcpy((*(result_header_ptr)).value_ptr.string,
  1821.               (*argument_header_ptr).value_ptr.string);
  1822.             break;
  1823.         }
  1824.     return(result_header_ptr);
  1825.   }
  1826.  
  1827. static queue_node_ptr copy_of_queue(queue_head)
  1828.   queue_node_ptr queue_head;
  1829.     {
  1830.       queue_node_ptr copy_queue_head;
  1831.       queue_node_ptr copy_queue_tail;
  1832.       queue_node_ptr new_copy_queue_tail;
  1833.       queue_node_ptr new_queue_head;
  1834.  
  1835.       copy_queue_head=NULL;
  1836.       copy_queue_tail=NULL;
  1837.       while ((queue_head != NULL) && (! fatal_error))
  1838.         {
  1839.           new_queue_head=(*queue_head).next;
  1840.           if (copy_queue_head == NULL)
  1841.             if ((copy_queue_head=(queue_node_ptr)
  1842.              malloc((unsigned) sizeof(struct queue_node))) == NULL)
  1843.               {
  1844.                 fatal_error=TRUE;
  1845.                 printf(
  1846.                  "Fatal error:  out of memory at line %ld, column %ld.\n",
  1847.                  source_line_num,source_column_num);
  1848.               }
  1849.             else
  1850.               {
  1851.                 copy_queue_tail=copy_queue_head;
  1852.                 (*copy_queue_head).next=NULL;
  1853.                 (*copy_queue_head).argument_header_ptr
  1854.                  =copy_of_subscripts((*queue_head).argument_header_ptr);
  1855.               }
  1856.           else
  1857.             if ((new_copy_queue_tail=(queue_node_ptr)
  1858.              malloc((unsigned) sizeof(struct queue_node))) == NULL)
  1859.               {
  1860.                 fatal_error=TRUE;
  1861.                 printf(
  1862.                  "Fatal error:  out of memory at line %ld, column %ld.\n",
  1863.                  source_line_num,source_column_num);
  1864.               }
  1865.             else
  1866.               {
  1867.                 (*new_copy_queue_tail).next=NULL;
  1868.                 (*copy_queue_tail).next=new_copy_queue_tail;
  1869.                 copy_queue_tail=new_copy_queue_tail;
  1870.                 (*new_copy_queue_tail).argument_header_ptr
  1871.                  =copy_of_subscripts((*queue_head).argument_header_ptr);
  1872.               }
  1873.           queue_head=new_queue_head;
  1874.         }
  1875.       return(copy_queue_head);
  1876.     }
  1877.  
  1878. static value_header_ptr variable_header_ptr(variable_name,evaluate,queue_head)
  1879.   char           *variable_name;
  1880.   int            evaluate;
  1881.   queue_node_ptr queue_head;
  1882.     {
  1883.       int              comparison;
  1884.       int              finished;
  1885.       queue_node_ptr   new_queue_copy;
  1886.       variable_ptr     parameter_ptr;
  1887.       queue_node_ptr   queue_copy;
  1888.       value_header_ptr result_header_ptr;
  1889.       int              variable_found;
  1890.  
  1891.       if (evaluate)
  1892.         {
  1893.           variable_found=FALSE;
  1894.           if (variable_head != NULL)
  1895.             {
  1896.               parameter_ptr=variable_head;
  1897.               queue_copy=copy_of_queue(queue_head);
  1898.               finished=FALSE;
  1899.               do
  1900.                 {
  1901.                   comparison=variable_comparison(variable_name,queue_copy,
  1902.                    (*parameter_ptr).name,(*parameter_ptr).subscripts);
  1903.                   if (comparison < 0)
  1904.                     if ((*parameter_ptr).smaller_successor_ptr == NULL)
  1905.                       finished=TRUE;
  1906.                     else
  1907.                       parameter_ptr=(*parameter_ptr).smaller_successor_ptr;
  1908.                   else
  1909.                     if (comparison > 0)
  1910.                       if ((*parameter_ptr).larger_successor_ptr == NULL)
  1911.                         finished=TRUE;
  1912.                       else
  1913.                         parameter_ptr=(*parameter_ptr).larger_successor_ptr;
  1914.                     else
  1915.                       {
  1916.                         variable_found=TRUE;
  1917.                         result_header_ptr
  1918.                          =copy_of_arguments(
  1919.                          (*parameter_ptr).variable_value_header_ptr);
  1920.                         finished=TRUE;
  1921.                       }
  1922.                 }
  1923.               while (! finished);
  1924.               while (queue_copy != NULL)
  1925.                 {
  1926.                   new_queue_copy=(*queue_copy).next;
  1927.                   free_value((*queue_copy).argument_header_ptr);
  1928.                   free((char *) queue_copy);
  1929.                   queue_copy=new_queue_copy;
  1930.                 }
  1931.             }
  1932.           if (! variable_found)
  1933.             result_header_ptr=NULL;
  1934.         }
  1935.       else
  1936.         result_header_ptr=NULL;
  1937.       return(result_header_ptr);
  1938.     }
  1939.  
  1940. static value_header_ptr unsigned_integer_header_ptr()
  1941.     {
  1942.       unsigned long    result;
  1943.       value_header_ptr result_header_ptr;
  1944.       unsigned long    tem_unsigned_long;
  1945.  
  1946.       result=(unsigned long) 0;
  1947.       do
  1948.         {
  1949.           if ((source_char >= '0') && (source_char <= '9'))
  1950.             {
  1951.               tem_unsigned_long=(unsigned long) source_char;
  1952.               tem_unsigned_long-=(unsigned long) '0';
  1953.               result*=(unsigned long) 10;
  1954.               result+=tem_unsigned_long;
  1955.               if (result <= (unsigned long) 0x7fffffff)
  1956.                 get_source_char();
  1957.             }
  1958.         }
  1959.       while ((source_char >= '0') && (source_char <= '9')
  1960.       &&     (result <= (unsigned long) 0x7fffffff));
  1961.       if (result <= (unsigned long) 0x7fffffff)
  1962.         {
  1963.           result_header_ptr=new_integer_header_ptr();
  1964.           if (! fatal_error)
  1965.             *((*result_header_ptr).value_ptr.integer)=(long) result;
  1966.         }
  1967.       else
  1968.         {
  1969.           fatal_error=TRUE;
  1970.           result_header_ptr=NULL;
  1971.           printf(
  1972.            "Fatal error:  integer constant too big at line %ld, column %ld.\n",
  1973.            source_line_num,source_column_num);
  1974.         }
  1975.       return(result_header_ptr);
  1976.     }
  1977.  
  1978. static value_header_ptr unsigned_number_header_ptr(evaluate)
  1979.   int evaluate;
  1980.     {
  1981.       value_header_ptr exponent_header_ptr;
  1982.       char             exponent_sign;
  1983.       long             exponent_value;
  1984.       double           factor;
  1985.       value_header_ptr result_header_ptr;
  1986.       double           tem_real_1;
  1987.       double           tem_real_2;
  1988.  
  1989.       result_header_ptr=unsigned_integer_header_ptr();
  1990.       if (! fatal_error)
  1991.         {
  1992.           if (source_char == '.')
  1993.             {
  1994.               tem_real_1=(double) *((*result_header_ptr).value_ptr.integer);
  1995.               free_value(result_header_ptr);
  1996.               result_header_ptr=new_real_header_ptr();
  1997.               if (! fatal_error)
  1998.                 {
  1999.                   *((*result_header_ptr).value_ptr.real)=tem_real_1;
  2000.                   get_source_char();
  2001.                   if (isdigit((int) source_char))
  2002.                     {
  2003.                       factor=1.0;
  2004.                       while (isdigit((int) source_char))
  2005.                         {
  2006.                           factor=factor/10.0;
  2007.                           tem_real_2=(float) source_char;
  2008.                           tem_real_2-=(float) '0';
  2009.                           tem_real_1+=factor*tem_real_2;
  2010.                           get_source_char();
  2011.                         }
  2012.                       *((*result_header_ptr).value_ptr.real)=tem_real_1;
  2013.                     }
  2014.                   else
  2015.                     {
  2016.                       fatal_error=TRUE;
  2017.                       free_value(result_header_ptr);
  2018.                       result_header_ptr=NULL;
  2019.                       printf(
  2020.                   "Fatal error:  decimal part of real number is missing at\n");
  2021.                       printf(
  2022.                   "line %ld, column %ld.\n",source_line_num,source_column_num);
  2023.                     }
  2024.                 }
  2025.             }
  2026.           if (! fatal_error)
  2027.             {
  2028.               if ((source_char == 'e') || (source_char == 'E'))
  2029.                 {
  2030.                   if ((*result_header_ptr).type == 'I')
  2031.                     {
  2032.                       tem_real_1
  2033.                        =(double) *((*result_header_ptr).value_ptr.integer);
  2034.                       free_value(result_header_ptr);
  2035.                       result_header_ptr=new_real_header_ptr();
  2036.                       if (! fatal_error)
  2037.                         *((*result_header_ptr).value_ptr.real)=tem_real_1;
  2038.                     }
  2039.                   if (! fatal_error)
  2040.                     {
  2041.                       get_source_char();
  2042.                       if (source_eof)
  2043.                         {
  2044.                           fatal_error=TRUE;
  2045.                           free_value(result_header_ptr);
  2046.                           result_header_ptr=NULL;
  2047.                           printf(
  2048.                            "Fatal error:  file ends before real number ");
  2049.                           printf(
  2050.                            "completed.\n");
  2051.                         }
  2052.                     }
  2053.                   if (! fatal_error)
  2054.                     {
  2055.                       if ((source_char == '+')
  2056.                       ||  (source_char == '-'))
  2057.                         {
  2058.                           exponent_sign=source_char;
  2059.                           get_source_char();
  2060.                         }
  2061.                       else
  2062.                         exponent_sign=' ';
  2063.                     }
  2064.                   if (! fatal_error)
  2065.                     {
  2066.                       if (source_eof)
  2067.                         {
  2068.                           fatal_error=TRUE;
  2069.                           free_value(result_header_ptr);
  2070.                           result_header_ptr=NULL;
  2071.                           printf(
  2072.                            "Fatal error:  file ends before real number ");
  2073.                           printf(
  2074.                            "completed.\n");
  2075.                         }
  2076.                     }
  2077.                   if (! fatal_error)
  2078.                     {
  2079.                       if (! isdigit((int) source_char))
  2080.                         {
  2081.                           fatal_error=TRUE;
  2082.                           free_value(result_header_ptr);
  2083.                           result_header_ptr=NULL;
  2084.                           printf(
  2085.                 "Fatal error:  nonnumeric exponent at line %ld, column %ld.\n",
  2086.                            source_line_num,source_column_num);
  2087.                         }
  2088.                     }
  2089.                   if (! fatal_error)
  2090.                     exponent_header_ptr=unsigned_integer_header_ptr();
  2091.                   if (! fatal_error)
  2092.                     {
  2093.                       if (*((*exponent_header_ptr).value_ptr.integer)
  2094.                        > (long) 37)
  2095.                         {
  2096.                           fatal_error=TRUE;
  2097.                           free_value(result_header_ptr);
  2098.                           free_value(exponent_header_ptr);
  2099.                           result_header_ptr=NULL;
  2100.                           printf(
  2101.                 "Fatal error:  exponent too large at line %ld, column %ld.\n",
  2102.                            source_line_num,source_column_num);
  2103.                         }
  2104.                     }
  2105.                   if (! fatal_error)
  2106.                     {
  2107.                       tem_real_1=1.0;
  2108.                       exponent_value
  2109.                        =*((*exponent_header_ptr).value_ptr.integer);
  2110.                       free_value(exponent_header_ptr);
  2111.                       while (exponent_value > (long) 0)
  2112.                         {
  2113.                           exponent_value--;
  2114.                           tem_real_1*=10.0;
  2115.                         }
  2116.                       if (exponent_sign == '-')
  2117.                         tem_real_1=1.0/tem_real_1;
  2118.                       if (*((*result_header_ptr).value_ptr.real) != 0.0)
  2119.                         {
  2120.                           tem_real_2=(log(tem_real_1)
  2121.                            +log(fabs(*((*result_header_ptr).value_ptr.real))))
  2122.                            /log(10.0);
  2123.                           if (tem_real_2 < -37.0)
  2124.                             *((*result_header_ptr).value_ptr.real)=0.0;
  2125.                           else
  2126.                             if (tem_real_2 > 37.0)
  2127.                               {
  2128.                                 fatal_error=TRUE;
  2129.                                 free_value(result_header_ptr);
  2130.                                 result_header_ptr=NULL;
  2131.                                 printf(
  2132.                      "Fatal error:  real too large at line %ld, column %ld.\n",
  2133.                                  source_line_num,source_column_num);
  2134.                               }
  2135.                             else
  2136.                               *((*result_header_ptr).value_ptr.real)
  2137.                                *=tem_real_1;
  2138.                         }
  2139.                     }
  2140.                 }
  2141.             }
  2142.         }
  2143.       if (! evaluate)
  2144.         {
  2145.           free_value(result_header_ptr);
  2146.           result_header_ptr=NULL;
  2147.         }
  2148.       return(result_header_ptr);
  2149.     }
  2150.  
  2151. static value_header_ptr abs_header_ptr(queue_head,function_name,evaluate)
  2152.   queue_node_ptr queue_head;
  2153.   char           *function_name;
  2154.   int            evaluate;
  2155.     {
  2156.       value_header_ptr result_header_ptr;
  2157.  
  2158.       if (queue_head == NULL)
  2159.         {
  2160.           fatal_error=TRUE;
  2161.           result_header_ptr=NULL;
  2162.           printf(
  2163.           "Fatal error:  argument to function \"%s\" is missing on\n",
  2164.            function_name);
  2165.           printf("     line %ld, column %ld.\n",source_line_num,
  2166.            source_column_num);
  2167.         }
  2168.       else
  2169.         if ((*queue_head).next == NULL)
  2170.           if (evaluate)
  2171.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  2172.               {
  2173.                 result_header_ptr=new_integer_header_ptr();
  2174.                 if (! fatal_error)
  2175.                   *((*result_header_ptr).value_ptr.integer)
  2176.                    =labs(*((*((*queue_head).argument_header_ptr)).
  2177.                    value_ptr.integer));
  2178.               }
  2179.             else
  2180.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  2181.                 {
  2182.                   result_header_ptr=new_real_header_ptr();
  2183.                   if (! fatal_error)
  2184.                     *((*result_header_ptr).value_ptr.real)
  2185.                      =fabs(*((*((*queue_head).argument_header_ptr)).
  2186.                      value_ptr.real));
  2187.                 }
  2188.               else
  2189.                 {
  2190.                   fatal_error=TRUE;
  2191.                   result_header_ptr=NULL;
  2192.                   printf(
  2193. "Fatal error:  other than a number supplied as argument to function \"%s\"\n",
  2194.                    function_name);
  2195.                   printf("     on line %ld, column %ld.\n",source_line_num,
  2196.                    source_column_num);
  2197.                 }
  2198.           else
  2199.             result_header_ptr=NULL;
  2200.         else
  2201.           {
  2202.             fatal_error=TRUE;
  2203.             result_header_ptr=NULL;
  2204.             printf(
  2205.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2206.              function_name);
  2207.             printf("     line %ld, column %ld.\n",source_line_num,
  2208.              source_column_num);
  2209.           }
  2210.       return(result_header_ptr);
  2211.     }
  2212.  
  2213. static value_header_ptr atan_header_ptr(queue_head,function_name,evaluate)
  2214.   queue_node_ptr queue_head;
  2215.   char           *function_name;
  2216.   int            evaluate;
  2217.     {
  2218.       value_header_ptr result_header_ptr;
  2219.       double           tem_real;
  2220.  
  2221.       if (queue_head == NULL)
  2222.         {
  2223.           fatal_error=TRUE;
  2224.           result_header_ptr=NULL;
  2225.           printf(
  2226.           "Fatal error:  argument to function \"%s\" is missing on\n",
  2227.            function_name);
  2228.           printf("     line %ld, column %ld.\n",source_line_num,
  2229.            source_column_num);
  2230.         }
  2231.       else
  2232.         if ((*queue_head).next == NULL)
  2233.           if (evaluate)
  2234.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  2235.               {
  2236.                 tem_real=(double) *((*((*queue_head).argument_header_ptr)).
  2237.                    value_ptr.integer);
  2238.                 result_header_ptr=new_real_header_ptr();
  2239.                 if (! fatal_error)
  2240.                   *((*result_header_ptr).value_ptr.real)=atan(tem_real);
  2241.               }
  2242.             else
  2243.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  2244.                 {
  2245.                   result_header_ptr=new_real_header_ptr();
  2246.                   if (! fatal_error)
  2247.                     *((*result_header_ptr).value_ptr.real)
  2248.                      =atan(*((*((*queue_head).argument_header_ptr)).
  2249.                      value_ptr.real));
  2250.                 }
  2251.               else
  2252.                 {
  2253.                   fatal_error=TRUE;
  2254.                   result_header_ptr=NULL;
  2255.                   printf(
  2256. "Fatal error:  other than a number supplied as argument to function \"%s\"\n",
  2257.                    function_name);
  2258.                   printf("     on line %ld, column %ld.\n",source_line_num,
  2259.                    source_column_num);
  2260.                 }
  2261.           else
  2262.             result_header_ptr=NULL;
  2263.         else
  2264.           {
  2265.             fatal_error=TRUE;
  2266.             result_header_ptr=NULL;
  2267.             printf(
  2268.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2269.              function_name);
  2270.             printf("     line %ld, column %ld.\n",source_line_num,
  2271.              source_column_num);
  2272.           }
  2273.       return(result_header_ptr);
  2274.     }
  2275.  
  2276. static value_header_ptr char_header_ptr(queue_head,function_name,evaluate)
  2277.   queue_node_ptr queue_head;
  2278.   char           *function_name;
  2279.   int            evaluate;
  2280.     {
  2281.       value_header_ptr result_header_ptr;
  2282.       long             tem_integer;
  2283.  
  2284.       if (queue_head == NULL)
  2285.         {
  2286.           fatal_error=TRUE;
  2287.           result_header_ptr=NULL;
  2288.           printf(
  2289.           "Fatal error:  argument to function \"%s\" is missing on\n",
  2290.            function_name);
  2291.           printf("     line %ld, column %ld.\n",source_line_num,
  2292.            source_column_num);
  2293.         }
  2294.       else
  2295.         if ((*queue_head).next == NULL)
  2296.           if (evaluate)
  2297.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  2298.               {
  2299.                 tem_integer=*((*((*queue_head).argument_header_ptr)).
  2300.                    value_ptr.integer);
  2301.                 if (((long) 0 <= tem_integer) && (tem_integer <= (long) 255))
  2302.                   {
  2303.                     result_header_ptr=new_string_header_ptr((unsigned) 1);
  2304.                     if (! fatal_error)
  2305.                       {
  2306.                         *((*((*result_header_ptr).value_ptr.string)).value)
  2307.                          =(unsigned char) tem_integer;
  2308.                         *((*((*result_header_ptr).value_ptr.string)).value+1)
  2309.                          =(unsigned char) '\0';
  2310.                       }
  2311.                   }
  2312.                 else
  2313.                   {
  2314.                     fatal_error=TRUE;
  2315.                     result_header_ptr=NULL;
  2316.                     printf(
  2317.                   "Fatal error:  argument to CHAR is not between 0 and 255\n");
  2318.                     printf("     on line %ld, column %ld.\n",source_line_num,
  2319.                      source_column_num);
  2320.                   }
  2321.               }
  2322.             else
  2323.               {
  2324.                 fatal_error=TRUE;
  2325.                 result_header_ptr=NULL;
  2326.                 printf(
  2327.                  "Fatal error:  argument to CHAR is other than an integer\n");
  2328.                 printf("     on line %ld, column %ld.\n",source_line_num,
  2329.                  source_column_num);
  2330.               }
  2331.           else
  2332.             result_header_ptr=NULL;
  2333.         else
  2334.           {
  2335.             fatal_error=TRUE;
  2336.             result_header_ptr=NULL;
  2337.             printf(
  2338.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2339.              function_name);
  2340.             printf("     line %ld, column %ld.\n",source_line_num,
  2341.              source_column_num);
  2342.           }
  2343.       return(result_header_ptr);
  2344.     }
  2345.  
  2346. static value_header_ptr cos_header_ptr(queue_head,function_name,evaluate)
  2347.   queue_node_ptr queue_head;
  2348.   char           *function_name;
  2349.   int            evaluate;
  2350.     {
  2351.       value_header_ptr result_header_ptr;
  2352.       double           tem_real;
  2353.  
  2354.       if (queue_head == NULL)
  2355.         {
  2356.           fatal_error=TRUE;
  2357.           result_header_ptr=NULL;
  2358.           printf(
  2359.           "Fatal error:  argument to function \"%s\" is missing on\n",
  2360.            function_name);
  2361.           printf("     line %ld, column %ld.\n",source_line_num,
  2362.            source_column_num);
  2363.         }
  2364.       else
  2365.         if ((*queue_head).next == NULL)
  2366.           if (evaluate)
  2367.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  2368.               {
  2369.                 tem_real=(double) *((*((*queue_head).argument_header_ptr)).
  2370.                    value_ptr.integer);
  2371.                 result_header_ptr=new_real_header_ptr();
  2372.                 if (! fatal_error)
  2373.                   *((*result_header_ptr).value_ptr.real)=cos(tem_real);
  2374.               }
  2375.             else
  2376.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  2377.                 {
  2378.                   result_header_ptr=new_real_header_ptr();
  2379.                   if (! fatal_error)
  2380.                     *((*result_header_ptr).value_ptr.real)
  2381.                      =cos(*((*((*queue_head).argument_header_ptr)).
  2382.                      value_ptr.real));
  2383.                 }
  2384.               else
  2385.                 {
  2386.                   fatal_error=TRUE;
  2387.                   result_header_ptr=NULL;
  2388.                   printf(
  2389. "Fatal error:  other than a number supplied as argument to function \"%s\"\n",
  2390.                    function_name);
  2391.                   printf("     on line %ld, column %ld.\n",source_line_num,
  2392.                    source_column_num);
  2393.                 }
  2394.           else
  2395.             result_header_ptr=NULL;
  2396.         else
  2397.           {
  2398.             fatal_error=TRUE;
  2399.             result_header_ptr=NULL;
  2400.             printf(
  2401.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2402.              function_name);
  2403.             printf("     line %ld, column %ld.\n",source_line_num,
  2404.              source_column_num);
  2405.           }
  2406.       return(result_header_ptr);
  2407.     }
  2408.  
  2409. static value_header_ptr date_header_ptr(queue_head,function_name,evaluate)
  2410.   queue_node_ptr queue_head;
  2411.   char           *function_name;
  2412.   int            evaluate;
  2413.     {
  2414.       unsigned char    *char_ptr_1;
  2415.       char             *char_ptr_2;
  2416.       char             date_and_time [26];
  2417.       long             elapsed_time;
  2418.       struct tm        *local_time;
  2419.       value_header_ptr result_header_ptr;
  2420.  
  2421.       if (queue_head != NULL)
  2422.         {
  2423.           fatal_error=TRUE;
  2424.           result_header_ptr=NULL;
  2425.           printf(
  2426.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2427.            function_name);
  2428.           printf("     line %ld, column %ld.\n",source_line_num,
  2429.            source_column_num);
  2430.         }
  2431.       else
  2432.         if (evaluate)
  2433.           {
  2434.             result_header_ptr=new_string_header_ptr(6);
  2435.             if (! fatal_error)
  2436.               {
  2437.                 char_ptr_1=(*((*result_header_ptr).value_ptr.string)).value;
  2438.                 time(&elapsed_time);
  2439.                 local_time=localtime(&elapsed_time);
  2440.                 strcpy(&date_and_time[0],asctime(local_time));
  2441.                 strncpy((char *) char_ptr_1,&date_and_time[22],2);
  2442.                 *(char_ptr_1+2)=(unsigned char) '\0';
  2443.                 date_and_time[7]='\0';
  2444.                 char_ptr_2=&date_and_time[4];
  2445.                 if      (strcmp(char_ptr_2,"Jan") == 0)
  2446.                   strcat((char *) char_ptr_1,"01");
  2447.                 else if (strcmp(char_ptr_2,"Feb") == 0)
  2448.                   strcat((char *) char_ptr_1,"02");
  2449.                 else if (strcmp(char_ptr_2,"Mar") == 0)
  2450.                   strcat((char *) char_ptr_1,"03");
  2451.                 else if (strcmp(char_ptr_2,"Apr") == 0)
  2452.                   strcat((char *) char_ptr_1,"04");
  2453.                 else if (strcmp(char_ptr_2,"May") == 0)
  2454.                   strcat((char *) char_ptr_1,"05");
  2455.                 else if (strcmp(char_ptr_2,"Jun") == 0)
  2456.                   strcat((char *) char_ptr_1,"06");
  2457.                 else if (strcmp(char_ptr_2,"Jul") == 0)
  2458.                   strcat((char *) char_ptr_1,"07");
  2459.                 else if (strcmp(char_ptr_2,"Aug") == 0)
  2460.                   strcat((char *) char_ptr_1,"08");
  2461.                 else if (strcmp(char_ptr_2,"Sep") == 0)
  2462.                   strcat((char *) char_ptr_1,"09");
  2463.                 else if (strcmp(char_ptr_2,"Oct") == 0)
  2464.                   strcat((char *) char_ptr_1,"10");
  2465.                 else if (strcmp(char_ptr_2,"Nov") == 0)
  2466.                   strcat((char *) char_ptr_1,"11");
  2467.                 else
  2468.                   strcat((char *) char_ptr_1,"12");
  2469.                 strncat((char *) char_ptr_1,&date_and_time[8],2);
  2470.               }
  2471.           }
  2472.         else
  2473.           result_header_ptr=NULL;
  2474.       return(result_header_ptr);
  2475.     }
  2476.  
  2477. static value_header_ptr endfile_header_ptr(queue_head,function_name,evaluate)
  2478.   queue_node_ptr queue_head;
  2479.   char           *function_name;
  2480.   int            evaluate;
  2481.     {
  2482.       FILE             *file;
  2483.       value_header_ptr result_header_ptr;
  2484.  
  2485.       if (queue_head == NULL)
  2486.         {
  2487.           result_header_ptr=new_boolean_header_ptr();
  2488.           if (! fatal_error)
  2489.             {
  2490.               if (feof(stdin) == 0)
  2491.                 *((*result_header_ptr).value_ptr.boolean)=FALSE;
  2492.               else
  2493.                 *((*result_header_ptr).value_ptr.boolean)=TRUE;
  2494.             }
  2495.         }
  2496.       else
  2497.         if ((*queue_head).next == NULL)
  2498.           if (evaluate)
  2499.             if ((*((*queue_head).argument_header_ptr)).type == 'D')
  2500.               {
  2501.                 file=*((*((*queue_head).argument_header_ptr)).
  2502.                  value_ptr.dataset);
  2503.                 result_header_ptr=new_boolean_header_ptr();
  2504.                 if (! fatal_error)
  2505.                   {
  2506.                     if (feof(file) == 0)
  2507.                       *((*result_header_ptr).value_ptr.boolean)=FALSE;
  2508.                     else
  2509.                       *((*result_header_ptr).value_ptr.boolean)=TRUE;
  2510.                   }
  2511.               }
  2512.             else
  2513.               {
  2514.                 fatal_error=TRUE;
  2515.                 result_header_ptr=NULL;
  2516.                 printf(
  2517.            "Fatal error:  argument to ENDFILE is other than a file pointer\n");
  2518.                 printf("     on line %ld, column %ld.\n",source_line_num,
  2519.                  source_column_num);
  2520.               }
  2521.           else
  2522.             result_header_ptr=NULL;
  2523.         else
  2524.           {
  2525.             fatal_error=TRUE;
  2526.             result_header_ptr=NULL;
  2527.             printf(
  2528.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2529.              function_name);
  2530.             printf("     line %ld, column %ld.\n",source_line_num,
  2531.              source_column_num);
  2532.           }
  2533.       return(result_header_ptr);
  2534.     }
  2535.  
  2536. static value_header_ptr exec_header_ptr(queue_head,function_name,evaluate)
  2537.   queue_node_ptr queue_head;
  2538.   char           *function_name;
  2539.   int            evaluate;
  2540.     {
  2541.       value_header_ptr result_header_ptr;
  2542.  
  2543.       if (queue_head == NULL)
  2544.         {
  2545.           fatal_error=TRUE;
  2546.           result_header_ptr=NULL;
  2547.           printf(
  2548.           "Fatal error:  argument to function \"%s\" is missing on\n",
  2549.            function_name);
  2550.           printf("     line %ld, column %ld.\n",source_line_num,
  2551.            source_column_num);
  2552.         }
  2553.       else
  2554.         if ((*queue_head).next == NULL)
  2555.           if (evaluate)
  2556.             if ((*((*queue_head).argument_header_ptr)).type == 'S')
  2557.               {
  2558.                 result_header_ptr=new_boolean_header_ptr();
  2559.                 if (! fatal_error)
  2560.                   {
  2561.                     if (system(
  2562.                      (char *) (*((*((*queue_head).argument_header_ptr)).
  2563.                      value_ptr.string)).value) == 0)
  2564.                       *((*result_header_ptr).value_ptr.boolean)=TRUE;
  2565.                     else
  2566.                       *((*result_header_ptr).value_ptr.boolean)=FALSE;
  2567.                   }
  2568.               }
  2569.             else
  2570.               {
  2571.                 fatal_error=TRUE;
  2572.                 result_header_ptr=NULL;
  2573.                 printf(
  2574. "Fatal error:  other than a string supplied as argument to function \"%s\"\n",
  2575.                  function_name);
  2576.                 printf("     on line %ld, column %ld.\n",source_line_num,
  2577.                  source_column_num);
  2578.               }
  2579.           else
  2580.             result_header_ptr=NULL;
  2581.         else
  2582.           {
  2583.             fatal_error=TRUE;
  2584.             result_header_ptr=NULL;
  2585.             printf(
  2586.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2587.              function_name);
  2588.             printf("     line %ld, column %ld.\n",source_line_num,
  2589.              source_column_num);
  2590.           }
  2591.       return(result_header_ptr);
  2592.     }
  2593.  
  2594. static value_header_ptr exp_header_ptr(queue_head,function_name,evaluate)
  2595.   queue_node_ptr queue_head;
  2596.   char           *function_name;
  2597.   int            evaluate;
  2598.     {
  2599.       value_header_ptr result_header_ptr;
  2600.       double           tem_real_1;
  2601.       double           tem_real_2;
  2602.  
  2603.       if (queue_head == NULL)
  2604.         {
  2605.           fatal_error=TRUE;
  2606.           result_header_ptr=NULL;
  2607.           printf(
  2608.           "Fatal error:  argument to function \"%s\" is missing on\n",
  2609.            function_name);
  2610.           printf("     line %ld, column %ld.\n",source_line_num,
  2611.            source_column_num);
  2612.         }
  2613.       else
  2614.         if ((*queue_head).next == NULL)
  2615.           if (evaluate)
  2616.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  2617.               {
  2618.                 tem_real_1=(double) *((*((*queue_head).argument_header_ptr)).
  2619.                    value_ptr.integer);
  2620.                 result_header_ptr=new_real_header_ptr();
  2621.                 if (! fatal_error)
  2622.                   {
  2623.                     tem_real_2=tem_real_1/log(10.0);
  2624.                     if (tem_real_2 < -37.0)
  2625.                       *((*result_header_ptr).value_ptr.real)=0.0;
  2626.                     else
  2627.                       if (tem_real_2 > 37.0)
  2628.                         {
  2629.                           fatal_error=TRUE;
  2630.                           free_value(result_header_ptr);
  2631.                           result_header_ptr=NULL;
  2632.                           printf(
  2633.        "Fatal error:  argument to EXP is too large at line %ld, column %ld.\n",
  2634.                            source_line_num,source_column_num);
  2635.                         }
  2636.                       else
  2637.                         *((*result_header_ptr).value_ptr.real)=exp(tem_real_1);
  2638.                   }
  2639.               }
  2640.             else
  2641.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  2642.                 {
  2643.                   tem_real_1=*((*((*queue_head).argument_header_ptr)).
  2644.                      value_ptr.real);
  2645.                   result_header_ptr=new_real_header_ptr();
  2646.                   if (! fatal_error)
  2647.                     {
  2648.                       tem_real_2=tem_real_1/log(10.0);
  2649.                       if (tem_real_2 < -37.0)
  2650.                         *((*result_header_ptr).value_ptr.real)=0.0;
  2651.                       else
  2652.                         if (tem_real_2 > 37.0)
  2653.                           {
  2654.                             fatal_error=TRUE;
  2655.                             free_value(result_header_ptr);
  2656.                             result_header_ptr=NULL;
  2657.                             printf(
  2658.        "Fatal error:  argument to EXP is too large at line %ld, column %ld.\n",
  2659.                              source_line_num,source_column_num);
  2660.                           }
  2661.                         else
  2662.                           *((*result_header_ptr).value_ptr.real)
  2663.                            =exp(tem_real_1);
  2664.                     }
  2665.                 }
  2666.               else
  2667.                 {
  2668.                   fatal_error=TRUE;
  2669.                   result_header_ptr=NULL;
  2670.                   printf(
  2671. "Fatal error:  other than a number supplied as argument to function \"%s\"\n",
  2672.                    function_name);
  2673.                   printf("     on line %ld, column %ld.\n",source_line_num,
  2674.                    source_column_num);
  2675.                 }
  2676.           else
  2677.             result_header_ptr=NULL;
  2678.         else
  2679.           {
  2680.             fatal_error=TRUE;
  2681.             result_header_ptr=NULL;
  2682.             printf(
  2683.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2684.              function_name);
  2685.             printf("     line %ld, column %ld.\n",source_line_num,
  2686.              source_column_num);
  2687.           }
  2688.       return(result_header_ptr);
  2689.     }
  2690.  
  2691. static value_header_ptr false_header_ptr(queue_head,function_name,evaluate)
  2692.   queue_node_ptr queue_head;
  2693.   char           *function_name;
  2694.   int            evaluate;
  2695.     {
  2696.       value_header_ptr result_header_ptr;
  2697.  
  2698.       if (queue_head != NULL)
  2699.         {
  2700.           fatal_error=TRUE;
  2701.           result_header_ptr=NULL;
  2702.           printf(
  2703.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2704.            function_name);
  2705.           printf("     line %ld, column %ld.\n",source_line_num,
  2706.            source_column_num);
  2707.         }
  2708.       else
  2709.         if (evaluate)
  2710.           {
  2711.             result_header_ptr=new_boolean_header_ptr();
  2712.             if (! fatal_error)
  2713.               *((*result_header_ptr).value_ptr.boolean)=FALSE;
  2714.           }
  2715.         else
  2716.           result_header_ptr=NULL;
  2717.       return(result_header_ptr);
  2718.     }
  2719.  
  2720. static value_header_ptr float_header_ptr(queue_head,function_name,evaluate)
  2721.   queue_node_ptr queue_head;
  2722.   char           *function_name;
  2723.   int            evaluate;
  2724.     {
  2725.       value_header_ptr result_header_ptr;
  2726.       int              status;
  2727.  
  2728.       if (queue_head == NULL)
  2729.         {
  2730.           fatal_error=TRUE;
  2731.           result_header_ptr=NULL;
  2732.           printf(
  2733.           "Fatal error:  argument to function \"%s\" is missing on\n",
  2734.            function_name);
  2735.           printf("     line %ld, column %ld.\n",source_line_num,
  2736.            source_column_num);
  2737.         }
  2738.       else
  2739.         if ((*queue_head).next == NULL)
  2740.           if (evaluate)
  2741.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  2742.               {
  2743.                 result_header_ptr=new_real_header_ptr();
  2744.                 if (! fatal_error)
  2745.                   *((*result_header_ptr).value_ptr.real)
  2746.                    =(double) *((*((*queue_head).argument_header_ptr)).
  2747.                    value_ptr.integer);
  2748.               }
  2749.             else
  2750.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  2751.                 {
  2752.                   result_header_ptr=new_real_header_ptr();
  2753.                   if (! fatal_error)
  2754.                     *((*result_header_ptr).value_ptr.real)
  2755.                      =*((*((*queue_head).argument_header_ptr)).
  2756.                      value_ptr.real);
  2757.                 }
  2758.               else
  2759.                 if ((*((*queue_head).argument_header_ptr)).type == 'B')
  2760.                   {
  2761.                     result_header_ptr=new_real_header_ptr();
  2762.                     if (! fatal_error)
  2763.                       {
  2764.                         if (*((*((*queue_head).argument_header_ptr)).
  2765.                          value_ptr.boolean))
  2766.                           *((*result_header_ptr).value_ptr.real)=1.0;
  2767.                         else
  2768.                           *((*result_header_ptr).value_ptr.real)=0.0;
  2769.                       }
  2770.                   }
  2771.                 else
  2772.                   if ((*((*queue_head).argument_header_ptr)).type == 'S')
  2773.                     {
  2774.                       result_header_ptr=new_real_header_ptr();
  2775.                       if (! fatal_error)
  2776.                         {
  2777.                           status=sscanf((char *)
  2778.                            (*((*((*queue_head).argument_header_ptr)).
  2779.                            value_ptr.string)).value,"%lf",
  2780.                            (*result_header_ptr).value_ptr.real);
  2781.                           if ((status == EOF) || (status == 0))
  2782.                             {
  2783.                               fatal_error=TRUE;
  2784.                               free_value(result_header_ptr);
  2785.                               result_header_ptr=NULL;
  2786.                               printf(
  2787.                    "Fatal error:  argument to FLOAT cannot be converted on\n");
  2788.                               printf("     line %ld, column %ld.\n",
  2789.                                source_line_num,source_column_num);
  2790.                             }
  2791.                         }
  2792.                     }
  2793.                   else
  2794.                     {
  2795.                       fatal_error=TRUE;
  2796.                       result_header_ptr=NULL;
  2797.                       printf(
  2798.  "Fatal error:  argument to FLOAT is other than Boolean, number, or string\n");
  2799.                       printf("     on line %ld, column %ld.\n",
  2800.                        source_line_num,source_column_num);
  2801.                     }
  2802.           else
  2803.             result_header_ptr=NULL;
  2804.         else
  2805.           {
  2806.             fatal_error=TRUE;
  2807.             result_header_ptr=NULL;
  2808.             printf(
  2809.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2810.              function_name);
  2811.             printf("     line %ld, column %ld.\n",source_line_num,
  2812.              source_column_num);
  2813.           }
  2814.       return(result_header_ptr);
  2815.     }
  2816.  
  2817. static value_header_ptr getchar_header_ptr(queue_head,function_name,evaluate)
  2818.   queue_node_ptr queue_head;
  2819.   char           *function_name;
  2820.   int            evaluate;
  2821.     {
  2822.       int              current_char;
  2823.       value_header_ptr result_header_ptr;
  2824.  
  2825.       if (queue_head != NULL)
  2826.         if ((*queue_head).next == NULL)
  2827.           if (evaluate)
  2828.             if ((*((*queue_head).argument_header_ptr)).type == 'D')
  2829.               {
  2830.                 current_char=fgetc(
  2831.                  *((*((*queue_head).argument_header_ptr)).value_ptr.dataset));
  2832.                 if (current_char == EOF)
  2833.                   {
  2834.                     result_header_ptr=new_string_header_ptr(0);
  2835.                     if (! fatal_error)
  2836.                       *((*((*result_header_ptr).value_ptr.string)).value)
  2837.                        =(unsigned char) '\0';
  2838.                   }
  2839.                 else
  2840.                   {
  2841.                     result_header_ptr=new_string_header_ptr(1);
  2842.                     if (! fatal_error)
  2843.                       {
  2844.                         *((*((*result_header_ptr).value_ptr.string)).value)
  2845.                          =(unsigned char) current_char;
  2846.                         *((*((*result_header_ptr).value_ptr.string)).value+1)
  2847.                          =(unsigned char) '\0';
  2848.                       }
  2849.                   }
  2850.               }
  2851.             else
  2852.               {
  2853.                 fatal_error=TRUE;
  2854.                 result_header_ptr=NULL;
  2855.                 printf(
  2856.         "Fatal error:  argument to GETCHAR is other than a file pointer on\n");
  2857.                 printf("     line %ld, column %ld.\n",source_line_num,
  2858.                  source_column_num);
  2859.               }
  2860.           else
  2861.             result_header_ptr=NULL;
  2862.         else
  2863.           {
  2864.             fatal_error=TRUE;
  2865.             result_header_ptr=NULL;
  2866.             printf(
  2867.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2868.              function_name);
  2869.             printf("     line %ld, column %ld.\n",source_line_num,
  2870.              source_column_num);
  2871.           }
  2872.       else
  2873.         if (evaluate)
  2874.           {
  2875.             current_char=fgetc(stdin);
  2876.             if (current_char == EOF)
  2877.               {
  2878.                 result_header_ptr=new_string_header_ptr(0);
  2879.                 if (! fatal_error)
  2880.                   *((*((*result_header_ptr).value_ptr.string)).value)
  2881.                    =(unsigned char) '\0';
  2882.               }
  2883.             else
  2884.               {
  2885.                 result_header_ptr=new_string_header_ptr(1);
  2886.                 if (! fatal_error)
  2887.                   {
  2888.                     *((*((*result_header_ptr).value_ptr.string)).value)
  2889.                      =(unsigned char) current_char;
  2890.                     *((*((*result_header_ptr).value_ptr.string)).value+1)
  2891.                      =(unsigned char) '\0';
  2892.                   }
  2893.               }
  2894.           }
  2895.         else
  2896.           result_header_ptr=NULL;
  2897.       return(result_header_ptr);
  2898.     }
  2899.  
  2900. static value_header_ptr getint_header_ptr(queue_head,function_name,evaluate)
  2901.   queue_node_ptr queue_head;
  2902.   char           *function_name;
  2903.   int            evaluate;
  2904.     {
  2905.       int              num_fields_read;
  2906.       value_header_ptr result_header_ptr;
  2907.       long             tem_integer;
  2908.  
  2909.       if (queue_head != NULL)
  2910.         if ((*queue_head).next == NULL)
  2911.           if (evaluate)
  2912.             if ((*((*queue_head).argument_header_ptr)).type == 'D')
  2913.               {
  2914.                 num_fields_read=fscanf(
  2915.                  *((*((*queue_head).argument_header_ptr)).value_ptr.dataset),
  2916.                  "%I",&tem_integer);
  2917.                 if (num_fields_read == 0)
  2918.                   tem_integer=(long) 0;
  2919.                 result_header_ptr=new_integer_header_ptr();
  2920.                 if (! fatal_error)
  2921.                   *((*result_header_ptr).value_ptr.integer)=tem_integer;
  2922.               }
  2923.             else
  2924.               {
  2925.                 fatal_error=TRUE;
  2926.                 result_header_ptr=NULL;
  2927.                 printf(
  2928.          "Fatal error:  argument to GETINT is other than a file pointer on\n");
  2929.                 printf("     line %ld, column %ld.\n",source_line_num,
  2930.                  source_column_num);
  2931.               }
  2932.           else
  2933.             result_header_ptr=NULL;
  2934.         else
  2935.           {
  2936.             fatal_error=TRUE;
  2937.             result_header_ptr=NULL;
  2938.             printf(
  2939.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2940.              function_name);
  2941.             printf("     line %ld, column %ld.\n",source_line_num,
  2942.              source_column_num);
  2943.           }
  2944.       else
  2945.         if (evaluate)
  2946.           {
  2947.             num_fields_read=scanf("%I",&tem_integer);
  2948.             if (num_fields_read == 0)
  2949.               tem_integer=(long) 0;
  2950.             result_header_ptr=new_integer_header_ptr();
  2951.             if (! fatal_error)
  2952.               *((*result_header_ptr).value_ptr.integer)=tem_integer;
  2953.           }
  2954.         else
  2955.           result_header_ptr=NULL;
  2956.       return(result_header_ptr);
  2957.     }
  2958.  
  2959. static value_header_ptr getreal_header_ptr(queue_head,function_name,evaluate)
  2960.   queue_node_ptr queue_head;
  2961.   char           *function_name;
  2962.   int            evaluate;
  2963.     {
  2964.       int              num_fields_read;
  2965.       value_header_ptr result_header_ptr;
  2966.       double           tem_real;
  2967.  
  2968.       if (queue_head != NULL)
  2969.         if ((*queue_head).next == NULL)
  2970.           if (evaluate)
  2971.             if ((*((*queue_head).argument_header_ptr)).type == 'D')
  2972.               {
  2973.                 num_fields_read=fscanf(
  2974.                  *((*((*queue_head).argument_header_ptr)).value_ptr.dataset),
  2975.                  "%lf",&tem_real);
  2976.                 if (num_fields_read == 0)
  2977.                   tem_real=0.0;
  2978.                 result_header_ptr=new_real_header_ptr();
  2979.                 if (! fatal_error)
  2980.                   *((*result_header_ptr).value_ptr.real)=tem_real;
  2981.               }
  2982.             else
  2983.               {
  2984.                 fatal_error=TRUE;
  2985.                 result_header_ptr=NULL;
  2986.                 printf(
  2987.         "Fatal error:  argument to GETREAL is other than a file pointer on\n");
  2988.                 printf("     line %ld, column %ld.\n",source_line_num,
  2989.                  source_column_num);
  2990.               }
  2991.           else
  2992.             result_header_ptr=NULL;
  2993.         else
  2994.           {
  2995.             fatal_error=TRUE;
  2996.             result_header_ptr=NULL;
  2997.             printf(
  2998.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  2999.              function_name);
  3000.             printf("     line %ld, column %ld.\n",source_line_num,
  3001.              source_column_num);
  3002.           }
  3003.       else
  3004.         if (evaluate)
  3005.           {
  3006.             num_fields_read=scanf("%lf",&tem_real);
  3007.             if (num_fields_read == 0)
  3008.               tem_real=0.0;
  3009.             result_header_ptr=new_real_header_ptr();
  3010.             if (! fatal_error)
  3011.               *((*result_header_ptr).value_ptr.real)=tem_real;
  3012.           }
  3013.         else
  3014.           result_header_ptr=NULL;
  3015.       return(result_header_ptr);
  3016.     }
  3017.  
  3018. static value_header_ptr getstring_header_ptr(queue_head,function_name,evaluate)
  3019.   queue_node_ptr queue_head;
  3020.   char           *function_name;
  3021.   int            evaluate;
  3022.     {
  3023.       int              current_char;
  3024.       value_header_ptr new_result_header_ptr;
  3025.       value_header_ptr result_header_ptr;
  3026.       unsigned         string_length;
  3027.  
  3028.       if (queue_head != NULL)
  3029.         if ((*queue_head).next == NULL)
  3030.           if (evaluate)
  3031.             if ((*((*queue_head).argument_header_ptr)).type == 'D')
  3032.               {
  3033.                 string_length=0;
  3034.                 result_header_ptr=new_string_header_ptr(string_length);
  3035.                 if (! fatal_error)
  3036.                   {
  3037.                     *((*((*result_header_ptr).value_ptr.string)).value)
  3038.                      =(unsigned char) '\0';
  3039.                     do
  3040.                       {
  3041.                         current_char=fgetc(
  3042.                          *((*((*queue_head).argument_header_ptr)).value_ptr.
  3043.                          dataset));
  3044.                         if ((current_char != EOF)
  3045.                         &&  (current_char != 10))
  3046.                           {
  3047.                             string_length++;
  3048.                             new_result_header_ptr
  3049.                              =new_string_header_ptr(string_length);
  3050.                             if (! fatal_error)
  3051.                               {
  3052.                                 pli_strcpy(
  3053.                                  (*new_result_header_ptr).value_ptr.string,
  3054.                                  (*result_header_ptr).value_ptr.string);
  3055.                                 (*((*new_result_header_ptr).value_ptr.string)).
  3056.                                  value[string_length-1]
  3057.                                  =(unsigned char) current_char;
  3058.                                 (*((*new_result_header_ptr).value_ptr.string)).
  3059.                                  value[string_length]=(unsigned char) '\0';
  3060.                                 free_value(result_header_ptr);
  3061.                                 result_header_ptr=new_result_header_ptr;
  3062.                               }
  3063.                           }
  3064.                       }
  3065.                     while ((! fatal_error)
  3066.                     &&     (current_char != EOF)
  3067.                     &&     (current_char != 10));
  3068.                     if ((*((*result_header_ptr).value_ptr.string)).value[
  3069.                      string_length-1] == (unsigned) 13)
  3070.                       {
  3071.                         string_length--;
  3072.                         (*((*result_header_ptr).value_ptr.string)).value[
  3073.                          string_length]=(unsigned char) '\0';
  3074.                         (*((*result_header_ptr).value_ptr.string)).length
  3075.                          =string_length;
  3076.                       }
  3077.                   }
  3078.               }
  3079.             else
  3080.               {
  3081.                 fatal_error=TRUE;
  3082.                 result_header_ptr=NULL;
  3083.                 printf(
  3084.       "Fatal error:  argument to GETSTRING is other than a file pointer on\n");
  3085.                 printf("     line %ld, column %ld.\n",source_line_num,
  3086.                  source_column_num);
  3087.               }
  3088.           else
  3089.             result_header_ptr=NULL;
  3090.         else
  3091.           {
  3092.             fatal_error=TRUE;
  3093.             result_header_ptr=NULL;
  3094.             printf(
  3095.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3096.              function_name);
  3097.             printf("     line %ld, column %ld.\n",source_line_num,
  3098.              source_column_num);
  3099.           }
  3100.       else
  3101.         if (evaluate)
  3102.           {
  3103.             string_length=0;
  3104.             result_header_ptr=new_string_header_ptr(string_length);
  3105.             if (! fatal_error)
  3106.               {
  3107.                 *((*((*result_header_ptr).value_ptr.string)).value)
  3108.                  =(unsigned char) '\0';
  3109.                 fflush(stdin);
  3110.                 do
  3111.                   {
  3112.                     current_char=fgetc(stdin);
  3113.                     if ((current_char != EOF)
  3114.                     &&  (current_char != 10))
  3115.                       {
  3116.                         string_length++;
  3117.                         new_result_header_ptr
  3118.                          =new_string_header_ptr(string_length);
  3119.                         if (! fatal_error)
  3120.                           {
  3121.                             pli_strcpy(
  3122.                              (*new_result_header_ptr).value_ptr.string,
  3123.                              (*result_header_ptr).value_ptr.string);
  3124.                             (*((*new_result_header_ptr).value_ptr.string)).
  3125.                              value[string_length-1]
  3126.                              =(unsigned char) current_char;
  3127.                             (*((*new_result_header_ptr).value_ptr.string)).
  3128.                              value[string_length]=(unsigned char) '\0';
  3129.                             free_value(result_header_ptr);
  3130.                             result_header_ptr=new_result_header_ptr;
  3131.                           }
  3132.                       }
  3133.                   }
  3134.                 while ((! fatal_error)
  3135.                 &&     (current_char != EOF)
  3136.                 &&     (current_char != 10));
  3137.                 if ((*((*result_header_ptr).value_ptr.string)).value[
  3138.                  string_length-1] == (unsigned) 13)
  3139.                   {
  3140.                     string_length--;
  3141.                     (*((*result_header_ptr).value_ptr.string)).value[
  3142.                      string_length]=(unsigned char) '\0';
  3143.                     (*((*result_header_ptr).value_ptr.string)).length
  3144.                      =string_length;
  3145.                   }
  3146.               }
  3147.           }
  3148.         else
  3149.           result_header_ptr=NULL;
  3150.       return(result_header_ptr);
  3151.     }
  3152.  
  3153. static value_header_ptr index_header_ptr(queue_head,function_name,evaluate)
  3154.   queue_node_ptr queue_head;
  3155.   char           *function_name;
  3156.   int            evaluate;
  3157.     {
  3158.       long             char_index_2;
  3159.       unsigned char    *char_ptr_1;
  3160.       unsigned char    *char_ptr_2;
  3161.       unsigned char    *char_ptr_3;
  3162.       unsigned char    *char_ptr_4;
  3163.       unsigned char    *char_ptr_5;
  3164.       long             length_1;
  3165.       long             length_2;
  3166.       int              match_found;
  3167.       long             num_trials;
  3168.       long             result;
  3169.       value_header_ptr result_header_ptr;
  3170.  
  3171.       if (queue_head == NULL)
  3172.         {
  3173.           fatal_error=TRUE;
  3174.           result_header_ptr=NULL;
  3175.           printf(
  3176.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3177.            function_name);
  3178.           printf("     line %ld, column %ld.\n",source_line_num,
  3179.            source_column_num);
  3180.         }
  3181.       else
  3182.         if ((*queue_head).next == NULL)
  3183.           {
  3184.             fatal_error=TRUE;
  3185.             result_header_ptr=NULL;
  3186.             printf(
  3187.              "Fatal error:  argument to function \"%s\" is missing on\n",
  3188.              function_name);
  3189.             printf("     line %ld, column %ld.\n",source_line_num,
  3190.              source_column_num);
  3191.           }
  3192.         else
  3193.           if ((*((*queue_head).next)).next == NULL)
  3194.             if (evaluate)
  3195.               if ((*((*queue_head).argument_header_ptr)).type == 'S')
  3196.                 if ((*((*((*queue_head).next)).argument_header_ptr)).type
  3197.                  == 'S')
  3198.                   {
  3199.                     result_header_ptr=new_integer_header_ptr();
  3200.                     if (! fatal_error)
  3201.                       {
  3202.                         char_ptr_1=(*((*((*queue_head).
  3203.                          argument_header_ptr)).value_ptr.string)).value;
  3204.                         length_1=(*((*((*queue_head).
  3205.                          argument_header_ptr)).value_ptr.string)).length;
  3206.                         char_ptr_2=(*((*((*((*queue_head).next)).
  3207.                          argument_header_ptr)).value_ptr.string)).value;
  3208.                         length_2=(*((*((*((*queue_head).next)).
  3209.                          argument_header_ptr)).value_ptr.string)).length;
  3210.                         if (length_2 == (long) 0)
  3211.                           *((*result_header_ptr).value_ptr.integer)=(long) 0;
  3212.                         else
  3213.                           {
  3214.                             num_trials=length_1-length_2+(long) 1;
  3215.                             char_ptr_3=char_ptr_1;
  3216.                             match_found=FALSE;
  3217.                             result=(long) 1;
  3218.                             while ((result <= num_trials)
  3219.                             &&     (! match_found))
  3220.                               {
  3221.                                 char_ptr_4=char_ptr_2;
  3222.                                 char_index_2=(long) 1;
  3223.                                 char_ptr_5=char_ptr_3;
  3224.                                 while ((char_index_2 <= length_2)
  3225.                                 &&     (*char_ptr_4 == *char_ptr_5))
  3226.                                   {
  3227.                                     char_ptr_4++;
  3228.                                     char_ptr_5++;
  3229.                                     char_index_2++;
  3230.                                   }
  3231.                                 if (char_index_2 > length_2)
  3232.                                   match_found=TRUE;
  3233.                                 else
  3234.                                   {
  3235.                                     char_ptr_3++;
  3236.                                     result++;
  3237.                                   }
  3238.                               }
  3239.                             if (match_found)
  3240.                               *((*result_header_ptr).value_ptr.integer)=result;
  3241.                             else
  3242.                               *((*result_header_ptr).value_ptr.integer)
  3243.                                =(long) 0;
  3244.                           }
  3245.                       }
  3246.                   }
  3247.                 else
  3248.                   {
  3249.                     fatal_error=TRUE;
  3250.                     result_header_ptr=NULL;
  3251.                     printf(
  3252.             "Fatal error:  second argument to INDEX is other than a string\n");
  3253.                     printf("     on line %ld, column %ld.\n",source_line_num,
  3254.                      source_column_num);
  3255.                   }
  3256.               else
  3257.                 {
  3258.                   fatal_error=TRUE;
  3259.                   result_header_ptr=NULL;
  3260.                   printf(
  3261.              "Fatal error:  first argument to INDEX is other than a string\n");
  3262.                   printf("     on line %ld, column %ld.\n",source_line_num,
  3263.                    source_column_num);
  3264.                 }
  3265.             else
  3266.               result_header_ptr=NULL;
  3267.           else
  3268.             {
  3269.               fatal_error=TRUE;
  3270.               result_header_ptr=NULL;
  3271.               printf(
  3272.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3273.                function_name);
  3274.               printf("     line %ld, column %ld.\n",source_line_num,
  3275.                source_column_num);
  3276.             }
  3277.       return(result_header_ptr);
  3278.     }
  3279.  
  3280. static value_header_ptr length_header_ptr(queue_head,function_name,evaluate)
  3281.   queue_node_ptr queue_head;
  3282.   char           *function_name;
  3283.   int            evaluate;
  3284.     {
  3285.       value_header_ptr result_header_ptr;
  3286.  
  3287.       if (queue_head == NULL)
  3288.         {
  3289.           fatal_error=TRUE;
  3290.           result_header_ptr=NULL;
  3291.           printf(
  3292.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3293.            function_name);
  3294.           printf("     line %ld, column %ld.\n",source_line_num,
  3295.            source_column_num);
  3296.         }
  3297.       else
  3298.         if ((*queue_head).next == NULL)
  3299.           if (evaluate)
  3300.             if ((*((*queue_head).argument_header_ptr)).type == 'S')
  3301.               {
  3302.                 result_header_ptr=new_integer_header_ptr();
  3303.                 if (! fatal_error)
  3304.                   *((*result_header_ptr).value_ptr.integer)=(long)
  3305.                    (*((*((*queue_head).argument_header_ptr)).
  3306.                    value_ptr.string)).length;
  3307.               }
  3308.             else
  3309.               {
  3310.                 fatal_error=TRUE;
  3311.                 result_header_ptr=NULL;
  3312.                 printf(
  3313.                  "Fatal error:  argument to LENGTH is other than a string\n");
  3314.                 printf("     on line %ld, column %ld.\n",source_line_num,
  3315.                  source_column_num);
  3316.               }
  3317.           else
  3318.             result_header_ptr=NULL;
  3319.         else
  3320.           {
  3321.             fatal_error=TRUE;
  3322.             result_header_ptr=NULL;
  3323.             printf(
  3324.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3325.              function_name);
  3326.             printf("     line %ld, column %ld.\n",source_line_num,
  3327.              source_column_num);
  3328.           }
  3329.       return(result_header_ptr);
  3330.     }
  3331.  
  3332. static value_header_ptr lineno_header_ptr(queue_head,function_name,evaluate)
  3333.   queue_node_ptr queue_head;
  3334.   char           *function_name;
  3335.   int            evaluate;
  3336.     {
  3337.       value_header_ptr result_header_ptr;
  3338.  
  3339.       if (queue_head != NULL)
  3340.         {
  3341.           fatal_error=TRUE;
  3342.           result_header_ptr=NULL;
  3343.           printf(
  3344.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3345.            function_name);
  3346.           printf("     line %ld, column %ld.\n",source_line_num,
  3347.            source_column_num);
  3348.         }
  3349.       else
  3350.         if (evaluate)
  3351.           {
  3352.             result_header_ptr=new_integer_header_ptr();
  3353.             if (! fatal_error)
  3354.               *((*result_header_ptr).value_ptr.integer)=source_line_num;
  3355.           }
  3356.         else
  3357.           result_header_ptr=NULL;
  3358.       return(result_header_ptr);
  3359.     }
  3360.  
  3361. static value_header_ptr log_header_ptr(queue_head,function_name,evaluate)
  3362.   queue_node_ptr queue_head;
  3363.   char           *function_name;
  3364.   int            evaluate;
  3365.     {
  3366.       value_header_ptr result_header_ptr;
  3367.       double           tem_real;
  3368.  
  3369.       if (queue_head == NULL)
  3370.         {
  3371.           fatal_error=TRUE;
  3372.           result_header_ptr=NULL;
  3373.           printf(
  3374.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3375.            function_name);
  3376.           printf("     line %ld, column %ld.\n",source_line_num,
  3377.            source_column_num);
  3378.         }
  3379.       else
  3380.         if ((*queue_head).next == NULL)
  3381.           if (evaluate)
  3382.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  3383.               {
  3384.                 tem_real=(double) *((*((*queue_head).argument_header_ptr)).
  3385.                    value_ptr.integer);
  3386.                 result_header_ptr=new_real_header_ptr();
  3387.                 if (! fatal_error)
  3388.                   {
  3389.                     if (tem_real > 0.0)
  3390.                       *((*result_header_ptr).value_ptr.real)=log(tem_real);
  3391.                     else
  3392.                       {
  3393.                         fatal_error=TRUE;
  3394.                         free_value(result_header_ptr);
  3395.                         result_header_ptr=NULL;
  3396.                         printf(
  3397.     "Fatal error:  argument to LOG is not positive at line %ld, column %ld.\n",
  3398.                          source_line_num,source_column_num);
  3399.                       }
  3400.                   }
  3401.               }
  3402.             else
  3403.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  3404.                 {
  3405.                   tem_real=*((*((*queue_head).argument_header_ptr)).
  3406.                      value_ptr.real);
  3407.                   result_header_ptr=new_real_header_ptr();
  3408.                   if (! fatal_error)
  3409.                     {
  3410.                       if (tem_real > 0.0)
  3411.                         *((*result_header_ptr).value_ptr.real)=log(tem_real);
  3412.                       else
  3413.                         {
  3414.                           fatal_error=TRUE;
  3415.                           free_value(result_header_ptr);
  3416.                           result_header_ptr=NULL;
  3417.                           printf(
  3418.     "Fatal error:  argument to LOG is not positive at line %ld, column %ld.\n",
  3419.                            source_line_num,source_column_num);
  3420.                         }
  3421.                     }
  3422.                 }
  3423.               else
  3424.                 {
  3425.                   fatal_error=TRUE;
  3426.                   result_header_ptr=NULL;
  3427.                   printf(
  3428. "Fatal error:  other than a number supplied as argument to function \"%s\"\n",
  3429.                    function_name);
  3430.                   printf("     on line %ld, column %ld.\n",source_line_num,
  3431.                    source_column_num);
  3432.                 }
  3433.           else
  3434.             result_header_ptr=NULL;
  3435.         else
  3436.           {
  3437.             fatal_error=TRUE;
  3438.             result_header_ptr=NULL;
  3439.             printf(
  3440.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3441.              function_name);
  3442.             printf("     line %ld, column %ld.\n",source_line_num,
  3443.              source_column_num);
  3444.           }
  3445.       return(result_header_ptr);
  3446.     }
  3447.  
  3448. static value_header_ptr mod_header_ptr(queue_head,function_name,evaluate)
  3449.   queue_node_ptr queue_head;
  3450.   char           *function_name;
  3451.   int            evaluate;
  3452.     {
  3453.       value_header_ptr result_header_ptr;
  3454.       long             tem_int_1;
  3455.       long             tem_int_2;
  3456.       long             tem_int_3;
  3457.  
  3458.       if (queue_head == NULL)
  3459.         {
  3460.           fatal_error=TRUE;
  3461.           result_header_ptr=NULL;
  3462.           printf(
  3463.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3464.            function_name);
  3465.           printf("     line %ld, column %ld.\n",source_line_num,
  3466.            source_column_num);
  3467.         }
  3468.       else
  3469.         if ((*queue_head).next == NULL)
  3470.           {
  3471.             fatal_error=TRUE;
  3472.             result_header_ptr=NULL;
  3473.             printf(
  3474.              "Fatal error:  argument to function \"%s\" is missing on\n",
  3475.              function_name);
  3476.             printf("     line %ld, column %ld.\n",source_line_num,
  3477.              source_column_num);
  3478.           }
  3479.         else
  3480.           if ((*((*queue_head).next)).next == NULL)
  3481.             if (evaluate)
  3482.               if ((*((*queue_head).argument_header_ptr)).type == 'I')
  3483.                 if ((*((*((*queue_head).next)).argument_header_ptr)).type
  3484.                  == 'I')
  3485.                   if (*((*((*((*queue_head).next)).argument_header_ptr)).
  3486.                    value_ptr.integer) == 0)
  3487.                     {
  3488.                       fatal_error=TRUE;
  3489.                       result_header_ptr=NULL;
  3490.                       printf(
  3491.                        "Fatal error:  second argument to MOD is zero\n");
  3492.                       printf("     on line %ld, column %ld.\n",source_line_num,
  3493.                        source_column_num);
  3494.                     }
  3495.                   else
  3496.                     {
  3497.                       result_header_ptr=new_integer_header_ptr();
  3498.                       if (! fatal_error)
  3499.                         {
  3500.                           tem_int_1
  3501.                            =*((*((*queue_head).argument_header_ptr)).
  3502.                            value_ptr.integer);
  3503.                           tem_int_2
  3504.                            =*((*((*((*queue_head).next)).argument_header_ptr)).
  3505.                            value_ptr.integer);
  3506.                           tem_int_3=tem_int_1/tem_int_2;
  3507.                           tem_int_3*=tem_int_2;
  3508.                           *((*result_header_ptr).value_ptr.integer)
  3509.                            =tem_int_1-tem_int_3;
  3510.                         }
  3511.                     }
  3512.                 else
  3513.                   {
  3514.                     fatal_error=TRUE;
  3515.                     result_header_ptr=NULL;
  3516.                     printf(
  3517.             "Fatal error:  second argument to MOD is other than an integer\n");
  3518.                     printf("     on line %ld, column %ld.\n",source_line_num,
  3519.                      source_column_num);
  3520.                   }
  3521.               else
  3522.                 {
  3523.                   fatal_error=TRUE;
  3524.                   result_header_ptr=NULL;
  3525.                   printf(
  3526.              "Fatal error:  first argument to MOD is other than an integer\n");
  3527.                   printf("     on line %ld, column %ld.\n",source_line_num,
  3528.                    source_column_num);
  3529.                 }
  3530.             else
  3531.               result_header_ptr=NULL;
  3532.           else
  3533.             {
  3534.               fatal_error=TRUE;
  3535.               result_header_ptr=NULL;
  3536.               printf(
  3537.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3538.                function_name);
  3539.               printf("     line %ld, column %ld.\n",source_line_num,
  3540.                source_column_num);
  3541.             }
  3542.       return(result_header_ptr);
  3543.     }
  3544.  
  3545. static value_header_ptr open_header_ptr(queue_head,function_name,evaluate)
  3546.   queue_node_ptr queue_head;
  3547.   char           *function_name;
  3548.   int            evaluate;
  3549.     {
  3550.       value_header_ptr result_header_ptr;
  3551.  
  3552.       if (queue_head == NULL)
  3553.         {
  3554.           fatal_error=TRUE;
  3555.           result_header_ptr=NULL;
  3556.           printf(
  3557.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3558.            function_name);
  3559.           printf("     line %ld, column %ld.\n",source_line_num,
  3560.            source_column_num);
  3561.         }
  3562.       else
  3563.         if ((*queue_head).next == NULL)
  3564.           {
  3565.             fatal_error=TRUE;
  3566.             result_header_ptr=NULL;
  3567.             printf(
  3568.              "Fatal error:  argument to function \"%s\" is missing on\n",
  3569.              function_name);
  3570.             printf("     line %ld, column %ld.\n",source_line_num,
  3571.              source_column_num);
  3572.           }
  3573.         else
  3574.           if ((*((*queue_head).next)).next == NULL)
  3575.             if (evaluate)
  3576.               if ((*((*queue_head).argument_header_ptr)).type == 'S')
  3577.                 if ((*((*((*queue_head).next)).argument_header_ptr)).type
  3578.                  == 'S')
  3579.                   {
  3580.                     result_header_ptr=new_dataset_header_ptr();
  3581.                     if (! fatal_error)
  3582.                       {
  3583.                         *((*result_header_ptr).value_ptr.dataset)
  3584.                          =fopen((char *) (*((*((*queue_head).
  3585.                          argument_header_ptr)).value_ptr.string)).value,
  3586.                          (char *) (*((*((*((*queue_head).next)).
  3587.                          argument_header_ptr)).value_ptr.string)).value);
  3588.                         if (*((*result_header_ptr).value_ptr.dataset) == NULL)
  3589.                           {
  3590.                             fatal_error=TRUE;
  3591.                             free_value(result_header_ptr);
  3592.                             result_header_ptr=NULL;
  3593.                             printf(
  3594.                         "Fatal error:  cannot OPEN \"%s\" in mode \"%s\" on\n",
  3595.                              (*((*((*queue_head).argument_header_ptr)).
  3596.                              value_ptr.string)).value,
  3597.                              (*((*((*((*queue_head).next)).
  3598.                              argument_header_ptr)).value_ptr.string)).value);
  3599.                             printf("     on line %ld, column %ld.\n",
  3600.                              source_line_num,source_column_num);
  3601.                           }
  3602.                       }
  3603.                   }
  3604.                 else
  3605.                   {
  3606.                     fatal_error=TRUE;
  3607.                     result_header_ptr=NULL;
  3608.                     printf(
  3609.             "Fatal error:  second argument to OPEN is other than a string\n");
  3610.                     printf("     on line %ld, column %ld.\n",source_line_num,
  3611.                      source_column_num);
  3612.                   }
  3613.               else
  3614.                 {
  3615.                   fatal_error=TRUE;
  3616.                   result_header_ptr=NULL;
  3617.                   printf(
  3618.              "Fatal error:  first argument to OPEN is other than a string\n");
  3619.                   printf("     on line %ld, column %ld.\n",source_line_num,
  3620.                    source_column_num);
  3621.                 }
  3622.             else
  3623.               result_header_ptr=NULL;
  3624.           else
  3625.             {
  3626.               fatal_error=TRUE;
  3627.               result_header_ptr=NULL;
  3628.               printf(
  3629.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3630.                function_name);
  3631.               printf("     line %ld, column %ld.\n",source_line_num,
  3632.                source_column_num);
  3633.             }
  3634.       return(result_header_ptr);
  3635.     }
  3636.  
  3637. static value_header_ptr ord_header_ptr(queue_head,function_name,evaluate)
  3638.   queue_node_ptr queue_head;
  3639.   char           *function_name;
  3640.   int            evaluate;
  3641.     {
  3642.       value_header_ptr result_header_ptr;
  3643.  
  3644.       if (queue_head == NULL)
  3645.         {
  3646.           fatal_error=TRUE;
  3647.           result_header_ptr=NULL;
  3648.           printf(
  3649.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3650.            function_name);
  3651.           printf("     line %ld, column %ld.\n",source_line_num,
  3652.            source_column_num);
  3653.         }
  3654.       else
  3655.         if ((*queue_head).next == NULL)
  3656.           if (evaluate)
  3657.             if ((*((*queue_head).argument_header_ptr)).type == 'S')
  3658.               if ((*((*((*queue_head).argument_header_ptr)).value_ptr.string)).
  3659.                length == 0)
  3660.                 {
  3661.                   fatal_error=TRUE;
  3662.                   result_header_ptr=NULL;
  3663.                   printf(
  3664.                    "Fatal error:  argument to ORD has length zero\n");
  3665.                   printf("     on line %ld, column %ld.\n",source_line_num,
  3666.                    source_column_num);
  3667.                 }
  3668.               else
  3669.                 {
  3670.                   result_header_ptr=new_integer_header_ptr();
  3671.                   if (! fatal_error)
  3672.                     *((*result_header_ptr).value_ptr.integer)
  3673.                      =(long) *((*((*((*queue_head).argument_header_ptr)).
  3674.                      value_ptr.string)).value);
  3675.                 }
  3676.             else
  3677.               {
  3678.                 fatal_error=TRUE;
  3679.                 result_header_ptr=NULL;
  3680.                 printf(
  3681.                  "Fatal error:  argument to ORD is other than a string\n");
  3682.                 printf("     on line %ld, column %ld.\n",source_line_num,
  3683.                  source_column_num);
  3684.               }
  3685.           else
  3686.             result_header_ptr=NULL;
  3687.         else
  3688.           {
  3689.             fatal_error=TRUE;
  3690.             result_header_ptr=NULL;
  3691.             printf(
  3692.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3693.              function_name);
  3694.             printf("     line %ld, column %ld.\n",source_line_num,
  3695.              source_column_num);
  3696.           }
  3697.       return(result_header_ptr);
  3698.     }
  3699.  
  3700. static value_header_ptr pi_header_ptr(queue_head,function_name,evaluate)
  3701.   queue_node_ptr queue_head;
  3702.   char           *function_name;
  3703.   int            evaluate;
  3704.     {
  3705.       value_header_ptr result_header_ptr;
  3706.  
  3707.       if (queue_head != NULL)
  3708.         {
  3709.           fatal_error=TRUE;
  3710.           result_header_ptr=NULL;
  3711.           printf(
  3712.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3713.            function_name);
  3714.           printf("     line %ld, column %ld.\n",source_line_num,
  3715.            source_column_num);
  3716.         }
  3717.       else
  3718.         if (evaluate)
  3719.           {
  3720.             result_header_ptr=new_real_header_ptr();
  3721.             if (! fatal_error)
  3722.               *((*result_header_ptr).value_ptr.real)=4.0*atan(1.0);
  3723.           }
  3724.         else
  3725.           result_header_ptr=NULL;
  3726.       return(result_header_ptr);
  3727.     }
  3728.  
  3729. static value_header_ptr repeat_header_ptr(queue_head,function_name,evaluate)
  3730.   queue_node_ptr queue_head;
  3731.   char           *function_name;
  3732.   int            evaluate;
  3733.     {
  3734.       long             char_index;
  3735.       unsigned char    *char_ptr_1;
  3736.       unsigned char    *char_ptr_2;
  3737.       unsigned char    *char_ptr_3;
  3738.       value_header_ptr result_header_ptr;
  3739.       long             tem_int_1;
  3740.       long             tem_int_2;
  3741.       long             result_length;
  3742.       double           tem_real_1;
  3743.       double           tem_real_2;
  3744.       double           tem_real_3;
  3745.  
  3746.       if (queue_head == NULL)
  3747.         {
  3748.           fatal_error=TRUE;
  3749.           result_header_ptr=NULL;
  3750.           printf(
  3751.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3752.            function_name);
  3753.           printf("     line %ld, column %ld.\n",source_line_num,
  3754.            source_column_num);
  3755.         }
  3756.       else
  3757.         if ((*queue_head).next == NULL)
  3758.           {
  3759.             fatal_error=TRUE;
  3760.             result_header_ptr=NULL;
  3761.             printf(
  3762.              "Fatal error:  argument to function \"%s\" is missing on\n",
  3763.              function_name);
  3764.             printf("     line %ld, column %ld.\n",source_line_num,
  3765.              source_column_num);
  3766.           }
  3767.         else
  3768.           if ((*((*queue_head).next)).next == NULL)
  3769.             if (evaluate)
  3770.               if ((*((*queue_head).argument_header_ptr)).type == 'S')
  3771.                 if ((*((*((*queue_head).next)).argument_header_ptr)).type
  3772.                  == 'I')
  3773.                   {
  3774.                     char_ptr_1=(*((*((*queue_head).argument_header_ptr)).
  3775.                      value_ptr.string)).value;
  3776.                     tem_int_1=(*((*((*queue_head).argument_header_ptr)).
  3777.                      value_ptr.string)).length;
  3778.                     tem_int_2
  3779.                      =*((*((*((*queue_head).next)).
  3780.                      argument_header_ptr)).value_ptr.integer);
  3781.                     if (tem_int_2 >= (long) 0)
  3782.                       if (tem_int_1 == 0)
  3783.                         {
  3784.                           result_header_ptr
  3785.                            =new_string_header_ptr((unsigned) 0);
  3786.                           if (! fatal_error)
  3787.                             *((*((*result_header_ptr).value_ptr.string)).value)
  3788.                             =(unsigned char) '\0';
  3789.                         }
  3790.                       else
  3791.                         {
  3792.                           tem_real_1=(double) tem_int_1;
  3793.                           tem_real_2=(double) tem_int_2;
  3794.                           tem_real_3
  3795.                            =(log(fabs(tem_real_1))+log(fabs(tem_real_2+1.0)))
  3796.                            /log(2.0);
  3797.                           if (tem_real_3 >= 15.0)
  3798.                             {
  3799.                               fatal_error=TRUE;
  3800.                               result_header_ptr=NULL;
  3801.                              printf(
  3802.                           "Fatal error:  result of REPEAT too long on line\n");
  3803.                               printf(
  3804.                                "     %ld, column %ld.\n",source_line_num,
  3805.                                source_column_num);
  3806.                             }
  3807.                           else
  3808.                             {
  3809.                               result_length=tem_int_1;
  3810.                               result_length*=(tem_int_2+(long) 1);
  3811.                               result_header_ptr
  3812.                                =new_string_header_ptr(
  3813.                                (unsigned) result_length);
  3814.                               if (! fatal_error)
  3815.                                 {
  3816.                                   char_ptr_3
  3817.                                    =(*((*result_header_ptr).value_ptr.string)).
  3818.                                    value;
  3819.                                   while (tem_int_2 >= (long) 0)
  3820.                                     {
  3821.                                       char_ptr_2=char_ptr_1;
  3822.                                       for (char_index=(long) 0;
  3823.                                        char_index < tem_int_1;
  3824.                                        char_index++)
  3825.                                         {
  3826.                                           *char_ptr_3=*char_ptr_2;
  3827.                                           char_ptr_3++;
  3828.                                           char_ptr_2++;
  3829.                                         }
  3830.                                       tem_int_2--;
  3831.                                     }
  3832.                                 }
  3833.                             }
  3834.                         }
  3835.                     else
  3836.                       result_header_ptr=copy_of_arguments(
  3837.                        (*queue_head).argument_header_ptr);
  3838.                   }
  3839.                 else
  3840.                   {
  3841.                     fatal_error=TRUE;
  3842.                     result_header_ptr=NULL;
  3843.                     printf(
  3844.          "Fatal error:  second argument to REPEAT is other than an integer\n");
  3845.                     printf("     on line %ld, column %ld.\n",source_line_num,
  3846.                      source_column_num);
  3847.                   }
  3848.               else
  3849.                 {
  3850.                   fatal_error=TRUE;
  3851.                   result_header_ptr=NULL;
  3852.                   printf(
  3853.             "Fatal error:  first argument to REPEAT is other than a string\n");
  3854.                   printf("     on line %ld, column %ld.\n",source_line_num,
  3855.                    source_column_num);
  3856.                 }
  3857.             else
  3858.               result_header_ptr=NULL;
  3859.           else
  3860.             {
  3861.               fatal_error=TRUE;
  3862.               result_header_ptr=NULL;
  3863.               printf(
  3864.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3865.                function_name);
  3866.               printf("     line %ld, column %ld.\n",source_line_num,
  3867.                source_column_num);
  3868.             }
  3869.       return(result_header_ptr);
  3870.     }
  3871.  
  3872. static value_header_ptr sin_header_ptr(queue_head,function_name,evaluate)
  3873.   queue_node_ptr queue_head;
  3874.   char           *function_name;
  3875.   int            evaluate;
  3876.     {
  3877.       value_header_ptr result_header_ptr;
  3878.       double           tem_real;
  3879.  
  3880.       if (queue_head == NULL)
  3881.         {
  3882.           fatal_error=TRUE;
  3883.           result_header_ptr=NULL;
  3884.           printf(
  3885.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3886.            function_name);
  3887.           printf("     line %ld, column %ld.\n",source_line_num,
  3888.            source_column_num);
  3889.         }
  3890.       else
  3891.         if ((*queue_head).next == NULL)
  3892.           if (evaluate)
  3893.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  3894.               {
  3895.                 tem_real=(double) *((*((*queue_head).argument_header_ptr)).
  3896.                    value_ptr.integer);
  3897.                 result_header_ptr=new_real_header_ptr();
  3898.                 if (! fatal_error)
  3899.                   *((*result_header_ptr).value_ptr.real)=sin(tem_real);
  3900.               }
  3901.             else
  3902.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  3903.                 {
  3904.                   result_header_ptr=new_real_header_ptr();
  3905.                   if (! fatal_error)
  3906.                     *((*result_header_ptr).value_ptr.real)
  3907.                      =sin(*((*((*queue_head).argument_header_ptr)).
  3908.                      value_ptr.real));
  3909.                 }
  3910.               else
  3911.                 {
  3912.                   fatal_error=TRUE;
  3913.                   result_header_ptr=NULL;
  3914.                   printf(
  3915. "Fatal error:  other than a number supplied as argument to function \"%s\"\n",
  3916.                    function_name);
  3917.                   printf("     on line %ld, column %ld.\n",source_line_num,
  3918.                    source_column_num);
  3919.                 }
  3920.           else
  3921.             result_header_ptr=NULL;
  3922.         else
  3923.           {
  3924.             fatal_error=TRUE;
  3925.             result_header_ptr=NULL;
  3926.             printf(
  3927.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  3928.              function_name);
  3929.             printf("     line %ld, column %ld.\n",source_line_num,
  3930.              source_column_num);
  3931.           }
  3932.       return(result_header_ptr);
  3933.     }
  3934.  
  3935. static value_header_ptr sqr_header_ptr(queue_head,function_name,evaluate)
  3936.   queue_node_ptr queue_head;
  3937.   char           *function_name;
  3938.   int            evaluate;
  3939.     {
  3940.       value_header_ptr result_header_ptr;
  3941.       long             tem_integer;
  3942.       double           tem_real_1;
  3943.       double           tem_real_2;
  3944.  
  3945.       if (queue_head == NULL)
  3946.         {
  3947.           fatal_error=TRUE;
  3948.           result_header_ptr=NULL;
  3949.           printf(
  3950.           "Fatal error:  argument to function \"%s\" is missing on\n",
  3951.            function_name);
  3952.           printf("     line %ld, column %ld.\n",source_line_num,
  3953.            source_column_num);
  3954.         }
  3955.       else
  3956.         if ((*queue_head).next == NULL)
  3957.           if (evaluate)
  3958.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  3959.               {
  3960.                 result_header_ptr=new_integer_header_ptr();
  3961.                 if (! fatal_error)
  3962.                   {
  3963.                     tem_integer
  3964.                      =*((*((*queue_head).argument_header_ptr)).
  3965.                      value_ptr.integer);
  3966.                     if (tem_integer == 0)
  3967.                       *((*result_header_ptr).value_ptr.integer)=0;
  3968.                     else
  3969.                       {
  3970.                         tem_real_1=(double) tem_integer;
  3971.                         tem_real_2=2.0*log(fabs(tem_real_1))/log(2.0);
  3972.                         if (tem_real_2 >= 31.0)
  3973.                           {
  3974.                             fatal_error=TRUE;
  3975.                             free_value(result_header_ptr);
  3976.                             result_header_ptr=NULL;
  3977.                             printf(
  3978.           "Fatal error:  argument to SQR too large on line %ld, column %ld.\n",
  3979.                              source_line_num,source_column_num);
  3980.                           }
  3981.                         else
  3982.                           *((*result_header_ptr).value_ptr.integer)
  3983.                            =tem_integer*tem_integer;
  3984.                       }
  3985.                   }
  3986.               }
  3987.             else
  3988.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  3989.                 {
  3990.                   result_header_ptr=new_real_header_ptr();
  3991.                   if (! fatal_error)
  3992.                     {
  3993.                       tem_real_1
  3994.                        =*((*((*queue_head).argument_header_ptr)).
  3995.                        value_ptr.real);
  3996.                       if (tem_real_1 == 0.0)
  3997.                         *((*result_header_ptr).value_ptr.real)=0.0;
  3998.                       else
  3999.                         {
  4000.                           tem_real_2=2.0*log(fabs(tem_real_1))/log(10.0);
  4001.                           if (tem_real_2 < -37.0)
  4002.                             *((*result_header_ptr).value_ptr.real)=0.0;
  4003.                           else
  4004.                             if (tem_real_2 > 37.0)
  4005.                               {
  4006.                                 fatal_error=TRUE;
  4007.                                 free_value(result_header_ptr);
  4008.                                 result_header_ptr=NULL;
  4009.                                 printf(
  4010.           "Fatal error:  argument to SQR too large on line %ld, column %ld.\n",
  4011.                                  source_line_num,source_column_num);
  4012.                               }
  4013.                             else
  4014.                               *((*result_header_ptr).value_ptr.real)
  4015.                                =tem_real_1*tem_real_1;
  4016.                         }
  4017.                     }
  4018.                 }
  4019.               else
  4020.                 {
  4021.                   fatal_error=TRUE;
  4022.                   result_header_ptr=NULL;
  4023.                   printf(
  4024. "Fatal error:  other than a number supplied as argument to function \"%s\"\n",
  4025.                    function_name);
  4026.                   printf("     on line %ld, column %ld.\n",source_line_num,
  4027.                    source_column_num);
  4028.                 }
  4029.           else
  4030.             result_header_ptr=NULL;
  4031.         else
  4032.           {
  4033.             fatal_error=TRUE;
  4034.             result_header_ptr=NULL;
  4035.             printf(
  4036.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4037.              function_name);
  4038.             printf("     line %ld, column %ld.\n",source_line_num,
  4039.              source_column_num);
  4040.           }
  4041.       return(result_header_ptr);
  4042.     }
  4043.  
  4044. static value_header_ptr sqrt_header_ptr(queue_head,function_name,evaluate)
  4045.   queue_node_ptr queue_head;
  4046.   char           *function_name;
  4047.   int            evaluate;
  4048.     {
  4049.       value_header_ptr result_header_ptr;
  4050.       double           tem_real;
  4051.  
  4052.       if (queue_head == NULL)
  4053.         {
  4054.           fatal_error=TRUE;
  4055.           result_header_ptr=NULL;
  4056.           printf(
  4057.           "Fatal error:  argument to function \"%s\" is missing on\n",
  4058.            function_name);
  4059.           printf("     line %ld, column %ld.\n",source_line_num,
  4060.            source_column_num);
  4061.         }
  4062.       else
  4063.         if ((*queue_head).next == NULL)
  4064.           if (evaluate)
  4065.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  4066.                 {
  4067.                   tem_real=(double) *((*((*queue_head).argument_header_ptr)).
  4068.                    value_ptr.integer);
  4069.                   if (tem_real < 0.0)
  4070.                     {
  4071.                       fatal_error=TRUE;
  4072.                       result_header_ptr=NULL;
  4073.                       printf(
  4074.                      "Fatal error:  argument to function \"%s\" is negative\n",
  4075.                        function_name);
  4076.                       printf("     on line %ld, column %ld.\n",source_line_num,
  4077.                        source_column_num);
  4078.                     }
  4079.                   else
  4080.                     {
  4081.                       tem_real=sqrt(tem_real);
  4082.                       result_header_ptr=new_real_header_ptr();
  4083.                       if (! fatal_error)
  4084.                         *((*result_header_ptr).value_ptr.real)=tem_real;
  4085.                     }
  4086.                 }
  4087.             else
  4088.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  4089.                 {
  4090.                   tem_real=*((*((*queue_head).argument_header_ptr)).
  4091.                    value_ptr.real);
  4092.                   if (tem_real < 0.0)
  4093.                     {
  4094.                       fatal_error=TRUE;
  4095.                       result_header_ptr=NULL;
  4096.                       printf(
  4097.                      "Fatal error:  argument to function \"%s\" is negative\n",
  4098.                        function_name);
  4099.                       printf("     on line %ld, column %ld.\n",source_line_num,
  4100.                        source_column_num);
  4101.                     }
  4102.                   else
  4103.                     {
  4104.                       tem_real=sqrt(tem_real);
  4105.                       result_header_ptr=new_real_header_ptr();
  4106.                       if (! fatal_error)
  4107.                         *((*result_header_ptr).value_ptr.real)=tem_real;
  4108.                     }
  4109.                 }
  4110.               else
  4111.                 {
  4112.                   fatal_error=TRUE;
  4113.                   result_header_ptr=NULL;
  4114.                   printf(
  4115. "Fatal error:  other than a number supplied as argument to function \"%s\"\n",
  4116.                    function_name);
  4117.                   printf("     on line %ld, column %ld.\n",source_line_num,
  4118.                    source_column_num);
  4119.                 }
  4120.           else
  4121.             result_header_ptr=NULL;
  4122.         else
  4123.           {
  4124.             fatal_error=TRUE;
  4125.             result_header_ptr=NULL;
  4126.             printf(
  4127.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4128.              function_name);
  4129.             printf("     line %ld, column %ld.\n",source_line_num,
  4130.              source_column_num);
  4131.           }
  4132.       return(result_header_ptr);
  4133.     }
  4134.  
  4135. static value_header_ptr str_header_ptr(queue_head,function_name,evaluate)
  4136.   queue_node_ptr queue_head;
  4137.   char           *function_name;
  4138.   int            evaluate;
  4139.     {
  4140.       char             buffer [256];
  4141.       value_header_ptr result_header_ptr;
  4142.  
  4143.       if (queue_head == NULL)
  4144.         {
  4145.           fatal_error=TRUE;
  4146.           result_header_ptr=NULL;
  4147.           printf(
  4148.           "Fatal error:  argument to function \"%s\" is missing on\n",
  4149.            function_name);
  4150.           printf("     line %ld, column %ld.\n",source_line_num,
  4151.            source_column_num);
  4152.         }
  4153.       else
  4154.         if ((*queue_head).next == NULL)
  4155.           if (evaluate)
  4156.             switch ((*((*queue_head).argument_header_ptr)).type)
  4157.               {
  4158.                 case 'B':
  4159.                   if
  4160.                   (*((*((*queue_head).argument_header_ptr)).value_ptr.boolean))
  4161.                     {
  4162.                       result_header_ptr=new_string_header_ptr((unsigned) 4);
  4163.                       if (! fatal_error)
  4164.                         strcpy((char *)
  4165.                          (*((*result_header_ptr).value_ptr.string)).value,
  4166.                          "TRUE");
  4167.                     }
  4168.                   else
  4169.                     {
  4170.                       result_header_ptr=new_string_header_ptr((unsigned) 5);
  4171.                       if (! fatal_error)
  4172.                         strcpy((char *)
  4173.                          (*((*result_header_ptr).value_ptr.string)).value,
  4174.                          "FALSE");
  4175.                     }
  4176.                   break;
  4177.                 case 'D':
  4178.                   buffer[sprintf(buffer,"%p",
  4179.                    *((*((*queue_head).argument_header_ptr)).value_ptr.
  4180.                    dataset))]='\0';
  4181.                   result_header_ptr
  4182.                    =new_string_header_ptr((unsigned) strlen(buffer));
  4183.                   if (! fatal_error)
  4184.                     strcpy((char *)
  4185.                      (*((*result_header_ptr).value_ptr.string)).value,buffer);
  4186.                   break;
  4187.                 case 'I':
  4188.                   buffer[sprintf(buffer,"%ld",
  4189.                    *((*((*queue_head).argument_header_ptr)).value_ptr.integer))]
  4190.                    ='\0';
  4191.                   result_header_ptr
  4192.                    =new_string_header_ptr((unsigned) strlen(buffer));
  4193.                   if (! fatal_error)
  4194.                     strcpy((char *)
  4195.                      (*((*result_header_ptr).value_ptr.string)).value,buffer);
  4196.                   break;
  4197.                 case 'R':
  4198.                   buffer[sprintf(buffer,"%lG",
  4199.                    *((*((*queue_head).argument_header_ptr)).value_ptr.real))]
  4200.                    ='\0';
  4201.                   result_header_ptr
  4202.                    =new_string_header_ptr((unsigned) strlen(buffer));
  4203.                   if (! fatal_error)
  4204.                     strcpy((char *)
  4205.                      (*((*result_header_ptr).value_ptr.string)).value,buffer);
  4206.                   break;
  4207.                 default:
  4208.                   result_header_ptr=new_string_header_ptr((unsigned)
  4209.                    (*((*((*queue_head).argument_header_ptr)).value_ptr.
  4210.                    string)).length);
  4211.                   if (! fatal_error)
  4212.                     pli_strcpy((*result_header_ptr).value_ptr.string,
  4213.                      (*((*queue_head).argument_header_ptr)).value_ptr.string);
  4214.                   break;
  4215.               }
  4216.           else
  4217.             result_header_ptr=NULL;
  4218.         else
  4219.           {
  4220.             fatal_error=TRUE;
  4221.             result_header_ptr=NULL;
  4222.             printf(
  4223.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4224.              function_name);
  4225.             printf("     line %ld, column %ld.\n",source_line_num,
  4226.              source_column_num);
  4227.           }
  4228.       return(result_header_ptr);
  4229.     }
  4230.  
  4231. static value_header_ptr substr_header_ptr(queue_head,function_name,evaluate)
  4232.   queue_node_ptr queue_head;
  4233.   char           *function_name;
  4234.   int            evaluate;
  4235.     {
  4236.       unsigned char    *char_ptr;
  4237.       unsigned char    *destination_ptr;
  4238.       long             final_column;
  4239.       long             num_columns;
  4240.       int              offset;
  4241.       value_header_ptr result_header_ptr;
  4242.       unsigned char    *source_ptr;
  4243.       long             starting_column;
  4244.       int              string_length;
  4245.  
  4246.       if (queue_head == NULL)
  4247.         {
  4248.           fatal_error=TRUE;
  4249.           result_header_ptr=NULL;
  4250.           printf(
  4251.           "Fatal error:  argument to function \"%s\" is missing on\n",
  4252.            function_name);
  4253.           printf("     line %ld, column %ld.\n",source_line_num,
  4254.            source_column_num);
  4255.         }
  4256.       else
  4257.         if ((*queue_head).next == NULL)
  4258.           {
  4259.             fatal_error=TRUE;
  4260.              result_header_ptr=NULL;
  4261.             printf(
  4262.              "Fatal error:  argument to function \"%s\" is missing on\n",
  4263.              function_name);
  4264.             printf("     line %ld, column %ld.\n",source_line_num,
  4265.              source_column_num);
  4266.           }
  4267.         else
  4268.           if ((*((*queue_head).next)).next == NULL)
  4269.             if (evaluate)
  4270.               if ((*((*queue_head).argument_header_ptr)).type == 'S')
  4271.                 if ((*((*((*queue_head).next)).argument_header_ptr)).type
  4272.                  == 'I')
  4273.                   {
  4274.                     char_ptr=(*((*((*queue_head).argument_header_ptr)).
  4275.                      value_ptr.string)).value;
  4276.                     string_length=(*((*((*queue_head).argument_header_ptr)).
  4277.                      value_ptr.string)).length;
  4278.                     starting_column
  4279.                      =*((*((*((*queue_head).next)).
  4280.                      argument_header_ptr)).value_ptr.integer);
  4281.                     if (starting_column <= (long) 0)
  4282.                       {
  4283.                         fatal_error=TRUE;
  4284.                         result_header_ptr=NULL;
  4285.                         printf(
  4286.                   "Fatal error:  second argument to SUBSTR is not positive\n");
  4287.                         printf(
  4288.                          "     on line %ld, column %ld.\n",
  4289.                          source_line_num,source_column_num);
  4290.                       }
  4291.                     else
  4292.                       if (starting_column > string_length)
  4293.                         {
  4294.                           fatal_error=TRUE;
  4295.                           result_header_ptr=NULL;
  4296.                           printf(
  4297.  "Fatal error:  second argument to SUBSTR exceeds length of first argument\n");
  4298.                           printf(
  4299.                            "     on line %ld, column %ld.\n",
  4300.                            source_line_num,source_column_num);
  4301.                         }
  4302.                       else
  4303.                         {
  4304.                           num_columns=string_length-starting_column+(long) 1;
  4305.                           result_header_ptr
  4306.                            =new_string_header_ptr((unsigned) num_columns);
  4307.                           if (! fatal_error)
  4308.                             {
  4309.                               offset=(int) starting_column;
  4310.                               offset--;
  4311.                               source_ptr=char_ptr+offset;
  4312.                               destination_ptr
  4313.                                =(*((*result_header_ptr).value_ptr.string)).
  4314.                                value;
  4315.                               while (num_columns > 0)
  4316.                                 {
  4317.                                    *destination_ptr=*source_ptr;
  4318.                                    source_ptr++;
  4319.                                    destination_ptr++;
  4320.                                    num_columns--;
  4321.                                 }
  4322.                               *destination_ptr=(unsigned char) '\0';
  4323.                             }
  4324.                         }
  4325.                   }
  4326.                 else
  4327.                   {
  4328.                     fatal_error=TRUE;
  4329.                     result_header_ptr=NULL;
  4330.                     printf(
  4331.          "Fatal error:  second argument to SUBSTR is other than an integer\n");
  4332.                     printf("     on line %ld, column %ld.\n",source_line_num,
  4333.                      source_column_num);
  4334.                   }
  4335.               else
  4336.                 {
  4337.                   fatal_error=TRUE;
  4338.                   result_header_ptr=NULL;
  4339.                   printf(
  4340.             "Fatal error:  first argument to SUBSTR is other than a string\n");
  4341.                   printf("     on line %ld, column %ld.\n",source_line_num,
  4342.                    source_column_num);
  4343.                 }
  4344.             else
  4345.               result_header_ptr=NULL;
  4346.           else
  4347.             if ((*((*((*queue_head).next)).next)).next == NULL)
  4348.               if (evaluate)
  4349.                 if ((*((*queue_head).argument_header_ptr)).type == 'S')
  4350.                   if ((*((*((*queue_head).next)).argument_header_ptr)).type
  4351.                    == 'I')
  4352.                     if ((*((*((*((*queue_head).next)).next)).
  4353.                      argument_header_ptr)).type == 'I')
  4354.                       {
  4355.                         char_ptr=(*((*((*queue_head).argument_header_ptr)).
  4356.                          value_ptr.string)).value;
  4357.                         string_length
  4358.                          =(*((*((*queue_head).argument_header_ptr)).
  4359.                          value_ptr.string)).length;
  4360.                         starting_column
  4361.                          =*((*((*((*queue_head).next)).
  4362.                          argument_header_ptr)).value_ptr.integer);
  4363.                         if (starting_column <= (long) 0)
  4364.                           {
  4365.                             fatal_error=TRUE;
  4366.                             result_header_ptr=NULL;
  4367.                             printf(
  4368.                   "Fatal error:  second argument to SUBSTR is not positive\n");
  4369.                             printf(
  4370.                              "     on line %ld, column %ld.\n",
  4371.                              source_line_num,source_column_num);
  4372.                           }
  4373.                         else
  4374.                           {
  4375.                             num_columns
  4376.                              =*((*((*((*((*queue_head).next)).next)).
  4377.                              argument_header_ptr)).value_ptr.integer);
  4378.                             if (num_columns == (long) 0)
  4379.                               {
  4380.                                 result_header_ptr=new_string_header_ptr(0);
  4381.                                 if (! fatal_error)
  4382.                                   *((*((*result_header_ptr).value_ptr.string)).
  4383.                                    value)=(unsigned char) '\0';
  4384.                               }
  4385.                             else
  4386.                               {
  4387.                                 final_column=starting_column+num_columns-1;
  4388.                                 if (final_column > string_length)
  4389.                                   {
  4390.                                     fatal_error=TRUE;
  4391.                                     result_header_ptr=NULL;
  4392.                                     printf(
  4393.              "Fatal error:  SUBSTRing extends beyond end of first argument\n");
  4394.                                     printf(
  4395.                                      "     on line %ld, column %ld.\n",
  4396.                                      source_line_num,source_column_num);
  4397.                                   }
  4398.                                 else
  4399.                                   if (final_column < starting_column)
  4400.                                     {
  4401.                                       fatal_error=TRUE;
  4402.                                       result_header_ptr=NULL;
  4403.                                       printf(
  4404.                    "Fatal error:  third argument to SUBSTR is not positive\n");
  4405.                                       printf(
  4406.                                        "     on line %ld, column %ld.\n",
  4407.                                        source_line_num,source_column_num);
  4408.                                     }
  4409.                                   else
  4410.                                     {
  4411.                                       result_header_ptr
  4412.                                        =new_string_header_ptr(
  4413.                                        (unsigned) num_columns);
  4414.                                       if (! fatal_error)
  4415.                                         {
  4416.                                           offset=(int) starting_column;
  4417.                                           offset--;
  4418.                                           source_ptr=char_ptr+offset;
  4419.                                           destination_ptr
  4420.                                            =(*((*result_header_ptr).
  4421.                                            value_ptr.string)).value;
  4422.                                           while (final_column
  4423.                                            >= starting_column)
  4424.                                             {
  4425.                                               *destination_ptr=*source_ptr;
  4426.                                               source_ptr++;
  4427.                                               destination_ptr++;
  4428.                                               starting_column++;
  4429.                                             }
  4430.                                           *destination_ptr='\0';
  4431.                                         }
  4432.                                     }
  4433.                               }
  4434.                           }
  4435.                       }
  4436.                     else
  4437.                       {
  4438.                         fatal_error=TRUE;
  4439.                         result_header_ptr=NULL;
  4440.                         printf(
  4441.           "Fatal error:  third argument to SUBSTR is other than an integer\n");
  4442.                         printf("     on line %ld, column %ld.\n",
  4443.                          source_line_num,source_column_num);
  4444.                       }
  4445.                   else
  4446.                     {
  4447.                       fatal_error=TRUE;
  4448.                       result_header_ptr=NULL;
  4449.                       printf(
  4450.          "Fatal error:  second argument to SUBSTR is other than an integer\n");
  4451.                       printf("     on line %ld, column %ld.\n",source_line_num,
  4452.                        source_column_num);
  4453.                     }
  4454.                 else
  4455.                   {
  4456.                     fatal_error=TRUE;
  4457.                     result_header_ptr=NULL;
  4458.                     printf(
  4459.             "Fatal error:  first argument to SUBSTR is other than a string\n");
  4460.                     printf("     on line %ld, column %ld.\n",source_line_num,
  4461.                      source_column_num);
  4462.                   }
  4463.               else
  4464.                 result_header_ptr=NULL;
  4465.             else
  4466.               {
  4467.                 fatal_error=TRUE;
  4468.                 result_header_ptr=NULL;
  4469.                 printf(
  4470.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4471.                  function_name);
  4472.                 printf("     line %ld, column %ld.\n",source_line_num,
  4473.                  source_column_num);
  4474.               }
  4475.       return(result_header_ptr);
  4476.     }
  4477.  
  4478. static value_header_ptr sysin_header_ptr(queue_head,function_name,evaluate)
  4479.   queue_node_ptr queue_head;
  4480.   char           *function_name;
  4481.   int            evaluate;
  4482.     {
  4483.       value_header_ptr result_header_ptr;
  4484.  
  4485.       if (queue_head != NULL)
  4486.         {
  4487.           fatal_error=TRUE;
  4488.           result_header_ptr=NULL;
  4489.           printf(
  4490.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4491.            function_name);
  4492.           printf("     line %ld, column %ld.\n",source_line_num,
  4493.            source_column_num);
  4494.         }
  4495.       else
  4496.         if (evaluate)
  4497.           {
  4498.             result_header_ptr=new_dataset_header_ptr();
  4499.             if (! fatal_error)
  4500.               *((*result_header_ptr).value_ptr.dataset)=stdin;
  4501.           }
  4502.         else
  4503.           result_header_ptr=NULL;
  4504.       return(result_header_ptr);
  4505.     }
  4506.  
  4507. static value_header_ptr sysprint_header_ptr(queue_head,function_name,evaluate)
  4508.   queue_node_ptr queue_head;
  4509.   char           *function_name;
  4510.   int            evaluate;
  4511.     {
  4512.       value_header_ptr result_header_ptr;
  4513.  
  4514.       if (queue_head != NULL)
  4515.         {
  4516.           fatal_error=TRUE;
  4517.           result_header_ptr=NULL;
  4518.           printf(
  4519.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4520.            function_name);
  4521.           printf("     line %ld, column %ld.\n",source_line_num,
  4522.            source_column_num);
  4523.         }
  4524.       else
  4525.         if (evaluate)
  4526.           {
  4527.             result_header_ptr=new_dataset_header_ptr();
  4528.             if (! fatal_error)
  4529.               *((*result_header_ptr).value_ptr.dataset)=stdout;
  4530.           }
  4531.         else
  4532.           result_header_ptr=NULL;
  4533.       return(result_header_ptr);
  4534.     }
  4535.  
  4536. static value_header_ptr time_header_ptr(queue_head,function_name,evaluate)
  4537.   queue_node_ptr queue_head;
  4538.   char           *function_name;
  4539.   int            evaluate;
  4540.     {
  4541.       unsigned char    *char_ptr;
  4542.       char             date_and_time [26];
  4543.       long             elapsed_time;
  4544.       struct tm        *local_time;
  4545.       value_header_ptr result_header_ptr;
  4546.  
  4547.       if (queue_head != NULL)
  4548.         {
  4549.           fatal_error=TRUE;
  4550.           result_header_ptr=NULL;
  4551.           printf(
  4552.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4553.            function_name);
  4554.           printf("     line %ld, column %ld.\n",source_line_num,
  4555.            source_column_num);
  4556.         }
  4557.       else
  4558.         if (evaluate)
  4559.           {
  4560.             result_header_ptr=new_string_header_ptr((unsigned) 9);
  4561.             if (! fatal_error)
  4562.               {
  4563.                 char_ptr=(*((*result_header_ptr).value_ptr.string)).value;
  4564.                 time(&elapsed_time);
  4565.                 local_time=localtime(&elapsed_time);
  4566.                 strcpy(&date_and_time[0],asctime(local_time));
  4567.                 *char_ptr=(unsigned char) date_and_time[11];
  4568.                 char_ptr++;
  4569.                 *char_ptr=(unsigned char) date_and_time[12];
  4570.                 char_ptr++;
  4571.                 *char_ptr=(unsigned char) date_and_time[14];
  4572.                 char_ptr++;
  4573.                 *char_ptr=(unsigned char) date_and_time[15];
  4574.                 char_ptr++;
  4575.                 *char_ptr=(unsigned char) date_and_time[17];
  4576.                 char_ptr++;
  4577.                 *char_ptr=(unsigned char) date_and_time[18];
  4578.                 char_ptr++;
  4579.                 *char_ptr=(unsigned char) '0';
  4580.                 char_ptr++;
  4581.                 *char_ptr=(unsigned char) '0';
  4582.                 char_ptr++;
  4583.                 *char_ptr=(unsigned char) '0';
  4584.                 char_ptr++;
  4585.                 *char_ptr=(unsigned char) '\0';
  4586.               }
  4587.           }
  4588.         else
  4589.           result_header_ptr=NULL;
  4590.       return(result_header_ptr);
  4591.     }
  4592.  
  4593. static value_header_ptr translate_header_ptr(queue_head,function_name,evaluate)
  4594.   queue_node_ptr queue_head;
  4595.   char           *function_name;
  4596.   int            evaluate;
  4597.     {
  4598.       unsigned         char_index_1;
  4599.       int              char_index_2;
  4600.       unsigned         char_index_3;
  4601.       unsigned char    *char_ptr_1;
  4602.       unsigned char    *char_ptr_2;
  4603.       unsigned char    *char_ptr_3;
  4604.       unsigned char    *char_ptr_4;
  4605.       unsigned char    *char_ptr_5;
  4606.       value_header_ptr result_header_ptr;
  4607.       unsigned         length_1;
  4608.       int              length_2;
  4609.       unsigned         length_3;
  4610.  
  4611.       if (queue_head == NULL)
  4612.         {
  4613.           fatal_error=TRUE;
  4614.           result_header_ptr=NULL;
  4615.           printf(
  4616.            "Fatal error:  argument to function \"%s\" is missing on\n",
  4617.            function_name);
  4618.           printf("     line %ld, column %ld.\n",source_line_num,
  4619.            source_column_num);
  4620.         }
  4621.       else
  4622.         if ((*queue_head).next == NULL)
  4623.           {
  4624.             fatal_error=TRUE;
  4625.              result_header_ptr=NULL;
  4626.             printf(
  4627.              "Fatal error:  argument to function \"%s\" is missing on\n",
  4628.              function_name);
  4629.             printf("     line %ld, column %ld.\n",source_line_num,
  4630.              source_column_num);
  4631.           }
  4632.         else
  4633.           if ((*((*queue_head).next)).next == NULL)
  4634.             if (evaluate)
  4635.               if ((*((*queue_head).argument_header_ptr)).type == 'S')
  4636.                 if ((*((*((*queue_head).next)).argument_header_ptr)).type
  4637.                  == 'S')
  4638.                   {
  4639.                     char_ptr_1
  4640.                      =(*((*((*queue_head).argument_header_ptr)).
  4641.                      value_ptr.string)).value;
  4642.                     length_1
  4643.                      =(*((*((*queue_head).argument_header_ptr)).
  4644.                      value_ptr.string)).length;
  4645.                     char_ptr_2=(*((*((*((*queue_head).next)).
  4646.                      argument_header_ptr)).value_ptr.string)).value;
  4647.                     length_2=(*((*((*((*queue_head).next)).
  4648.                      argument_header_ptr)).value_ptr.string)).length;
  4649.                     result_header_ptr=new_string_header_ptr((unsigned)
  4650.                      (*((*((*queue_head).argument_header_ptr)).
  4651.                      value_ptr.string)).length);
  4652.                     if (! fatal_error)
  4653.                       {
  4654.                         char_ptr_5
  4655.                          =(*((*result_header_ptr).value_ptr.string)).value;
  4656.                         char_index_1=(unsigned) 1;
  4657.                         while (char_index_1 <= length_1)
  4658.                           {
  4659.                             char_index_2=(int) *char_ptr_1;
  4660.                             if (char_index_2 < length_2)
  4661.                               *char_ptr_5=*(char_ptr_2+char_index_2);
  4662.                             else
  4663.                               *char_ptr_5=(unsigned char) ' ';
  4664.                             char_index_1++;
  4665.                             char_ptr_1++;
  4666.                             char_ptr_5++;
  4667.                           }
  4668.                       }
  4669.                   }
  4670.                 else
  4671.                   {
  4672.                     fatal_error=TRUE;
  4673.                     result_header_ptr=NULL;
  4674.                     printf(
  4675.         "Fatal error:  second argument to TRANSLATE is other than a string\n");
  4676.                     printf("     on line %ld, column %ld.\n",source_line_num,
  4677.                      source_column_num);
  4678.                   }
  4679.               else
  4680.                 {
  4681.                   fatal_error=TRUE;
  4682.                   result_header_ptr=NULL;
  4683.                   printf(
  4684.          "Fatal error:  first argument to TRANSLATE is other than a string\n");
  4685.                   printf("     on line %ld, column %ld.\n",source_line_num,
  4686.                    source_column_num);
  4687.                 }
  4688.             else
  4689.               result_header_ptr=NULL;
  4690.           else
  4691.             if ((*((*((*queue_head).next)).next)).next == NULL)
  4692.               if (evaluate)
  4693.                 if ((*((*queue_head).argument_header_ptr)).type == 'S')
  4694.                   if ((*((*((*queue_head).next)).argument_header_ptr)).type
  4695.                    == 'S')
  4696.                     if ((*((*((*((*queue_head).next)).next)).
  4697.                      argument_header_ptr)).type == 'S')
  4698.                       {
  4699.                         char_ptr_1
  4700.                          =(*((*((*queue_head).argument_header_ptr)).
  4701.                          value_ptr.string)).value;
  4702.                         length_1
  4703.                          =(unsigned) (*((*((*queue_head).argument_header_ptr)).
  4704.                          value_ptr.string)).length;
  4705.                         char_ptr_2=(*((*((*((*queue_head).next)).
  4706.                          argument_header_ptr)).value_ptr.string)).value;
  4707.                         length_2=(*((*((*((*queue_head).next)).
  4708.                          argument_header_ptr)).value_ptr.string)).length;
  4709.                         char_ptr_3=(*((*((*((*((*queue_head).next)).next)).
  4710.                          argument_header_ptr)).value_ptr.string)).value;
  4711.                         length_3
  4712.                          =(unsigned) (*((*((*((*((*queue_head).next)).next)).
  4713.                          argument_header_ptr)).value_ptr.string)).length;
  4714.                         result_header_ptr=new_string_header_ptr((unsigned)
  4715.                          (*((*((*queue_head).argument_header_ptr)).
  4716.                          value_ptr.string)).length);
  4717.                         if (! fatal_error)
  4718.                           {
  4719.                             char_ptr_5
  4720.                              =(*((*result_header_ptr).value_ptr.string)).value;
  4721.                             char_index_1=(unsigned) 1;
  4722.                             while (char_index_1 <= length_1)
  4723.                               {
  4724.                                 char_index_2=0;
  4725.                                 char_ptr_4=char_ptr_3;
  4726.                                 char_index_3=1;
  4727.                                 while ((char_index_3 <= length_3)
  4728.                                 &&     (*char_ptr_4 != *char_ptr_1))
  4729.                                   {
  4730.                                     char_ptr_4++;
  4731.                                     char_index_2++;
  4732.                                     char_index_3++;
  4733.                                   }
  4734.                                 if (char_index_3 <= length_3)
  4735.                                   {
  4736.                                     if ((long) char_index_2 >= length_2)
  4737.                                       *char_ptr_5=(unsigned char) ' ';
  4738.                                     else
  4739.                                       *char_ptr_5=*(char_ptr_2+char_index_2);
  4740.                                   }
  4741.                                 else
  4742.                                   *char_ptr_5=*char_ptr_1;
  4743.                                 char_ptr_1++;
  4744.                                 char_ptr_5++;
  4745.                                 char_index_1++;
  4746.                               }
  4747.                             *char_ptr_5=(unsigned char) '\0';
  4748.                           }
  4749.                       }
  4750.                     else
  4751.                       {
  4752.                         fatal_error=TRUE;
  4753.                         result_header_ptr=NULL;
  4754.                         printf(
  4755.          "Fatal error:  third argument to TRANSLATE is other than a string\n");
  4756.                         printf("     on line %ld, column %ld.\n",
  4757.                          source_line_num,source_column_num);
  4758.                       }
  4759.                   else
  4760.                     {
  4761.                       fatal_error=TRUE;
  4762.                       result_header_ptr=NULL;
  4763.                       printf(
  4764.         "Fatal error:  second argument to TRANSLATE is other than a string\n");
  4765.                       printf("     on line %ld, column %ld.\n",source_line_num,
  4766.                        source_column_num);
  4767.                     }
  4768.                 else
  4769.                   {
  4770.                     fatal_error=TRUE;
  4771.                     result_header_ptr=NULL;
  4772.                     printf(
  4773.          "Fatal error:  first argument to TRANSLATE is other than a string\n");
  4774.                     printf("     on line %ld, column %ld.\n",source_line_num,
  4775.                      source_column_num);
  4776.                   }
  4777.               else
  4778.                 result_header_ptr=NULL;
  4779.             else
  4780.               {
  4781.                 fatal_error=TRUE;
  4782.                 result_header_ptr=NULL;
  4783.                 printf(
  4784.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4785.                  function_name);
  4786.                 printf("     line %ld, column %ld.\n",source_line_num,
  4787.                  source_column_num);
  4788.               }
  4789.       return(result_header_ptr);
  4790.     }
  4791.  
  4792. static value_header_ptr true_header_ptr(queue_head,function_name,evaluate)
  4793.   queue_node_ptr queue_head;
  4794.   char           *function_name;
  4795.   int            evaluate;
  4796.     {
  4797.       value_header_ptr result_header_ptr;
  4798.  
  4799.       if (queue_head != NULL)
  4800.         {
  4801.           fatal_error=TRUE;
  4802.           result_header_ptr=NULL;
  4803.           printf(
  4804.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4805.            function_name);
  4806.           printf("     line %ld, column %ld.\n",source_line_num,
  4807.            source_column_num);
  4808.         }
  4809.       else
  4810.         if (evaluate)
  4811.           {
  4812.             result_header_ptr=new_boolean_header_ptr();
  4813.             if (! fatal_error)
  4814.               *((*result_header_ptr).value_ptr.boolean)=TRUE;
  4815.           }
  4816.         else
  4817.           result_header_ptr=NULL;
  4818.       return(result_header_ptr);
  4819.     }
  4820.  
  4821. static value_header_ptr trunc_header_ptr(queue_head,function_name,evaluate)
  4822.   queue_node_ptr queue_head;
  4823.   char           *function_name;
  4824.   int            evaluate;
  4825.     {
  4826.       value_header_ptr result_header_ptr;
  4827.       int              status;
  4828.       double           tem_real_1;
  4829.       double           tem_real_2;
  4830.  
  4831.       if (queue_head == NULL)
  4832.         {
  4833.           fatal_error=TRUE;
  4834.           result_header_ptr=NULL;
  4835.           printf(
  4836.           "Fatal error:  argument to function \"%s\" is missing on\n",
  4837.            function_name);
  4838.           printf("     line %ld, column %ld.\n",source_line_num,
  4839.            source_column_num);
  4840.         }
  4841.       else
  4842.         if ((*queue_head).next == NULL)
  4843.           if (evaluate)
  4844.             if ((*((*queue_head).argument_header_ptr)).type == 'I')
  4845.               {
  4846.                 result_header_ptr=new_integer_header_ptr();
  4847.                 if (! fatal_error)
  4848.                   *((*result_header_ptr).value_ptr.integer)
  4849.                    =*((*((*queue_head).argument_header_ptr)).
  4850.                    value_ptr.integer);
  4851.               }
  4852.             else
  4853.               if ((*((*queue_head).argument_header_ptr)).type == 'R')
  4854.                 {
  4855.                   tem_real_1=*((*((*queue_head).argument_header_ptr)).
  4856.                    value_ptr.real);
  4857.                   if (tem_real_1 == 0.0)
  4858.                     {
  4859.                       result_header_ptr=new_integer_header_ptr();
  4860.                       if (! fatal_error)
  4861.                         *((*result_header_ptr).value_ptr.integer)=(long) 0;
  4862.                     }
  4863.                   else
  4864.                     {
  4865.                       tem_real_2=log(fabs(tem_real_1))/log(2.0);
  4866.                       if (tem_real_2 >= 31.0)
  4867.                         {
  4868.                           fatal_error=TRUE;
  4869.                           result_header_ptr=NULL;
  4870.                           printf(
  4871.                    "Fatal error:  magnitude of argument to TRUNC too large\n");
  4872.                           printf("     on line %ld, column %ld.\n",
  4873.                            source_line_num,source_column_num);
  4874.                         }
  4875.                       else
  4876.                         {
  4877.                           result_header_ptr=new_integer_header_ptr();
  4878.                           if (! fatal_error)
  4879.                             *((*result_header_ptr).value_ptr.integer)
  4880.                              =(long) tem_real_1;
  4881.                         }
  4882.                     }
  4883.                 }
  4884.               else
  4885.                 if ((*((*queue_head).argument_header_ptr)).type == 'B')
  4886.                   {
  4887.                     result_header_ptr=new_integer_header_ptr();
  4888.                     if (! fatal_error)
  4889.                       {
  4890.                         if (*((*((*queue_head).argument_header_ptr)).
  4891.                          value_ptr.boolean))
  4892.                           *((*result_header_ptr).value_ptr.integer)=1;
  4893.                         else
  4894.                           *((*result_header_ptr).value_ptr.integer)=0;
  4895.                       }
  4896.                   }
  4897.                 else
  4898.                   if ((*((*queue_head).argument_header_ptr)).type == 'S')
  4899.                     {
  4900.                       result_header_ptr=new_integer_header_ptr();
  4901.                       if (! fatal_error)
  4902.                         {
  4903.                           status=sscanf((char *)
  4904.                            (*((*((*queue_head).argument_header_ptr)).
  4905.                            value_ptr.string)).value,"%I",
  4906.                            (*result_header_ptr).value_ptr.integer);
  4907.                           if ((status == EOF) || (status == 0))
  4908.                             {
  4909.                               fatal_error=TRUE;
  4910.                               free_value(result_header_ptr);
  4911.                               result_header_ptr=NULL;
  4912.                               printf(
  4913.                    "Fatal error:  argument to TRUNC cannot be converted on\n");
  4914.                               printf("     line %ld, column %ld.\n",
  4915.                                source_line_num,source_column_num);
  4916.                             }
  4917.                         }
  4918.                     }
  4919.                   else
  4920.                     {
  4921.                       fatal_error=TRUE;
  4922.                       result_header_ptr=NULL;
  4923.                       printf(
  4924.  "Fatal error:  argument to TRUNC is other than Boolean, number, or string\n");
  4925.                       printf("     on line %ld, column %ld.\n",
  4926.                        source_line_num,source_column_num);
  4927.                     }
  4928.           else
  4929.             result_header_ptr=NULL;
  4930.         else
  4931.           {
  4932.             fatal_error=TRUE;
  4933.             result_header_ptr=NULL;
  4934.             printf(
  4935.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  4936.              function_name);
  4937.             printf("     line %ld, column %ld.\n",source_line_num,
  4938.              source_column_num);
  4939.           }
  4940.       return(result_header_ptr);
  4941.     }
  4942.  
  4943. static value_header_ptr upper_header_ptr(queue_head,function_name,evaluate)
  4944.   queue_node_ptr queue_head;
  4945.   char           *function_name;
  4946.   int            evaluate;
  4947.     {
  4948.       register int     char_index;
  4949.       unsigned char    *char_ptr;
  4950.       value_header_ptr result_header_ptr;
  4951.       int              string_length;
  4952.  
  4953.       if (queue_head == NULL)
  4954.         {
  4955.           fatal_error=TRUE;
  4956.           result_header_ptr=NULL;
  4957.           printf(
  4958.           "Fatal error:  argument to function \"%s\" is missing on\n",
  4959.            function_name);
  4960.           printf("     line %ld, column %ld.\n",source_line_num,
  4961.            source_column_num);
  4962.         }
  4963.       else
  4964.         if ((*queue_head).next == NULL)
  4965.           if (evaluate)
  4966.             if ((*((*queue_head).argument_header_ptr)).type == 'S')
  4967.               {
  4968.                 result_header_ptr=new_string_header_ptr((unsigned)
  4969.                  (*((*((*queue_head).argument_header_ptr)).value_ptr.string)).
  4970.                  length);
  4971.                 if (! fatal_error)
  4972.                   {
  4973.                     pli_strcpy((*result_header_ptr).value_ptr.string,
  4974.                      (*((*queue_head).argument_header_ptr)).value_ptr.string);
  4975.                     char_ptr=(*((*result_header_ptr).value_ptr.string)).value;
  4976.                     string_length
  4977.                      =(*((*result_header_ptr).value_ptr.string)).length;
  4978.                     for (char_index=0; char_index < string_length;
  4979.                      char_index++)
  4980.                       {
  4981.                         *char_ptr=(unsigned char) toupper((int) *char_ptr);
  4982.                         char_ptr++;
  4983.                       }
  4984.                   }
  4985.               }
  4986.             else
  4987.               {
  4988.                 fatal_error=TRUE;
  4989.                 result_header_ptr=NULL;
  4990.                 printf(
  4991.                  "Fatal error:  argument to UPPER is other than a string\n");
  4992.                 printf("     on line %ld, column %ld.\n",source_line_num,
  4993.                  source_column_num);
  4994.               }
  4995.           else
  4996.             result_header_ptr=NULL;
  4997.         else
  4998.           {
  4999.             fatal_error=TRUE;
  5000.             result_header_ptr=NULL;
  5001.             printf(
  5002.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  5003.              function_name);
  5004.             printf("     line %ld, column %ld.\n",source_line_num,
  5005.              source_column_num);
  5006.           }
  5007.       return(result_header_ptr);
  5008.     }
  5009.  
  5010. static value_header_ptr verify_header_ptr(queue_head,function_name,evaluate)
  5011.   queue_node_ptr queue_head;
  5012.   char           *function_name;
  5013.   int            evaluate;
  5014.     {
  5015.       long             char_index;
  5016.       int              char_okay;
  5017.       unsigned char    *char_ptr;
  5018.       value_header_ptr result_header_ptr;
  5019.       unsigned         rule_index;
  5020.       unsigned         rule_length;
  5021.       unsigned char    *rule_ptr;
  5022.       long             string_length;
  5023.  
  5024.       if (queue_head == NULL)
  5025.         {
  5026.           fatal_error=TRUE;
  5027.           result_header_ptr=NULL;
  5028.           printf(
  5029.           "Fatal error:  argument to function \"%s\" is missing on\n",
  5030.            function_name);
  5031.           printf("     line %ld, column %ld.\n",source_line_num,
  5032.            source_column_num);
  5033.         }
  5034.       else
  5035.         if ((*queue_head).next == NULL)
  5036.           {
  5037.             fatal_error=TRUE;
  5038.             result_header_ptr=NULL;
  5039.             printf(
  5040.              "Fatal error:  argument to function \"%s\" is missing on\n",
  5041.              function_name);
  5042.             printf("     line %ld, column %ld.\n",source_line_num,
  5043.              source_column_num);
  5044.           }
  5045.         else
  5046.           if ((*((*queue_head).next)).next == NULL)
  5047.             if (evaluate)
  5048.               if ((*((*queue_head).argument_header_ptr)).type == 'S')
  5049.                 if ((*((*((*queue_head).next)).argument_header_ptr)).type
  5050.                  == 'S')
  5051.                   {
  5052.                     result_header_ptr=new_integer_header_ptr();
  5053.                     if (! fatal_error)
  5054.                       {
  5055.                         char_ptr=(*((*((*queue_head).argument_header_ptr)).
  5056.                          value_ptr.string)).value;
  5057.                         string_length
  5058.                          =(long) (*((*((*queue_head).argument_header_ptr)).
  5059.                          value_ptr.string)).length;
  5060.                         char_index=(long) 1;
  5061.                         char_okay=TRUE;
  5062.                         while ((char_index <= string_length)
  5063.                         &&     (char_okay))
  5064.                           {
  5065.                             char_okay=FALSE;
  5066.                             rule_ptr
  5067.                              =(*((*((*((*queue_head).next)).
  5068.                              argument_header_ptr)).value_ptr.string)).value;
  5069.                             rule_length
  5070.                              =(unsigned) (*((*((*((*queue_head).next)).
  5071.                              argument_header_ptr)).value_ptr.string)).length;
  5072.                             rule_index=(unsigned) 1;
  5073.                             while ((! char_okay)
  5074.                             &&     (rule_index <= rule_length))
  5075.                               if (*rule_ptr == *char_ptr)
  5076.                                 char_okay=TRUE;
  5077.                               else
  5078.                                 {
  5079.                                   rule_ptr++;
  5080.                                   rule_index++;
  5081.                                 }
  5082.                             if (char_okay)
  5083.                               {
  5084.                                 char_ptr++;
  5085.                                 char_index++;
  5086.                               }
  5087.                           }
  5088.                         if (char_okay)
  5089.                           *((*result_header_ptr).value_ptr.integer)=(long) 0;
  5090.                         else
  5091.                           *((*result_header_ptr).value_ptr.integer)
  5092.                            =char_index;
  5093.                       }
  5094.                   }
  5095.                 else
  5096.                   {
  5097.                     fatal_error=TRUE;
  5098.                     result_header_ptr=NULL;
  5099.                     printf(
  5100.            "Fatal error:  second argument to VERIFY is other than a string\n");
  5101.                     printf("     on line %ld, column %ld.\n",source_line_num,
  5102.                      source_column_num);
  5103.                   }
  5104.               else
  5105.                 {
  5106.                   fatal_error=TRUE;
  5107.                   result_header_ptr=NULL;
  5108.                   printf(
  5109.             "Fatal error:  first argument to VERIFY is other than a string\n");
  5110.                   printf("     on line %ld, column %ld.\n",source_line_num,
  5111.                    source_column_num);
  5112.                 }
  5113.             else
  5114.               result_header_ptr=NULL;
  5115.           else
  5116.             {
  5117.               fatal_error=TRUE;
  5118.               result_header_ptr=NULL;
  5119.               printf(
  5120.           "Fatal error:  extraneous argument supplied to function \"%s\" on\n",
  5121.                function_name);
  5122.               printf("     line %ld, column %ld.\n",source_line_num,
  5123.                source_column_num);
  5124.             }
  5125.       return(result_header_ptr);
  5126.     }
  5127.  
  5128. static value_header_ptr function_header_ptr(evaluate)
  5129.   int evaluate;
  5130.     {
  5131.       queue_node_ptr   new_queue_head;
  5132.       queue_node_ptr   new_queue_tail;
  5133.       queue_node_ptr   queue_head;
  5134.       queue_node_ptr   queue_tail;
  5135.       value_header_ptr result_header_ptr;
  5136.       char             function_name [256];
  5137.  
  5138.       get_token();
  5139.       strcpy(function_name,source_token);
  5140.       queue_head=NULL;
  5141.       queue_tail=NULL;
  5142.       if (source_char == '(')
  5143.         {
  5144.           get_token();
  5145.           if ((queue_head=(queue_node_ptr)
  5146.            malloc((unsigned) sizeof(struct queue_node)))
  5147.            == NULL)
  5148.             {
  5149.               fatal_error=TRUE;
  5150.               result_header_ptr=NULL;
  5151.               printf("Fatal error:  out of memory at line %ld, column %ld.\n",
  5152.                source_line_num,source_column_num);
  5153.             }
  5154.           else
  5155.             {
  5156.               queue_tail=queue_head;
  5157.               (*queue_head).next=NULL;
  5158.               (*queue_head).argument_header_ptr
  5159.                =interpret_expression(evaluate);
  5160.             }
  5161.           if (! fatal_error)
  5162.             get_token();
  5163.           while ((! fatal_error)
  5164.           &&     (! source_eof)
  5165.           &&     (source_token[0] != ')'))
  5166.             {
  5167.               if ((new_queue_tail=(queue_node_ptr)
  5168.                malloc((unsigned) sizeof(struct queue_node)))
  5169.                == NULL)
  5170.                 {
  5171.                   fatal_error=TRUE;
  5172.                   result_header_ptr=NULL;
  5173.                   printf(
  5174.                    "Fatal error:  out of memory at line %ld, column %ld.\n",
  5175.                    source_line_num,source_column_num);
  5176.                 }
  5177.               else
  5178.                 {
  5179.                   (*new_queue_tail).next=NULL;
  5180.                   (*queue_tail).next=new_queue_tail;
  5181.                   queue_tail=new_queue_tail;
  5182.                   (*new_queue_tail).argument_header_ptr
  5183.                    =interpret_expression(evaluate);
  5184.                 }
  5185.               if (! fatal_error)
  5186.                 get_token();
  5187.             }
  5188.           if (! fatal_error)
  5189.             {
  5190.               if (source_token[0] != ')')
  5191.                 {
  5192.                   fatal_error=TRUE;
  5193.                   result_header_ptr=NULL;
  5194.                   printf(
  5195.    "Fatal error:  file ends before arguments to function \"%s\" completed.\n",
  5196.                    function_name);
  5197.                 }
  5198.             }
  5199.         }
  5200.       if (! fatal_error)
  5201.         {
  5202.           result_header_ptr
  5203.            =variable_header_ptr(function_name,evaluate,queue_head);
  5204.           if (! fatal_error)
  5205.             {
  5206.               if (result_header_ptr == NULL)
  5207.                 {
  5208.                   if      (strcmp(function_name,"ABS") == 0)
  5209.                     result_header_ptr
  5210.                      =abs_header_ptr(queue_head,function_name,evaluate);
  5211.                   else if (strcmp(function_name,"ATAN") == 0)
  5212.                     result_header_ptr
  5213.                      =atan_header_ptr(queue_head,function_name,evaluate);
  5214.                   else if (strcmp(function_name,"CHAR") == 0)
  5215.                     result_header_ptr
  5216.                      =char_header_ptr(queue_head,function_name,evaluate);
  5217.                   else if (strcmp(function_name,"COS") == 0)
  5218.                     result_header_ptr
  5219.                      =cos_header_ptr(queue_head,function_name,evaluate);
  5220.                   else if (strcmp(function_name,"DATE") == 0)
  5221.                     result_header_ptr
  5222.                      =date_header_ptr(queue_head,function_name,evaluate);
  5223.                   else if (strcmp(function_name,"ENDFILE") == 0)
  5224.                     result_header_ptr
  5225.                      =endfile_header_ptr(queue_head,function_name,evaluate);
  5226.                   else if (strcmp(function_name,"EXEC") == 0)
  5227.                     result_header_ptr
  5228.                      =exec_header_ptr(queue_head,function_name,evaluate);
  5229.                   else if (strcmp(function_name,"EXP") == 0)
  5230.                     result_header_ptr
  5231.                      =exp_header_ptr(queue_head,function_name,evaluate);
  5232.                   else if (strcmp(function_name,"FALSE") == 0)
  5233.                     result_header_ptr
  5234.                      =false_header_ptr(queue_head,function_name,evaluate);
  5235.                   else if (strcmp(function_name,"FLOAT") == 0)
  5236.                     result_header_ptr
  5237.                      =float_header_ptr(queue_head,function_name,evaluate);
  5238.                   else if (strcmp(function_name,"GETCHAR") == 0)
  5239.                     result_header_ptr
  5240.                      =getchar_header_ptr(queue_head,function_name,evaluate);
  5241.                   else if (strcmp(function_name,"GETINT") == 0)
  5242.                     result_header_ptr
  5243.                      =getint_header_ptr(queue_head,function_name,evaluate);
  5244.                   else if (strcmp(function_name,"GETREAL") == 0)
  5245.                     result_header_ptr
  5246.                      =getreal_header_ptr(queue_head,function_name,evaluate);
  5247.                   else if (strcmp(function_name,"GETSTRING") == 0)
  5248.                     result_header_ptr
  5249.                      =getstring_header_ptr(queue_head,function_name,evaluate);
  5250.                   else if (strcmp(function_name,"INDEX") == 0)
  5251.                     result_header_ptr
  5252.                      =index_header_ptr(queue_head,function_name,evaluate);
  5253.                   else if (strcmp(function_name,"LENGTH") == 0)
  5254.                     result_header_ptr
  5255.                      =length_header_ptr(queue_head,function_name,evaluate);
  5256.                   else if (strcmp(function_name,"LINENO") == 0)
  5257.                     result_header_ptr
  5258.                      =lineno_header_ptr(queue_head,function_name,evaluate);
  5259.                   else if (strcmp(function_name,"LOG") == 0)
  5260.                     result_header_ptr
  5261.                      =log_header_ptr(queue_head,function_name,evaluate);
  5262.                   else if (strcmp(function_name,"MOD") == 0)
  5263.                     result_header_ptr
  5264.                      =mod_header_ptr(queue_head,function_name,evaluate);
  5265.                   else if (strcmp(function_name,"OPEN") == 0)
  5266.                     result_header_ptr
  5267.                      =open_header_ptr(queue_head,function_name,evaluate);
  5268.                   else if (strcmp(function_name,"ORD") == 0)
  5269.                     result_header_ptr
  5270.                      =ord_header_ptr(queue_head,function_name,evaluate);
  5271.                   else if (strcmp(function_name,"PI") == 0)
  5272.                     result_header_ptr
  5273.                      =pi_header_ptr(queue_head,function_name,evaluate);
  5274.                   else if (strcmp(function_name,"REPEAT") == 0)
  5275.                     result_header_ptr
  5276.                      =repeat_header_ptr(queue_head,function_name,evaluate);
  5277.                   else if (strcmp(function_name,"SIN") == 0)
  5278.                     result_header_ptr
  5279.                      =sin_header_ptr(queue_head,function_name,evaluate);
  5280.                   else if (strcmp(function_name,"SQR") == 0)
  5281.                     result_header_ptr
  5282.                      =sqr_header_ptr(queue_head,function_name,evaluate);
  5283.                   else if (strcmp(function_name,"SQRT") == 0)
  5284.                     result_header_ptr
  5285.                      =sqrt_header_ptr(queue_head,function_name,evaluate);
  5286.                   else if (strcmp(function_name,"STR") == 0)
  5287.                     result_header_ptr
  5288.                      =str_header_ptr(queue_head,function_name,evaluate);
  5289.                   else if (strcmp(function_name,"SUBSTR") == 0)
  5290.                     result_header_ptr
  5291.                      =substr_header_ptr(queue_head,function_name,evaluate);
  5292.                   else if (strcmp(function_name,"SYSIN") == 0)
  5293.                     result_header_ptr
  5294.                      =sysin_header_ptr(queue_head,function_name,evaluate);
  5295.                   else if (strcmp(function_name,"SYSPRINT") == 0)
  5296.                     result_header_ptr
  5297.                      =sysprint_header_ptr(queue_head,function_name,evaluate);
  5298.                   else if (strcmp(function_name,"TIME") == 0)
  5299.                     result_header_ptr
  5300.                      =time_header_ptr(queue_head,function_name,evaluate);
  5301.                   else if (strcmp(function_name,"TRANSLATE") == 0)
  5302.                     result_header_ptr
  5303.                      =translate_header_ptr(queue_head,function_name,evaluate);
  5304.                   else if (strcmp(function_name,"TRUE") == 0)
  5305.                     result_header_ptr
  5306.                      =true_header_ptr(queue_head,function_name,evaluate);
  5307.                   else if (strcmp(function_name,"TRUNC") == 0)
  5308.                     result_header_ptr
  5309.                      =trunc_header_ptr(queue_head,function_name,evaluate);
  5310.                   else if (strcmp(function_name,"UPPER") == 0)
  5311.                     result_header_ptr
  5312.                      =upper_header_ptr(queue_head,function_name,evaluate);
  5313.                   else if (strcmp(function_name,"VERIFY") == 0)
  5314.                     result_header_ptr
  5315.                      =verify_header_ptr(queue_head,function_name,evaluate);
  5316.                   else
  5317.                     {
  5318.                       if (evaluate)
  5319.                         {
  5320.                           fatal_error=TRUE;
  5321.                           printf(
  5322.                  "Fatal error:  the function \"%s\" on line %ld, column %ld\n",
  5323.                            function_name,source_line_num,source_column_num);
  5324.                           printf("     is unknown.\n");
  5325.                         }
  5326.                     }
  5327.                }
  5328.             }
  5329.         }
  5330.       while (queue_head != NULL)
  5331.         {
  5332.           new_queue_head=(*queue_head).next;
  5333.           free_value((*queue_head).argument_header_ptr);
  5334.           free((char *) queue_head);
  5335.           queue_head=new_queue_head;
  5336.         }
  5337.       return(result_header_ptr);
  5338.     }
  5339.  
  5340. static value_header_ptr factor_header_ptr(evaluate)
  5341.   int evaluate;
  5342.     {
  5343.       value_header_ptr result_header_ptr;
  5344.  
  5345.       while ((source_char == ' ')
  5346.       &&     (! source_eof))
  5347.         get_source_char();
  5348.       if (source_eof)
  5349.         {
  5350.           fatal_error=TRUE;
  5351.           result_header_ptr=NULL;
  5352.           printf(
  5353.            "Fatal error:  end of file encountered where factor expected.\n");
  5354.         }
  5355.       else
  5356.         {
  5357.           switch (source_char)
  5358.             {
  5359.               case '(':
  5360.                 get_source_char();
  5361.                 result_header_ptr=interpret_expression(evaluate);
  5362.                 if (! fatal_error)
  5363.                   {
  5364.                     while ((source_char == ' ')
  5365.                     &&     (! source_eof))
  5366.                       get_source_char();
  5367.                     if (source_eof)
  5368.                       {
  5369.                         fatal_error=TRUE;
  5370.                         free_value(result_header_ptr);
  5371.                         result_header_ptr=NULL;
  5372.                         printf(
  5373.               "Fatal error:  end of file encountered where \"(\" expected.\n");
  5374.                       }
  5375.                     else
  5376.                       if (source_char == ')')
  5377.                         get_source_char();
  5378.                       else
  5379.                         {
  5380.                           fatal_error=TRUE;
  5381.                           free_value(result_header_ptr);
  5382.                           result_header_ptr=NULL;
  5383.                           printf(
  5384.    "Fatal error:  expression not followed by \"(\" on line %ld, column %ld.\n",
  5385.                            source_line_num,source_column_num);
  5386.                         }
  5387.                   }
  5388.                 break;
  5389.               case '!':
  5390.                 get_source_char();
  5391.                 result_header_ptr=factor_header_ptr(evaluate);
  5392.                 if (! fatal_error)
  5393.                   {
  5394.                     if (evaluate)
  5395.                       if ((*result_header_ptr).type == 'B')
  5396.                         *((*result_header_ptr).value_ptr.boolean)
  5397.                          =! (*((*result_header_ptr).value_ptr.boolean));
  5398.                       else
  5399.                         {
  5400.                           fatal_error=TRUE;
  5401.                           free_value(result_header_ptr);
  5402.                           result_header_ptr=NULL;
  5403.                           printf(
  5404.        "Fatal error:  other than a boolean negated at line %ld, column %ld.\n",
  5405.                            source_line_num,source_column_num);
  5406.                         }
  5407.                     else
  5408.                       result_header_ptr=NULL;
  5409.                   }
  5410.                 break;
  5411.               case '\'':
  5412.                 result_header_ptr=string_header_ptr(evaluate);
  5413.                 break;
  5414.               case '0':
  5415.               case '1':
  5416.               case '2':
  5417.               case '3':
  5418.               case '4':
  5419.               case '5':
  5420.               case '6':
  5421.               case '7':
  5422.               case '8':
  5423.               case '9':
  5424.                 result_header_ptr=unsigned_number_header_ptr(evaluate);
  5425.                 break;
  5426.               default:
  5427.                result_header_ptr=function_header_ptr(evaluate);
  5428.                break;
  5429.             }
  5430.         }
  5431.       return(result_header_ptr);
  5432.     }
  5433.  
  5434. static value_header_ptr and_factors(left_header_ptr,right_header_ptr)
  5435.   value_header_ptr left_header_ptr;
  5436.   value_header_ptr right_header_ptr;
  5437.     {
  5438.       value_header_ptr result_header_ptr;
  5439.  
  5440.       if (((*left_header_ptr).type == 'B')
  5441.       &&  ((*right_header_ptr).type == 'B'))
  5442.         {
  5443.           result_header_ptr=new_boolean_header_ptr();
  5444.           if (! fatal_error)
  5445.             *((*result_header_ptr).value_ptr.boolean)
  5446.              =(*((*left_header_ptr).value_ptr.boolean))
  5447.              && (*((*right_header_ptr).value_ptr.boolean));
  5448.         }
  5449.       else
  5450.         {
  5451.           fatal_error=TRUE;
  5452.           result_header_ptr=NULL;
  5453.           printf(
  5454.            "Fatal error:  attempt to \"and\" other than two booleans\n");
  5455.           printf(
  5456.            "at line %ld, column %ld.\n",source_line_num,source_column_num);
  5457.         }
  5458.       return(result_header_ptr);
  5459.     }
  5460.  
  5461. static value_header_ptr divide_factors(left_header_ptr,right_header_ptr)
  5462.   value_header_ptr left_header_ptr;
  5463.   value_header_ptr right_header_ptr;
  5464.     {
  5465.       double           left_value;
  5466.       value_header_ptr result_header_ptr;
  5467.       double           right_value;
  5468.       double           tem_real;
  5469.  
  5470.       if (((*left_header_ptr).type == 'I')
  5471.       &&  ((*right_header_ptr).type == 'I'))
  5472.         {
  5473.           if (*((*right_header_ptr).value_ptr.integer) == (long) 0)
  5474.             {
  5475.               fatal_error=TRUE;
  5476.               result_header_ptr=NULL;
  5477.               printf(
  5478.          "Fatal error:  division by zero attempted at line %ld, column %ld.\n",
  5479.                source_line_num,source_column_num);
  5480.             }
  5481.           else
  5482.             {
  5483.               result_header_ptr=new_integer_header_ptr();
  5484.               if (! fatal_error)
  5485.                 {
  5486.                   *((*result_header_ptr).value_ptr.integer)
  5487.                    =(*((*left_header_ptr).value_ptr.integer))
  5488.                    /(*((*right_header_ptr).value_ptr.integer));
  5489.                 }
  5490.             }
  5491.         }
  5492.       else
  5493.         if (((*left_header_ptr).type == 'R')
  5494.         &&  ((*right_header_ptr).type == 'R'))
  5495.           {
  5496.             if (*((*right_header_ptr).value_ptr.real) == 0.0)
  5497.               {
  5498.                 fatal_error=TRUE;
  5499.                 result_header_ptr=NULL;
  5500.                 printf(
  5501.          "Fatal error:  division by zero attempted at line %ld, column %ld.\n",
  5502.                  source_line_num,source_column_num);
  5503.               }
  5504.             else
  5505.               {
  5506.                 result_header_ptr=new_real_header_ptr();
  5507.                 if (! fatal_error)
  5508.                   {
  5509.                     left_value=*((*left_header_ptr).value_ptr.real);
  5510.                     right_value=*((*right_header_ptr).value_ptr.real);
  5511.                     if (left_value == 0.0)
  5512.                       tem_real=0.0;
  5513.                     else
  5514.                       tem_real
  5515.                        =(log(fabs(left_value))-log(fabs(right_value)))
  5516.                        /log(10.0);
  5517.                     if (tem_real < -37.0)
  5518.                       *((*result_header_ptr).value_ptr.real)=0.0;
  5519.                     else
  5520.                       if (tem_real > 37.0)
  5521.                         {
  5522.                           fatal_error=TRUE;
  5523.                           free_value(result_header_ptr);
  5524.                           result_header_ptr=NULL;
  5525.                           printf(
  5526.       "Fatal error:  overflow detected in division at line %ld, column %ld.\n",
  5527.                            source_line_num,source_column_num);
  5528.                         }
  5529.                       else
  5530.                         *((*result_header_ptr).value_ptr.real)
  5531.                          =left_value/right_value;
  5532.                   }
  5533.               }
  5534.           }
  5535.         else
  5536.           if (((*left_header_ptr).type == 'I')
  5537.           &&  ((*right_header_ptr).type == 'R'))
  5538.             {
  5539.               if (*((*right_header_ptr).value_ptr.real) == 0.0)
  5540.                 {
  5541.                   fatal_error=TRUE;
  5542.                   result_header_ptr=NULL;
  5543.                   printf(
  5544.          "Fatal error:  division by zero attempted at line %ld, column %ld.\n",
  5545.                    source_line_num,source_column_num);
  5546.                 }
  5547.               else
  5548.                 {
  5549.                   result_header_ptr=new_real_header_ptr();
  5550.                   if (! fatal_error)
  5551.                     {
  5552.                       left_value
  5553.                        =(float) *((*left_header_ptr).value_ptr.integer);
  5554.                       right_value=*((*right_header_ptr).value_ptr.real);
  5555.                       if (left_value == 0.0)
  5556.                         tem_real=0.0;
  5557.                       else
  5558.                         tem_real
  5559.                          =(log(fabs(left_value))-log(fabs(right_value)))
  5560.                          /log(10.0);
  5561.                       if (tem_real < -37.0)
  5562.                         *((*result_header_ptr).value_ptr.real)=0.0;
  5563.                       else
  5564.                         if (tem_real > 37.0)
  5565.                           {
  5566.                             fatal_error=TRUE;
  5567.                             free_value(result_header_ptr);
  5568.                             result_header_ptr=NULL;
  5569.                             printf(
  5570.       "Fatal error:  overflow detected in division at line %ld, column %ld.\n",
  5571.                              source_line_num,source_column_num);
  5572.                           }
  5573.                         else
  5574.                           *((*result_header_ptr).value_ptr.real)
  5575.                            =left_value/right_value;
  5576.                     }
  5577.                 }
  5578.             }
  5579.           else
  5580.             if (((*left_header_ptr).type == 'R')
  5581.             &&  ((*right_header_ptr).type == 'I'))
  5582.               {
  5583.                 if (*((*right_header_ptr).value_ptr.integer) == 0)
  5584.                   {
  5585.                     fatal_error=TRUE;
  5586.                     result_header_ptr=NULL;
  5587.                     printf(
  5588.          "Fatal error:  division by zero attempted at line %ld, column %ld.\n",
  5589.                      source_line_num,source_column_num);
  5590.                   }
  5591.                 else
  5592.                   {
  5593.                     result_header_ptr=new_real_header_ptr();
  5594.                     if (! fatal_error)
  5595.                       {
  5596.                         left_value=*((*left_header_ptr).value_ptr.real);
  5597.                         right_value
  5598.                          =(float) *((*right_header_ptr).value_ptr.integer);
  5599.                         if (left_value == 0.0)
  5600.                           tem_real=0.0;
  5601.                         else
  5602.                           tem_real
  5603.                            =(log(fabs(left_value))-log(fabs(right_value)))
  5604.                            /log(10.0);
  5605.                         if (tem_real < -37.0)
  5606.                           *((*result_header_ptr).value_ptr.real)=0.0;
  5607.                         else
  5608.                           if (tem_real > 37.0)
  5609.                             {
  5610.                               fatal_error=TRUE;
  5611.                               free_value(result_header_ptr);
  5612.                               result_header_ptr=NULL;
  5613.                               printf(
  5614.       "Fatal error:  overflow detected in division at line %ld, column %ld.\n",
  5615.                                source_line_num,source_column_num);
  5616.                             }
  5617.                           else
  5618.                             *((*result_header_ptr).value_ptr.real)
  5619.                              =left_value/right_value;
  5620.                       }
  5621.                   }
  5622.               }
  5623.             else
  5624.               {
  5625.                 fatal_error=TRUE;
  5626.                 result_header_ptr=NULL;
  5627.                 printf(
  5628.                 "Fatal error:  attempt to divide other than two numbers at\n");
  5629.                 printf(
  5630.                  "line %ld, column %ld.\n",source_line_num,source_column_num);
  5631.               }
  5632.       return(result_header_ptr);
  5633.     }
  5634.  
  5635. static value_header_ptr multiply_factors(left_header_ptr,right_header_ptr)
  5636.   value_header_ptr left_header_ptr;
  5637.   value_header_ptr right_header_ptr;
  5638.     {
  5639.       long             left_integer_value;
  5640.       double           left_real_value;
  5641.       value_header_ptr result_header_ptr;
  5642.       long             right_integer_value;
  5643.       double           right_real_value;
  5644.       double           tem_real;
  5645.  
  5646.       if (((*left_header_ptr).type == 'I')
  5647.       &&  ((*right_header_ptr).type == 'I'))
  5648.         {
  5649.           result_header_ptr=new_integer_header_ptr();
  5650.           if (! fatal_error)
  5651.             {
  5652.               left_integer_value=*((*left_header_ptr).value_ptr.integer);
  5653.               right_integer_value=*((*right_header_ptr).value_ptr.integer);
  5654.               if ((left_integer_value == 0) || (right_integer_value == 0))
  5655.                 tem_real=0.0;
  5656.               else
  5657.                 {
  5658.                   left_real_value=(float) left_integer_value;
  5659.                   right_real_value=(float) right_integer_value;
  5660.                   tem_real
  5661.                    =(log(fabs(left_real_value))+log(fabs(right_real_value)))
  5662.                    /log(2.0);
  5663.                 }
  5664.               if (tem_real >= 31.0)
  5665.                 {
  5666.                   fatal_error=TRUE;
  5667.                   free_value(result_header_ptr);
  5668.                   result_header_ptr=NULL;
  5669.                   printf(
  5670. "Fatal error:  overflow detected in multiplication at line %ld, column %ld.\n",
  5671.                    source_line_num,source_column_num);
  5672.                 }
  5673.               else
  5674.                 *((*result_header_ptr).value_ptr.integer)
  5675.                  =left_integer_value*right_integer_value;
  5676.             }
  5677.         }
  5678.       else
  5679.         if (((*left_header_ptr).type == 'R')
  5680.         &&  ((*right_header_ptr).type == 'R'))
  5681.           {
  5682.             result_header_ptr=new_real_header_ptr();
  5683.             if (! fatal_error)
  5684.               {
  5685.                 left_real_value=*((*left_header_ptr).value_ptr.real);
  5686.                 right_real_value=*((*right_header_ptr).value_ptr.real);
  5687.                 if ((left_real_value == 0.0) || (right_real_value == 0.0))
  5688.                   tem_real=0.0;
  5689.                 else
  5690.                   tem_real
  5691.                    =(log(fabs(left_real_value))+log(fabs(right_real_value)))
  5692.                    /log(10.0);
  5693.                 if (tem_real < -37.0)
  5694.                   *((*result_header_ptr).value_ptr.real)=0.0;
  5695.                 else
  5696.                   if (tem_real > 37.0)
  5697.                     {
  5698.                       fatal_error=TRUE;
  5699.                       free_value(result_header_ptr);
  5700.                       result_header_ptr=NULL;
  5701.                       printf(
  5702. "Fatal error:  overflow detected in multiplication at line %ld, column %ld.\n",
  5703.                        source_line_num,source_column_num);
  5704.                     }
  5705.                   else
  5706.                     *((*result_header_ptr).value_ptr.real)
  5707.                      =left_real_value*right_real_value;
  5708.               }
  5709.           }
  5710.         else
  5711.           if (((*left_header_ptr).type == 'I')
  5712.           &&  ((*right_header_ptr).type == 'R'))
  5713.             {
  5714.               result_header_ptr=new_real_header_ptr();
  5715.               if (! fatal_error)
  5716.                 {
  5717.                   left_real_value
  5718.                    =(float) *((*left_header_ptr).value_ptr.integer);
  5719.                   right_real_value=*((*right_header_ptr).value_ptr.real);
  5720.                   if ((left_real_value == 0.0) || (right_real_value == 0.0))
  5721.                     tem_real=0.0;
  5722.                   else
  5723.                     tem_real
  5724.                      =(log(fabs(left_real_value))+log(fabs(right_real_value)))
  5725.                      /log(10.0);
  5726.                   if (tem_real < -37.0)
  5727.                     *((*result_header_ptr).value_ptr.real)=0.0;
  5728.                   else
  5729.                     if (tem_real > 37.0)
  5730.                       {
  5731.                         fatal_error=TRUE;
  5732.                         free_value(result_header_ptr);
  5733.                         result_header_ptr=NULL;
  5734.                         printf(
  5735. "Fatal error:  overflow detected in multiplication at line %ld, column %ld.\n",
  5736.                          source_line_num,source_column_num);
  5737.                       }
  5738.                     else
  5739.                       *((*result_header_ptr).value_ptr.real)
  5740.                        =left_real_value*right_real_value;
  5741.                 }
  5742.             }
  5743.           else
  5744.             if (((*left_header_ptr).type == 'R')
  5745.             &&  ((*right_header_ptr).type == 'I'))
  5746.               {
  5747.                 result_header_ptr=new_real_header_ptr();
  5748.                 if (! fatal_error)
  5749.                   {
  5750.                     left_real_value=*((*left_header_ptr).value_ptr.real);
  5751.                     right_real_value
  5752.                      =(float) *((*right_header_ptr).value_ptr.integer);
  5753.                     if ((left_real_value == 0.0) || (right_real_value == 0.0))
  5754.                       tem_real=0.0;
  5755.                     else
  5756.                       tem_real
  5757.                        =(log(fabs(left_real_value))
  5758.                        +log(fabs(right_real_value)))
  5759.                        /log(10.0);
  5760.                     if (tem_real < -37.0)
  5761.                       *((*result_header_ptr).value_ptr.real)=0.0;
  5762.                     else
  5763.                       if (tem_real > 37.0)
  5764.                         {
  5765.                           fatal_error=TRUE;
  5766.                           free_value(result_header_ptr);
  5767.                           result_header_ptr=NULL;
  5768.                           printf(
  5769. "Fatal error:  overflow detected in multiplication at line %ld, column %ld.\n",
  5770.                            source_line_num,source_column_num);
  5771.                         }
  5772.                       else
  5773.                         *((*result_header_ptr).value_ptr.real)
  5774.                          =left_real_value*right_real_value;
  5775.                   }
  5776.               }
  5777.             else
  5778.               {
  5779.                 fatal_error=TRUE;
  5780.                 result_header_ptr=NULL;
  5781.                 printf(
  5782.               "Fatal error:  attempt to multiply other than two numbers at\n");
  5783.                 printf(
  5784.                  "line %ld, column %ld.\n",source_line_num,source_column_num);
  5785.               }
  5786.       return(result_header_ptr);
  5787.     }
  5788.  
  5789. static void get_factor_operator(operator)
  5790.   char *operator;
  5791.     {
  5792.       while ((source_char == ' ')
  5793.       &&     (! source_eof))
  5794.         get_source_char();
  5795.       switch (source_char)
  5796.         {
  5797.           case '*':
  5798.             *operator=source_char;
  5799.             get_source_char();
  5800.             break;
  5801.           case '/':
  5802.             *operator=source_char;
  5803.             get_source_char();
  5804.             break;
  5805.           case '&':
  5806.             *operator=source_char;
  5807.             get_source_char();
  5808.             break;
  5809.           default:
  5810.             *operator='\0';
  5811.             break;
  5812.         }
  5813.       return;
  5814.     }
  5815.  
  5816. static value_header_ptr term_header_ptr(evaluate)
  5817.   int evaluate;
  5818.     {
  5819.       value_header_ptr left_header_ptr;
  5820.       char             operator;
  5821.       int              operator_found;
  5822.       value_header_ptr result_header_ptr;
  5823.       value_header_ptr right_header_ptr;
  5824.  
  5825.       while ((source_char == ' ')
  5826.       &&     (! source_eof))
  5827.         get_source_char();
  5828.       if (source_char == ' ')
  5829.         {
  5830.           fatal_error=TRUE;
  5831.           result_header_ptr=NULL;
  5832.           printf(
  5833.            "Fatal error:  end of file encountered where term expected.\n");
  5834.         }
  5835.       else
  5836.         {
  5837.           result_header_ptr=factor_header_ptr(evaluate);
  5838.           operator_found=TRUE;
  5839.           while ((! fatal_error)
  5840.           &&     (operator_found))
  5841.             {
  5842.               get_factor_operator(&operator);
  5843.               if ((operator != '*')
  5844.               &&  (operator != '/')
  5845.               &&  (operator != '&'))
  5846.                  operator_found=FALSE;
  5847.               else
  5848.                 {
  5849.                   right_header_ptr=factor_header_ptr(evaluate);
  5850.                   if (fatal_error)
  5851.                     {
  5852.                       free_value(result_header_ptr);
  5853.                       result_header_ptr=NULL;
  5854.                     }
  5855.                   else
  5856.                     {
  5857.                       left_header_ptr=result_header_ptr;
  5858.                       if (evaluate)
  5859.                         {
  5860.                           switch (operator)
  5861.                             {
  5862.                               case '*':
  5863.                                 result_header_ptr=multiply_factors(
  5864.                                  left_header_ptr,right_header_ptr);
  5865.                                 break;
  5866.                               case '/':
  5867.                                 result_header_ptr=divide_factors(
  5868.                                  left_header_ptr,right_header_ptr);
  5869.                                 break;
  5870.                               default:
  5871.                                 result_header_ptr=and_factors(
  5872.                                  left_header_ptr,right_header_ptr);
  5873.                                 break;
  5874.                             }
  5875.                           free_value(left_header_ptr);
  5876.                           free_value(right_header_ptr);
  5877.                         }
  5878.                       else
  5879.                         result_header_ptr=NULL;
  5880.                     }
  5881.                 }
  5882.             }
  5883.         }
  5884.       return(result_header_ptr);
  5885.     }
  5886.  
  5887. static value_header_ptr concatenate_terms(left_header_ptr,right_header_ptr)
  5888.   value_header_ptr left_header_ptr;
  5889.   value_header_ptr right_header_ptr;
  5890.     {
  5891.       register int     char_index;
  5892.       unsigned char    *char_ptr;
  5893.       unsigned char    *result_char_ptr;
  5894.       value_header_ptr result_header_ptr;
  5895.       unsigned         string_length;
  5896.  
  5897.       if (((*left_header_ptr).type == 'S')
  5898.       &&  ((*right_header_ptr).type == 'S'))
  5899.         {
  5900.           result_header_ptr=new_string_header_ptr((unsigned)
  5901.            (*((*left_header_ptr).value_ptr.string)).length
  5902.            +(unsigned) (*((*right_header_ptr).value_ptr.string)).length);
  5903.           if (! fatal_error)
  5904.             {
  5905.               result_char_ptr=(*((*result_header_ptr).value_ptr.string)).value;
  5906.               char_ptr=(*((*left_header_ptr).value_ptr.string)).value;
  5907.               string_length=(*((*left_header_ptr).value_ptr.string)).length;
  5908.               for (char_index=0; char_index < string_length; char_index++)
  5909.                 {
  5910.                   *result_char_ptr=*char_ptr;
  5911.                   result_char_ptr++;
  5912.                   char_ptr++;
  5913.                 }
  5914.               char_ptr=(*((*right_header_ptr).value_ptr.string)).value;
  5915.               string_length=(*((*right_header_ptr).value_ptr.string)).length;
  5916.               for (char_index=0; char_index < string_length; char_index++)
  5917.                 {
  5918.                   *result_char_ptr=*char_ptr;
  5919.                   result_char_ptr++;
  5920.                   char_ptr++;
  5921.                 }
  5922.               *result_char_ptr=(unsigned char) '\0';
  5923.             }
  5924.         }
  5925.       else
  5926.         {
  5927.           fatal_error=TRUE;
  5928.           result_header_ptr=NULL;
  5929.           printf(
  5930.            "Fatal error:  attempt to concatenate other than two strings\n");
  5931.           printf(
  5932.            "at line %ld, column %ld.\n",source_line_num,source_column_num);
  5933.         }
  5934.       return(result_header_ptr);
  5935.     }
  5936.  
  5937. static value_header_ptr add_terms(left_header_ptr,right_header_ptr)
  5938.   value_header_ptr left_header_ptr;
  5939.   value_header_ptr right_header_ptr;
  5940.     {
  5941.       long             left_integer_value;
  5942.       double           left_real_value;
  5943.       value_header_ptr result_header_ptr;
  5944.       long             right_integer_value;
  5945.       double           right_real_value;
  5946.  
  5947.       if (((*left_header_ptr).type == 'I')
  5948.       &&  ((*right_header_ptr).type == 'I'))
  5949.         {
  5950.           result_header_ptr=new_integer_header_ptr();
  5951.           if (! fatal_error)
  5952.             {
  5953.               left_integer_value=*((*left_header_ptr).value_ptr.integer);
  5954.               right_integer_value=*((*right_header_ptr).value_ptr.integer);
  5955.               if ((left_integer_value > 0) && (right_integer_value > 0))
  5956.                 if (left_integer_value
  5957.                  > ((long) 0x7fffffff - right_integer_value))
  5958.                   {
  5959.                     fatal_error=TRUE;
  5960.                     free_value(result_header_ptr);
  5961.                     result_header_ptr=NULL;
  5962.                     printf(
  5963.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  5964.                      source_line_num,source_column_num);
  5965.                   }
  5966.                 else
  5967.                   *((*result_header_ptr).value_ptr.integer)
  5968.                    =left_integer_value+right_integer_value;
  5969.               else
  5970.                 if ((left_integer_value < 0) && (right_integer_value < 0))
  5971.                   if (left_integer_value
  5972.                    < (-((long) 0x7fffffff) - right_integer_value))
  5973.                     {
  5974.                       fatal_error=TRUE;
  5975.                       free_value(result_header_ptr);
  5976.                       result_header_ptr=NULL;
  5977.                       printf(
  5978.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  5979.                        source_line_num,source_column_num);
  5980.                     }
  5981.                   else
  5982.                     *((*result_header_ptr).value_ptr.integer)
  5983.                      =left_integer_value+right_integer_value;
  5984.                 else
  5985.                   *((*result_header_ptr).value_ptr.integer)
  5986.                    =left_integer_value+right_integer_value;
  5987.             }
  5988.         }
  5989.       else
  5990.         if (((*left_header_ptr).type == 'R')
  5991.         &&  ((*right_header_ptr).type == 'R'))
  5992.           {
  5993.             result_header_ptr=new_real_header_ptr();
  5994.             if (! fatal_error)
  5995.               {
  5996.                 left_real_value=*((*left_header_ptr).value_ptr.real);
  5997.                 right_real_value=*((*right_header_ptr).value_ptr.real);
  5998.                 if ((left_real_value > 0.0) && (right_real_value > 0.0))
  5999.                   if (left_real_value > (1.0E37 - right_real_value))
  6000.                     {
  6001.                       fatal_error=TRUE;
  6002.                       free_value(result_header_ptr);
  6003.                       result_header_ptr=NULL;
  6004.                       printf(
  6005.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6006.                        source_line_num,source_column_num);
  6007.                     }
  6008.                   else
  6009.                     *((*result_header_ptr).value_ptr.real)
  6010.                      =left_real_value+right_real_value;
  6011.                 else
  6012.                   if ((left_real_value < 0.0) && (right_real_value < 0.0))
  6013.                     if (left_real_value < (-1.0E37 - right_real_value))
  6014.                       {
  6015.                         fatal_error=TRUE;
  6016.                         free_value(result_header_ptr);
  6017.                         result_header_ptr=NULL;
  6018.                         printf(
  6019.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6020.                          source_line_num,source_column_num);
  6021.                       }
  6022.                     else
  6023.                       *((*result_header_ptr).value_ptr.real)
  6024.                        =left_real_value+right_real_value;
  6025.                   else
  6026.                     *((*result_header_ptr).value_ptr.real)
  6027.                      =left_real_value+right_real_value;
  6028.               }
  6029.           }
  6030.         else
  6031.           if (((*left_header_ptr).type == 'I')
  6032.           &&  ((*right_header_ptr).type == 'R'))
  6033.             {
  6034.               result_header_ptr=new_real_header_ptr();
  6035.               if (! fatal_error)
  6036.                 {
  6037.                   left_real_value=(double)
  6038.                    *((*left_header_ptr).value_ptr.integer);
  6039.                   right_real_value=*((*right_header_ptr).value_ptr.real);
  6040.                   if ((left_real_value > 0.0) && (right_real_value > 0.0))
  6041.                     if (left_real_value > (1.0E37 - right_real_value))
  6042.                       {
  6043.                         fatal_error=TRUE;
  6044.                         free_value(result_header_ptr);
  6045.                         result_header_ptr=NULL;
  6046.                         printf(
  6047.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6048.                          source_line_num,source_column_num);
  6049.                       }
  6050.                     else
  6051.                       *((*result_header_ptr).value_ptr.real)
  6052.                        =left_real_value+right_real_value;
  6053.                   else
  6054.                     if ((left_real_value < 0.0) && (right_real_value < 0.0))
  6055.                       if (left_real_value < (-1.0E37 - right_real_value))
  6056.                         {
  6057.                           fatal_error=TRUE;
  6058.                           free_value(result_header_ptr);
  6059.                           result_header_ptr=NULL;
  6060.                           printf(
  6061.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6062.                            source_line_num,source_column_num);
  6063.                         }
  6064.                       else
  6065.                         *((*result_header_ptr).value_ptr.real)
  6066.                          =left_real_value+right_real_value;
  6067.                    else
  6068.                      *((*result_header_ptr).value_ptr.real)
  6069.                       =left_real_value+right_real_value;
  6070.                 }
  6071.             }
  6072.           else
  6073.             if (((*left_header_ptr).type == 'R')
  6074.             &&  ((*right_header_ptr).type == 'I'))
  6075.               {
  6076.                 result_header_ptr=new_real_header_ptr();
  6077.                 if (! fatal_error)
  6078.                   {
  6079.                     left_real_value=*((*left_header_ptr).value_ptr.real);
  6080.                     right_real_value=*((*right_header_ptr).value_ptr.real);
  6081.                     if ((left_real_value > 0.0)
  6082.                     && (right_real_value > 0.0))
  6083.                       if (left_real_value > (1.0E37 - right_real_value))
  6084.                         {
  6085.                           fatal_error=TRUE;
  6086.                           free_value(result_header_ptr);
  6087.                           result_header_ptr=NULL;
  6088.                           printf(
  6089.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6090.                            source_line_num,source_column_num);
  6091.                         }
  6092.                       else
  6093.                         *((*result_header_ptr).value_ptr.real)
  6094.                          =left_real_value+right_real_value;
  6095.                     else
  6096.                       if ((left_real_value < 0.0)
  6097.                       &&  (right_real_value < 0.0))
  6098.                         if (left_real_value < (-1.0E37 - right_real_value))
  6099.                           {
  6100.                             fatal_error=TRUE;
  6101.                             free_value(result_header_ptr);
  6102.                             result_header_ptr=NULL;
  6103.                             printf(
  6104.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6105.                              source_line_num,source_column_num);
  6106.                           }
  6107.                         else
  6108.                           *((*result_header_ptr).value_ptr.real)
  6109.                            =left_real_value+right_real_value;
  6110.                       else
  6111.                         *((*result_header_ptr).value_ptr.real)
  6112.                          =left_real_value+right_real_value;
  6113.                   }
  6114.               }
  6115.             else
  6116.               {
  6117.                 fatal_error=TRUE;
  6118.                 result_header_ptr=NULL;
  6119.                 printf(
  6120.                  "Fatal error:  attempt to add other than two numbers at\n");
  6121.                 printf(
  6122.                  "line %ld, column %ld.\n",source_line_num,source_column_num);
  6123.               }
  6124.       return(result_header_ptr);
  6125.     }
  6126.  
  6127. static value_header_ptr subtract_terms(left_header_ptr,right_header_ptr)
  6128.   value_header_ptr left_header_ptr;
  6129.   value_header_ptr right_header_ptr;
  6130.     {
  6131.       long             left_integer_value;
  6132.       double           left_real_value;
  6133.       value_header_ptr result_header_ptr;
  6134.       long             right_integer_value;
  6135.       double           right_real_value;
  6136.  
  6137.       if (((*left_header_ptr).type == 'I')
  6138.       &&  ((*right_header_ptr).type == 'I'))
  6139.         {
  6140.           result_header_ptr=new_integer_header_ptr();
  6141.           if (! fatal_error)
  6142.             {
  6143.               left_integer_value=*((*left_header_ptr).value_ptr.integer);
  6144.               right_integer_value=*((*right_header_ptr).value_ptr.integer);
  6145.               if ((left_integer_value < 0) && (right_integer_value > 0))
  6146.                 if (left_integer_value
  6147.                  < (right_integer_value-((long) 0x7fffffff)))
  6148.                   {
  6149.                     fatal_error=TRUE;
  6150.                     free_value(result_header_ptr);
  6151.                     result_header_ptr=NULL;
  6152.                     printf(
  6153.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6154.                      source_line_num,source_column_num);
  6155.                   }
  6156.                 else
  6157.                   *((*result_header_ptr).value_ptr.integer)
  6158.                    =left_integer_value-right_integer_value;
  6159.               else
  6160.                 if ((left_integer_value > 0) && (right_integer_value < 0))
  6161.                   if (left_integer_value
  6162.                    > (right_integer_value+(long) 0x7fffffff))
  6163.                     {
  6164.                       fatal_error=TRUE;
  6165.                       free_value(result_header_ptr);
  6166.                       result_header_ptr=NULL;
  6167.                       printf(
  6168.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6169.                        source_line_num,source_column_num);
  6170.                     }
  6171.                   else
  6172.                     *((*result_header_ptr).value_ptr.integer)
  6173.                      =left_integer_value-right_integer_value;
  6174.                 else
  6175.                   *((*result_header_ptr).value_ptr.integer)
  6176.                    =left_integer_value-right_integer_value;
  6177.             }
  6178.         }
  6179.       else
  6180.         if (((*left_header_ptr).type == 'R')
  6181.         &&  ((*right_header_ptr).type == 'R'))
  6182.           {
  6183.             result_header_ptr=new_real_header_ptr();
  6184.             if (! fatal_error)
  6185.               {
  6186.                 left_real_value=*((*left_header_ptr).value_ptr.real);
  6187.                 right_real_value=*((*right_header_ptr).value_ptr.real);
  6188.                 if ((left_real_value < 0.0) && (right_real_value > 0.0))
  6189.                   if (left_real_value < (right_real_value-1.0E37))
  6190.                     {
  6191.                       fatal_error=TRUE;
  6192.                       free_value(result_header_ptr);
  6193.                       result_header_ptr=NULL;
  6194.                       printf(
  6195.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6196.                        source_line_num,source_column_num);
  6197.                     }
  6198.                   else
  6199.                     *((*result_header_ptr).value_ptr.real)
  6200.                      =left_real_value-right_real_value;
  6201.                 else
  6202.                   if ((left_real_value > 0.0) && (right_real_value < 0.0))
  6203.                     if (left_real_value > (right_real_value+1.0E37))
  6204.                       {
  6205.                         fatal_error=TRUE;
  6206.                         free_value(result_header_ptr);
  6207.                         result_header_ptr=NULL;
  6208.                         printf(
  6209.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6210.                          source_line_num,source_column_num);
  6211.                       }
  6212.                     else
  6213.                       *((*result_header_ptr).value_ptr.real)
  6214.                        =left_real_value-right_real_value;
  6215.                   else
  6216.                     *((*result_header_ptr).value_ptr.real)
  6217.                      =left_real_value-right_real_value;
  6218.               }
  6219.           }
  6220.         else
  6221.           if (((*left_header_ptr).type == 'I')
  6222.           &&  ((*right_header_ptr).type == 'R'))
  6223.             {
  6224.               result_header_ptr=new_real_header_ptr();
  6225.               if (! fatal_error)
  6226.                 {
  6227.                   left_real_value=(double)
  6228.                    *((*left_header_ptr).value_ptr.integer);
  6229.                   right_real_value=*((*right_header_ptr).value_ptr.real);
  6230.                   if ((left_real_value < 0.0) && (right_real_value > 0.0))
  6231.                     if (left_real_value < (right_real_value-1.0E37))
  6232.                       {
  6233.                         fatal_error=TRUE;
  6234.                         free_value(result_header_ptr);
  6235.                         result_header_ptr=NULL;
  6236.                         printf(
  6237.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6238.                          source_line_num,source_column_num);
  6239.                       }
  6240.                     else
  6241.                       *((*result_header_ptr).value_ptr.real)
  6242.                        =left_real_value-right_real_value;
  6243.                   else
  6244.                     if ((left_real_value > 0.0) && (right_real_value < 0.0))
  6245.                       if (left_real_value > (right_real_value+1.0E37))
  6246.                         {
  6247.                           fatal_error=TRUE;
  6248.                           free_value(result_header_ptr);
  6249.                           result_header_ptr=NULL;
  6250.                           printf(
  6251.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6252.                            source_line_num,source_column_num);
  6253.                         }
  6254.                       else
  6255.                         *((*result_header_ptr).value_ptr.real)
  6256.                          =left_real_value-right_real_value;
  6257.                    else
  6258.                      *((*result_header_ptr).value_ptr.real)
  6259.                       =left_real_value-right_real_value;
  6260.                 }
  6261.             }
  6262.           else
  6263.             if (((*left_header_ptr).type == 'R')
  6264.             &&  ((*right_header_ptr).type == 'I'))
  6265.               {
  6266.                 result_header_ptr=new_real_header_ptr();
  6267.                 if (! fatal_error)
  6268.                   {
  6269.                     left_real_value=*((*left_header_ptr).value_ptr.real);
  6270.                     right_real_value=*((*right_header_ptr).value_ptr.real);
  6271.                     if ((left_real_value < 0.0)
  6272.                     && (right_real_value > 0.0))
  6273.                       if (left_real_value < (right_real_value-1.0E37))
  6274.                         {
  6275.                           fatal_error=TRUE;
  6276.                           free_value(result_header_ptr);
  6277.                           result_header_ptr=NULL;
  6278.                           printf(
  6279.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6280.                            source_line_num,source_column_num);
  6281.                         }
  6282.                       else
  6283.                         *((*result_header_ptr).value_ptr.real)
  6284.                          =left_real_value-right_real_value;
  6285.                     else
  6286.                       if ((left_real_value > 0.0)
  6287.                       &&  (right_real_value < 0.0))
  6288.                         if (left_real_value > (right_real_value+1.0E37))
  6289.                           {
  6290.                             fatal_error=TRUE;
  6291.                             free_value(result_header_ptr);
  6292.                             result_header_ptr=NULL;
  6293.                             printf(
  6294.       "Fatal error:  overflow detected in addition at line %ld, column %ld.\n",
  6295.                              source_line_num,source_column_num);
  6296.                           }
  6297.                         else
  6298.                           *((*result_header_ptr).value_ptr.real)
  6299.                            =left_real_value-right_real_value;
  6300.                       else
  6301.                         *((*result_header_ptr).value_ptr.real)
  6302.                          =left_real_value-right_real_value;
  6303.                   }
  6304.               }
  6305.             else
  6306.               {
  6307.                 fatal_error=TRUE;
  6308.                 result_header_ptr=NULL;
  6309.                 printf(
  6310.                  "Fatal error:  attempt to add other than two numbers at\n");
  6311.                 printf(
  6312.                  "line %ld, column %ld.\n",source_line_num,source_column_num);
  6313.               }
  6314.       return(result_header_ptr);
  6315.     }
  6316.  
  6317. static value_header_ptr or_terms(left_header_ptr,right_header_ptr)
  6318.   value_header_ptr left_header_ptr;
  6319.   value_header_ptr right_header_ptr;
  6320.     {
  6321.       value_header_ptr result_header_ptr;
  6322.  
  6323.       if (((*left_header_ptr).type == 'B')
  6324.       &&  ((*right_header_ptr).type == 'B'))
  6325.         {
  6326.           result_header_ptr=new_boolean_header_ptr();
  6327.           if (! fatal_error)
  6328.             *((*result_header_ptr).value_ptr.boolean)
  6329.              =(*((*left_header_ptr).value_ptr.boolean))
  6330.              || (*((*right_header_ptr).value_ptr.boolean));
  6331.         }
  6332.       else
  6333.         {
  6334.           fatal_error=TRUE;
  6335.           result_header_ptr=NULL;
  6336.           printf(
  6337.            "Fatal error:  attempt to \"or\" other than two booleans\n");
  6338.           printf(
  6339.            "at line %ld, column %ld.\n",source_line_num,source_column_num);
  6340.         }
  6341.       return(result_header_ptr);
  6342.     }
  6343.  
  6344. static void get_term_operator(operator)
  6345.   char *operator;
  6346.     {
  6347.       while ((source_char == ' ')
  6348.       &&     (! source_eof))
  6349.         get_source_char();
  6350.       switch (source_char)
  6351.         {
  6352.           case '+':
  6353.             operator[0]=source_char;
  6354.             operator[1]='\0';
  6355.             get_source_char();
  6356.             break;
  6357.           case '-':
  6358.             operator[0]=source_char;
  6359.             operator[1]='\0';
  6360.             get_source_char();
  6361.             break;
  6362.           case '|':
  6363.             operator[0]=source_char;
  6364.             operator[1]='\0';
  6365.             get_source_char();
  6366.             if (source_char == '|')
  6367.               {
  6368.                 operator[1]='|';
  6369.                 operator[2]='\0';
  6370.                 get_source_char();
  6371.               }
  6372.             break;
  6373.           default:
  6374.             operator[0]='\0';
  6375.             break;
  6376.         }
  6377.       return;
  6378.     }
  6379.  
  6380. static value_header_ptr simple_expression_header_ptr(evaluate)
  6381.   int evaluate;
  6382.     {
  6383.       char             leading_sign;
  6384.       value_header_ptr left_header_ptr;
  6385.       char             operator [3];
  6386.       int              operator_found;
  6387.       value_header_ptr result_header_ptr;
  6388.       value_header_ptr right_header_ptr;
  6389.  
  6390.       while ((source_char == ' ')
  6391.       &&     (! source_eof))
  6392.         get_source_char();
  6393.       if (source_char == ' ')
  6394.         {
  6395.           fatal_error=TRUE;
  6396.           result_header_ptr=NULL;
  6397.           printf(
  6398.   "Fatal error:  end of file encountered where simple expression expected.\n");
  6399.         }
  6400.       else
  6401.         {
  6402.           leading_sign=' ';
  6403.           if ((source_char == '+') || (source_char == '-'))
  6404.             {
  6405.               leading_sign=source_char;
  6406.               get_source_char();
  6407.             }
  6408.           result_header_ptr=term_header_ptr(evaluate);
  6409.           if (! fatal_error)
  6410.             {
  6411.               if ((evaluate) && (leading_sign != ' '))
  6412.                 switch ((*result_header_ptr).type)
  6413.                   {
  6414.                     case 'I':
  6415.                       if (leading_sign == '-')
  6416.                         *((*result_header_ptr).value_ptr.integer)
  6417.                          =-(*((*result_header_ptr).value_ptr.integer));
  6418.                       break;
  6419.                     case 'R':
  6420.                       if (leading_sign == '-')
  6421.                         *((*result_header_ptr).value_ptr.real)
  6422.                          =-(*((*result_header_ptr).value_ptr.real));
  6423.                       break;
  6424.                     default:
  6425.                       fatal_error=TRUE;
  6426.                       free_value(result_header_ptr);
  6427.                       result_header_ptr=NULL;
  6428.                       printf(
  6429.                        "Fatal error:  sign applied to other than number at ");
  6430.                       printf(
  6431.                        "line %ld, column %ld.\n",
  6432.                        source_line_num,source_column_num);
  6433.                       break;
  6434.                   }
  6435.               operator_found=TRUE;
  6436.               while ((! fatal_error)
  6437.               &&     (operator_found))
  6438.                 {
  6439.                   get_term_operator(operator);
  6440.                   if ((strcmp(operator,"||") != 0)
  6441.                   &&  (strcmp(operator,"|") != 0)
  6442.                   &&  (strcmp(operator,"+") != 0)
  6443.                   &&  (strcmp(operator,"-") != 0))
  6444.                     operator_found=FALSE;
  6445.                   else
  6446.                     {
  6447.                       right_header_ptr=term_header_ptr(evaluate);
  6448.                       if (fatal_error)
  6449.                         {
  6450.                           free_value(result_header_ptr);
  6451.                           result_header_ptr=NULL;
  6452.                         }
  6453.                       else
  6454.                         {
  6455.                           left_header_ptr=result_header_ptr;
  6456.                           if (evaluate)
  6457.                             {
  6458.                               if (strcmp(operator,"||") == 0)
  6459.                                 result_header_ptr=concatenate_terms(
  6460.                                  left_header_ptr,right_header_ptr);
  6461.                               else
  6462.                                 switch (operator[0])
  6463.                                   {
  6464.                                     case '+':
  6465.                                       result_header_ptr=add_terms(
  6466.                                        left_header_ptr,right_header_ptr);
  6467.                                       break;
  6468.                                     case '-':
  6469.                                       result_header_ptr=subtract_terms(
  6470.                                        left_header_ptr,right_header_ptr);
  6471.                                       break;
  6472.                                     default:
  6473.                                       result_header_ptr=or_terms(
  6474.                                        left_header_ptr,right_header_ptr);
  6475.                                       break;
  6476.                                   }
  6477.                               free_value(left_header_ptr);
  6478.                               free_value(right_header_ptr);
  6479.                             }
  6480.                           else
  6481.                             result_header_ptr=NULL;
  6482.                         }
  6483.                     }
  6484.                 }
  6485.             }
  6486.         }
  6487.       return(result_header_ptr);
  6488.     }
  6489.  
  6490. static value_header_ptr boolean_comparison(left_header_ptr,operator,
  6491.  right_header_ptr)
  6492.   value_header_ptr left_header_ptr;
  6493.   char             *operator;
  6494.   value_header_ptr right_header_ptr;
  6495.     {
  6496.       value_header_ptr result_header_ptr;
  6497.  
  6498.       if (strcmp(operator,"!=") == 0)
  6499.         {
  6500.           result_header_ptr=new_boolean_header_ptr();
  6501.           if (! fatal_error)
  6502.             {
  6503.               if (*((*left_header_ptr).value_ptr.boolean)
  6504.                != *((*right_header_ptr).value_ptr.boolean))
  6505.                 *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6506.               else
  6507.                 *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6508.             }
  6509.         }
  6510.       else
  6511.         if (strcmp(operator,"=") == 0)
  6512.           {
  6513.             result_header_ptr=new_boolean_header_ptr();
  6514.             if (! fatal_error)
  6515.               {
  6516.                 if (*((*left_header_ptr).value_ptr.boolean)
  6517.                  == *((*right_header_ptr).value_ptr.boolean))
  6518.                   *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6519.                 else
  6520.                   *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6521.               }
  6522.           }
  6523.         else
  6524.           {
  6525.             fatal_error=TRUE;
  6526.             result_header_ptr=NULL;
  6527.             printf("Fatal error:  \"%s\" used to compare booleans at ",
  6528.              operator);
  6529.             printf("line %ld, column %ld.\n",
  6530.              source_line_num,source_column_num);
  6531.           }
  6532.       return(result_header_ptr);
  6533.     }
  6534.  
  6535. static value_header_ptr dataset_comparison(left_header_ptr,operator,
  6536.  right_header_ptr)
  6537.   value_header_ptr left_header_ptr;
  6538.   char             *operator;
  6539.   value_header_ptr right_header_ptr;
  6540.     {
  6541.       value_header_ptr result_header_ptr;
  6542.  
  6543.       if (strcmp(operator,"!=") == 0)
  6544.         {
  6545.           result_header_ptr=new_boolean_header_ptr();
  6546.           if (! fatal_error)
  6547.             {
  6548.               if (*((*left_header_ptr).value_ptr.dataset)
  6549.                != *((*right_header_ptr).value_ptr.dataset))
  6550.                 *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6551.               else
  6552.                 *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6553.             }
  6554.         }
  6555.       else
  6556.         if (strcmp(operator,"=") == 0)
  6557.           {
  6558.             result_header_ptr=new_boolean_header_ptr();
  6559.             if (! fatal_error)
  6560.               {
  6561.                 if (*((*left_header_ptr).value_ptr.dataset)
  6562.                  == *((*right_header_ptr).value_ptr.dataset))
  6563.                   *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6564.                 else
  6565.                   *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6566.               }
  6567.           }
  6568.         else
  6569.           {
  6570.             fatal_error=TRUE;
  6571.             result_header_ptr=NULL;
  6572.             printf("Fatal error:  \"%s\" used to compare file pointers at ",
  6573.              operator);
  6574.             printf("line %ld, column %ld.\n",
  6575.              source_line_num,source_column_num);
  6576.           }
  6577.       return(result_header_ptr);
  6578.     }
  6579.  
  6580. static value_header_ptr integer_comparison(left_header_ptr,operator,
  6581.  right_header_ptr)
  6582.   value_header_ptr left_header_ptr;
  6583.   char             *operator;
  6584.   value_header_ptr right_header_ptr;
  6585.     {
  6586.       value_header_ptr result_header_ptr;
  6587.  
  6588.       result_header_ptr=new_boolean_header_ptr();
  6589.       if (! fatal_error)
  6590.         {
  6591.           if (strcmp(operator,"<=") == 0)
  6592.             if (*((*left_header_ptr).value_ptr.integer)
  6593.              <= *((*right_header_ptr).value_ptr.integer))
  6594.               *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6595.             else
  6596.               *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6597.           else
  6598.             if (strcmp(operator,">=") == 0)
  6599.               if (*((*left_header_ptr).value_ptr.integer)
  6600.                >= *((*right_header_ptr).value_ptr.integer))
  6601.                 *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6602.               else
  6603.                 *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6604.             else
  6605.               if (strcmp(operator,"!=") == 0)
  6606.                 if (*((*left_header_ptr).value_ptr.integer)
  6607.                  != *((*right_header_ptr).value_ptr.integer))
  6608.                   *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6609.                 else
  6610.                   *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6611.               else
  6612.                 if (strcmp(operator,">") == 0)
  6613.                   if (*((*left_header_ptr).value_ptr.integer)
  6614.                    > *((*right_header_ptr).value_ptr.integer))
  6615.                     *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6616.                   else
  6617.                     *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6618.                 else
  6619.                   if (strcmp(operator,"<") == 0)
  6620.                     if (*((*left_header_ptr).value_ptr.integer)
  6621.                      < *((*right_header_ptr).value_ptr.integer))
  6622.                       *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6623.                     else
  6624.                       *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6625.                   else
  6626.                     if (*((*left_header_ptr).value_ptr.integer)
  6627.                      == *((*right_header_ptr).value_ptr.integer))
  6628.                       *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6629.                     else
  6630.                       *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6631.         }
  6632.       return(result_header_ptr);
  6633.     }
  6634.  
  6635.  
  6636. static value_header_ptr real_comparison(left_header_ptr,operator,
  6637.  right_header_ptr)
  6638.   value_header_ptr left_header_ptr;
  6639.   char             *operator;
  6640.   value_header_ptr right_header_ptr;
  6641.     {
  6642.       value_header_ptr result_header_ptr;
  6643.  
  6644.       result_header_ptr=new_boolean_header_ptr();
  6645.       if (! fatal_error)
  6646.         {
  6647.           if (strcmp(operator,"<=") == 0)
  6648.             if (*((*left_header_ptr).value_ptr.real)
  6649.              <= *((*right_header_ptr).value_ptr.real))
  6650.               *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6651.             else
  6652.               *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6653.           else
  6654.             if (strcmp(operator,">=") == 0)
  6655.               if (*((*left_header_ptr).value_ptr.real)
  6656.                >= *((*right_header_ptr).value_ptr.real))
  6657.                 *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6658.               else
  6659.                 *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6660.             else
  6661.               if (strcmp(operator,"!=") == 0)
  6662.                 if (*((*left_header_ptr).value_ptr.real)
  6663.                  != *((*right_header_ptr).value_ptr.real))
  6664.                   *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6665.                 else
  6666.                   *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6667.               else
  6668.                 if (strcmp(operator,">") == 0)
  6669.                   if (*((*left_header_ptr).value_ptr.real)
  6670.                    > *((*right_header_ptr).value_ptr.real))
  6671.                     *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6672.                   else
  6673.                     *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6674.                 else
  6675.                   if (strcmp(operator,"<") == 0)
  6676.                     if (*((*left_header_ptr).value_ptr.real)
  6677.                      < *((*right_header_ptr).value_ptr.real))
  6678.                       *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6679.                     else
  6680.                       *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6681.                   else
  6682.                     if (*((*left_header_ptr).value_ptr.real)
  6683.                      == *((*right_header_ptr).value_ptr.real))
  6684.                       *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6685.                     else
  6686.                       *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6687.         }
  6688.       return(result_header_ptr);
  6689.     }
  6690.  
  6691.  
  6692. static value_header_ptr string_comparison(left_header_ptr,operator,
  6693.  right_header_ptr)
  6694.   value_header_ptr left_header_ptr;
  6695.   char             *operator;
  6696.   value_header_ptr right_header_ptr;
  6697.     {
  6698.       value_header_ptr result_header_ptr;
  6699.  
  6700.       result_header_ptr=new_boolean_header_ptr();
  6701.       if (! fatal_error)
  6702.         {
  6703.           if (strcmp(operator,"<=") == 0)
  6704.             if (pli_strcmp((*left_header_ptr).value_ptr.string,
  6705.              (*right_header_ptr).value_ptr.string) <= 0)
  6706.               *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6707.             else
  6708.               *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6709.           else
  6710.             if (strcmp(operator,">=") == 0)
  6711.               if (pli_strcmp((*left_header_ptr).value_ptr.string,
  6712.                 (*right_header_ptr).value_ptr.string) >= 0)
  6713.                 *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6714.               else
  6715.                 *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6716.             else
  6717.               if (strcmp(operator,"!=") == 0)
  6718.                 if (pli_strcmp((*left_header_ptr).value_ptr.string,
  6719.                  (*right_header_ptr).value_ptr.string) != 0)
  6720.                   *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6721.                 else
  6722.                   *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6723.               else
  6724.                 if (strcmp(operator,"<") == 0)
  6725.                   if (pli_strcmp((*left_header_ptr).value_ptr.string,
  6726.                    (*right_header_ptr).value_ptr.string) < 0)
  6727.                     *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6728.                   else
  6729.                     *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6730.                 else
  6731.                   if (strcmp(operator,">") == 0)
  6732.                     if (pli_strcmp((*left_header_ptr).value_ptr.string,
  6733.                      (*right_header_ptr).value_ptr.string) > 0)
  6734.                       *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6735.                     else
  6736.                       *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6737.                   else
  6738.                     if (pli_strcmp((*left_header_ptr).value_ptr.string,
  6739.                      (*right_header_ptr).value_ptr.string) == 0)
  6740.                       *((*result_header_ptr).value_ptr.boolean)=TRUE;
  6741.                     else
  6742.                       *((*result_header_ptr).value_ptr.boolean)=FALSE;
  6743.         }
  6744.       return(result_header_ptr);
  6745.     }
  6746.  
  6747. static void get_comparison_operator(operator)
  6748.   char *operator;
  6749.     {
  6750.       while ((source_char == ' ')
  6751.       &&     (! source_eof))
  6752.         get_source_char();
  6753.       switch (source_char)
  6754.         {
  6755.           case '=':
  6756.             operator[0]=source_char;
  6757.             operator[1]='\0';
  6758.             get_source_char();
  6759.             break;
  6760.           case '<':
  6761.             operator[0]=source_char;
  6762.             operator[1]='\0';
  6763.             get_source_char();
  6764.             if (source_char == '=')
  6765.               {
  6766.                 operator[1]='=';
  6767.                 operator[2]='\0';
  6768.                 get_source_char();
  6769.               }
  6770.             break;
  6771.           case '!':
  6772.             operator[0]=source_char;
  6773.             operator[1]='\0';
  6774.             get_source_char();
  6775.             if (source_char == '=')
  6776.               {
  6777.                 operator[1]='=';
  6778.                 operator[2]='\0';
  6779.                 get_source_char();
  6780.               }
  6781.             break;
  6782.           case '>':
  6783.             operator[0]=source_char;
  6784.             operator[1]='\0';
  6785.             get_source_char();
  6786.             if (source_char == '=')
  6787.               {
  6788.                 operator[1]='=';
  6789.                 operator[2]='\0';
  6790.                 get_source_char();
  6791.               }
  6792.             break;
  6793.           default:
  6794.             operator[0]='\0';
  6795.             break;
  6796.         }
  6797.       return;
  6798.     }
  6799.  
  6800. static value_header_ptr interpret_expression(evaluate)
  6801.   int evaluate;
  6802.     {
  6803.       value_header_ptr left_header_ptr;
  6804.       char             operator [3];
  6805.       value_header_ptr result_header_ptr;
  6806.       value_header_ptr right_header_ptr;
  6807.       double           tem_real_1;
  6808.  
  6809.       left_header_ptr=simple_expression_header_ptr(evaluate);
  6810.       if (fatal_error)
  6811.         result_header_ptr=NULL;
  6812.       else
  6813.         {
  6814.           get_comparison_operator(operator);
  6815.           if ((strcmp(operator,"<=") != 0)
  6816.           &&  (strcmp(operator,">=") != 0)
  6817.           &&  (strcmp(operator,"!=") != 0)
  6818.           &&  (strcmp(operator,"<") != 0)
  6819.           &&  (strcmp(operator,">") != 0)
  6820.           &&  (strcmp(operator,"=") != 0))
  6821.              result_header_ptr=left_header_ptr;
  6822.           else
  6823.             {
  6824.               right_header_ptr=simple_expression_header_ptr(evaluate);
  6825.               if (fatal_error)
  6826.                 {
  6827.                   free_value(left_header_ptr);
  6828.                   result_header_ptr=NULL;
  6829.                 }
  6830.               else
  6831.                 {
  6832.                   if (evaluate)
  6833.                     {
  6834.                       if ((*left_header_ptr).type
  6835.                        == (*right_header_ptr).type)
  6836.                         switch ((*left_header_ptr).type)
  6837.                           {
  6838.                             case 'B':
  6839.                               result_header_ptr=boolean_comparison(
  6840.                                left_header_ptr,operator,
  6841.                                right_header_ptr);
  6842.                               break;
  6843.                             case 'D':
  6844.                               result_header_ptr=dataset_comparison(
  6845.                                left_header_ptr,operator,
  6846.                                right_header_ptr);
  6847.                               break;
  6848.                             case 'I':
  6849.                               result_header_ptr=integer_comparison(
  6850.                                left_header_ptr,operator,
  6851.                                right_header_ptr);
  6852.                               break;
  6853.                             case 'R':
  6854.                               result_header_ptr=real_comparison(
  6855.                                left_header_ptr,operator,
  6856.                                right_header_ptr);
  6857.                               break;
  6858.                             default:
  6859.                               result_header_ptr=string_comparison(
  6860.                                left_header_ptr,operator,
  6861.                                right_header_ptr);
  6862.                               break;
  6863.                           }
  6864.                       else
  6865.                         if (((*left_header_ptr).type == 'I')
  6866.                         &&  ((*right_header_ptr).type == 'R'))
  6867.                           {
  6868.                             tem_real_1=(double)
  6869.                              *((*left_header_ptr).value_ptr.integer);
  6870.                             free((char *)
  6871.                              (*left_header_ptr).value_ptr.integer);
  6872.                             if (((*left_header_ptr).value_ptr.real
  6873.                              =(double *)
  6874.                              malloc((unsigned) sizeof(double))) == NULL)
  6875.                               {
  6876.                                 fatal_error=TRUE;
  6877.                                 result_header_ptr=NULL;
  6878.                                 printf("Fatal error:  out of memory at ");
  6879.                                 printf("line %ld, column %ld.\n",
  6880.                                  source_line_num,source_column_num);
  6881.                                 free((char *) left_header_ptr);
  6882.                                 free_value(right_header_ptr);
  6883.                               }
  6884.                             else
  6885.                               {
  6886.                                 *((*left_header_ptr).value_ptr.real)
  6887.                                  =tem_real_1;
  6888.                                 (*left_header_ptr).type='R';
  6889.                                 result_header_ptr=real_comparison(
  6890.                                  left_header_ptr,operator,
  6891.                                  right_header_ptr);
  6892.                               }
  6893.                           }
  6894.                         else
  6895.                           if (((*left_header_ptr).type == 'R')
  6896.                           &&  ((*right_header_ptr).type == 'I'))
  6897.                             {
  6898.                               tem_real_1=(double)
  6899.                                *((*right_header_ptr).value_ptr.integer);
  6900.                               free((char *)
  6901.                                (*right_header_ptr).value_ptr.integer);
  6902.                               if (((*right_header_ptr).value_ptr.real
  6903.                                =(double *)
  6904.                                malloc((unsigned) sizeof(double))) == NULL)
  6905.                                 {
  6906.                                   fatal_error=TRUE;
  6907.                                   result_header_ptr=NULL;
  6908.                                   printf("Fatal error:  out of memory ");
  6909.                                   printf("at line %ld, column %ld.\n",
  6910.                                    source_line_num,source_column_num);
  6911.                                   free((char *) right_header_ptr);
  6912.                                   free_value(left_header_ptr);
  6913.                                 }
  6914.                               else
  6915.                                 {
  6916.                                   *((*right_header_ptr).value_ptr.real)
  6917.                                    =tem_real_1;
  6918.                                   (*right_header_ptr).type='R';
  6919.                                   result_header_ptr=real_comparison(
  6920.                                    left_header_ptr,operator,
  6921.                                    right_header_ptr);
  6922.                                 }
  6923.                             }
  6924.                           else
  6925.                             {
  6926.                               fatal_error=TRUE;
  6927.                               result_header_ptr=NULL;
  6928.                               printf("Fatal error:  comparands differ ");
  6929.                               printf("in type at line %ld, column %ld.\n",
  6930.                                source_line_num,source_column_num);
  6931.                               free_value(left_header_ptr);
  6932.                               free_value(right_header_ptr);
  6933.                             }
  6934.                       if (! fatal_error)
  6935.                         {
  6936.                           free_value(left_header_ptr);
  6937.                           free_value(right_header_ptr);
  6938.                         }
  6939.                     }
  6940.                   else
  6941.                     result_header_ptr=NULL;
  6942.                 }
  6943.             }
  6944.         }
  6945.       return(result_header_ptr);
  6946.     }
  6947.  
  6948. static void interpret_do(evaluate)
  6949.   int evaluate;
  6950.     {
  6951.       int              condition_is_true;
  6952.       value_header_ptr expression_header_ptr;
  6953.       char             while_char;
  6954.       long             while_column_num;
  6955.       int              while_eof;
  6956.       int              while_index;
  6957.       long             while_line_num;
  6958.  
  6959.       get_token();
  6960.       if (source_token[0] == ';')
  6961.         {
  6962.           do
  6963.             {
  6964.               get_token();
  6965.               if (source_token[0] == ' ')
  6966.                 {
  6967.                   fatal_error=TRUE;
  6968.                   printf("Fatal error:  file ends before \"END;\" ");
  6969.                   printf("corresponding to \"DO;\".\n");
  6970.                 }
  6971.               else
  6972.                 {
  6973.                   if (strcmp(source_token,"END") != 0)
  6974.                     interpret_statement(evaluate);
  6975.                 }
  6976.             }
  6977.           while ((strcmp(source_token,"END") != 0)
  6978.           &&     (! fatal_error));
  6979.           if (! fatal_error)
  6980.             {
  6981.               get_token();
  6982.               if (source_token[0] == ' ')
  6983.                 {
  6984.                   fatal_error=TRUE;
  6985.                   printf("Fatal error:  file ends where \";\" of \"END;\" ");
  6986.                   printf("expected.\n");
  6987.                 }
  6988.               else
  6989.                 {
  6990.                   if (source_token[0] != ';')
  6991.                     {
  6992.                       fatal_error=TRUE;
  6993.                       printf(
  6994.                      "Fatal error:  \";\" expected at line %ld, column %ld.\n",
  6995.                        source_line_num,source_column_num);
  6996.                     }
  6997.                 }
  6998.             }
  6999.         }
  7000.       else
  7001.         if (strcmp(source_token,"WHILE") == 0)
  7002.           {
  7003.             get_token();
  7004.             if (source_token[0] == ' ')
  7005.               {
  7006.                 fatal_error=TRUE;
  7007.                 printf(
  7008.            "Fatal error:  file ends where \"(\" of \"DO WHILE(\" expected.\n");
  7009.               }
  7010.             else
  7011.               if (source_token[0] == '(')
  7012.                 {
  7013.                   while_index=source_index;
  7014.                   while_char=source_char;
  7015.                   while_column_num=source_column_num;
  7016.                   while_eof=source_eof;
  7017.                   while_line_num=source_line_num;
  7018.                   do
  7019.                     {
  7020.                       if (while_index != source_index)
  7021.                         {
  7022.                           source_index=while_index;
  7023.                           source_char=source_buffer[source_index];
  7024.                         }
  7025.                       source_char=while_char;
  7026.                       source_column_num=while_column_num;
  7027.                       source_eof=while_eof;
  7028.                       source_line_num=while_line_num;
  7029.                       expression_header_ptr=interpret_expression(evaluate);
  7030.                       if (! fatal_error)
  7031.                         {
  7032.                           if ((! evaluate)
  7033.                           ||  ((*expression_header_ptr).type == 'B'))
  7034.                             {
  7035.                               get_token();
  7036.                               if (source_token[0] == ')')
  7037.                                 {
  7038.                                   get_token();
  7039.                                   if (source_token[0] == ';')
  7040.                                     {
  7041.                                       if (evaluate)
  7042.                                         condition_is_true
  7043.                                =*((*expression_header_ptr).value_ptr.boolean);
  7044.                                       else
  7045.                                         condition_is_true=FALSE;
  7046.                                       do
  7047.                                         {
  7048.                                           get_token();
  7049.                                           if (source_token[0] == ' ')
  7050.                                             {
  7051.                                               fatal_error=TRUE;
  7052.                                               printf(
  7053.                                    "Fatal error:  file ends before \"END;\" ");
  7054.                                               printf(
  7055.                                    "corresponding to \"DO WHILE();\".\n");
  7056.                                             }
  7057.                                           else
  7058.                                             {
  7059.                                               if (strcmp(source_token,"END")
  7060.                                                != 0)
  7061.                                                 interpret_statement(
  7062.                                                  evaluate && condition_is_true);
  7063.                                             }
  7064.                                         }
  7065.                                       while ((strcmp(source_token,"END") != 0)
  7066.                                       &&     (! fatal_error));
  7067.                                     }
  7068.                                   else
  7069.                                     if (source_token[0] == ' ')
  7070.                                       {
  7071.                                         fatal_error=TRUE;
  7072.                                         printf(
  7073.                  "Fatal error:  file ends before \";\" of \"DO WHILE();\".\n");
  7074.                                       }
  7075.                                     else
  7076.                                       {
  7077.                                         fatal_error=TRUE;
  7078.                                         printf(
  7079.   "Fatal error:  \";\" of \"DO WHILE();\" expected at line %ld, column %ld.\n",
  7080.                                          source_line_num,source_column_num);
  7081.                                       }
  7082.                                 }
  7083.                               else
  7084.                                 if (source_token[0] == ' ')
  7085.                                   {
  7086.                                     fatal_error=TRUE;
  7087.                                     printf(
  7088.                    "Fatal error:  file ends before \")\" of \"DO WHILE()\".\n");
  7089.                                   }
  7090.                                 else
  7091.                                   {
  7092.                                     fatal_error=TRUE;
  7093.                                     printf(
  7094.    "Fatal error:  \")\" of \"DO WHILE()\" expected at line %ld, column %ld.\n",
  7095.                                      source_line_num,source_column_num);
  7096.                                   }
  7097.                             }
  7098.                           else
  7099.                             {
  7100.                               fatal_error=TRUE;
  7101.                               printf(
  7102.               "Fatal error:  the expression preceding column %ld on line %d\n",
  7103.                                source_column_num,source_line_num);
  7104.                               printf(
  7105.               "     should be Boolean but isn\'t.\n");
  7106.                             }
  7107.                           free_value(expression_header_ptr);
  7108.                         }
  7109.                       if (! fatal_error)
  7110.                         {
  7111.                           get_token();
  7112.                           if (source_token[0] == ' ')
  7113.                             {
  7114.                               fatal_error=TRUE;
  7115.                               printf("Fatal error:  file ends where \";\" ");
  7116.                               printf("of \"END;\" expected.\n");
  7117.                             }
  7118.                           else
  7119.                             {
  7120.                               if (source_token[0] != ';')
  7121.                                 {
  7122.                                   fatal_error=TRUE;
  7123.                                   printf(
  7124.                      "Fatal error:  \";\" expected at line %ld, column %ld.\n",
  7125.                                    source_line_num,source_column_num);
  7126.                                 }
  7127.                             }
  7128.                         }
  7129.                     }
  7130.                   while((! fatal_error)
  7131.                   &&    (evaluate)
  7132.                   &&    (condition_is_true));
  7133.                 }
  7134.               else
  7135.                 {
  7136.                   fatal_error=TRUE;
  7137.                   printf(
  7138.                   "\"(\" of \"DO WHILE(\" expected at line %ld, column %ld.\n",
  7139.                    source_line_num,source_column_num);
  7140.                 }
  7141.           }
  7142.         else
  7143.           if (source_token[0] == ' ')
  7144.             {
  7145.               fatal_error=TRUE;
  7146.               printf(
  7147.                "Fatal error:  file ends before \"DO\" statement completed.\n");
  7148.             }
  7149.           else
  7150.             {
  7151.               fatal_error=TRUE;
  7152.               printf(
  7153.         "Fatal error:  \";\" or \"WHILE\" expected at line %ld, column %ld.\n",
  7154.                source_line_num,source_column_num);
  7155.             }
  7156.       return;
  7157.     }
  7158.  
  7159. static void interpret_if(evaluate)
  7160.   int evaluate;
  7161.     {
  7162.       char             else_char;
  7163.       long             else_column_num;
  7164.       int              else_eof;
  7165.       long             else_line_num;
  7166.       int              else_index;
  7167.       char             else_token [256];
  7168.       value_header_ptr expression_header_ptr;
  7169.  
  7170.       expression_header_ptr=interpret_expression(evaluate);
  7171.       if (! fatal_error)
  7172.         {
  7173.           if ((! evaluate)
  7174.           ||  ((*expression_header_ptr).type == 'B'))
  7175.             {
  7176.               get_token();
  7177.               if (strcmp(source_token,"THEN") == 0)
  7178.                 {
  7179.                   get_token();
  7180.                   if (evaluate)
  7181.                     if (*((*expression_header_ptr).value_ptr.boolean))
  7182.                       interpret_statement(TRUE);
  7183.                     else
  7184.                       interpret_statement(FALSE);
  7185.                   else
  7186.                     interpret_statement(FALSE);
  7187.                   else_char=source_char;
  7188.                   else_column_num=source_column_num;
  7189.                   else_eof=source_eof;
  7190.                   else_index=source_index;
  7191.                   else_line_num=source_line_num;
  7192.                   strcpy(else_token,source_token);
  7193.                   get_token();
  7194.                   if (strcmp(source_token,"ELSE") == 0)
  7195.                     {
  7196.                       get_token();
  7197.                       if (evaluate)
  7198.                         if (*((*expression_header_ptr).value_ptr.boolean))
  7199.                           interpret_statement(FALSE);
  7200.                         else
  7201.                           interpret_statement(TRUE);
  7202.                       else
  7203.                         interpret_statement(FALSE);
  7204.                     }
  7205.                   else
  7206.                     {
  7207.                       if (else_index != source_index)
  7208.                         {
  7209.                           source_index=else_index;
  7210.                           source_char=source_buffer[source_index];
  7211.                         }
  7212.                       source_char=else_char;
  7213.                       source_column_num=else_column_num;
  7214.                       source_eof=else_eof;
  7215.                       source_line_num=else_line_num;
  7216.                       strcpy(source_token,else_token);
  7217.                     }
  7218.                 }
  7219.               else
  7220.                 if (source_token[0] == ' ')
  7221.                   {
  7222.                     fatal_error=TRUE;
  7223.                     printf(
  7224.                      "Fatal error:  file ends where \"THEN\" expected.\n");
  7225.                   }
  7226.                 else
  7227.                   {
  7228.                     fatal_error=TRUE;
  7229.                     printf(
  7230.                   "Fatal error:  \"THEN\" expected at line %ld, column %ld.\n",
  7231.                      source_line_num,source_column_num);
  7232.                   }
  7233.             }
  7234.           else
  7235.             {
  7236.               fatal_error=TRUE;
  7237.               printf(
  7238.              "Fatal error:  the expression preceding column %ld on line %ld\n",
  7239.                source_column_num,source_line_num);
  7240.               printf(
  7241.                "     is not a Boolean expression.\n");
  7242.             }
  7243.           free_value(expression_header_ptr);
  7244.         }
  7245.       return;
  7246.     }
  7247.  
  7248. static void interpret_assignment(evaluate,queue_head)
  7249.   int            evaluate;
  7250.   queue_node_ptr queue_head;
  7251.     {
  7252.       int              comparison;
  7253.       value_header_ptr expression_header_ptr;
  7254.       int              finished;
  7255.       queue_node_ptr   new_queue_copy;
  7256.       variable_ptr     new_variable_ptr;
  7257.       variable_ptr     old_variable_ptr;
  7258.       queue_node_ptr   queue_copy;
  7259.  
  7260.       expression_header_ptr=interpret_expression(evaluate);
  7261.       if (! fatal_error)
  7262.         {
  7263.           if (evaluate)
  7264.             {
  7265.               if (variable_head == NULL)
  7266.                 if ((variable_head=(struct variable *)
  7267.                  malloc((unsigned) sizeof(struct variable))) == NULL)
  7268.                   {
  7269.                     fatal_error=TRUE;
  7270.                     printf("Fatal error:  out of memory at ");
  7271.                     printf("line %ld, column %ld.\n",
  7272.                      source_line_num,source_column_num);
  7273.                   }
  7274.                 else
  7275.                   if (((*variable_head).name
  7276.                    =malloc((unsigned) (1+strlen(identifier)))) == NULL)
  7277.                     {
  7278.                       fatal_error=TRUE;
  7279.                       printf("Fatal error:  out of memory at ");
  7280.                       printf("line %ld, column %ld.\n",
  7281.                        source_line_num,source_column_num);
  7282.                       free((char *) variable_head);
  7283.                       variable_head=NULL;
  7284.                     }
  7285.                   else
  7286.                     {
  7287.                       strcpy((*variable_head).name,identifier);
  7288.                       (*variable_head).subscripts=copy_of_queue(queue_head);
  7289.                       if (! fatal_error)
  7290.                         (*variable_head).variable_value_header_ptr
  7291.                          =copy_of_arguments(expression_header_ptr);
  7292.                       if (fatal_error)
  7293.                         {
  7294.                           free((*variable_head).name);
  7295.                           free((char *) variable_head);
  7296.                           variable_head=NULL;
  7297.                         }
  7298.                       else
  7299.                         {
  7300.                           (*variable_head).predecessor_ptr=NULL;
  7301.                           (*variable_head).smaller_successor_ptr=NULL;
  7302.                           (*variable_head).larger_successor_ptr=NULL;
  7303.                         }
  7304.                     }
  7305.               else
  7306.                 {
  7307.                   old_variable_ptr=variable_head;
  7308.                   finished=FALSE;
  7309.                   queue_copy=copy_of_queue(queue_head);
  7310.                   do
  7311.                     {
  7312.                       comparison=variable_comparison(identifier,queue_copy,
  7313.                        (*old_variable_ptr).name,
  7314.                        (*old_variable_ptr).subscripts);
  7315.                       if (comparison < 0)
  7316.                         if ((*old_variable_ptr).smaller_successor_ptr == NULL)
  7317.                           {
  7318.                             if ((new_variable_ptr=(struct variable *)
  7319.                              malloc((unsigned) sizeof(struct variable)))
  7320.                              == NULL)
  7321.                               {
  7322.                                 fatal_error=TRUE;
  7323.                                 printf("Fatal error:  out of memory at ");
  7324.                                 printf("line %ld, column %ld.\n",
  7325.                                 source_line_num,source_column_num);
  7326.                               }
  7327.                             else
  7328.                               if (((*new_variable_ptr).name
  7329.                                =malloc((unsigned) (1+strlen(identifier))))
  7330.                                == NULL)
  7331.                                 {
  7332.                                   fatal_error=TRUE;
  7333.                                   printf("Fatal error:  out of memory at ");
  7334.                                   printf("line %ld, column %ld.\n",
  7335.                                    source_line_num,source_column_num);
  7336.                                   free((char *) variable_head);
  7337.                                   variable_head=NULL;
  7338.                                 }
  7339.                               else
  7340.                                 {
  7341.                                   strcpy((*new_variable_ptr).name,identifier);
  7342.                                   (*new_variable_ptr).subscripts=queue_copy;
  7343.                                   if (! fatal_error)
  7344.                                     (*new_variable_ptr).
  7345.                                      variable_value_header_ptr
  7346.                                      =copy_of_arguments(expression_header_ptr);
  7347.                                   if (fatal_error)
  7348.                                     {
  7349.                                       free((*new_variable_ptr).name);
  7350.                                       free((char *) new_variable_ptr);
  7351.                                       new_variable_ptr=NULL;
  7352.                                     }
  7353.                                   else
  7354.                                     {
  7355.                                       (*new_variable_ptr).predecessor_ptr
  7356.                                        =old_variable_ptr;
  7357.                                       (*new_variable_ptr).
  7358.                                        smaller_successor_ptr=NULL;
  7359.                                       (*new_variable_ptr).
  7360.                                        larger_successor_ptr=NULL;
  7361.                                       (*old_variable_ptr).
  7362.                                        smaller_successor_ptr
  7363.                                        =new_variable_ptr;
  7364.                                     }
  7365.                                 }
  7366.                             finished=TRUE;
  7367.                           }
  7368.                         else
  7369.                           old_variable_ptr
  7370.                            =(*old_variable_ptr).smaller_successor_ptr;
  7371.                       else
  7372.                         if (comparison > 0)
  7373.                           if ((*old_variable_ptr).larger_successor_ptr
  7374.                            == NULL)
  7375.                             {
  7376.                               if ((new_variable_ptr=(struct variable *)
  7377.                                malloc((unsigned) sizeof(struct variable)))
  7378.                                == NULL)
  7379.                                 {
  7380.                                   fatal_error=TRUE;
  7381.                                   printf("Fatal error:  out of memory at ");
  7382.                                   printf("line %ld, column %ld.\n",
  7383.                                   source_line_num,source_column_num);
  7384.                                 }
  7385.                               else
  7386.                                 if (((*new_variable_ptr).name
  7387.                                  =malloc((unsigned) (1+strlen(identifier))))
  7388.                                  == NULL)
  7389.                                   {
  7390.                                     fatal_error=TRUE;
  7391.                                     printf("Fatal error:  out of memory at ");
  7392.                                     printf("line %ld, column %ld.\n",
  7393.                                      source_line_num,source_column_num);
  7394.                                     free((char *) variable_head);
  7395.                                     variable_head=NULL;
  7396.                                   }
  7397.                                 else
  7398.                                   {
  7399.                                     strcpy((*new_variable_ptr).name,
  7400.                                      identifier);
  7401.                                     (*new_variable_ptr).subscripts=queue_copy;
  7402.                                     if (! fatal_error)
  7403.                                       (*new_variable_ptr).
  7404.                                        variable_value_header_ptr
  7405.                                        =copy_of_arguments(
  7406.                                        expression_header_ptr);
  7407.                                     if (fatal_error)
  7408.                                       {
  7409.                                         free((*new_variable_ptr).name);
  7410.                                         free((char *) new_variable_ptr);
  7411.                                         new_variable_ptr=NULL;
  7412.                                       }
  7413.                                     else
  7414.                                       {
  7415.                                         (*new_variable_ptr).predecessor_ptr
  7416.                                          =old_variable_ptr;
  7417.                                         (*new_variable_ptr).
  7418.                                          smaller_successor_ptr=NULL;
  7419.                                         (*new_variable_ptr).
  7420.                                          larger_successor_ptr=NULL;
  7421.                                         (*old_variable_ptr).
  7422.                                          larger_successor_ptr
  7423.                                          =new_variable_ptr;
  7424.                                       }
  7425.                                   }
  7426.                               finished=TRUE;
  7427.                             }
  7428.                           else
  7429.                             old_variable_ptr
  7430.                              =(*old_variable_ptr).larger_successor_ptr;
  7431.                         else
  7432.                           {
  7433.                             finished=TRUE;
  7434.                             while (queue_copy != NULL)
  7435.                               {
  7436.                                 new_queue_copy=(*queue_copy).next;
  7437.                                 free_value((*queue_copy).argument_header_ptr);
  7438.                                 free((char *) queue_copy);
  7439.                                 queue_copy=new_queue_copy;
  7440.                               }
  7441.                             free_value(
  7442.                              (*old_variable_ptr).variable_value_header_ptr);
  7443.                             (*old_variable_ptr).variable_value_header_ptr
  7444.                              =copy_of_arguments(expression_header_ptr);
  7445.                           }
  7446.                     }
  7447.                   while (! finished);
  7448.                 }
  7449.               free_value(expression_header_ptr);
  7450.             }
  7451.         }
  7452.       if (! fatal_error)
  7453.         {
  7454.           get_token();
  7455.           if (source_token[0] == ' ')
  7456.             {
  7457.               fatal_error=TRUE;
  7458.               printf(
  7459.                "Fatal error:  file ends where \";\" expected.\n");
  7460.             }
  7461.           else
  7462.             {
  7463.               if (source_token[0] != ';')
  7464.                 {
  7465.                   fatal_error=TRUE;
  7466.                   printf(
  7467.                    "Fatal error:  \";\" expected at line %ld, column %ld.\n",
  7468.                    source_line_num,source_column_num);
  7469.                 }
  7470.             }
  7471.         }
  7472.     }
  7473.  
  7474. static void perform_close(evaluate,queue_head)
  7475.   int            evaluate;
  7476.   queue_node_ptr queue_head;
  7477.     {
  7478.       if (queue_head == NULL)
  7479.         {
  7480.           if (evaluate)
  7481.             fclose(stdin);
  7482.         }
  7483.       else
  7484.         if ((*queue_head).next == NULL)
  7485.           {
  7486.             if (evaluate)
  7487.               {
  7488.                 if ((*((*queue_head).argument_header_ptr)).type == 'D')
  7489.                   fclose(
  7490.                    *((*((*queue_head).argument_header_ptr)).value_ptr.dataset));
  7491.                 else
  7492.                   {
  7493.                     fatal_error=TRUE;
  7494.                     printf(
  7495.                  "Fatal error:  argument to CLOSE is not a file pointer on\n");
  7496.                     printf("     line %ld, column %ld.\n",
  7497.                      source_line_num,source_column_num);
  7498.                   }
  7499.               }
  7500.           }
  7501.         else
  7502.           {
  7503.             fatal_error=TRUE;
  7504.             printf(
  7505.              "Fatal error:  extraneous arguments supplied to CLOSE on\n");
  7506.             printf("     line %ld, column %ld.\n",
  7507.              source_line_num,source_column_num);
  7508.           }
  7509.       return;
  7510.     }
  7511.  
  7512. static void perform_clrscr(evaluate,queue_head)
  7513.   int            evaluate;
  7514.   queue_node_ptr queue_head;
  7515.     {
  7516.       union REGS inreg;
  7517.       union REGS outreg;
  7518.  
  7519.       if (queue_head == NULL)
  7520.         {
  7521.           if (evaluate)
  7522.             {
  7523.               inreg.h.ah=(unsigned char) 15;
  7524.               int86(16,&inreg,&outreg);
  7525.               inreg.h.ah=(unsigned char) 0;
  7526.               inreg.h.al=outreg.h.al;
  7527.               int86(16,&inreg,&outreg);
  7528.             }
  7529.         }
  7530.       else
  7531.         {
  7532.           fatal_error=TRUE;
  7533.           printf(
  7534.            "Fatal error:  extraneous arguments supplied to CLOSE on\n");
  7535.           printf("     line %ld, column %ld.\n",
  7536.            source_line_num,source_column_num);
  7537.         }
  7538.       return;
  7539.     }
  7540.  
  7541. static void perform_print(evaluate,queue_head)
  7542.   int            evaluate;
  7543.   queue_node_ptr queue_head;
  7544.     {
  7545.       register int  char_index;
  7546.       unsigned char *char_ptr;
  7547.       FILE          *file;
  7548.       int           string_length;
  7549.  
  7550.       if (queue_head == NULL)
  7551.         {
  7552.           fatal_error=TRUE;
  7553.           printf(
  7554.            "Fatal error:  first parameter to PRINT is missing on\n");
  7555.           printf(
  7556.            "     line %ld, column %ld.\n",source_line_num,
  7557.            source_column_num);
  7558.         }
  7559.       else
  7560.         {
  7561.           if (evaluate)
  7562.             {
  7563.               if ((*((*queue_head).argument_header_ptr)).type == 'D')
  7564.                 {
  7565.                   file=
  7566.                    *((*((*queue_head).argument_header_ptr)).value_ptr.dataset);
  7567.                   queue_head=(*queue_head).next;
  7568.                   while (queue_head != NULL)
  7569.                     {
  7570.                       switch ((*((*queue_head).argument_header_ptr)).type)
  7571.                         {
  7572.                           case 'B':
  7573.                             if (*((*((*queue_head).argument_header_ptr)).
  7574.                              value_ptr.boolean))
  7575.                               fprintf(file,"TRUE");
  7576.                             else
  7577.                               fprintf(file,"FALSE");
  7578.                             break;
  7579.                           case 'D':
  7580.                             fprintf(file,"%p",(char far *)
  7581.                              *((*((*queue_head).argument_header_ptr)).
  7582.                              value_ptr.dataset));
  7583.                             break;
  7584.                           case 'I':
  7585.                             fprintf(file,"%ld",
  7586.                              *((*((*queue_head).argument_header_ptr)).
  7587.                              value_ptr.integer));
  7588.                             break;
  7589.                           case 'R':
  7590.                             fprintf(file,"%lG",
  7591.                              *((*((*queue_head).argument_header_ptr)).
  7592.                              value_ptr.real));
  7593.                             break;
  7594.                           default:
  7595.                             char_ptr=(*((*((*queue_head).argument_header_ptr)).
  7596.                              value_ptr.string)).value;
  7597.                             string_length
  7598.                              =(*((*((*queue_head).argument_header_ptr)).
  7599.                              value_ptr.string)).length;
  7600.                             for (char_index=0; char_index < string_length;
  7601.                              char_index++)
  7602.                               {
  7603.                                 fputc((int) *char_ptr,file);
  7604.                                 char_ptr++;
  7605.                               }
  7606.                             break;
  7607.                         }
  7608.                       queue_head=(*queue_head).next;
  7609.                     }
  7610.                 }
  7611.               else
  7612.                 {
  7613.                   fatal_error=TRUE;
  7614.                   printf(
  7615.           "Fatal error:  first parameter to PRINT is not a file pointer on\n");
  7616.                   printf(
  7617.                    "     line %ld, column %ld.\n",source_line_num,
  7618.                    source_column_num);
  7619.                 }
  7620.             }
  7621.         }
  7622.       return;
  7623.     }
  7624.  
  7625. static void perform_putcrlf(evaluate,queue_head)
  7626.   int            evaluate;
  7627.   queue_node_ptr queue_head;
  7628.     {
  7629.       if (queue_head == NULL)
  7630.         {
  7631.           if (evaluate)
  7632.             printf("\n");
  7633.         }
  7634.       else
  7635.         if ((*queue_head).next == NULL)
  7636.           {
  7637.             if (evaluate)
  7638.               {
  7639.                 if ((*((*queue_head).argument_header_ptr)).type == 'D')
  7640.                   fprintf(
  7641.                    *((*((*queue_head).argument_header_ptr)).value_ptr.dataset),
  7642.                    "\n");
  7643.                 else
  7644.                   {
  7645.                     fatal_error=TRUE;
  7646.                     printf(
  7647.                "Fatal error:  argument to PUTCRLF is not a file pointer on\n");
  7648.                     printf("     line %ld, column %ld.\n",
  7649.                      source_line_num,source_column_num);
  7650.                   }
  7651.               }
  7652.           }
  7653.         else
  7654.           {
  7655.             fatal_error=TRUE;
  7656.             printf(
  7657.              "Fatal error:  extraneous arguments supplied to PUTCRLF on\n");
  7658.             printf("     line %ld, column %ld.\n",
  7659.              source_line_num,source_column_num);
  7660.           }
  7661.       return;
  7662.     }
  7663.  
  7664. static void perform_troff(evaluate,queue_head)
  7665.   int            evaluate;
  7666.   queue_node_ptr queue_head;
  7667.     {
  7668.       if (queue_head == NULL)
  7669.         {
  7670.           if (evaluate)
  7671.             trace=FALSE;
  7672.         }
  7673.       else
  7674.         {
  7675.           fatal_error=TRUE;
  7676.           printf(
  7677.            "Fatal error:  extraneous arguments supplied to TROFF on\n");
  7678.           printf("     line %ld, column %ld.\n",
  7679.            source_line_num,source_column_num);
  7680.         }
  7681.       return;
  7682.     }
  7683.  
  7684. static void perform_tron(evaluate,queue_head)
  7685.   int            evaluate;
  7686.   queue_node_ptr queue_head;
  7687.     {
  7688.       if (queue_head == NULL)
  7689.         {
  7690.           if (evaluate)
  7691.             trace=TRUE;
  7692.         }
  7693.       else
  7694.         {
  7695.           fatal_error=TRUE;
  7696.           printf(
  7697.            "Fatal error:  extraneous arguments supplied to TRON on\n");
  7698.           printf("     line %ld, column %ld.\n",
  7699.            source_line_num,source_column_num);
  7700.         }
  7701.       return;
  7702.     }
  7703.  
  7704. static void interpret_procedure(evaluate,queue_head)
  7705.   int            evaluate;
  7706.   queue_node_ptr queue_head;
  7707.     {
  7708.       if      (strcmp(identifier,"CLOSE") == 0)
  7709.         perform_close(evaluate,queue_head);
  7710.       else if (strcmp(identifier,"CLRSCR") == 0)
  7711.         perform_clrscr(evaluate,queue_head);
  7712.       else if (strcmp(identifier,"PRINT") == 0)
  7713.         perform_print(evaluate,queue_head);
  7714.       else if (strcmp(identifier,"PUTCRLF") == 0)
  7715.         perform_putcrlf(evaluate,queue_head);
  7716.       else if (strcmp(identifier,"TROFF") == 0)
  7717.         perform_troff(evaluate,queue_head);
  7718.       else if (strcmp(identifier,"TRON") == 0)
  7719.         perform_tron(evaluate,queue_head);
  7720.       else
  7721.         {
  7722.           fatal_error=TRUE;
  7723.           printf(
  7724.            "Fatal error:  unrecognized procedure \"%s\" at ",
  7725.            identifier);
  7726.           printf(
  7727.            "line %ld, column %ld.\n",source_line_num,
  7728.            source_column_num);
  7729.         }
  7730.       return;
  7731.     }
  7732.  
  7733. static void interpret_statement(evaluate)
  7734.   int evaluate;
  7735.     {
  7736.       queue_node_ptr new_queue_head;
  7737.       queue_node_ptr new_queue_tail;
  7738.       queue_node_ptr queue_head;
  7739.       queue_node_ptr queue_tail;
  7740.  
  7741.       if ((evaluate) && (trace))
  7742.         printf("[%ld]",source_line_num);
  7743.       if (source_token[0] == ' ')
  7744.         {
  7745.           fatal_error=TRUE;
  7746.           printf("Fatal error:  end of file encountered where statement ");
  7747.           printf("expected.\n");
  7748.         }
  7749.       else
  7750.         if (strcmp(source_token,"DO") == 0)
  7751.           interpret_do(evaluate);
  7752.         else
  7753.           if (strcmp(source_token,"IF") == 0)
  7754.             interpret_if(evaluate);
  7755.           else
  7756.             {
  7757.               if (strcmp(source_token,";") != 0)
  7758.                 {
  7759.                   if (isalpha((int) source_token[0]))
  7760.                     {
  7761.                       queue_tail=NULL;
  7762.                       queue_head=NULL;
  7763.                       strcpy(identifier,source_token);
  7764.                       get_token();
  7765.                       if (source_token[0] == '(')
  7766.                         {
  7767.                           if ((queue_head=(queue_node_ptr)
  7768.                            malloc((unsigned) sizeof(struct queue_node)))
  7769.                            == NULL)
  7770.                             {
  7771.                               fatal_error=TRUE;
  7772.                               printf(
  7773.                       "Fatal error:  out of memory at line %ld, column %ld.\n",
  7774.                                source_line_num,source_column_num);
  7775.                             }
  7776.                           else
  7777.                             {
  7778.                               queue_tail=queue_head;
  7779.                               (*queue_head).next=NULL;
  7780.                               (*queue_head).argument_header_ptr
  7781.                                =interpret_expression(evaluate);
  7782.                             }
  7783.                           if (! fatal_error)
  7784.                             get_token();
  7785.                           while ((! fatal_error)
  7786.                           &&     (! source_eof)
  7787.                           &&     (source_token[0] != ')'))
  7788.                             {
  7789.                               if ((new_queue_tail=(queue_node_ptr)
  7790.                                malloc((unsigned) sizeof(struct queue_node)))
  7791.                                == NULL)
  7792.                                 {
  7793.                                   fatal_error=TRUE;
  7794.                                   printf(
  7795.                       "Fatal error:  out of memory at line %ld, column %ld.\n",
  7796.                                    source_line_num,source_column_num);
  7797.                                 }
  7798.                               else
  7799.                                 {
  7800.                                   (*new_queue_tail).next=NULL;
  7801.                                   (*queue_tail).next=new_queue_tail;
  7802.                                   queue_tail=new_queue_tail;
  7803.                                   (*new_queue_tail).argument_header_ptr
  7804.                                    =interpret_expression(evaluate);
  7805.                                 }
  7806.                               if (! fatal_error)
  7807.                                 get_token();
  7808.                             }
  7809.                           if (! fatal_error)
  7810.                             {
  7811.                               if (source_token [0] == ')')
  7812.                                 get_token();
  7813.                             }
  7814.                         }
  7815.                       if (! fatal_error)
  7816.                         {
  7817.                           if (source_token[0] == '=')
  7818.                             interpret_assignment(evaluate,queue_head);
  7819.                           else
  7820.                             if (source_token[0] == ';')
  7821.                               interpret_procedure(evaluate,queue_head);
  7822.                             else
  7823.                               if (source_token[0] == ' ')
  7824.                                 {
  7825.                                   fatal_error=TRUE;
  7826.                                   printf(
  7827.                    "Fatal error:  file ends where \"=\" or \";\" expected.\n");
  7828.                                 }
  7829.                               else
  7830.                                 {
  7831.                                   fatal_error=TRUE;
  7832.                                   printf(
  7833.                        "Fatal error:  \"=\", or \";\" expected at line %ld,\n",
  7834.                                    source_line_num);
  7835.                                   printf(
  7836.                                    "     column %ld.\n",source_column_num);
  7837.                                 }
  7838.                         }
  7839.                       while (queue_head != NULL)
  7840.                         {
  7841.                           new_queue_head=(*queue_head).next;
  7842.                           free_value((*queue_head).argument_header_ptr);
  7843.                           free((char *) queue_head);
  7844.                           queue_head=new_queue_head;
  7845.                         }
  7846.                     }
  7847.                   else
  7848.                     if (source_token[0] == ' ')
  7849.                       {
  7850.                         fatal_error=TRUE;
  7851.                         printf(
  7852.           "Fatal error:  end of file encountered where statement expected.\n");
  7853.                       }
  7854.                     else
  7855.                       {
  7856.                         fatal_error=TRUE;
  7857.                         printf("Fatal error:  expected statement at ");
  7858.                         printf("     line %ld, column %ld.\n",source_line_num,
  7859.                          source_column_num);
  7860.                       }
  7861.                 }
  7862.             }
  7863.       return;
  7864.     }
  7865.  
  7866. void set_boolean_variable(identifier,value)
  7867.   char *identifier;
  7868.   int  value;
  7869.     {
  7870.       int              comparison;
  7871.       char             current_identifier [256];
  7872.       int              finished;
  7873.       variable_ptr     new_variable_ptr;
  7874.       variable_ptr     old_variable_ptr;
  7875.  
  7876.       if (variable_head == NULL)
  7877.         if ((variable_head=(struct variable *)
  7878.          malloc((unsigned) sizeof(struct variable))) == NULL)
  7879.           {
  7880.             fatal_error=TRUE;
  7881.             printf("Fatal error:  out of memory at ");
  7882.             printf("line %ld, column %ld.\n",
  7883.              source_line_num,source_column_num);
  7884.           }
  7885.         else
  7886.           if (((*variable_head).name
  7887.            =malloc((unsigned) (1+strlen(identifier)))) == NULL)
  7888.             {
  7889.               fatal_error=TRUE;
  7890.               printf("Fatal error:  out of memory at ");
  7891.               printf("line %ld, column %ld.\n",
  7892.                source_line_num,source_column_num);
  7893.               free((char *) variable_head);
  7894.               variable_head=NULL;
  7895.             }
  7896.           else
  7897.             {
  7898.               strcpy((*variable_head).name,identifier);
  7899.               strupr((*variable_head).name);
  7900.               (*variable_head).subscripts=NULL;
  7901.               if (! fatal_error)
  7902.                 (*variable_head).variable_value_header_ptr
  7903.                  =new_boolean_header_ptr();
  7904.               if (fatal_error)
  7905.                 {
  7906.                   free((*variable_head).name);
  7907.                   free((char *) variable_head);
  7908.                   variable_head=NULL;
  7909.                 }
  7910.               else
  7911.                 {
  7912.                   if (value)
  7913.                     *((*((*variable_head).variable_value_header_ptr)).value_ptr.
  7914.                      boolean)=TRUE;
  7915.                   else
  7916.                     *((*((*variable_head).variable_value_header_ptr)).value_ptr.
  7917.                      boolean)=FALSE;
  7918.                   (*variable_head).predecessor_ptr=NULL;
  7919.                   (*variable_head).smaller_successor_ptr=NULL;
  7920.                   (*variable_head).larger_successor_ptr=NULL;
  7921.                 }
  7922.             }
  7923.       else
  7924.         {
  7925.           strcpy(current_identifier,identifier);
  7926.           strupr(current_identifier);
  7927.           old_variable_ptr=variable_head;
  7928.           finished=FALSE;
  7929.           do
  7930.             {
  7931.               comparison=variable_comparison(current_identifier,NULL,
  7932.                (*old_variable_ptr).name,
  7933.                (*old_variable_ptr).subscripts);
  7934.               if (comparison < 0)
  7935.                 if ((*old_variable_ptr).smaller_successor_ptr == NULL)
  7936.                   {
  7937.                     if ((new_variable_ptr=(struct variable *)
  7938.                      malloc((unsigned) sizeof(struct variable)))
  7939.                      == NULL)
  7940.                       {
  7941.                         fatal_error=TRUE;
  7942.                         printf("Fatal error:  out of memory at ");
  7943.                         printf("line %ld, column %ld.\n",
  7944.                         source_line_num,source_column_num);
  7945.                       }
  7946.                     else
  7947.                       if (((*new_variable_ptr).name
  7948.                        =malloc((unsigned) (1+strlen(current_identifier))))
  7949.                        == NULL)
  7950.                         {
  7951.                           fatal_error=TRUE;
  7952.                           printf("Fatal error:  out of memory at ");
  7953.                           printf("line %ld, column %ld.\n",
  7954.                            source_line_num,source_column_num);
  7955.                           free((char *) variable_head);
  7956.                           variable_head=NULL;
  7957.                         }
  7958.                       else
  7959.                         {
  7960.                           strcpy((*new_variable_ptr).name,current_identifier);
  7961.                           (*new_variable_ptr).subscripts=NULL;
  7962.                           if (! fatal_error)
  7963.                             (*new_variable_ptr).
  7964.                              variable_value_header_ptr
  7965.                              =new_boolean_header_ptr();
  7966.                           if (fatal_error)
  7967.                             {
  7968.                               free((*new_variable_ptr).name);
  7969.                               free((char *) new_variable_ptr);
  7970.                               new_variable_ptr=NULL;
  7971.                             }
  7972.                           else
  7973.                             {
  7974.                               if (value)
  7975.                                 *((*((*new_variable_ptr).
  7976.                                  variable_value_header_ptr)).value_ptr.boolean)
  7977.                                  =TRUE;
  7978.                               else
  7979.                                 *((*((*new_variable_ptr).
  7980.                                  variable_value_header_ptr)).value_ptr.boolean)
  7981.                                  =FALSE;
  7982.                               (*new_variable_ptr).predecessor_ptr
  7983.                                =old_variable_ptr;
  7984.                               (*new_variable_ptr).
  7985.                                smaller_successor_ptr=NULL;
  7986.                               (*new_variable_ptr).
  7987.                                larger_successor_ptr=NULL;
  7988.                               (*old_variable_ptr).
  7989.                                smaller_successor_ptr
  7990.                                =new_variable_ptr;
  7991.                             }
  7992.                         }
  7993.                     finished=TRUE;
  7994.                   }
  7995.                 else
  7996.                   old_variable_ptr
  7997.                    =(*old_variable_ptr).smaller_successor_ptr;
  7998.               else
  7999.                 if (comparison > 0)
  8000.                   if ((*old_variable_ptr).larger_successor_ptr
  8001.                    == NULL)
  8002.                     {
  8003.                       if ((new_variable_ptr=(struct variable *)
  8004.                        malloc((unsigned) sizeof(struct variable)))
  8005.                        == NULL)
  8006.                         {
  8007.                           fatal_error=TRUE;
  8008.                           printf("Fatal error:  out of memory at ");
  8009.                           printf("line %ld, column %ld.\n",
  8010.                           source_line_num,source_column_num);
  8011.                         }
  8012.                       else
  8013.                         if (((*new_variable_ptr).name
  8014.                          =malloc((unsigned) (1+strlen(current_identifier))))
  8015.                          == NULL)
  8016.                           {
  8017.                             fatal_error=TRUE;
  8018.                             printf("Fatal error:  out of memory at ");
  8019.                             printf("line %ld, column %ld.\n",
  8020.                              source_line_num,source_column_num);
  8021.                             free((char *) variable_head);
  8022.                             variable_head=NULL;
  8023.                           }
  8024.                         else
  8025.                           {
  8026.                             strcpy((*new_variable_ptr).name,
  8027.                              current_identifier);
  8028.                             (*new_variable_ptr).subscripts=NULL;
  8029.                             if (! fatal_error)
  8030.                               (*new_variable_ptr).
  8031.                                variable_value_header_ptr
  8032.                                =new_boolean_header_ptr();
  8033.                             if (fatal_error)
  8034.                               {
  8035.                                 free((*new_variable_ptr).name);
  8036.                                 free((char *) new_variable_ptr);
  8037.                                 new_variable_ptr=NULL;
  8038.                               }
  8039.                             else
  8040.                               {
  8041.                                 if (value)
  8042.                                   *((*((*new_variable_ptr).
  8043.                                    variable_value_header_ptr)).value_ptr.boolean)
  8044.                                    =TRUE;
  8045.                                 else
  8046.                                   *((*((*new_variable_ptr).
  8047.                                    variable_value_header_ptr)).value_ptr.boolean)
  8048.                                    =FALSE;
  8049.                                 (*new_variable_ptr).predecessor_ptr
  8050.                                  =old_variable_ptr;
  8051.                                 (*new_variable_ptr).
  8052.                                  smaller_successor_ptr=NULL;
  8053.                                 (*new_variable_ptr).
  8054.                                  larger_successor_ptr=NULL;
  8055.                                 (*old_variable_ptr).
  8056.                                  larger_successor_ptr
  8057.                                  =new_variable_ptr;
  8058.                               }
  8059.                           }
  8060.                       finished=TRUE;
  8061.                     }
  8062.                   else
  8063.                     old_variable_ptr
  8064.                      =(*old_variable_ptr).larger_successor_ptr;
  8065.                 else
  8066.                   {
  8067.                     finished=TRUE;
  8068.                     free_value(
  8069.                      (*old_variable_ptr).variable_value_header_ptr);
  8070.                     (*old_variable_ptr).variable_value_header_ptr
  8071.                       =new_boolean_header_ptr();
  8072.                     if (! fatal_error)
  8073.                       {
  8074.                         if (value)
  8075.                           *((*((*old_variable_ptr).
  8076.                            variable_value_header_ptr)).value_ptr.boolean)
  8077.                            =TRUE;
  8078.                         else
  8079.                           *((*((*old_variable_ptr).
  8080.                            variable_value_header_ptr)).value_ptr.boolean)
  8081.                            =FALSE;
  8082.                       }
  8083.                   }
  8084.             }
  8085.           while (! finished);
  8086.         }
  8087.     }
  8088.  
  8089. void set_integer_variable(identifier,value)
  8090.   char *identifier;
  8091.   long value;
  8092.     {
  8093.       int              comparison;
  8094.       char             current_identifier [256];
  8095.       int              finished;
  8096.       variable_ptr     new_variable_ptr;
  8097.       variable_ptr     old_variable_ptr;
  8098.  
  8099.       if (variable_head == NULL)
  8100.         if ((variable_head=(struct variable *)
  8101.          malloc((unsigned) sizeof(struct variable))) == NULL)
  8102.           {
  8103.             fatal_error=TRUE;
  8104.             printf("Fatal error:  out of memory at ");
  8105.             printf("line %ld, column %ld.\n",
  8106.              source_line_num,source_column_num);
  8107.           }
  8108.         else
  8109.           if (((*variable_head).name
  8110.            =malloc((unsigned) (1+strlen(identifier)))) == NULL)
  8111.             {
  8112.               fatal_error=TRUE;
  8113.               printf("Fatal error:  out of memory at ");
  8114.               printf("line %ld, column %ld.\n",
  8115.                source_line_num,source_column_num);
  8116.               free((char *) variable_head);
  8117.               variable_head=NULL;
  8118.             }
  8119.           else
  8120.             {
  8121.               strcpy((*variable_head).name,identifier);
  8122.               strupr((*variable_head).name);
  8123.               (*variable_head).subscripts=NULL;
  8124.               if (! fatal_error)
  8125.                 (*variable_head).variable_value_header_ptr
  8126.                  =new_integer_header_ptr();
  8127.               if (fatal_error)
  8128.                 {
  8129.                   free((*variable_head).name);
  8130.                   free((char *) variable_head);
  8131.                   variable_head=NULL;
  8132.                 }
  8133.               else
  8134.                 {
  8135.                   *((*((*variable_head).variable_value_header_ptr)).value_ptr.
  8136.                    integer)=value;
  8137.                   (*variable_head).predecessor_ptr=NULL;
  8138.                   (*variable_head).smaller_successor_ptr=NULL;
  8139.                   (*variable_head).larger_successor_ptr=NULL;
  8140.                 }
  8141.             }
  8142.       else
  8143.         {
  8144.           strcpy(current_identifier,identifier);
  8145.           strupr(current_identifier);
  8146.           old_variable_ptr=variable_head;
  8147.           finished=FALSE;
  8148.           do
  8149.             {
  8150.               comparison=variable_comparison(current_identifier,NULL,
  8151.                (*old_variable_ptr).name,
  8152.                (*old_variable_ptr).subscripts);
  8153.               if (comparison < 0)
  8154.                 if ((*old_variable_ptr).smaller_successor_ptr == NULL)
  8155.                   {
  8156.                     if ((new_variable_ptr=(struct variable *)
  8157.                      malloc((unsigned) sizeof(struct variable)))
  8158.                      == NULL)
  8159.                       {
  8160.                         fatal_error=TRUE;
  8161.                         printf("Fatal error:  out of memory at ");
  8162.                         printf("line %ld, column %ld.\n",
  8163.                         source_line_num,source_column_num);
  8164.                       }
  8165.                     else
  8166.                       if (((*new_variable_ptr).name
  8167.                        =malloc((unsigned) (1+strlen(current_identifier))))
  8168.                        == NULL)
  8169.                         {
  8170.                           fatal_error=TRUE;
  8171.                           printf("Fatal error:  out of memory at ");
  8172.                           printf("line %ld, column %ld.\n",
  8173.                            source_line_num,source_column_num);
  8174.                           free((char *) variable_head);
  8175.                           variable_head=NULL;
  8176.                         }
  8177.                       else
  8178.                         {
  8179.                           strcpy((*new_variable_ptr).name,current_identifier);
  8180.                           (*new_variable_ptr).subscripts=NULL;
  8181.                           if (! fatal_error)
  8182.                             (*new_variable_ptr).
  8183.                              variable_value_header_ptr
  8184.                              =new_integer_header_ptr();
  8185.                           if (fatal_error)
  8186.                             {
  8187.                               free((*new_variable_ptr).name);
  8188.                               free((char *) new_variable_ptr);
  8189.                               new_variable_ptr=NULL;
  8190.                             }
  8191.                           else
  8192.                             {
  8193.                               *((*((*new_variable_ptr).
  8194.                                variable_value_header_ptr)).value_ptr.integer)
  8195.                                =value;
  8196.                               (*new_variable_ptr).predecessor_ptr
  8197.                                =old_variable_ptr;
  8198.                               (*new_variable_ptr).
  8199.                                smaller_successor_ptr=NULL;
  8200.                               (*new_variable_ptr).
  8201.                                larger_successor_ptr=NULL;
  8202.                               (*old_variable_ptr).
  8203.                                smaller_successor_ptr
  8204.                                =new_variable_ptr;
  8205.                             }
  8206.                         }
  8207.                     finished=TRUE;
  8208.                   }
  8209.                 else
  8210.                   old_variable_ptr
  8211.                    =(*old_variable_ptr).smaller_successor_ptr;
  8212.               else
  8213.                 if (comparison > 0)
  8214.                   if ((*old_variable_ptr).larger_successor_ptr
  8215.                    == NULL)
  8216.                     {
  8217.                       if ((new_variable_ptr=(struct variable *)
  8218.                        malloc((unsigned) sizeof(struct variable)))
  8219.                        == NULL)
  8220.                         {
  8221.                           fatal_error=TRUE;
  8222.                           printf("Fatal error:  out of memory at ");
  8223.                           printf("line %ld, column %ld.\n",
  8224.                           source_line_num,source_column_num);
  8225.                         }
  8226.                       else
  8227.                         if (((*new_variable_ptr).name
  8228.                          =malloc((unsigned) (1+strlen(current_identifier))))
  8229.                          == NULL)
  8230.                           {
  8231.                             fatal_error=TRUE;
  8232.                             printf("Fatal error:  out of memory at ");
  8233.                             printf("line %ld, column %ld.\n",
  8234.                              source_line_num,source_column_num);
  8235.                             free((char *) variable_head);
  8236.                             variable_head=NULL;
  8237.                           }
  8238.                         else
  8239.                           {
  8240.                             strcpy((*new_variable_ptr).name,
  8241.                              current_identifier);
  8242.                             (*new_variable_ptr).subscripts=NULL;
  8243.                             if (! fatal_error)
  8244.                               (*new_variable_ptr).
  8245.                                variable_value_header_ptr
  8246.                                =new_integer_header_ptr();
  8247.                             if (fatal_error)
  8248.                               {
  8249.                                 free((*new_variable_ptr).name);
  8250.                                 free((char *) new_variable_ptr);
  8251.                                 new_variable_ptr=NULL;
  8252.                               }
  8253.                             else
  8254.                               {
  8255.                                 *((*((*new_variable_ptr).
  8256.                                  variable_value_header_ptr)).value_ptr.integer)
  8257.                                  =value;
  8258.                                 (*new_variable_ptr).predecessor_ptr
  8259.                                  =old_variable_ptr;
  8260.                                 (*new_variable_ptr).
  8261.                                  smaller_successor_ptr=NULL;
  8262.                                 (*new_variable_ptr).
  8263.                                  larger_successor_ptr=NULL;
  8264.                                 (*old_variable_ptr).
  8265.                                  larger_successor_ptr
  8266.                                  =new_variable_ptr;
  8267.                               }
  8268.                           }
  8269.                       finished=TRUE;
  8270.                     }
  8271.                   else
  8272.                     old_variable_ptr
  8273.                      =(*old_variable_ptr).larger_successor_ptr;
  8274.                 else
  8275.                   {
  8276.                     finished=TRUE;
  8277.                     free_value(
  8278.                      (*old_variable_ptr).variable_value_header_ptr);
  8279.                     (*old_variable_ptr).variable_value_header_ptr
  8280.                       =new_integer_header_ptr();
  8281.                     if (! fatal_error)
  8282.                       *((*((*old_variable_ptr).
  8283.                        variable_value_header_ptr)).value_ptr.integer)=value;
  8284.                   }
  8285.             }
  8286.           while (! finished);
  8287.         }
  8288.     }
  8289.  
  8290. void set_real_variable(identifier,value)
  8291.   char   *identifier;
  8292.   double value;
  8293.     {
  8294.       int              comparison;
  8295.       char             current_identifier [256];
  8296.       int              finished;
  8297.       variable_ptr     new_variable_ptr;
  8298.       variable_ptr     old_variable_ptr;
  8299.  
  8300.       if (variable_head == NULL)
  8301.         if ((variable_head=(struct variable *)
  8302.          malloc((unsigned) sizeof(struct variable))) == NULL)
  8303.           {
  8304.             fatal_error=TRUE;
  8305.             printf("Fatal error:  out of memory at ");
  8306.             printf("line %ld, column %ld.\n",
  8307.              source_line_num,source_column_num);
  8308.           }
  8309.         else
  8310.           if (((*variable_head).name
  8311.            =malloc((unsigned) (1+strlen(identifier)))) == NULL)
  8312.             {
  8313.               fatal_error=TRUE;
  8314.               printf("Fatal error:  out of memory at ");
  8315.               printf("line %ld, column %ld.\n",
  8316.                source_line_num,source_column_num);
  8317.               free((char *) variable_head);
  8318.               variable_head=NULL;
  8319.             }
  8320.           else
  8321.             {
  8322.               strcpy((*variable_head).name,identifier);
  8323.               strupr((*variable_head).name);
  8324.               (*variable_head).subscripts=NULL;
  8325.               if (! fatal_error)
  8326.                 (*variable_head).variable_value_header_ptr
  8327.                  =new_real_header_ptr();
  8328.               if (fatal_error)
  8329.                 {
  8330.                   free((*variable_head).name);
  8331.                   free((char *) variable_head);
  8332.                   variable_head=NULL;
  8333.                 }
  8334.               else
  8335.                 {
  8336.                   *((*((*variable_head).variable_value_header_ptr)).value_ptr.
  8337.                    real)=value;
  8338.                   (*variable_head).predecessor_ptr=NULL;
  8339.                   (*variable_head).smaller_successor_ptr=NULL;
  8340.                   (*variable_head).larger_successor_ptr=NULL;
  8341.                 }
  8342.             }
  8343.       else
  8344.         {
  8345.           strcpy(current_identifier,identifier);
  8346.           strupr(current_identifier);
  8347.           old_variable_ptr=variable_head;
  8348.           finished=FALSE;
  8349.           do
  8350.             {
  8351.               comparison=variable_comparison(current_identifier,NULL,
  8352.                (*old_variable_ptr).name,
  8353.                (*old_variable_ptr).subscripts);
  8354.               if (comparison < 0)
  8355.                 if ((*old_variable_ptr).smaller_successor_ptr == NULL)
  8356.                   {
  8357.                     if ((new_variable_ptr=(struct variable *)
  8358.                      malloc((unsigned) sizeof(struct variable)))
  8359.                      == NULL)
  8360.                       {
  8361.                         fatal_error=TRUE;
  8362.                         printf("Fatal error:  out of memory at ");
  8363.                         printf("line %ld, column %ld.\n",
  8364.                         source_line_num,source_column_num);
  8365.                       }
  8366.                     else
  8367.                       if (((*new_variable_ptr).name
  8368.                        =malloc((unsigned) (1+strlen(current_identifier))))
  8369.                        == NULL)
  8370.                         {
  8371.                           fatal_error=TRUE;
  8372.                           printf("Fatal error:  out of memory at ");
  8373.                           printf("line %ld, column %ld.\n",
  8374.                            source_line_num,source_column_num);
  8375.                           free((char *) variable_head);
  8376.                           variable_head=NULL;
  8377.                         }
  8378.                       else
  8379.                         {
  8380.                           strcpy((*new_variable_ptr).name,current_identifier);
  8381.                           (*new_variable_ptr).subscripts=NULL;
  8382.                           if (! fatal_error)
  8383.                             (*new_variable_ptr).
  8384.                              variable_value_header_ptr
  8385.                              =new_real_header_ptr();
  8386.                           if (fatal_error)
  8387.                             {
  8388.                               free((*new_variable_ptr).name);
  8389.                               free((char *) new_variable_ptr);
  8390.                               new_variable_ptr=NULL;
  8391.                             }
  8392.                           else
  8393.                             {
  8394.                               *((*((*new_variable_ptr).
  8395.                                variable_value_header_ptr)).value_ptr.real)
  8396.                                =value;
  8397.                               (*new_variable_ptr).predecessor_ptr
  8398.                                =old_variable_ptr;
  8399.                               (*new_variable_ptr).
  8400.                                smaller_successor_ptr=NULL;
  8401.                               (*new_variable_ptr).
  8402.                                larger_successor_ptr=NULL;
  8403.                               (*old_variable_ptr).
  8404.                                smaller_successor_ptr
  8405.                                =new_variable_ptr;
  8406.                             }
  8407.                         }
  8408.                     finished=TRUE;
  8409.                   }
  8410.                 else
  8411.                   old_variable_ptr
  8412.                    =(*old_variable_ptr).smaller_successor_ptr;
  8413.               else
  8414.                 if (comparison > 0)
  8415.                   if ((*old_variable_ptr).larger_successor_ptr
  8416.                    == NULL)
  8417.                     {
  8418.                       if ((new_variable_ptr=(struct variable *)
  8419.                        malloc((unsigned) sizeof(struct variable)))
  8420.                        == NULL)
  8421.                         {
  8422.                           fatal_error=TRUE;
  8423.                           printf("Fatal error:  out of memory at ");
  8424.                           printf("line %ld, column %ld.\n",
  8425.                           source_line_num,source_column_num);
  8426.                         }
  8427.                       else
  8428.                         if (((*new_variable_ptr).name
  8429.                          =malloc((unsigned) (1+strlen(current_identifier))))
  8430.                          == NULL)
  8431.                           {
  8432.                             fatal_error=TRUE;
  8433.                             printf("Fatal error:  out of memory at ");
  8434.                             printf("line %ld, column %ld.\n",
  8435.                              source_line_num,source_column_num);
  8436.                             free((char *) variable_head);
  8437.                             variable_head=NULL;
  8438.                           }
  8439.                         else
  8440.                           {
  8441.                             strcpy((*new_variable_ptr).name,
  8442.                              current_identifier);
  8443.                             (*new_variable_ptr).subscripts=NULL;
  8444.                             if (! fatal_error)
  8445.                               (*new_variable_ptr).
  8446.                                variable_value_header_ptr
  8447.                                =new_real_header_ptr();
  8448.                             if (fatal_error)
  8449.                               {
  8450.                                 free((*new_variable_ptr).name);
  8451.                                 free((char *) new_variable_ptr);
  8452.                                 new_variable_ptr=NULL;
  8453.                               }
  8454.                             else
  8455.                               {
  8456.                                 *((*((*new_variable_ptr).
  8457.                                  variable_value_header_ptr)).value_ptr.real)
  8458.                                  =value;
  8459.                                 (*new_variable_ptr).predecessor_ptr
  8460.                                  =old_variable_ptr;
  8461.                                 (*new_variable_ptr).
  8462.                                  smaller_successor_ptr=NULL;
  8463.                                 (*new_variable_ptr).
  8464.                                  larger_successor_ptr=NULL;
  8465.                                 (*old_variable_ptr).
  8466.                                  larger_successor_ptr
  8467.                                  =new_variable_ptr;
  8468.                               }
  8469.                           }
  8470.                       finished=TRUE;
  8471.                     }
  8472.                   else
  8473.                     old_variable_ptr
  8474.                      =(*old_variable_ptr).larger_successor_ptr;
  8475.                 else
  8476.                   {
  8477.                     finished=TRUE;
  8478.                     free_value(
  8479.                      (*old_variable_ptr).variable_value_header_ptr);
  8480.                     (*old_variable_ptr).variable_value_header_ptr
  8481.                       =new_real_header_ptr();
  8482.                     if (! fatal_error)
  8483.                       *((*((*old_variable_ptr).
  8484.                        variable_value_header_ptr)).value_ptr.real)=value;
  8485.                   }
  8486.             }
  8487.           while (! finished);
  8488.         }
  8489.     }
  8490.  
  8491. void set_string_variable(identifier,value)
  8492.   char *identifier;
  8493.   char *value;
  8494.     {
  8495.       int              comparison;
  8496.       char             current_identifier [256];
  8497.       int              finished;
  8498.       variable_ptr     new_variable_ptr;
  8499.       variable_ptr     old_variable_ptr;
  8500.  
  8501.       if (variable_head == NULL)
  8502.         if ((variable_head=(struct variable *)
  8503.          malloc((unsigned) sizeof(struct variable))) == NULL)
  8504.           {
  8505.             fatal_error=TRUE;
  8506.             printf("Fatal error:  out of memory at ");
  8507.             printf("line %ld, column %ld.\n",
  8508.              source_line_num,source_column_num);
  8509.           }
  8510.         else
  8511.           if (((*variable_head).name
  8512.            =malloc((unsigned) (1+strlen(identifier)))) == NULL)
  8513.             {
  8514.               fatal_error=TRUE;
  8515.               printf("Fatal error:  out of memory at ");
  8516.               printf("line %ld, column %ld.\n",
  8517.                source_line_num,source_column_num);
  8518.               free((char *) variable_head);
  8519.               variable_head=NULL;
  8520.             }
  8521.           else
  8522.             {
  8523.               strcpy((*variable_head).name,identifier);
  8524.               strupr((*variable_head).name);
  8525.               (*variable_head).subscripts=NULL;
  8526.               if (! fatal_error)
  8527.                 (*variable_head).variable_value_header_ptr
  8528.                  =new_string_header_ptr(strlen(value));
  8529.               if (fatal_error)
  8530.                 {
  8531.                   free((*variable_head).name);
  8532.                   free((char *) variable_head);
  8533.                   variable_head=NULL;
  8534.                 }
  8535.               else
  8536.                 {
  8537.                   strcpy((char *)
  8538.                    (*((*((*variable_head).variable_value_header_ptr)).value_ptr.string)).value,
  8539.                    value);
  8540.                   (*variable_head).predecessor_ptr=NULL;
  8541.                   (*variable_head).smaller_successor_ptr=NULL;
  8542.                   (*variable_head).larger_successor_ptr=NULL;
  8543.                 }
  8544.             }
  8545.       else
  8546.         {
  8547.           strcpy(current_identifier,identifier);
  8548.           strupr(current_identifier);
  8549.           old_variable_ptr=variable_head;
  8550.           finished=FALSE;
  8551.           do
  8552.             {
  8553.               comparison=variable_comparison(current_identifier,NULL,
  8554.                (*old_variable_ptr).name,
  8555.                (*old_variable_ptr).subscripts);
  8556.               if (comparison < 0)
  8557.                 if ((*old_variable_ptr).smaller_successor_ptr == NULL)
  8558.                   {
  8559.                     if ((new_variable_ptr=(struct variable *)
  8560.                      malloc((unsigned) sizeof(struct variable)))
  8561.                      == NULL)
  8562.                       {
  8563.                         fatal_error=TRUE;
  8564.                         printf("Fatal error:  out of memory at ");
  8565.                         printf("line %ld, column %ld.\n",
  8566.                         source_line_num,source_column_num);
  8567.                       }
  8568.                     else
  8569.                       if (((*new_variable_ptr).name
  8570.                        =malloc((unsigned) (1+strlen(current_identifier))))
  8571.                        == NULL)
  8572.                         {
  8573.                           fatal_error=TRUE;
  8574.                           printf("Fatal error:  out of memory at ");
  8575.                           printf("line %ld, column %ld.\n",
  8576.                            source_line_num,source_column_num);
  8577.                           free((char *) variable_head);
  8578.                           variable_head=NULL;
  8579.                         }
  8580.                       else
  8581.                         {
  8582.                           strcpy((*new_variable_ptr).name,current_identifier);
  8583.                           (*new_variable_ptr).subscripts=NULL;
  8584.                           if (! fatal_error)
  8585.                             (*new_variable_ptr).
  8586.                              variable_value_header_ptr
  8587.                              =new_string_header_ptr(strlen(value));
  8588.                           if (fatal_error)
  8589.                             {
  8590.                               free((*new_variable_ptr).name);
  8591.                               free((char *) new_variable_ptr);
  8592.                               new_variable_ptr=NULL;
  8593.                             }
  8594.                           else
  8595.                             {
  8596.                               strcpy((char *)
  8597.                                (*((*((*new_variable_ptr).
  8598.                                variable_value_header_ptr)).
  8599.                                value_ptr.string)).value,
  8600.                                value);
  8601.                               (*new_variable_ptr).predecessor_ptr
  8602.                                =old_variable_ptr;
  8603.                               (*new_variable_ptr).
  8604.                                smaller_successor_ptr=NULL;
  8605.                               (*new_variable_ptr).
  8606.                                larger_successor_ptr=NULL;
  8607.                               (*old_variable_ptr).
  8608.                                smaller_successor_ptr
  8609.                                =new_variable_ptr;
  8610.                             }
  8611.                         }
  8612.                     finished=TRUE;
  8613.                   }
  8614.                 else
  8615.                   old_variable_ptr
  8616.                    =(*old_variable_ptr).smaller_successor_ptr;
  8617.               else
  8618.                 if (comparison > 0)
  8619.                   if ((*old_variable_ptr).larger_successor_ptr
  8620.                    == NULL)
  8621.                     {
  8622.                       if ((new_variable_ptr=(struct variable *)
  8623.                        malloc((unsigned) sizeof(struct variable)))
  8624.                        == NULL)
  8625.                         {
  8626.                           fatal_error=TRUE;
  8627.                           printf("Fatal error:  out of memory at ");
  8628.                           printf("line %ld, column %ld.\n",
  8629.                           source_line_num,source_column_num);
  8630.                         }
  8631.                       else
  8632.                         if (((*new_variable_ptr).name
  8633.                          =malloc((unsigned) (1+strlen(current_identifier))))
  8634.                          == NULL)
  8635.                           {
  8636.                             fatal_error=TRUE;
  8637.                             printf("Fatal error:  out of memory at ");
  8638.                             printf("line %ld, column %ld.\n",
  8639.                              source_line_num,source_column_num);
  8640.                             free((char *) variable_head);
  8641.                             variable_head=NULL;
  8642.                           }
  8643.                         else
  8644.                           {
  8645.                             strcpy((*new_variable_ptr).name,
  8646.                              current_identifier);
  8647.                             (*new_variable_ptr).subscripts=NULL;
  8648.                             if (! fatal_error)
  8649.                               (*new_variable_ptr).
  8650.                                variable_value_header_ptr
  8651.                                =new_string_header_ptr(strlen(value));
  8652.                             if (fatal_error)
  8653.                               {
  8654.                                 free((*new_variable_ptr).name);
  8655.                                 free((char *) new_variable_ptr);
  8656.                                 new_variable_ptr=NULL;
  8657.                               }
  8658.                             else
  8659.                               {
  8660.                                 strcpy((char *)
  8661.                                  (*((*((*new_variable_ptr).
  8662.                                  variable_value_header_ptr)).
  8663.                                  value_ptr.string)).value,
  8664.                                  value);
  8665.                                 (*new_variable_ptr).predecessor_ptr
  8666.                                  =old_variable_ptr;
  8667.                                 (*new_variable_ptr).
  8668.                                  smaller_successor_ptr=NULL;
  8669.                                 (*new_variable_ptr).
  8670.                                  larger_successor_ptr=NULL;
  8671.                                 (*old_variable_ptr).
  8672.                                  larger_successor_ptr
  8673.                                  =new_variable_ptr;
  8674.                               }
  8675.                           }
  8676.                       finished=TRUE;
  8677.                     }
  8678.                   else
  8679.                     old_variable_ptr
  8680.                      =(*old_variable_ptr).larger_successor_ptr;
  8681.                 else
  8682.                   {
  8683.                     finished=TRUE;
  8684.                     free_value(
  8685.                      (*old_variable_ptr).variable_value_header_ptr);
  8686.                     (*old_variable_ptr).variable_value_header_ptr
  8687.                       =new_string_header_ptr(strlen(value));
  8688.                     if (! fatal_error)
  8689.                       strcpy((char *)
  8690.                        (*((*((*old_variable_ptr).
  8691.                        variable_value_header_ptr)).
  8692.                        value_ptr.string)).value,
  8693.                        value);
  8694.                   }
  8695.             }
  8696.           while (! finished);
  8697.         }
  8698.     }
  8699.  
  8700. void get_boolean_variable(identifier,value,fatal_error)
  8701.   char *identifier;
  8702.   int  *value;
  8703.   int  *fatal_error;
  8704.     {
  8705.       static value_header_ptr result_header_ptr;
  8706.       static char             variable_name [256];
  8707.  
  8708.       strcpy(&variable_name[0],identifier);
  8709.       strupr(&variable_name[0]);
  8710.       result_header_ptr=variable_header_ptr(variable_name,TRUE,NULL);
  8711.       if ((*result_header_ptr).type == 'B')
  8712.         *value=*((*result_header_ptr).value_ptr.boolean);
  8713.       else
  8714.         {
  8715.           *fatal_error=TRUE;
  8716.           printf(
  8717.            "\007     Fatal error:  the variable %s is no longer boolean.\n",
  8718.            identifier);
  8719.         }
  8720.       free_value(result_header_ptr);
  8721.       return;
  8722.     }
  8723.  
  8724. void get_integer_variable(identifier,value,fatal_error)
  8725.   char *identifier;
  8726.   long *value;
  8727.   int  *fatal_error;
  8728.     {
  8729.       static value_header_ptr result_header_ptr;
  8730.       static char             variable_name [256];
  8731.  
  8732.       strcpy(&variable_name[0],identifier);
  8733.       strupr(&variable_name[0]);
  8734.       result_header_ptr=variable_header_ptr(variable_name,TRUE,NULL);
  8735.       if ((*result_header_ptr).type == 'I')
  8736.         *value=*((*result_header_ptr).value_ptr.integer);
  8737.       else
  8738.         {
  8739.           *fatal_error=TRUE;
  8740.           printf(
  8741.            "\007     Fatal error:  the variable %s is no longer integer.\n",
  8742.            identifier);
  8743.         }
  8744.       free_value(result_header_ptr);
  8745.       return;
  8746.     }
  8747.  
  8748. void get_real_variable(identifier,value,fatal_error)
  8749.   char   *identifier;
  8750.   double *value;
  8751.   int    *fatal_error;
  8752.     {
  8753.       static value_header_ptr result_header_ptr;
  8754.       static char             variable_name [256];
  8755.  
  8756.       strcpy(&variable_name[0],identifier);
  8757.       strupr(&variable_name[0]);
  8758.       result_header_ptr=variable_header_ptr(variable_name,TRUE,NULL);
  8759.       if ((*result_header_ptr).type == 'R')
  8760.         *value=*((*result_header_ptr).value_ptr.real);
  8761.       else
  8762.         {
  8763.           *fatal_error=TRUE;
  8764.           printf(
  8765.            "\007     Fatal error:  the variable %s is no longer real.\n",
  8766.            identifier);
  8767.         }
  8768.       free_value(result_header_ptr);
  8769.       return;
  8770.     }
  8771.  
  8772. void get_string_variable(identifier,value,length,fatal_error)
  8773.   char *identifier;
  8774.   char *value;
  8775.   int  length;
  8776.   int  *fatal_error;
  8777.     {
  8778.       register int              char_index;
  8779.       static   char             *char_ptr_1;
  8780.       static   char             *char_ptr_2;
  8781.       static   value_header_ptr result_header_ptr;
  8782.       static   char             variable_name [256];
  8783.  
  8784.       strcpy(&variable_name[0],identifier);
  8785.       strupr(&variable_name[0]);
  8786.       result_header_ptr=variable_header_ptr(variable_name,TRUE,NULL);
  8787.       if ((*result_header_ptr).type == 'S')
  8788.         {
  8789.           char_index=1;
  8790.           char_ptr_1=(char *) (*((*result_header_ptr).value_ptr.string)).value;
  8791.           char_ptr_2=value;
  8792.           while ((char_index
  8793.                   <= (*((*result_header_ptr).value_ptr.string)).length)
  8794.           &&     (char_index <= length))
  8795.             {
  8796.               if (*char_ptr_1 == (unsigned char) 0)
  8797.                 *char_ptr_2=' ';
  8798.               else
  8799.                 *char_ptr_2=(char) *char_ptr_1;
  8800.               char_ptr_1++;
  8801.               char_ptr_2++;
  8802.               char_index++;
  8803.             }
  8804.           *char_ptr_2='\0';
  8805.         }
  8806.       else
  8807.         {
  8808.           *fatal_error=TRUE;
  8809.           printf(
  8810.            "\007     Fatal error:  the variable %s is no longer string.\n",
  8811.            identifier);
  8812.         }
  8813.       free_value(result_header_ptr);
  8814.       return;
  8815.     }
  8816.