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

Monolingual 1.6.4 - Remove unwanted OS X...
Monolingual is a program for removing unnecesary language resources from OS X, in order to reclaim several hundred megabytes of disk space. If you use your computer in only one (human) language, you... Read more
CleanApp 5.0 - Application deinstaller a...
CleanApp is an application deinstaller and archiver.... Your hard drive gets fuller day by day, but do you know why? CleanApp 5 provides you with insights how to reclaim disk space. There are... Read more
Fantastical 2.0 - Create calendar events...
Fantastical is the Mac calendar you'll actually enjoy using. Creating an event with Fantastical is quick, easy, and fun: Open Fantastical with a single click or keystroke Type in your event details... Read more
Cocktail 8.2 - General maintenance and o...
Cocktail is a general purpose utility for OS X that lets you clean, repair and optimize your Mac. It is a powerful digital toolset that helps hundreds of thousands of Mac users around the world get... Read more
Direct Mail 4.0.4 - Create and send grea...
Direct Mail is an easy-to-use, fully-featured email marketing app purpose-built for OS X. It lets you create and send great looking email campaigns. Start your newsletter by selecting from a gallery... Read more
jAlbum Pro 12.6 - Organize your digital...
jAlbum Pro has all the features you love in jAlbum, but comes with a commercial license. With jAlbum, you can create gorgeous custom photo galleries for the Web without writing a line of code!... Read more
jAlbum 12.6 - Create custom photo galler...
With jAlbum, you can create gorgeous custom photo galleries for the Web without writing a line of code! Beginner-friendly, with pro results Simply drag and drop photos into groups, choose a design... Read more
Lyn 1.5.9 - Lightweight image browser an...
Lyn is a lightweight and fast image browser and viewer designed for photographers, graphic artists and Web designers. Featuring an extremely versatile and aesthetically pleasing interface, it... Read more
Sublime Text 3080 - Sophisticated text e...
Sublime Text is a sophisticated text editor for code, markup, and prose. You'll love the slick user interface, extraordinary features, and amazing performance. Goto Anything. Use Goto Anything to... Read more
WALTR 1.0.11 - Drag-and-drop any media f...
WALTR is designed to make it easy to upload and convert any music or video file to an iPad or iPhone format for native playback. It supports a huge variety of media file types, including MP3, MP4,... Read more

Bio Inc's New Expansion is Infectin...
Bio Inc., by DryGin Studios, is the real time strategy game where you infect a human body with the worst virus your evil brain can design. Recently, the game was updated to add a whole lot of new features. Now you can play the new “Lethal”... | Read more »
The Monocular Minion is Here! Despicable...
Despicable Me: Minion Rush, by Gameloft, is introducing a new runner to the mix in their latest update. Now you can play as Carl, the prankster minion. Carl has a few new abilities to play with, including running at a higher speed from the start.... | Read more »
Dungeon of Madness (Games)
Dungeon of Madness 1.0.0 Device: iOS Universal Category: Games Price: $1.99, Version: 1.0.0 (iTunes) Description: Dungeon of Madness is an action game where you rotate tiles to create our own route. Help the hero by connecting the... | Read more »
Filters for iPhone (Photography)
Filters for iPhone 1.0 Device: iOS iPhone Category: Photography Price: $.99, Version: 1.0 (iTunes) Description: | Read more »
Jump'N'Shoot Attack (Games)
Jump'N'Shoot Attack 1.0 Device: iOS Universal Category: Games Price: $1.99, Version: 1.0 (iTunes) Description: A mobile game for gamers! Join Louise Lightfoot, the legendary "Master of Jumping and Shooting", on her mission to save... | Read more »
Space Bounties Inc. (Games)
Space Bounties Inc. 1.4 Device: iOS Universal Category: Games Price: $1.99, Version: 1.4 (iTunes) Description: SuperGameDroid: 4/5 "Satisfying futuristic RPG combat, high replay value, and a heavy dose of nostalgia make Space... | Read more »
Gamebook: Pocket RPG (Games)
Gamebook: Pocket RPG 1.0.11 Device: iOS Universal Category: Games Price: $2.99, Version: 1.0.11 (iTunes) Description: Walk into the Land of Lanthir Lamath ruled by wicked skeletons and fight for your life in a thrilling adventure.... | Read more »
Kids Can Mix, Match, and Catch with Tata...
Tatadada MixMatch, by Tatadada Ltd, is a mobile version of the classic game of mix & match. The game uses brightly colored creatures to train your children's pattern matching skills and hand-eye coordination. It's aimed at children around age 5... | Read more »
The Trace: Murder Mystery Game (Games)
The Trace: Murder Mystery Game 1.2.0 Device: iOS Universal Category: Games Price: $4.99, Version: 1.2.0 (iTunes) Description: | Read more »
This Week at 148Apps: March 16-20, 2015
Spring Roars In At 148Apps How do you know what apps are worth your time and money? Just look to the review team at 148Apps. We sort through the chaos and find the apps you're looking for. The ones we love become Editor’s Choice, standing out above... | Read more »

Price Scanner via MacPrices.net

Logitech Says MX Master Is Its Most Advanced...
Logitech’s new MX Master Wireless Mouse incorporates the best of Logitech’s many computer mouse innovations into a striking hand-sculpted design. The company claims that the MX Master creates a new... Read more
Save up to $300 on a new Mac, $30 on an iPad,...
Purchase a new Mac or iPad at The Apple Store for Education and take up to $300 off MSRP. All teachers, students, and staff of any educational institution qualify for the discount. Shipping is free,... Read more
Apple refurbished 2014 MacBook Airs available...
The Apple Store lowered prices on Apple Certified Refurbished 2014 MacBook Airs recently, with models now available starting at $679. An Apple one-year warranty is included with each MacBook, and... Read more
Mac Notebook Evolution; A Desktop Replacement...
More often than not right from the beginning, Apple’s Macs have tended to skew toward small. The original Macs were called “compacts,”, and notwithstanding a few exceptions like the honking Big Mac... Read more
13-inch 1.4GHz/128GB MacBook Air (Apple refur...
The Apple Store has Apple Certified Refurbished 2014 13″ 1.4GHz/128GB MacBook Airs available for $759 including free shipping plus Apple’s standard one-year warranty. Their price is $240 off original... Read more
YEP! Alternative Browser for iOS Now Supports...
Pfaeffikon, Switzerland based Power App AG has announced the release of an update to their Yep! Web Browser (v1.3.0) for iOS8 iPhone and iPad. Yep! hit the App Store shortly after the release of iOS... Read more
15-inch Retina MacBook Pros on sale for up to...
B&H Photo has the new 2014 15″ Retina MacBook Pros on sale for up to $250 off MSRP for a limited time. Shipping is free, and B&H charges NY sales tax only: - 15″ 2.2GHz Retina MacBook Pro: $... Read more
Clearance 13-inch Retina MacBook Pros availab...
B&H Photo has leftover 2014 13″ Retina MacBook Pros on sale for up to $250 off original MSRP. Shipping is free, and B&H charges NY sales tax only: - 13″ 2.6GHz/128GB Retina MacBook Pro: $1098... Read more
Clearance 2014 MacBook Airs on sale for up to...
B&H Photo has MacBook Airs on sale for up to $180 off original MSRP. Shipping is free, and B&H charges NY sales tax only: - 11″ 128GB MacBook Air: $789.99 110 off original MSRP - 11″ 256GB... Read more
Apple refurbished Time Capsules available for...
The Apple Store has certified refurbished Time Capsules available for $100 off MSRP. Apple’s one-year warranty is included with each Time Capsule, and shipping is free: - 2TB Time Capsule: $199, $100... Read more

Jobs Board

*Apple* Solutions Consultant - Retail Sales...
**Job Summary** As an Apple Solutions Consultant (ASC) you are the link between our customers and our products. Your role is to drive the Apple business in a retail Read more
*Apple* Retail - Multiple Positions (US) - A...
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
*Apple* Retail - Multiple Positions (US) - D...
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* Systems Engineer - Pre Sales, Educat...
…is responsible for proactively providing technical expertise to drive sales of Apple solutions into assigned accounts. The SE architects, validates, and assists in Read more
Sr. Technical Services Consultant, *Apple*...
**Job Summary** Apple Professional Services (APS) has an opening for a senior technical position that contributes to Apple 's efforts for strategic and transactional Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.