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 miniprogram. 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 watereddown 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^^[i1] = 0 and ind^^[i] <> 0, a string starts at the ith position, and for all i > 1, if ind^^[i] = 0 and ind^^[i1] <> 0, a string ends at the (i1)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.24e3’, 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[i3], line[i2], line[i1], and line[i], taken together. If line[i3] = an integer or decimal and line[i2] = ‘e’ or ‘E’ and line[i1] = ‘+’ 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[i4], line[i3], line[i2], line[i1] and line[i] taken together. If line[i4] = integer or decimal and line[i3] = ‘e’ or ‘E’ and and line[i2] = ‘+’ or ‘’, and line[i1] = 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.24e3’ 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^^[i1] is neither a variable nor a real, and sy^^[i1] 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 treelike 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 j2. 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 j3. If (d) in Step 1, set the (j2)nd token equal to the (j1)st, set j to j2, set kth token equal to the (k+2)nd token for k = j+1 to jtot, then reset j to j2.
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) 9783327
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^^[j2] <> leftparen token or ty^^[j1] <> 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 NewtonRaphson 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 NewtonRaphson 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.0e30 then
csn := 1.0e30 * 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 (i1)th position if}
nend^^[numstrings] := i  1;
{ith is a 0 and (i1)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 builtin 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.