A Practical Parser

By Bill Murray, Annandale, VA

Introduction

This article describes a practical mathematical parser - an interactive program that can be used to perform basic arithmetic operations and standard function calculations. The heart of the program is a Pascal function [eval] which takes a mathematical expression [a str255 variable] as input and returns a real number [the result of the calculation]. Other binary operations and standard functions can be added to the code if one wishes to expand the program. By adding the Pascal code for eval to software code, an existing program can be made more flexible.

When I first started thinking about writing code to calculate a mathematical expression, I soon realized that it wasn’t that easy [at least for me]. I had to delve into such concepts as parsing, tokens, lexical analysis, node trees and tables, etc.

After searching the literature I came across an outline of an algorithm for parsing arithmetic expressions in Principles of Systems Programming by Robert M. Graham (Wiley, 1975). It used the four binary operators of multiplication, division, addition, and subtraction, set precedence values for operator tokens, and provided for handling parentheses. Basically, the rules of the algorithm were the same ones we learned in algebra. For example: multiply (or divide) before adding or subtracting; start with inner parentheses and work outwards; if a pair of binary operators have equal precedence, perform the left operator of the pair first.

The above algorithm was the starting point for developing my own parser. I extended it to include the exponentiation operator and some standard functions [such as sin, cos, etc.].

The main advantage in having a mathematical parser as part of a program is that it allows a user greater flexibility. Expressions [in lieu of numbers] can be entered from the keyboard. As an example, in fitting a least squares model to data, only the function would have to be typed in. Any names could be used for the variables, since the lexical analysis phase of the parser identifies constants and variables in an expression. Once the variables were identified they could then be solved for in the least squares sense. Also, by entering key words or phrases, a program could be made to branch to other areas, such as a plotting routine or a Fast Fourier Transform routine. The user could then return to the interactive mode of the parser by selecting an appropriate menu item.

In addition to the above, text files containing a number of mathematical expressions can be created and saved. If the name of a particular file is subsequently entered in an expression, all statements in that file will be executed and a real variable created which has the same name as the text file and a value equal to the result of the calculation. In this way, one can perform specific calculations, using the text file as one would a mini-program. Extended real variables can be defined, listed, and stored for further sessions, and the number of decimal places can be set by the user.

The Pascal program listed in the appendix is a watered-down version of one which is obtainable on disk. Both were written using THINK Pascal 2.0, System 4.2, and Finder 6.0. The project contains 10 units. In the extended program, 20 textfiles can be created, modified and stored for further use. In order to conserve on heap space, variable arrays are dynamically allocated through the use of handles.

Finally, it should be noted that the tokens need not be restricted to real numbers. That is, one could use the present algorithm with some minor modification to handle matrices and vectors.

Let’s get started by defining some terms. Then we will describe the procedures and functions which make up eval.

Parser

Parsing refers to the process of breaking something down into parts, explaining the form, function, and interrelation of the parts. In diagramming a sentence, we break it down into nouns, verbs, adjectives, etc. In this way we gain more insight into the meaning of an expression. Parsing is, essentially, a recognizing of structure.

A mathematical parser is an algorithm that identifies the structure and constituent parts of a mathematical expression. The expression, a string of characters [str255], is comprised of a number of basic elements, such as symbols, words, numbers, etc. The job of the parser is to recognize these elements [the operators and operands], transform them into tokens, and then into a node table which can be used to calculate the result of the expression, a real number.

Tokens

Tokens are symbols having the same form and size. Two pieces of information are associated with each each - its type and its index within an array of tokens. In the source code they are strings of 20 characters. Their types include: variable, constant, real, node, binary, unary, and function.

LexicalAnalysis

The LexicalAnalysis procedure is the workhorse of the parsing process. It identifies the basic elements in an expression, replaces them with tokens, determines their type, then assigns precedence values. The positions of operator and operand tokens with respect to each other define a certain syntactic structure. The hierarchy of the binary operators [their precedence values] along with the positions of function tokens determine which operations or functions will be performed first, and thus, the order in which the node table is constructed.

Input to LexicalAnalysis is the Pascal str255 variable, line, [the mathematical expression]. The output is the ordered array of tokens, sy^^[i], their types, tokentype^^[i], and precedence values, pr^^[i], for i = 1 to ntot.

In order to identify individual strings which make up line, an indicator array [of integers], ind^^[i], i = 1, length(line), is used. These indicators correspond one to one with the characters in line. The smaller strings which make up line, astr^^[i], include constants, and variable and function names. The start and stop positions of the strings are given by the arrays, nst^^[j] and nend^^[j] (j running from 1 to numstrings).

After allocating relocatable space on the heap for the arrays, ind, nst, nend, and astr, [using the NewHandle call], the procedure puts a semicolon (;) at the end of line if it isn’t already there [ The ampersand and semicolon are used as delimiters in the parsing process]. It then removes blanks from line, and initializes each indicator, ind^^[i], to zero, and each astr^^[i] to the null string. A loop running from i = 1 to length(line) does the following.

For each character [in line] that is a character of the alphabet, ind^^[i] is set to 1, and for each character that is 0 through 9, or the decimal point, ind^^[i] is set to 2. A pattern of 0’s, 1’s, and 2’s thus emerges which can be used to determine the start and stop positions of the strings, and hence, the length of the strings. Let’s see how we get the start and stop positions.

If ind^^[1] is a 1 or a 2, this means that a string starts at the first character position, and nst^^[1] is set to 1. If ind^^[length(line)] is a 1 or a 2, a string [the last one] ends at the last character position, and nst^^[numstrings] is set to length(line). For all i > 1, if ind^^[i-1] = 0 and ind^^[i] <> 0, a string starts at the ith position, and for all i > 1, if ind^^[i] = 0 and ind^^[i-1] <> 0, a string ends at the (i-1)th position.

The following figure illustrates the above scheme showing the breakdown of the equation, y = 1.23*xval + 3. The characters of line , the indicator values, ind^^[i], and the four small strings, astr^^[j], (j = 1 to 4), are shown.

The above has to be modified in order to handle real numbers written in scientific notation. For instance, with the string, ‘1.24e-3’, using the above procedure, the indicator sequence will be ‘2222102’, and we will erroneously get two strings - one starting at position 1 and ending at position 5, the other starting at position 7 and ending at position 7. In order to get around this we do the following.

For all i > 3 we look back at the characters, line[i-3], line[i-2], line[i-1], and line[i], taken together. If line[i-3] = an integer or decimal and line[i-2] = ‘e’ or ‘E’ and line[i-1] = ‘+’ or ‘-’ and line[i] = an integer, we don’t do anything except up the loop index 1. We do the same sort of thing for all i > 4 , looking back at the characters, line[i-4], line[i-3], line[i-2], line[i-1] and line[i] taken together. If line[i-4] = integer or decimal and line[i-3] = ‘e’ or ‘E’ and and line[i-2] = ‘+’ or ‘-’, and line[i-1] = integer, and line[i] = integer, we again just up the index 1. We do this procedure before we check for the beginning of a new string. Thus, in the example of the string ‘1.24e-3’ shown below, before we start a new string at the position of the ‘3’, we check back 3 positions. Our criterion for the scientific notation having been met, we jump to the end of the loop and raise the index by 1. We note that the end of the first string is first set to the position of the ‘e’, but reset later to the position of the ‘3’. All of this may seem at bit involved, but it appears to do the trick.

Next, the strings, astr^^[i], are meshed with operator symbols to obtain an ordered array of tokens, sy^^[i]. The zeroth token, sy^^[0], is set equal to the ampersand, ‘@’, to be used as a delimiter later in Parser. This ordered array of tokens now represents the mathematical expression. Each of the tokens is a Pascal string of type string[20].

We now want to identify the token types, tokentype^^[i], corresponding to each sy^^[i].

Within the loop from i = 0 to ntot, each token type is initially set equal ‘string’. If sy^^[i] is equal to one of the symbols ^ * / + - = ) ; ( or @ tokentype^^[i] is set to ‘binary’. If sy^^[i] is equal to ‘pi’ or the first character, sy^^[i][1], is one of the characters 0 through 9 or the decimal, tokentype^^[i] is set to ‘constant’. If sy^^[i] is one of the strings - ‘’’ (the quote), sqrt, sin, cos, exp, or ln - tokentype^^[i] is set equal to ‘function’. (The quote is used to take the inverse of a non zero real number). If tokentype^^[i] is a ‘string’, but not a ‘binary’, not a ‘constant’, and not a ‘function’, then it is a ‘variable’. Finally, for i > 0, if sy^^[i] is a plus or a minus (+ or -), and tokentype^^[i-1] is neither a variable nor a real, and sy^^[i-1] is neither a right parenthesis nor the quote (‘), then tokentype^^[i] is set equal to ‘unary’.

The next loop from 1 to ntot checks each string identified as a constant which is not equal to ‘pi’, running through each of the characters in the string. If the character is a letter of the alphabet and not an ‘e’ or ‘E’, it signals an error. If the character is an ‘e’ or ‘E’, then the character immediately to the left must be a number and the character immediately to the right must be either a plus, a minus, or a number [otherwise the program signals an error]. Also, each character in the string must be either a number (0 through 9), an ‘e’, ‘E’, ‘+’, ‘-’, or the decimal point ‘.’ [otherwise the program signals an error].

Finally, the precedence values, pr^^[i], are set for the tokens:

^ 7

* / 6

+ - 5

= 4

) ; 3

( 2

@ 1

other 0

Node Trees and Tables

The node table is the key to the parsing algorithm. A tree-like structure, it consists of a number of junction points [or nodes] in the evaluation of an expression. Each indexed entry, a node description, consists of enough information for an operation to be performed and a real number calculated and stored. Like the DNA molecule, the node table contains the code, revealing the pattern and syntactic structure of a mathematical expression. A node tree is a pictorial representation of the operations performed in the evaluation of a mathematical expression.

An appropriate data structure for storing the descriptive information in a node table is an indexed array of records, with the fields of each record being strings containing the type of operation, types of operand tokens, and the operator and operand tokens.

After a mathematical expression has been parsed, and a node table constructed, two passes are made through the table. In the first pass, values are substituted for variable names appearing in the operand fields. In the second pass, these values are read, an operation is performed, and a real number calculated for each node. This number is then stored in an indexed array of reals. If a node token appears in one of the operand fields, its value points to the result of a previous calculation, namely, the element of the array of reals having an index equal to the value of the node token. This element is then used as the operand in the present operation.

Let’s give an example showing the relationship between tokens, a node tree, and the node table. Consider the following expression.

 x = a + b * c * (d - e)                (1)

The node tree description of (1) shows the syntactic structure of the expression.

In this pictorial representation, the nodes are the numbered circles. The left and right branches of each node are the left and right operand tokens (variable). The middle branch is the binary operator token. Node tokens are the numbers 1 though 5.

Taking the nodes in order, we can describe the syntactic structure shown above as: Node 1: Multiply b times c, and store the result at 1; Node 2: Subtract e from d, and store the result at 2; Node 3: Multiply the result at 1 times the result at 2, and store the result at 3; Node 4: Add the result at 3 to a, and store the result at 4; Node 5: Assign the result at 4 to the variable x, and store the result at 5. Notice the hierarchy of operations underlying the structure of the node tree above.

The syntactic relationship of the tokens can also be seen in the node table below. The string fields of each node record are: optype (type of operation), loptype (type of left operand token), roptype (type of right operand token), op.index (binary operator token or function token), lop.index (left operand token), and rop.index (right operand token).

node optype loptype roptype op. lop. rop.

(i) index index index

1 binary real real * b c

2 binary real real - d e

3 binary node node * 1 2

4 binary real node + a 3

5 binary variable node = x 4

The representation of (1) in node table form above, contains all the information we need to perform operations and calculate, except for substituting values for the variable tokens (the names of the real tokens). Let us assign the following values: a = 1, b = 2, c = 3, d = 4, e = 5.

After making the first pass through the table, the node table will look like the following.

node optype loptype roptype op. lop. rop.

1 binary real real * 2.0 3.0

2 binary real real - 4.0 5.0

3 binary node node * 1 2

4 binary real node + 1.0 3

5 binary variable node = x 4

The node table, after making the second pass, is shown below. Numbers in the last column are the results of calculations performed at each node, and are elements of the indexed array of reals.

node optype loptype roptype op. lop. rop. t^^[i]

1 binary real real * 2.0 3.0 6.0

2 binary real real - 4.0 5.0 -1.0

3 binary node node * 6.0 -1.0 -6.0

4 binary real node + 1.0 -6.0 -5.0

5 binary variable node = x -5.0 -5.0

The final result is x = -5.

The Parser Algorithm

The procedure Parser creates a node table, nodetable^^[i], i = 1 to numnodes, using as input the tokens, ty^^[j], their types, typ^^[j], and precedence values, typr^^[j], j = 1 to ktot (the output from LexicalAnalysis).

A node is created whenever a binary, unary, or function operator token [along with its corresponding operands] is selected from the array of tokens, ty^^[j]. The node token is just the indexed number of the present operation. At the time the jth node is created, its description is entered in the string fields of the node record, nodetable^^[j], described above.

As an operator (or unary or function) token and its corresponding operand tokens are added to the table, a node token is substituted for one of the ty^^[j], some of the ty^^[j] are deleted, and the total number in the ty^^[j] array, jtot, decreases. The process ends with completion of the table when jtot = 2. If jtot is not equal to 2, the procedure signals an error that there is a possible incorrect pairing of parentheses. Let’s see how the algorithm works.

1. Scan ty^^[j] in ascending order( left to right) until: (a) we find a unary or function token with an operand (variable, constant, real, or node token) immediately to the right of it, or; (b) we find a quote (‘) with an operand immediately to the left, or; (c) we find a pair of operators (^, *, /, +, -, =, (, ), @, ;), ignoring a single token between them, such that the precedence of the left operator token is greater than or equal to the precedence of the right operator token, or; (d) we find a token for a right parenthesis. If the token just preceding the right parenthesis is an operand token and the token just before the operand token is a left parenthesis, then the tokens for both right and left parentheses are deleted and the scan continues. Otherwise proceed to step 2.

2. If (a) or (b) in Step 1, copy the unary (or function or quote) token and its operand token into the node table as the ith entry, replace both tokens with the node token, Ni, (the value of i), decrease jtot by 1, and reset j to j-2. If (c) in Step 1, copy the three tokens just preceding the right operator token into the node table as the ith entry, replace the three tokens with the node token, Ni, decrease jtot by 2, and reset j to j-3. If (d) in Step 1, set the (j-2)nd token equal to the (j-1)st, set j to j-2, set kth token equal to the (k+2)nd token for k = j+1 to jtot, then reset j to j-2.

3. Repeat steps 1 to 2 beginning with the test in Step 1 until the test fails, then continue the left to right scan.

SetValues

This procedure runs through the nodetable^^[i] for i = 1 to numnodes, and the stored variable names, strvar^^[j], in reverse order, from j = numvariables to 1, checking both the lop.index and rop.index fields for a match. If for some i and j either nodetable^^[i].lop.index or nodetable^^[i].rop.index is equal to strvar^^[j], then the corresponding lop.index or rop.index field is set to the value of strvar^^[j], that is, val^^[j], and the corresponding loptype or roptype field is set equal to strvartokentype^^[j] which is ‘real’. Within the loop it also checks for the name of the constant, pi. If one of the operand fields is equal to ‘pi’, then the value of ‘pi’ or ‘pivalue’ (see constant in Globals) is substituted for that operand.

The reason for checking the variable names in reverse order is that the last one in is the first one out (LIFO). We want the most recent value of a variable in storge.

EvaluateNodes

This procedure reads the string fields of each node record, nodetable^^[i], and calculates a real number for that node description, t^^[i]. The procedure calls the realfunctionoperations and realbinaryoperations procedures as needed to calculate the t^^[i].

The result of the calculation is stored in the variable ‘ans’.

If the boolean store is true [which will be the case if there is an assignment statement with an equals sign], another variable is added to the list of stored variables with its associated value and type, which is ‘real’.

CheckLine

This procedure makes preliminary checks of the tokens, sy^^[i], to be sure that all variable names which occur in the expression have been previously defined. It also checks to see that each character in a ‘constant’ string is either a 0 through 9 or a decimal point or the letter ‘e’ or ‘E’.

If everything is OK, it calls the procedures Parser, SetValues, and EvaluateNodes, and sets store to true if the second token, sy^^[2] is an equals.

Eval

This function calls lexicalanalysis and checkline. If there is an error, eval is set to the error statement. If there is no error, i.e., a real number has been calculated, it embeds the real number in eval.

ParserOps

This unit contains a number of procedures for setting the decimal point, reading, creating, and listing tfiles (in code available by requesting disc from MacTutor), clearing the screen, reading, listing, deleting, and storing real variables. These procedures are called by the main driver, ParserDriver.

Operations and ParserGlobals

The Operations unit contains two procedures. Realbinaryoperations is used for performing binary operations - exponentiation (^), multiplication (*), division (/), addition (+), and subtraction (-). Realfunctionoperations is used for performing the standard functions of square root (sqrt), sine (sin), cosine (cos), raising the base of the natural logarithm to a real number (exp), taking the natural logarithm of a number (ln), and taking the reciprocal of a real number (the quote or ‘). Realfunctionoperations also performs the unary operations of + and -.

The ParserGlobals unit defines the constants and array types and sets certain of the variables as global variables.

ParserDriver

The main purpose of ParserDriver is to run the eval function by entering mathematical expressions through the keyboard. It also is used to respond to key commands, such as setting the decimal place (dec), clearing the screen (cls), clearing memory (clm), listing variables and their values (listv), and stopping the program (stop). If the ‘stop’ command is typed in the user can either save the variables and their values for another session or delete them. In the longer version of the code [available by requesting it from MacTutor or Greer Software Products], text files can be created, modified, and listed. These are then stored and are read in when the program is powered up. Also, certain variables can be deleted by the ‘delete’ command [type ‘delete’, hit return, then type in the variable name and a return. Two returns takes you back to the blinking caret]. If none of the key commands are typed in the result of calculating an expression, i.e., eval(line), is set to the variable result and written to the screen.

At the start of ParserDriver, the variables file is defined, the decimal place set at 20 places [default], and a number of array handles allocated to conserve space on the heap. The text window is next set and opened. Variables that have been previously created and saved are read in (‘readvariables’). At 998, the global parameter, error, is initialized to the null string, and the number of nodes, numnodes, set to zero. Then a blinking caret appears on the screen [the ‘write (blank)’ statement)] and the user can enter something in [‘readln(line)’ statement].

As each expression, line, is entered, the program either writes out a number or an error message. If the name of a variable previously defined [through an assignment statement or a previous calculation] is entered, its value is printed to the screen. If a name which has not been defined is entered, the name is just printed on the screen.

To make an assignment statement or create a new variable, enter the name of the variable followed by an equals sign, followed by its value (scientific notation included), then hit the return key.

The following examples illustrate the eval function. At the prompt, type in each line and then hit a return.

a = 2
b = 3
c = 4
d = 5
e = 6
x = a + b * c * (d - e)

After the last return the answer should come up as -10.

y = sqrt(9)

The answer should be 3.

angle = 45*(pi/180)
z = sin(angle)

Creating a text file.

create           (hit return)
var1             (hit return)
a = 4            (hit return)
b = 5            (hit return)
c = a + b        (hit return twice)

The answer should come up 9 for both the variable c and a variable named var1. Note also that the values of a and b will have been changed. Do a listv to see the variables and their values.

Conclusion

This article has demonstrated the use of a practical parser. The code can be studied in its own right to gain more insight into how a parser works. If one wishes it can be used as a calculator and readily expanded upon [by including more binary operations and standard functions]. It can serve as an integral part of a larger program or to branch to different areas to perform specific tasks. Finally, the basic algorithm could be made to handle matrices and vectors with slight modifications.

A parser is inherently a powerful tool in that it allows the user greater flexibility in the execution of a program.

A demonstration program is available for $25 which illustrates the use of the MathParser Extender ($3 shipping). Also, the source code [which is extensively annotated] is available for $75 ($3 shipping). Both are available for $99 ($3 shipping). In the code for the Extender, the user can define his own functions in terms of the standard functions and also the binary operators. These can be obtained from

Greer Software Products

Box 268

Annandle, Virginia 22003

Tel: (703) 978-3327

About the author

Bill Murray is retired from NASA, having worked at the Goddard Space Flight Center in Greenbelt, Md. for 22 years as an applied mathematician. In the early days of the Apollo program he was involved with orbital calculations and statistical studies. Later he was involved in mathematical modelling of satellite imagery data from passive microwave radiometers. He has a BA in Mathematics from Duke University (1954) and a MS in Applied Mathematics from Catholic University (1962). His main “outside” activity over the past 17 years has been long distance running, although he presently runs (shorter distances), swims, and hikes. He also enjoys playing some of the old favorites on the piano for the elderly.

Listing:  ParserGlobals

unit ParserGlobals;
interface
 procedure ParserGlobals;
 const
 blank = ' ';
 asterisk = '*';
 rightslash = '/';
 plus = '+';
 minus = '-';
 equals = '=';
 rightparen = ')';
 semicolon = ';';
 leftparen = '(';
 exponent = '^';
 quote = '''';
 ampersand = '@';
 pivalue = 3.141592653589793238462643;
 maxnumberofstrings = 200;
 maxnumberofnodes = 200;
 maxstringsize = 20;
 type
 stringsize = string[maxstringsize];

 string30 = string[30];
 array2 = array[1..2] of stringsize;

 stringarray0 = array[0..maxnumberofstrings] of stringsize;
 ptrstringarray0 = ^stringarray0;
 hdlstringarray0 = ^ptrstringarray0;

 intarray0 = array[0..maxnumberofstrings] of integer;
 ptrintarray0 = ^intarray0;
 hdlintarray0 = ^ptrintarray0;

 extendarray = array[1..maxnumberofstrings] of extended;
 ptrextendarray = ^extendarray;
 hdlextendarray = ^ptrextendarray;

 flagtype = array[1..maxnumberofstrings] of boolean;
 ptrflagtype = ^flagtype;
 hdlflagtype = ^ptrflagtype;

 token = record
 index: string30;
 end;

 noderecord = array[1..maxnumberofnodes] of record
 optype: stringsize;      {type of operation}
 loptype: stringsize;     {left operand type}
 roptype: stringsize;     {right operand type}
 op: token;    {operator/function symbol}
 lop: token;   {name/value of left operand}
 rop: token;   {name/value of right operand}
 end;

 ptrnoderecord = ^noderecord;
 hdlnoderecord = ^ptrnoderecord;
 var
 numvariables, decplace, decplaceplus10: integer;
 strvar, strvartokentype: hdlstringarray0;
 {name & type of stored variable}
 val: hdlextendarray; {value of a stored variable}
 varfile, numfile: text;
 varfilename, numfilename: stringsize;
 ans: extended;
 error: str255;

implementation
 procedure parserglobals;
 begin
 end;

end.

Listing:  ParserOps

unit ParserOps;
interface
 uses ParserGlobals;
 procedure setdecimal;
 procedure clearscreen (var line: str255);
 procedure readvariables;
 procedure listvariables;
 procedure storevariables;
implementation
 procedure setdecimal;
 begin
 writeln('set number of decimal places to');
 write(blank);
 readln(decplace);
 decplaceplus10 := decplace + 10;
 end;

 procedure ClearScreen;
 var
 m, place: integer;
 removeblanks: boolean;
 begin
 removeblanks := true;

 place := pos(blank, line);
 while place <> 0 do
 begin
 delete(line, place, 1);
 place := pos(blank, line);
 end;

 m := pos('cls', line);
 delete(line, m, 4);
 if line <> '' then
 writeln('cls is a reserved word for clearing the screen');
 if line = '' then
 rewrite(output);
 end;

 procedure readvariables;
 var
 i: integer;
 begin
 for i := 1 to maxnumberofstrings do
 begin
 strvar^^[i] := '';
 strvartokentype^^[i] := '';
 val^^[i] := 0;
 end;

 open(varfile, varfilename);
 reset(varfile);
 numvariables := 0;

 while not eof(varfile) do
 begin
 numvariables := numvariables + 1;
 readln(varfile, strvar^^[numvariables]);
 readln(varfile, strvartokentype^^[numvariables]);
 readln(varfile, val^^[numvariables]);
 end;
 end;

 procedure listvariables;
 var
 i, j, k, m: integer;
 varname: stringsize;
 flag: hdlflagtype;
 begin
 flag := hdlflagtype(NewHandle(SizeOf(flagtype)));

 if numvariables > 0 then
 for i := 1 to numvariables do
 flag^^[i] := true;
 if numvariables > 0 then
 for i := 1 to numvariables do
 begin
 j := numvariables + 1 - i;
 for k := 1 to j - 1 do
 begin
 if (strvar^^[k] = strvar^^[j]) then
 flag^^[k] := false;
 end;
 end;
 if numvariables > 0 then
 for i := 1 to numvariables do
 if (strvartokentype^^[i] = 'real') and flag^^[i] then
 writeln(strvar^^[i], '   ', val^^[i] : decplaceplus10 : decplace);

 DisposHandle(handle(flag));
 end;

 procedure storevariables;
 var
 i, j, k, mtot: integer;
 flag: hdlflagtype;
 begin
 decplace := 20;
 decplaceplus10 := decplace + 10;

 flag := hdlflagtype(NewHandle(SizeOf(flagtype)));

 rewrite(varfile);
 for i := 1 to numvariables do
 flag^^[i] := false;
 for i := 1 to numvariables do
 begin
 k := numvariables + 1 - i;
 if flag^^[k] = false then
 for j := 1 to k - 1 do
 if (strvar^^[j] = strvar^^[k]) then
 flag^^[j] := true;
 end;

 mtot := 0;
 for i := 1 to numvariables do
 if not flag^^[i] then
 begin
 mtot := mtot + 1;
 strvar^^[mtot] := strvar^^[i];
 strvartokentype^^[mtot] := strvartokentype^^[i];
 val^^[mtot] := val^^[i];
 end;
 numvariables := mtot;

 for i := 1 to numvariables do
 begin
 writeln(varfile, strvar^^[i]);
 writeln(varfile, strvartokentype^^[i]);
 writeln(varfile, val^^[i] : decplaceplus10 : decplace);
 end;

 DisposHandle(handle(flag));
 end;
end.

Listing: Parser

unit Parser;
interface
 uses ParserGlobals;
 procedure parser (var ktot: integer; var ty: hdlstringarray0; var typ: 
hdlstringarray0; var typr: hdlintarray0; var nodetable: hdlnoderecord; 
var numnodes: integer; var error: str255);
implementation
 procedure parser;
 label
 992, 993;
 var
 i, j, k, l, m, n, del, jtot: integer;
 s1, s2, s3: boolean;
 procedure setnodefields (l, m, n: integer);
 begin
 numnodes := numnodes + 1;
 nodetable^^[numnodes].optype := typ^^[l];
 nodetable^^[numnodes].loptype := typ^^[m];
 nodetable^^[numnodes].roptype := typ^^[n];
 nodetable^^[numnodes].op.index := ty^^[l];
 nodetable^^[numnodes].lop.index := ty^^[m];
 nodetable^^[numnodes].rop.index := ty^^[n];
 end;

 procedure reset (l, m, n: integer);
 var
 k: integer;
 begin
 jtot := jtot - n;
 for k := l to m do
 begin
 ty^^[k] := ty^^[k + n];
 typr^^[k] := typr^^[k + n];
 typ^^[k] := typ^^[k + n];
 end;
 end;

 procedure setnodetoken (l: integer);
 begin
 ty^^[l] := stringof(numnodes : 2);
 typ^^[l] := 'node';
 typr^^[l] := 0;
 end;

 begin
 error := '';
 jtot := ktot;

 numnodes := 0;
 j := 0;
 repeat
 j := j + 1;
 if j < 1 then
 j := 1;

 s1 := (typ^^[j + 1] = 'constant') or (typ^^[j + 1] = 'variable') or 
(typ^^[j + 1] = 'real') or (typ^^[j + 1] = 'node');
 s2 := (typ^^[j - 1] = 'constant') or (typ^^[j - 1] = 'variable') or 
(typ^^[j - 1] = 'real') or (typ^^[j - 1] = 'node');
 s3 := (typ^^[j - 3] = 'constant') or (typ^^[j - 3] = 'variable') or 
(typ^^[j - 3] = 'real') or (typ^^[j - 3] = 'node');

 if ((typ^^[j] = 'unary') or (typ^^[j] = 'function')) and s1 then
 begin
 setnodefields(j, j + 1, j + 1);
 setnodetoken(j);
 reset(j + 1, jtot, 1);
 j := j - 2;
 goto 992;
 end;

 if (ty^^[j] = quote) and s2 then
 begin
 setnodefields(j, j - 1, j - 1);
 setnodetoken(j - 1);
 j := j - 1;
 reset(j + 1, jtot, 1);
 j := j - 2;
 goto 992;
 end;

 if (typ^^[j] = 'binary') and (ty^^[j] <> '(') then
 begin
 if (j - 2 >= 0) and (typ^^[j - 2] <> 'binary') and (typ^^[j - 2] <> 
'unary') and (typ^^[j - 2] <> 'function') then
 begin
 error := concat(ty^^[j - 2], ' is not a binary token ');
 goto 993;
 end;

 while (j - 2 >= 0) and (typr^^[j - 2] >= typr^^[j]) and (typ^^[j - 2] 
<> 'unary') and (typ^^[j - 2] <> 'function') do
 begin
 if (not s2) and (not s3) then
 begin
 error := concat(ty^^[j - 3], ' and ', ty^^[j - 1], '  are not both operand 
tokens');
 goto 993;
 end;

 setnodefields(j - 2, j - 3, j - 1);
 setnodetoken(j - 3);

 j := j - 3;
 reset(j + 1, jtot, 2);
 goto 992;
 end;

 if ty^^[j] = rightparen then
 begin
 if (ty^^[j - 2] <> leftparen) or (not s2) then
 begin
 error := ' ty^^[j-2] <> leftparen token or ty^^[j-1] <> an operand token';
 error := concat(ty^^[j - 2], ' is not a left parenthesis token or ', 
ty^^[j - 1], '  is not an operand token');
 goto 993;
 end;

 ty^^[j - 2] := ty^^[j - 1];
 typr^^[j - 2] := typr^^[j - 1];
 typ^^[j - 2] := typ^^[j - 1];

 j := j - 2;
 reset(j + 1, jtot, 2);
 j := j - 2;
 end;
992:
 end;
 until ty^^[j] = semicolon;

 if j <> 2 then
 error := 'possible incorrect pairing of parentheses';

993:
 ktot := jtot;
 end;
end.

Listing:  Functions
unit Functions;
interface
 uses ParserGlobals;
{following are the functions supported in the parser, besides the usual 
abs, sqr,sqrt,sin,cos,}
{exp, ln, round,trunc. log (log to base 10) is also supported.}
 function asin (var b2: extended): extended;
 function acos (var b2: extended): extended;
 function tan (var b2: extended): extended;
 function atan (var b2: extended): extended;
 function sinh (var b2: extended): extended;
 function cosh (var b2: extended): extended;
 function tanh (var b2: extended): extended;
 function inv (var b2: extended): extended;
 function invsinh (var b2: extended): extended;
 function invcosh (var b2: extended): extended;
 function invtanh (var b2: extended): extended;

implementation
 function asin;
 label
 1, 2;
 var
 y1, y2, sq, cub: extended;
 n: integer;
 begin
 if (b2 = 1) then  {Using a Newton-Raphson iteration to 'home in' on 
the asin function. Starting value}
 begin   {determined from the first few terms of series expansion of 
asin.(done for accuracy)}
 y1 := pi / 2;
 goto 2;
 end;
 if (b2 = -1) then
 begin
 y1 := -pi / 2;
 goto 2;
 end;
 sq := b2 * b2;
 cub := sq * b2;
 y1 := b2 + cub / 6 + (3 * sq * cub) / 40 + (15 * cub * cub * b2) / 336;
 y1 := y1 + (105 * cub * cub * cub) / 3456;
 n := 0;
1:
 n := n + 1;
 if n > 25 then
 goto 2;
 y2 := y1 + (b2 - sin(y1)) / cos(y1);
 y1 := y2;
 goto 1;
2:
 asin := y1;
 end;

 function acos;
 label
 1, 2;
 var
 y1, y2, sq, cub: extended;
 n: integer;
 begin
 if (b2 = 0) then   {Using a Newton-Raphson iteration to 'home in' on 
acos.}
 begin  {First estimate determined from first few terms of a}
 y1 := 0; 
 {series expansion of acos. (done for accuracy)}
 goto 2;
 end;
 sq := b2 * b2;
 cub := sq * b2;
 y1 := b2 + cub / 6 + (3 * sq * cub) / 40 + (15 * cub * cub * b2) / 336;
 y1 := y1 + (105 * cub * cub * cub) / 3456;
 y1 := pi / 2 - y1;
 n := 0;
1:
 n := n + 1;
 if n > 25 then
 goto 2;
 y2 := y1 - (b2 - cos(y1)) / sin(y1);
 y1 := y2;
 goto 1;
2:
 acos := y1;
 end;

 function tan;
 var
 csn, sgn: extended;
 l: integer;
 begin
 csn := cos(b2);
 if csn <= 0 then
 sgn := -1;
 if csn > 0 then
 sgn := 1;
 if abs(csn) <= 1.0e-30 then
 csn := 1.0e-30 * sgn;
 tan := sin(b2) / csn;
 end;

 function atan;
 begin
 atan := arctan(b2);
 end;

 function sinh;
 begin
 sinh := 0.5 * (exp(b2) - exp(-b2));
 end;

 function cosh;
 begin
 cosh := 0.5 * (exp(b2) + exp(-b2));
 end;

 function tanh;
 begin
 tanh := (exp(2 * b2) - 1) / (exp(2 * b2) + 1);
 end;

 function inv;
 begin

 if b2 <> 0 then
 inv := 1 / b2;
 end;

 function invsinh;
 begin
 invsinh := ln(b2 + sqrt(b2 * b2 + 1));
 end;

 function invcosh;
 begin
 if (b2 >= 1) then
 invcosh := ln(b2 + sqrt(b2 * b2 - 1));
 end;

 function invtanh;
 begin
 if (b2 * b2 >= 0) and (b2 * b2 < 1) then
 invtanh := 0.5 * ln((1 + b2) / (1 - b2));
 end;
end.

Listing:  LexicalAnalysis

unit LexicalAnalysis;
interface
 uses ParserGlobals;
 procedure lexicalanalysis (var line: str255; var removeblanks: boolean; 
var ntot: integer; var sy, tokentype: hdlstringarray0; var pr: hdlintarray0; 
var error: str255);
implementation
 procedure lexicalanalysis;
 label
 99, 999, 9999;
 type
 indicate = array[1..maxnumberofstrings] of integer;
 ptrindicate = ^indicate;
 hdlindicate = ^ptrindicate;
 var
 i, j, k, place, len, numstrings: integer;
 ind: hdlindicate;
 s1, s2, s3, s4, s5: boolean;
 nst, nend: hdlintarray0;
 astr: hdlstringarray0;
 ch, ch1, ch2, ch3: char;
 begin
 ind := hdlindicate(NewHandle(SizeOf(indicate)));
 nst := hdlintarray0(NewHandle(SizeOf(intarray0)));
 nend := hdlintarray0(NewHandle(SizeOf(intarray0)));
 astr := hdlstringarray0(NewHandle(SizeOf(stringarray0)));

 place := pos(semicolon, line);

 if place = 0 then
 line := concat(line, ';');

 if removeblanks then
 begin
 place := pos(blank, line);
 while place <> 0 do
 begin
 delete(line, place, 1);
 place := pos(blank, line);
 end;
 end;

 for i := 1 to length(line) do
 ind^^[i] := 0;            {initialize ind^^[i] array}

 for i := 1 to maxnumberofstrings do
 astr^^[i] := '';          {initialize astr^^[i] array}

 for i := 1 to length(line) do
 begin
 k := ord(line[i]);
 if ((65 <= k) and (k <= 90)) or ((97 <= k) and (k <= 122)) then
 ind^^[i] := 1;     {if line[i] is a letter of alphabet, set ind^^[i] 
= 1}
 if ((48 <= k) and (k <= 57)) or (k = 46) then
 ind^^[i] := 2;     {if line[i] is a number or decimal, set ind^^[i] 
= 2}
 end;

 numstrings := 0;
 for i := 1 to length(line) do
 begin

 if (i = 1) and ((ind^^[i] = 1) or (ind^^[i] = 2)) then
 begin
 numstrings := numstrings + 1;   {if first character is 1 or 2, string 
starts}
 nst^^[numstrings] := i;  {at the first character position of line}
 end;

 if i > 3 then
 if (ind^^[i] = 2) and ((line[i - 1] = '+') or (line[i - 1] = '-')) then
 if ((line[i - 2] = 'e') or (line[i - 2] = 'E')) and ((ind^^[i - 3] = 
2)) then
 goto 999;

 if i > 4 then
 if (ind^^[i] = 2) and (ind^^[i - 1] = 2) and ((line[i - 2] = '+') or 
(line[i - 2] = '-')) then
 if ((line[i - 3] = 'e') or (line[i - 3] = 'E')) and ((ind^^[i - 4] = 
2)) then
 goto 999;

 if (i > 1) and (ind^^[i] <> 0) and (ind^^[i - 1] = 0) then
 begin
 numstrings := numstrings + 1;   {start of string at ith position if 
1 or 2 follows}
 nst^^[numstrings] := i; {a 0 after the first character position.}
 end;

 if (i > 1) and (ind^^[i] = 0) and (ind^^[i - 1] <> 0) then     {end 
of string at (i-1)th position if}
 nend^^[numstrings] := i - 1;                                        
    {ith is a 0 and (i-1)the is <> 0}

 if (i = length(line)) and ((ind^^[i] = 1) or (ind^^[i] = 2)) then
 nend^^[numstrings] := i;

999:
 end;

 for i := 1 to numstrings do
 astr^^[i] := copy(line, nst^^[i], nend^^[i] + 1 - nst^^[i]);

 DisposHandle(handle(ind));

 ntot := 0;
 for i := 1 to numstrings do  {meshing strings and operators to get}
 for j := 1 to length(line) do {tokens, sy^^[i], i = 1, ntot}
 begin
 s1 := (j < nst^^[i]) and (i = 1);
 s2 := (nend^^[i] < j) and (j < nst^^[i + 1]) and (i < numstrings);
 s3 := (nend^^[i] < j) and (i = numstrings);
 if s1 or s2 or s3 then
 begin
 ntot := ntot + 1;
 sy^^[ntot] := line[j];
 goto 9999;
 end;
 if (nst^^[i] = j) then
 begin
 ntot := ntot + 1;
 sy^^[ntot] := astr^^[i];
 goto 9999;
 end;
 if (nst^^[i] < j) and (j <= nend^^[i]) then
 goto 9999;
9999:
 end;
 sy^^[0] := '@';

 DisposHandle(handle(nst));
 DisposHandle(handle(nend));
 DisposHandle(handle(astr));

 for i := 0 to ntot do  {setting token types, tokentype^^[i], i = 1, 
ntot}
 begin
 tokentype^^[i] := 'string';
 if (sy^^[i] = exponent) or (sy^^[i] = asterisk) or (sy^^[i] = rightslash) 
or (sy^^[i] = plus) or (sy^^[i] = minus) or (sy^^[i] = equals) or (sy^^[i] 
= rightparen) or (sy^^[i] = semicolon) or (sy^^[i] = leftparen) or (sy^^[i] 
= ampersand) then
 tokentype^^[i] := 'binary';
 if (sy^^[i] = 'pi') or (tokentype^^[i] = 'string') and (((48 <= ord(sy^^[i][1])) 
and (ord(sy^^[i][1]) <= 57)) or (ord(sy^^[i][1]) = 46)) then
 tokentype^^[i] := 'constant';
 if (sy^^[i] = '''') or (sy^^[i] = 'sqrt') or (sy^^[i] = 'sin') or (sy^^[i] 
= 'cos') or (sy^^[i] = 'exp') or (sy^^[i] = 'ln') then
 tokentype^^[i] := 'function';
 if (tokentype^^[i] = 'string') and (tokentype^^[i] <> 'binary') and 
(tokentype^^[i] <> 'constant') and (tokentype^^[i] <> 'function') then
 tokentype^^[i] := 'variable';
 if i > 0 then
 begin
 s1 := ((sy^^[i] = plus) or (sy^^[i] = minus));
 s2 := (tokentype^^[i - 1] <> 'variable') and (tokentype^^[i - 1] <> 
'constant');
 s3 := (sy^^[i - 1] <> rightparen) and (sy^^[i - 1] <> quote);
 if (s1 and s2 and s3) then
 tokentype^^[i] := 'unary';
 end;
 end;

 for i := 1 to ntot do
 if (tokentype^^[i] = 'constant') and (sy^^[i] <> 'pi') then
 begin
 for j := 1 to length(sy^^[i]) do
 begin
 ch1 := sy^^[i][j - 1];
 ch2 := sy^^[i][j];
 ch3 := sy^^[i][j + 1];
 s1 := (65 <= ord(ch2)) and (ord(ch2) <= 90);
 s2 := (97 <= ord(ch2)) and (ord(ch2) <= 122);
 s3 := (ch2 = 'e') or (ch2 = 'E');
 if (s1 or s2) and not s3 then
 begin
 error := 'constant or variable incorrectly constructed';
 goto 99;
 end;
 s1 := ((ch2 = 'e') or (ch2 = 'E'));
 s2 := ((48 <= ord(ch1)) and (ord(ch1) <= 57));
 s3 := ((48 <= ord(ch3)) and (ord(ch3) <= 57));
 s4 := ((ch3 = '+') or (ch3 = '-'));
 if (s1 and not s2) or (s1 and not (s3 or s4)) then
 begin
 error := 'constant or variable incorrectly constructed';
 goto 99;
 end;
 s1 := ((48 <= ord(ch2)) and (ord(ch2) <= 57));
 s2 := ((ch2 = 'e') or (ch2 = 'E'));
 s3 := ((ch2 = '+') or (ch2 = '-'));
 s4 := (ch2 = '.');
 if not (s1 or s2 or s3 or s4) then
 begin
 error := 'constant or variable incorrectly constructed';
 goto 99;
 end;
 end;
 end;

 for i := 0 to ntot do     {setting precedence values for tokens}
 begin
 if (sy^^[i] = exponent) then
 pr^^[i] := 8;
 if (tokentype^^[i] = 'function') then
 pr^^[i] := 7;
 if (sy^^[i] = asterisk) or (sy^^[i] = rightslash) then
 pr^^[i] := 6;
 if (sy^^[i] = plus) or (sy^^[i] = minus) then
 pr^^[i] := 5;
 if sy^^[i] = equals then
 pr^^[i] := 4;
 if (sy^^[i] = rightparen) or (sy^^[i] = semicolon) then
 pr^^[i] := 3;
 if sy^^[i] = leftparen then
 pr^^[i] := 2;
 if sy^^[i] = '@' then
 pr^^[i] := 1;
 if (tokentype^^[i] <> 'function') and (tokentype^^[i] <> 'binary') then
 pr^^[i] := 0;
 end;

99:
 end;
end.

Listing:  Operations

unit Operations;
interface
 uses ParserGlobals;
 procedure realbinaryoperations (var realbinoperator: stringsize; var 
b1, b2, b3: extended; var error: str255);
 procedure realfunctionoperations (var realfunctiontype, realfctoperator: 
stringsize; var b1, b2, b3: extended; var error: str255);
implementation
 procedure realbinaryoperations;
 label
 999;
 var
 j, a, b, c: integer;
 begin
{evaluating the real binary operations}
 if realbinoperator = plus then
 b3 := b1 + b2;
 if realbinoperator = minus then
 b3 := b1 - b2;
 if realbinoperator = asterisk then
 b3 := b1 * b2;
 if realbinoperator = equals then
 b3 := b2;
 if (realbinoperator = rightslash) and (b2 <> 0) then
 b3 := b1 / b2;
 if (realbinoperator = rightslash) and (b2 = 0) then
 begin
 error := 'divide by zero';
 goto 999;
 end;
 if realbinoperator = exponent then
 begin
 if b1 = 0 then
 b3 := 0;
 if b1 < 0 then
 b3 := -exp(b2 * ln(-b1));
 if b1 > 0 then
 b3 := exp(b2 * ln(b1));
 if b2 = 0 then
 b3 := 1;
 end;
999:
 end;

 procedure realfunctionoperations;
 label
 999;
 var
 x1: extended;
 strvalue: string[30];
 begin
 if realfunctiontype = 'function' then
 begin
 if realfctoperator = 'sqrt' then
 begin
 if (b2 < 0) then
 begin
 error := 'taking the square root of a negative number';
 goto 999;
 end;
 if b2 >= 0 then
 b3 := sqrt(b2);
 end;
 if realfctoperator = 'sin' then
 b3 := sin(b2);
 if realfctoperator = 'cos' then
 b3 := cos(b2);
 if realfctoperator = 'exp' then
 b3 := exp(b2);
 if realfctoperator = 'ln' then
 begin
 if (b2 < 0) then
 begin
 error := 'taking the logarithm of negative number';
 goto 999;
 end;
 b3 := ln(b2);
 end;

 if realfctoperator = '''' then
 begin
 if (b2 = 0) then
 begin
 error := 'infinite value';
 goto 999;
 end;
 b3 := 1 / b2;
 end;
 end;

 if realfunctiontype = 'unary' then
 begin
 if realfctoperator = plus then
 b3 := +b1;
 if realfctoperator = minus then
 b3 := -b1;
 end;
999:
 end;
end.

Listing:  EvaluateNodes

unit EvaluateNodes;
interface
 uses ParserGlobals, Operations;
 procedure evaluatenodes (var nodetable: hdlnoderecord; var numnodes: 
integer; var t: hdlextendarray; var store: boolean; var save: array2; 
var error: str255);
implementation
 procedure evaluatenodes;
 label
 777, 999;
 var
 i, j, k, l, m, n: integer;
 realbinoperator, realfunctiontype: stringsize;
 b1, b2, b3: extended;
 s1, s2, s3, s4: boolean;
 begin
 for i := 1 to numnodes do
 begin
 with nodetable^^[i] do
 begin
 s1 := (nodetable^^[i].lop.index <> save[1]);
 s2 := ((nodetable^^[i].lop.index = save[1]) and (save[2] <> equals));
 s3 := (nodetable^^[i].loptype = 'real') or (nodetable^^[i].loptype = 
'constant') or (nodetable^^[i].loptype = 'node');
 s4 := (nodetable^^[i].roptype = 'real') or (nodetable^^[i].roptype = 
'constant') or (nodetable^^[i].roptype = 'node');

 if (s1 or s2) and s3 then
 readstring(nodetable^^[i].lop.index, b1);

 if loptype = 'node' then
 b1 := t^^[round(b1)];

 if s4 then
 readstring(nodetable^^[i].rop.index, b2);

 if roptype = 'node' then
 b2 := t^^[round(b2)];

 if (nodetable^^[i].op.index = equals) then
 begin
 t^^[i] := b2;
 goto 777;
 end;
 end;

777:
 if (nodetable^^[i].optype = 'binary') then
 begin
 realbinoperator := nodetable^^[i].op.index;
 realbinaryoperations(realbinoperator, b1, b2, b3, error);
 end;
 if nodetable^^[i].optype = 'function' then
 begin
 realbinoperator := nodetable^^[i].op.index;
 realfunctiontype := 'function';
 realfunctionoperations(realfunctiontype, realbinoperator, b1, b2, b3, 
error);
 end;
 if nodetable^^[i].optype = 'unary' then
 begin
 realbinoperator := nodetable^^[i].op.index;
 realfunctiontype := 'unary';
 realfunctionoperations(realfunctiontype, realbinoperator, b1, b2, b3, 
error);
 end;
 t^^[i] := b3;
 end;

 numvariables := numvariables + 1;
 strvar^^[numvariables] := 'ans';
 if numnodes > 0 then
 begin
 val^^[numvariables] := t^^[numnodes];
 strvartokentype^^[numvariables] := 'real';
 end;

 if store then
 begin
 numvariables := numvariables + 1;
 strvar^^[numvariables] := save[1];
 if numnodes > 0 then
 begin
 val^^[numvariables] := t^^[numnodes];
 strvartokentype^^[numvariables] := 'real';
 end;
 end;
999:
 end;
end.

Listing:  CheckLine

unit CheckLine;
interface
 uses ParserGlobals, Parser, SetValues, EvaluateNodes;
 procedure checkline (var ntot: integer; var sy, tokentype: hdlstringarray0; 
var pr: hdlintarray0; var numnodes: integer; var t: hdlextendarray; var 
error: str255);
implementation
 procedure checkline;
 label
 998, 999;
 var
 i, j, k, l, nstart: integer;
 flag: hdlflagtype;
 save: array2;
 nodetable: hdlnoderecord;
 realnumber: extended;
 store: boolean;
 begin
 nstart := 0;
 store := false;
 nodetable := hdlnoderecord(NewHandle(SizeOf(noderecord)));
 flag := hdlflagtype(NewHandle(SizeOf(flagtype)));

 if (sy^^[1] = 'pi') and (sy^^[2] = equals) then
 begin
 writeln(sy^^[1], '  is a built-in constant. Define another variable, 
please.');
 goto 999;
 end;

 if ((sy^^[1] = 'listv') or (sy^^[1] = 'stop')) and (sy^^[2] = equals) 
then
 begin
 writeln(sy^^[1], '  is a command word. Define another variable, please.');
 goto 999;
 end;

 if (sy^^[2] = equals) then
 nstart := 3;

 for i := nstart to ntot do
 begin
 flag^^[i] := false;

 if (ntot = 4) and (sy^^[1] = '(') and (sy^^[3] = ')') then
 if sy^^[2] <> 'pi' then
 begin
 readstring(sy^^[2], realnumber);
 writeln(realnumber : decplaceplus10 : decplace);
 goto 999;
 end;

 if ntot = 2 then
 if (tokentype^^[1] = 'constant') then
 begin
 if sy^^[1] = 'pi' then
 writeln(pivalue : decplaceplus10 : decplace);
 if sy^^[1] <> 'pi' then
 begin
 readstring(sy^^[1], realnumber);
 writeln(realnumber : decplaceplus10 : decplace);
 end;
 goto 999;
 end;

 if (numvariables > 0) then
 begin
 for k := 1 to numvariables do
 begin
 j := numvariables + 1 - k;
 if (sy^^[i] = strvar^^[j]) and (tokentype^^[i] = 'variable') then
 begin
 flag^^[i] := true;
 tokentype^^[i] := strvartokentype^^[j];

 if (ntot = 2) then
 begin
 if ((strvartokentype^^[j] = 'real') or (strvartokentype^^[j] = 'variable')) 
then
 writeln(val^^[j] : decplaceplus10 : decplace);
 goto 999;
 end;

 if (ntot = 4) and (sy^^[1] = '(') and (sy^^[3] = ')') then
 begin
 if ((strvartokentype^^[j] = 'real') or (strvartokentype^^[j] = 'variable')) 
then
 writeln(val^^[j] : decplaceplus10 : decplace);
 goto 999;
 end;
 goto 998;
 end;
 end;
 end;
998:
 end;

 save[1] := sy^^[1];
 save[2] := sy^^[2];

 for i := nstart to ntot do
 begin
 if ((tokentype^^[i] = 'variable') or (tokentype^^[i] = 'real')) and 
(flag^^[i] = false) then
 begin
 if ntot = 2 then
 writeln(sy^^[i]);
 if ntot > 2 then
 writeln('  ', sy^^[i], '  has not been defined ');
 goto 999;
 end;

 if tokentype^^[i] = 'constant' then
 if (sy^^[i] <> 'pi') then
 for j := 1 to length(sy^^[i]) do
 if (((65 <= ord(sy^^[i][j])) and (ord(sy^^[i][j]) <= 90)) or ((97 <= 
ord(sy^^[i][j])) and (ord(sy^^[i][j]) <= 122))) and (sy^^[i][j] <> 'E') 
and (sy^^[i][j] <> 'e') then
 begin
 writeln('  ', sy^^[i], '  has not been defined');
 error := ' ';
 goto 999;
 end;
 end;

 parser(ntot, sy, tokentype, pr, nodetable, numnodes, error);
 if error <> '' then
 goto 999;

 setvalues(nodetable, numnodes, numvariables);
 if save[2] = equals then
 store := true;

 evaluatenodes(nodetable, numnodes, t, store, save, error);
 if error <> '' then
 goto 999;
999:
 DisposHandle(handle(nodetable));
 DisposHandle(handle(flag));
 end;
end.

Listing:  GetNodeTable

unit GetNodeTable;
interface
 uses ParserGlobals, StringStuff, GetTokenTypes, Parser, GetFunctionPlaces;
 procedure getnodetable (var nodetable: hdlnoderecord; var nodepointer: 
integer; var error: str255; var store: boolean; var save: array2);
implementation
 procedure getnodetable;
 label
 991, 999;
 type
 placetype = record
 typetoken: stringsize;
 pos: integer;
 strt: integer;
 stp: integer;
 end;
 ptrplacetype = ^placetype;
 hdlplacetype = ^ptrplacetype;
 var
 i, j, k, l, m, jtot, ktot, numnodeplaces: integer;
 numplaces: hdlintarray0;
 sysub: hdlstringarray0;
 subtokentype: hdlstringarray0;
 nst, nend: hdlintarray0;
 nodeplace: array[1..maxnumberofnodes] of hdlplacetype;
 subpr: hdlintarray0;
 begin
 nodepointer := 0;

 numplaces := hdlintarray0(NewHandle(SizeOf(intarray0)));
 nst := hdlintarray0(NewHandle(SizeOf(intarray0)));
 nend := hdlintarray0(NewHandle(SizeOf(intarray0)));

 sysub := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
 subtokentype := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
 subpr := hdlintarray0(NewHandle(SizeOf(intarray0)));

 getfunctionplaces(numnodeplaces, numplaces, nst, nend);

 for j := 1 to numnodeplaces do
 begin
 nodeplace[j] := hdlplacetype(NewHandle(SizeOf(placetype)));
 nodeplace[j]^^.typetoken := tokentype^^[numplaces^^[j]];
 nodeplace[j]^^.pos := numplaces^^[j];
 nodeplace[j]^^.strt := nst^^[j];
 nodeplace[j]^^.stp := nend^^[j];
 end;

 for m := 1 to numnodeplaces do
 begin
 i := numnodeplaces + 1 - m;
 ktot := nodeplace[i]^^.stp + 1 - nodeplace[i]^^.strt;
 for j := nodeplace[i]^^.strt to nodeplace[i]^^.stp do
 begin
 k := j + 1 - nodeplace[i]^^.strt;
 l := k + nodeplace[i]^^.pos;

 sysub^^[k] := sy^^[l];
 subtokentype^^[k] := tokentype^^[l];
 subpr^^[k] := pr^^[l];
 end;

 sysub^^[0] := sy^^[0];
 subtokentype^^[0] := tokentype^^[0];
 subpr^^[0] := pr^^[0];

 ktot := ktot + 1;
 sysub^^[ktot] := sy^^[ntot];
 subtokentype^^[ktot] := tokentype^^[ntot];
 subpr^^[ktot] := pr^^[ntot];

 if ktot = 2 then
 begin
 nodepointer := nodepointer + 1;
 nodetable^^[nodepointer].optype := 'unary';
 nodetable^^[nodepointer].loptype := tokentype^^[nodeplace[i]^^.strt];
 nodetable^^[nodepointer].roptype := tokentype^^[nodeplace[i]^^.strt];
 nodetable^^[nodepointer].op.index := plus;
 nodetable^^[nodepointer].lop.index := sy^^[nodeplace[i]^^.strt];
 nodetable^^[nodepointer].rop.index := sy^^[nodeplace[i]^^.strt];
 goto 991;
 end;

 parser(sysub, subtokentype, subpr, nodetable, nodepointer, error);
 if error <> '' then
 goto 999;

991:
 nodepointer := nodepointer + 1;
 nodetable^^[nodepointer].optype := nodeplace[i]^^.typetoken;
 nodetable^^[nodepointer].loptype := 'node';
 nodetable^^[nodepointer].roptype := 'node';
 nodetable^^[nodepointer].op.index := sy^^[nodeplace[i]^^.pos];
 nodetable^^[nodepointer].lop.index := stringof(nodepointer - 1);
 nodetable^^[nodepointer].rop.index := stringof(nodepointer - 1);

 sy^^[nodeplace[i]^^.pos] := stringof(nodepointer);
 tokentype^^[nodeplace[i]^^.pos] := 'node';
 pr^^[nodeplace[i]^^.pos] := 0;

 for j := nodeplace[i]^^.stp + 1 to ntot do
 begin
 k := j - nodeplace[i]^^.stp;
 sy^^[k + nodeplace[i]^^.pos] := sy^^[j];
 tokentype^^[k + nodeplace[i]^^.pos] := tokentype^^[j];
 pr^^[k + nodeplace[i]^^.pos] := pr^^[j];
 end;

 ntot := ntot - (ktot - 1);
 for l := 1 to i - 1 do
 if nodeplace[l]^^.stp > nodeplace[i]^^.stp then
 nodeplace[l]^^.stp := nodeplace[l]^^.stp - (ktot - 1);
 end;

 parser(sy, tokentype, pr, nodetable, nodepointer, error);

 ntot := jtot;
 if (save[2] = equals) then
 store := true;

999:
 for k := 1 to numnodeplaces do
 DisposHandle(handle(nodeplace[k]));

 DisposHandle(handle(numplaces));
 DisposHandle(handle(nst));
 DisposHandle(handle(nend));
 DisposHandle(handle(sysub));
 DisposHandle(handle(subtokentype));
 DisposHandle(handle(subpr));
 end;
end.

listing:  SetValues

unit SetValues;
interface
 uses ParserGlobals;
 procedure setvalues (var nodetable: hdlnoderecord; var numnodes, numvariables: 
integer);
implementation
 procedure setvalues;
 var 
 i, j, l, m: integer;
 begin
 i := 1;
 while i <= numnodes do
 begin
 l := numnodes + 1 - i;
 if nodetable^^[l].lop.index = 'pi' then
 nodetable^^[l].lop.index := stringof(pivalue : 30 : 20);
 if nodetable^^[l].rop.index = 'pi' then
 nodetable^^[l].rop.index := stringof(pivalue : 30 : 20);
 j := 1;
 while j <= numvariables do
 begin
 m := numvariables + 1 - j;

 if (nodetable^^[l].lop.index = strvar^^[m]) then
 begin
 nodetable^^[l].lop.index := stringof(val^^[m] : 30 : 20);
 nodetable^^[l].loptype := strvartokentype^^[m];
 end;
 if (nodetable^^[l].rop.index = strvar^^[m]) then
 begin
 nodetable^^[l].rop.index := stringof(val^^[m] : 30 : 20);
 nodetable^^[l].roptype := strvartokentype^^[m];
 end;
 j := j + 1;
 end;
 i := i + 1;
 end;
 end;
end.

Listing:  Eval

unit Eval;
interface
 uses ParserGlobals, Operations, LexicalAnalysis, Parser, SetValues, 
EvaluateNodes, CheckLine;
 function eval (var line: str255): str255;
implementation
 function eval;
 label
 999;
 var
 removeblanks: boolean;
 ntot, numnodes: integer;
 sy, tokentype, ty, tytokentype: hdlstringarray0;
 pr: hdlintarray0;
 t: hdlextendarray;
 begin
 sy := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
 ty := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
 tokentype := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
 tytokentype := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
 pr := hdlintarray0(NewHandle(SizeOf(intarray0)));
 t := hdlextendarray(NewHandle(SizeOf(extendarray)));

 removeblanks := true;
 lexicalanalysis(line, removeblanks, ntot, sy, tokentype, pr, error);

 if error <> '' then
 begin
 eval := error;
 goto 999;
 end;

 checkline(ntot, sy, tokentype, pr, numnodes, t, error);
 if error <> '' then
 begin
 eval := error;
 goto 999;
 end;

 if numnodes <= 0 then
 begin
 eval := '';
 goto 999;
 end;

 eval := stringof(t^^[numnodes] : decplaceplus10 : decplace);

 DisposHandle(handle(sy));
 DisposHandle(handle(ty));
 DisposHandle(handle(tokentype));
 DisposHandle(handle(tytokentype));
 DisposHandle(handle(pr));
 DisposHandle(handle(t));

999:
 end;
end.

Listing:  ParserDriver

program ParserDriver;
 uses ParserGlobals, Eval, ParserOps;
 label
 997, 998, 999;
 var
 numnodes: integer;
 windowsize: rect;
 line, result: str255;
 ch: char;
 ty: hdlstringarray0;
 savename: stringsize;
 tytokentype: hdlstringarray0;
 flag: hdlflagtype;

 procedure AllocateParserHandles;
 begin
 strvar := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
 strvartokentype := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
 val := hdlextendarray(NewHandle(SizeOf(extendarray)));
 flag := hdlflagtype(NewHandle(SizeOf(flagtype)));
 end;

 procedure DisposeOfParserHandles;
 begin
 DisposHandle(handle(strvar));
 DisposHandle(handle(strvartokentype));
 DisposHandle(handle(val));
 DisposHandle(handle(flag));
 end;
begin
 varfilename := 'variablefile';
 decplace := 20;
 decplaceplus10 := decplace + 10;

 AllocateParserHandles;

 Hideall;
 setrect(windowsize, 0, 38, 560, 340);
 settextrect(windowsize);
 showtext;
 readvariables;

998:
 error := '';
 numnodes := 0;

 write(blank);
 readln(line);

 if (pos('dec', line) <> 0) then
 begin
 setdecimal;
 goto 998;
 end;

 if (pos('cls', line) <> 0) then
 begin
 clearscreen(line);
 goto 998;
 end;

 if (pos('clm', line) <> 0) then
 begin
 numvariables := 0;
 goto 998;
 end;

 if line = '' then
 goto 998;

 if (line = 'stop') then
 goto 999;

 if (numvariables > 0) and (pos('listv', line) <> 0) then
 begin
 listvariables;
 goto 998;
 end;
 result := eval(line);
 writeln(result);
 goto 998;

999:
 if numvariables > 0 then
 begin
 writeln('Do you want to save your current variables for the next session? 
y/n');
997:
 writeln(blank);
 readln(ch);
 if (ch = 'n') or (ch = 'N') then
 begin
 rewrite(varfile);
 writeln('');
 end;
 if (ch = 'y') or (ch = 'Y') then
 storevariables;
 if not ((ch = 'n') or (ch = 'N') or (ch = 'y') or (ch = 'Y')) then
 begin
 writeln('Should be y, Y, n, or N, please');
 goto 997;
 end;
 close(varfile);
 end;
 DisposeOfParserHandles;
end.