TweetFollow Us on Twitter

Math Parser
Volume Number:7
Issue Number:5
Column Tag:Pascal Procedures

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.

(i) index index index

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]

(i) indx indx indx

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.

 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Arq 5.8.5 - Online backup to Google Driv...
Arq is super-easy online backup for Mac and Windows computers. Back up to your own cloud account (Amazon Cloud Drive, Google Drive, Dropbox, OneDrive, Google Cloud Storage, any S3-compatible server... Read more
Backblaze 4.3.0.44 - Online backup servi...
Backblaze is an online backup service designed from the ground-up for the Mac. With unlimited storage available for $5 per month, as well as a free 15-day trial, peace of mind is within reach with... Read more
Instaradio 7.1 - Listen to your favorite...
Instaradio is fast, and it could be the radio player you have been waiting for. Try the app thousands of people rely on for listening to radio. Features Listen to radio from all around the world... Read more
EtreCheck 3.3.3 - For troubleshooting yo...
EtreCheck is an app that displays the important details of your system configuration and allow you to copy that information to the Clipboard. It is meant to be used with Apple Support Communities to... Read more
Hopper Disassembler 4.2.1- - Binary disa...
Hopper Disassembler is a binary disassembler, decompiler, and debugger for 32-bit and 64-bit executables. It will let you disassemble any binary you want, and provide you all the information about... Read more
Slack 2.6.2 - Collaborative communicatio...
Slack is a collaborative communication app that simplifies real-time messaging, archiving, and search for modern working teams. Version 2.6.2: Fixed Inexplicably, context menus and spell-check... Read more
Apple Final Cut Pro X 10.3.4 - Professio...
Apple Final Cut Pro X is a professional video editing solution.Completely redesigned from the ground up, Final Cut Pro adds extraordinary speed, quality, and flexibility to every part of the post-... Read more
Numi 3.15 - Menu-bar calculator supports...
Numi is a calculator that magically combines calculations with text, and allows you to freely share your computations. Numi combines text editor and calculator Support plain English. For example, '5... Read more
TunnelBear 3.0.14 - Subscription-based p...
TunnelBear is a subscription-based virtual private network (VPN) service and companion app, enabling you to browse the internet privately and securely. Features Browse privately - Secure your data... Read more
Apple iMovie 10.1.6 - Edit personal vide...
With an all-new design, Apple iMovie lets you enjoy your videos like never before. Browse your clips more easily, instantly share your favorite moments, and create beautiful HD movies and Hollywood-... Read more

Latest Forum Discussions

See All

Goat Simulator PAYDAY (Games)
Goat Simulator PAYDAY 1.0 Device: iOS Universal Category: Games Price: $4.99, Version: 1.0 (iTunes) Description: ** IMPORTANT - SUPPORTED DEVICES **iPhone 4S, iPad 2, iPod Touch 5 or better Goat Simulator: Payday is the most... | Read more »
Zombie Gunship Survival Beginner's...
The much anticipated Zombie Gunship Survival is here. In this latest entry in the Zombie Gunship franchise, you're tasked with supporting ground troops and protecting your base from the zombie horde. There's a lot of rich base building fun, and... | Read more »
Mordheim: Warband Skirmish (Games)
Mordheim: Warband Skirmish 1.2.2 Device: iOS Universal Category: Games Price: $3.99, Version: 1.2.2 (iTunes) Description: Explore the ruins of the City of Mordheim, clash with other scavenging warbands and collect Wyrdstone -... | Read more »
Mordheim: Warband Skirmish brings tablet...
Legendary Games has just launched Mordheim: Warband Skirmish, a new turn-based action game for iOS and Android. | Read more »
Magikarp Jump splashes onto Android worl...
If you're tired ofPokémon GObut still want something to satisfy your mobilePokémon fix,Magikarp Jumpmay just do the trick. It's out now on Android devices the world over. While it looks like a simple arcade jumper, there's quite a bit more to it... | Read more »
Purrfectly charming open-world RPG Cat Q...
Cat Quest, an expansive open-world RPG from former Koei-Tecmo developers, got a new gameplay trailer today. The video showcases the combat and exploration features of this feline-themed RPG. Cat puns abound as you travel across a large map in a... | Read more »
Jaipur: A Card Game of Duels (Games)
Jaipur: A Card Game of Duels 1.0 Device: iOS Universal Category: Games Price: $1.99, Version: 1.0 (iTunes) Description: ** WARNING: iPad 2, iPad Mini 1 & iPhone 4S are NOT compatible. ** *** Special Launch Price for a limited... | Read more »
Subdivision Infinity (Games)
Subdivision Infinity 1.03 Device: iOS Universal Category: Games Price: $2.99, Version: 1.03 (iTunes) Description: Launch sale! 40% Off! Subdivision Infinity is an immersive and pulse pounding sci-fi 3D space shooter. https://www.... | Read more »
Clash of Clans' gets a huge new upd...
Clash of Clans just got a massive new update, and that's not hyperbole. The update easily tacks on a whole new game's worth of content to the hit base building game. In the update, that mysterious boat on the edge of the map has been repaired and... | Read more »
Thimbleweed Park officially headed to iO...
Welp, it's official. Thimbleweed Park will be getting a mobile version. After lots of wondering and speculation, the developers confirmed it today. Thimbleweed Park will be available on both iOS and Android sometime in the near future. There's no... | Read more »

Price Scanner via MacPrices.net

Free Tread Wisely Mobile App Endorsed By Fath...
Just in time for the summer driving season, Cooper Tire & Rubber Company has announced the launch of a new Tread Wisely mobile app. Designed to promote tire and vehicle safety among teens and... Read more
Commercial Notebooks And Detachable Tablets W...
Worldwide shipments of personal computing devices (PCDs), comprised of traditional PCs (a combination of desktop, notebook, and workstations) and tablets (slates and detachables), are forecast to... Read more
Best value this Memorial Day weekend: Touch B...
Apple has Certified Refurbished 2016 15″ and 13″ MacBook Pros available for $230 to $420 off original MSRP. An Apple one-year warranty is included with each model, and shipping is free: - 15″ 2.6GHz... Read more
13-inch MacBook Airs on sale for up to $130 o...
Overstock.com has 13″ MacBook Airs on sale for up to $130 off MSRP including free shipping: - 13″ 1.6GHz/128GB MacBook Air (sku MMGF2LL/A): $869.99 $130 off MSRP - 13″ 1.6GHz/256GB MacBook Air (sku... Read more
2.8GHz Mac mini available for $973 with free...
Adorama has the 2.8GHz Mac mini available for $973, $16 off MSRP, including a free copy of Apple’s 3-Year AppleCare Protection Plan. Shipping is free, and Adorama charges sales tax in NY & NJ... Read more
15-inch 2.2GHz Retina MacBook Pro on sale for...
Amazon has 15″ 2.2GHz Retina MacBook Pros (MJLQ2LL/A) available for $1749.99 including free shipping. Apple charges $1999 for this model, so Amazon’s price is represents a $250 savings. Note that... Read more
Huawei Unveils New ‘Business-Styled’ MateBook...
Huawei has introduced a trio of new MateBook laptops, expanding its mobile portfolio and building on its success in delivering attractive and powerful high-end devices. The company claims the HUAWEI... Read more
Deal! Gold 12-inch 1.2GHz Retina MacBook for...
Amazon has the 2016 Gold 12″ 1.2GHz Retina MacBook (MLHF2LL/A) on sale for $350 off MSRP for a limited time. Shipping is free: - 12″ 1.2GHz Gold Retina MacBook: $1249.99 $350 off MSRP We expect this... Read more
13-inch 2.0GHz MacBook Pros on sale for $100...
B&H has the non-Touch Bar 13″ 2.0GHz MacBook Pros in stock today and on sale for $100 off MSRP. Shipping is free, and B&H charges NY & NJ sales tax only: - 13″ 2.0GHz MacBook Pro Space... Read more
15-inch 2.2GHz Retina MacBook Pro, Apple refu...
Apple has Certified Refurbished 2015 15″ 2.2GHz Retina MacBook Pros available for $1699. That’s $300 off MSRP, and it’s the lowest price available for a 15″ MacBook Pro. An Apple one-year warranty is... Read more

Jobs Board

*Apple* Retail - Multiple Positions, White P...
Sales Specialist - Retail Customer Service and Sales Transform Apple Store visitors into loyal Apple customers. When customers enter the store, you're also the Read more
Best Buy *Apple* Computing Master - Best Bu...
**509110BR** **Job Title:** Best Buy Apple Computing Master **Location Number:** 000048-Topeka-Store **Job Description:** **What does a Best Buy Apple Computing Read more
*Apple* Retail - Multiple Positions - Apple,...
Job Description: Sales Specialist - Retail Customer Service and Sales Transform Apple Store visitors into loyal Apple customers. When customers enter the store, Read more
*Apple* Retail - Multiple Positions - Apple,...
Job Description:SalesSpecialist - Retail Customer Service and SalesTransform Apple Store visitors into loyal Apple customers. When customers enter the store, Read more
*Apple* Systems Engineer - California Polyte...
Cal Poly, San Luis Obispo Apple Systems Engineer Department: ITS - Customer & Tech Support (134900) College/Division: Academic Affairs Salary Range: Position Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.