UCL Expressions, part 3: Parsing

In the previous articles, we laid the groundwork for the parsing of UCL expressions. In this article, we will examine the parsing code itself.

function Parse_Expression( var Err : integer ; var Context : string ) : TExpression_Node ;
// Parse an expression into an expression tree, and return pointer to root

var Operator_Precedence : integer ;
    Operator : string ;
    Left_Subexpression, Current, Previous, Root : TExpression_Node ;
    A, Flags, P, PO : longint ;
    prc, _Result : integer ;

begin
    // Perform expression setup...
    Current := nil ;
    Root := nil ;
    Parse_Expression := nil ; // Assume complete failure
    Err := 0 ;

We initialize our state. If we return nil, it indicates that there was an error in the parsing. We initialize the result thusly to nil.

    // Get first subexpression...
    Left_Subexpression := Get_Subexpression( Err, Context ) ;
    if( Err <> 0 ) then
    begin
        exit ;
    end ;

We get the first subexpression by calling the Get_Subexpression function and assigning it to Left_Subexpression. If the function sets Err to non-zero, then we exit. Since Err is a var parameter, any error here will be passed back to the caller.

    // Process until end of expression...
    while( Left_Subexpression <> nil ) do
    begin
        // Get operator...
        Operator := Get_Token ;
        Resolve_Symbol( Operator, A, P, PO, Flags, prc, _Result ) ;
        if(
            ( _Result <> 0 )
            or
            ( ( Flags and UF_Type_Mask ) <> UF_Operator )
          ) then // Not an operator
        begin
            Parser.Put_Token( Operator ) ; // Return token
            if( Current <> nil ) then
            begin
                Current.Right := Left_Subexpression ;
                Left_Subexpression.Back := Current ;
            end else
            begin
                Root := Left_Subexpression ;
            end ;
            Err := UCL_EXPSYN ;
            Parse_Expression := Root ;
            exit ;
        end ;

Because there may be more to the expression than the already processed sub-expression, we will loop until the Left_Subexpression variable is nil (indicating that the expression is at an end - one way or another). Since we have just processed a sub-expression, the next token must be an operator (or the expression has an invalid syntax). So we assign Operator the next token. We call Resolve_Symbol (discussed later in the article) to determine which operator it is. That function returns Flags about the symbol and we use UF_Type_Mask to get the portion of the flags that are the symbol type. The error, if any, is returned via _Result. If _Result is anything but 0, there was an error in resolving the symbol. If that occurs, or the symbol's type is not and operator (=UF_Operator), we have run out of valid expression. This could indicate an error in the expression, or it could simply indicate the end of the expression. For instance, in an IF...THEN situation, once we have parsed the expression, the next symbol will be "THEN", which is not a valid operator, thus ending the parsing. In either case, we put the token back so the calling code can deal with it. At this point, we return the UCL_EXPSYN (ie syntax error) code through Err, and return the expression tree that we have built. There are two possible scenarios here. On one hand we might have part of an expression that is left over from later in the loop (see the code below). In such as case, we link the existing sub-expression to the right link of Current. Otherwise, we simply return Left_Subexpression. In this latter case, there was only the initial sub-expression in the expression.

        // Create node for operator...
        if( Root = nil ) then // First thing in tree
        begin
            Root := tExpression_Node.Create ;
            Current := Root ;
            Previous := nil ;
        end else
        begin
            Previous := Current ; // Save previous current node
            Current := tExpression_Node.Create ;
        end ;
        Current.Precedence := Prc ;
        Current.Left := Left_Subexpression ;
        Current.Right := nil ;
        Current.Back := Previous ;
        Current.Operator := A ;
        Left_Subexpression.Back := Current ;

Now that we have an operator, we must create a node for it. If we have no expression root yet, we set the root to the new node. Otherwise, we save the previous Current node and create a new one. At this point, Current is the new operator node. Then we set the node's values. The back link is to the previous node (if any). At this point we only have the previous subexpression and the operator, so the right link is nil, but the left link points to the subexpression.

        // Insert operator node into existing tree...
        if( Previous <> nil ) then // Tree exists
        begin
            if( Previous.Left = nil ) then
            begin
                Previous.Left := Current ;
            end else
            begin
                Previous.Right := Current ;
            end ;
        end ; // if( Previous <> nil )

Now we have to insert the new operator node into the expression tree in the proper location by linking the previous node to this node. If the previous node has no left link, the operator node will be put on the left of the previous node, otherwise we've already handled the left node and we link the operator node to the right link.

        // Handle precedence...
        Operator_Precedence := prc ;
        if( ( Current.Back <> nil ) and // There was a previous operator
            ( Current.Back.Precedence >= Operator_Precedence )
            { Current operator has less precedence than the last
              (Operators with same precedence evaluate from left to right,
               thus, the following has an implied lower precedence) }
           ) then
        begin

Now we address the issue of operator precedence. If this is not the first operator in the expression (Current node has a parent), and the previous operator (from the current node's parent node) has a higher precedence than the current operator, then we need to adjust the tree so that the current operator is evaluated after the previous operator. If neither of those conditions are true, then this is the first operator of the expression or the previous operator has the same or lower precedence, we don't need any adjustment to the tree. Remember: the farther from the root node an operator is, the earlier it is evaluted.

            // Back up to the proper node..
            Previous := Current ;
            while(
                   ( Previous.Back <> nil )
                   and
                   ( Previous.Back.Precedence >= Operator_Precedence )
                 ) do
            begin
                Previous := Previous.Back ;
            end ;

If we get here, the current operator has a lower precedence than it's parent, but it's parent's parent might also have a lower precedence, and so on. So we iterate up the tree until we reach the root node or find an operator with lower or equal precedence.

            // Move current node to proper location in tree...
            // Unlink from current location
            if( Current.Back.Left = Current ) then
            begin
                Current.Back.Left := Current.Left ;
            end else
            begin
                Current.Back.Right := Current.Left ;
            end ;
            if( Current.Left <> nil ) then
            begin
                Current.Left.Back := Current.Back ;
            end ;
            Current.Back := Previous.Back ;

Once we find the new location for the operator, we need to move the node to the new location. This is done in two steps. The first step is to unlink the node from it's current tree location (it was previously linked in on the assumption that it had a higher precedence and went here). So, we adjust the parent node's pointer to be our current left node pointer. Then we set our back pointer to our new parent node.

            // Relink to new location...
            if( Previous = Root ) then // Current becomes root node
            begin
                Current.Left := Root ;
                Root.Back := Current ;
                Root := Current ;
                Current.Back := nil ;
            end else
            begin
                if( Previous.Back.Left = Previous ) then
                begin
                    Previous.Back.Left := Current ;
                end else
                begin
                    Previous.Back.Right := Current ;
                end ;
                Current.Left := Previous ;
                Previous.Back := Current ;
            end ;
        end ; // Current operator has less precedence than the last

The second step in moving the current node is to insert it into the new position in the expression tree. If the previous node is the root, the current node becomes the root, so we point the root back to the current node, put the root on the left side, and set the Root pointer. If the current node is not becoming the root, we link the current node to the previous parent's left or right node, as appropriate. Then we set the current node's left pointer to the previous node and link the previous node back to the current node.

        // Get next subexpression and loop...
        Left_Subexpression := Get_Subexpression( Err, Context ) ;
        if( Err <> 0 ) then
        begin
            Parse_Expression := Root ;
            exit ;
        end ;
    end ; // while( Left_Subexpression <> nil ) do
    Parse_Expression := Root ;
end ; // Parse_Expression

At this point, the new node is now in the proper position in the expression tree. So, we get the next subexpression and assign it to Left_Subexpression. If there was an error getting the next subexpression, we exit and return the current tree. Otherwise, if Left_Subexpression is nil (no more expression tokens were encountered), then the loop ends and we return the expression tree.

Now let's look at the Get_Subexpression function.

function Get_Subexpression( var Err : integer ; var Context : string ) : tExpression_Node ;
{ Get a subexpression (term) and return pointer to subexpression tree.  Return
  nil if an error or no tokens. }

var Subexpression, Temp : tExpression_Node ;
    Operator : tExpression_Node ;
    X : Ansistring ; // Curren token
    A, P, PO : longint ;
    I : int64 ;
    Flags : longint ; // Symbol flags
    Op : integer ;
    prc, _Result : integer ; // Symbol information
    Unary_plus : boolean ; // True if unary plus found

begin
    // Setup...
    Unary_Plus := False ;
    Subexpression := nil ;
    Result := nil ; // Assume failure
    Err := 0 ;
    Context := '' ;

The first thing we do is initialize our context. The Error code and context are cleared, the function result is set to nil, and other values are cleared.

    // Process sub-expression...
    while( true ) do
    begin
        X := Get_Token ; // Get next token
        if( X = '(' ) then // Start of parenthesis
        begin
            Temp := Parse_Expression( Err, Context ) ;
            if( Err = UCL_EXPSYN ) then // Syntax error is okey - probably the ")"
            begin
                Err := 0 ;
                Context := '' ;
            end ;
            if( Err <> 0 ) then
            begin
                exit ;
            end ;

First, we get the next token. If the token is an opening parenthesis, then we parse whatever expression is within the parentheses. If the parsing operation results in an syntax error, we will pretend like there is no error - since this could simply be the result of finding the closing parenthesis. If the actually is a syntax error, we will deal with that below. Any other kind of error is passed back and we exit.

            if( Subexpression = nil ) then // First part of subexpression
            begin
                Subexpression := Temp ;
            end else
            begin
                Operator := Subexpression ;
                while( Operator.Left <> nil ) do
                begin
                    Operator := Operator.Left ;
                end ;
                Operator.Left := Subexpression ;
            end ;

If we have not accumulated any expression so far, we assign it to Subexpression. Otherwise, we navigate down the tree to the far-left terminal node. Remember: the parts of the tree farthest away from the root are evaluated first. Since this expression has forced precedence due to parentheses, we will place it at the far lower-left of the expression tree, thus ensuring it is evaluated first.

            X := Get_Token ;
            if( pos( X[ 1 ], ')' ) = 0 ) then // No closing parenthesis
            begin
                Parser.Put_Token( X ) ;
                Err := UCL_MISSRP ;
                Context := X ;
                Get_Subexpression := nil ;
                Zero_Expression_Tree( Subexpression ) ;
                exit ;
            end ;
            Result := Subexpression ;
            exit ;
        end ;

Now that we have the opening parenthesis and the contained expression, the next token should be the closing parenthesis. We get the next token and if it isn't the closing parenthesis, we put the token back, set the context to that token (so the calling code can report what token was the issue), set Err to indicate the problem, then we zero the subexpression tree that we've been building and exit. Otherwise, we are finished and we return the subexpression to the caller.

        if( X <> '+' ) then // Unary plus
        begin
            break ;
        end ;
        Unary_Plus := True ;
    end ; // while( true )

Recall that unary plus operators are ignored. If the next token is a plus sign, we set the flag and loop. Otherwise we end the loop. The purpose of the loop is to trim off the pointless unary pluses, if they exist, and to handle parentheses.

    Op := 0 ;
    if( X = '-' ) then // Unary minus
    begin
        Op := Op_Subtract ;
    end else
    if( lowercase( X ) = '.not.' ) then // logical not
    begin
        Op := Op_Not
    end ;
    if( Op <> 0 ) then
    begin
        Temp := Get_Subexpression( Err, Context ) ; // Get subexpression
        if( ( Err <> 0 ) or ( Temp = nil ) ) then
        begin
            Zero_Expression_Tree( Subexpression ) ;
            Result := nil ;
            exit ;
        end ;
        Operator := tExpression_Node.Create ;
        Operator.Operator := Op ;
        Operator.Right := Temp ;
        if( Subexpression = nil ) then // Nothing in tree yet
        begin
            Subexpression := Operator ;
        end else
        begin
            Temp := Subexpression ;
            while( Temp.Left <> nil ) do
            begin
                Temp := Temp.Left ;
            end ;
            Temp.Left := Operator ;
            Operator.Back := Temp ;
        end ;
        Result := Subexpression ;
        exit ;
    end ;

There are three possible unary operators. We've already dealt with unary plus. The others are unary minus and .NOT. We check for both of these unaries and set Op appropriately if one is found (Op is 0 otherwise). Then if either is present, we get the subexpression to which they apply. In the event of an error, we zero the subexpression tree and exit.

        Operator := tExpression_Node.Create ;
        Operator.Operator := Op ;
        Operator.Right := Temp ;
        if( Subexpression = nil ) then // Nothing in tree yet
        begin
            Subexpression := Operator ;
        end else
        begin
            Temp := Subexpression ;
            while( Temp.Left <> nil ) do
            begin
                Temp := Temp.Left ;
            end ;
            Temp.Left := Operator ;
            Operator.Back := Temp ;
        end ;
        Result := Subexpression ;
        exit ;
    end ;

Unary operators have a right link but no left link. So, we create an operator node with the right link to the expression. If the tree is currently empty, the new operator node becomes the root of the tree. Otherwise, we traverse the existing tree all the way left to a terminal node and link the operator node in there so that it has the highest precedence.

    if( Valid_Int( X, I ) or ( copy( X, 1, 1 ) = '"' ) ) then // Literal
    begin
        if( copy( X, 1, 1 ) = '"' ) then
        begin
            X := copy( X, 2, length( X ) ) ;
            if( copy( X, length( X ), 1 ) = '"' ) then
            begin
                setlength( X, length( X ) - 1 ) ;
            end ;
        end ;
        if( Unary_Plus ) then
        begin
            X := UCL_Strtoint( X ) ;
        end ;
        Subexpression := tExpression_Node.Create ;
        Subexpression.Value := X ;
        Result := Subexpression ;
        exit ;
    end ;

If we haven't found a unary minus, it's time to check for a value. First, we'll look for a string or numeric literal. String literals begin with a quote ("), whereas numerics do not and must conform to the syntax for numeric values described in the previous article. That check is done with Valid_Int. In the case of a string literal, we trim off the staring quote and then (if it is present), the terminating quote. Now we have a special case. Unary plus is effectively ignored. However, if the expression contained a unary plus before a non-numeric value, it has the effect of converting that value to a numeric value. So, if we had a unary plus, we convert the value to a number via UCL_Strtoint). Then we create a value node and return that node as the entire tree.

    // Must be a symbol, function, or an error
    Resolve_Symbol( X, A, P, PO, Flags, prc, _Result ) ;
    if( _Result <> 0 ) then
    begin
        Result := nil ;
        Zero_Expression_Tree( Subexpression ) ;
        if( copy( X, 1, 1 ) = '.' ) then
        begin
            Err := UCL_IVOPER ;
        end else
        if( pos( copy( X, 1, 1 ), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ$_abcdefghijklmnopqrstuvwxyz' ) = 0 ) then
        begin
            Err := UCL_EXPSYN ;
        end else
        begin
            Err := UCL_UNDSYM ;
        end ;
        exit ;
    end ;

If we get this far in the code, the token must be a symbol or a function (or an error). So we call Resolve_Symbol to get information on the token. We will discuss this procedure below. if _Result is set to non-zero, then the symbol resolution failed. There are three possible errors that we can return in this case. If the token starts with a period (.), that is the start of an operator. However, if we get here, it was not a valid operator. So we return UCL_IVOPER. Otherwise, if the token didn't start with a letter, dollar sign ($), or underscore (_), it isn't a valid UCL symbol name, so we return UCL_EXPSYN. The only other case is that it is a valid symbol name, but the symbol isn't defined, so we return UCL_UNDSYM. In all three cases, we zero the expression tree and exit.

    if( ( Flags and UF_Function ) <> 0 ) then // Function reference
    begin
        Temp := Function_Reference( A, Err ) ; // Process function parameters
        if( Err <> 0 ) then
        begin
            exit ;
        end ;
        Subexpression := Temp ;
        Result := Subexpression ;
        exit ;
    end ;

Next we check if the token is a lexical function. In this case, the flags indicate a function, we call Function_Reference, which will resolve the entire function, including it's parameters and return an expression tree (or an error). We will discuss Function_Reference in a future article. If there was an error, we exit. Otherwise, we return the function's expression tree.

    if( ( Flags and UF_Type_Mask ) = UF_Symbol ) then // A variable
    begin
        Temp := tExpression_Node.Create ;
        Temp.Value := X ;
        Subexpression := Temp ;
    end ;
    Result := Subexpression ;
end ; // Get_Subexpression

Note that if we get to this point, the token has to be a symbol, so the check of the flags is not necessary. However, we may ammend this function later, so we'll do the check. In any case, we simply create a value node and return it to the caller.

To summarise, Get_Subexpression handles parentheses and returns either a value node or an expression tree for a unary or a function. Parse_Expression handles building the expression tree, considering precedence, by calling Get_Subexpression one or more times. Now let's look at the Resolve_Symbol procedure that we used above.

// P = parameters, PO = Optional parameters
procedure Resolve_Symbol( var X : string ; var A, P, PO, Flags, prc : integer ;
    var _Result : integer ) ;

var Parent, PID : TPID ;
    N, S : string ;

begin
    // Setup...
    X := trim( uppercase( X ) ) ;
    P := 0 ; // Parameters for functions
    PO := 0 ; // How many of P are optional
    Flags := 0 ;
    prc := 0 ;
    _Result := 0 ;

Resolve_Symbol examines a token, tries to determine what it is and (where appropriate) return a value or an error. Only the token is passed in (as X) - the rest of the parameters are used to return information on that symbol. We start by trimming the symbol and converting it to uppercase to make comparisons easier. Then we clear all of the informational parameters to 0.

    Flags := UF_Operator ;
    if( X = '*' ) then
    begin
        Prc := 6 ;
        A := Op_Multiply ;
        exit ;
    end ;
    if( X = '/' ) then
    begin
        Prc := 6 ;
        A := Op_Divide ;
        exit ;
    end ;
    if( X = '+' ) then
    begin
        Prc := 5 ;
        A := Op_Add ;
        exit ;
    end ;
    if( X = '-' ) then
    begin
        Prc := 5 ;
        A := Op_Subtract ;
        exit ;
    end ;
    if( X = '.EQ.' ) then
    begin
        Prc := 4 ;
        A := Op_EQ ;
        exit ;
    end else
    if( X = '.EQS.' ) then
    begin
        Prc := 4 ;
        A := Op_EQS ;
        exit ;
    end else
    if( X = '.NE.' ) then
    begin
        Prc := 4 ;
        A := Op_NE ;
        exit ;
    end else
    if( X = '.NES.' ) then
    begin
        Prc := 4 ;
        A := Op_NES ;
        exit ;
    end else
    if( X = '.GE.' ) then
    begin
        Prc := 4 ;
        A := Op_GE ;
        Flags := UF_Operator ;
        exit ;
    end else
    if( X = '.GES.' ) then
    begin
        Prc := 4 ;
        A := Op_GES ;
        exit ;
    end else
    if( X = '.LE.' ) then
    begin
        Prc := 4 ;
        A := Op_LE ;
        exit ;
    end else
    if( X = '.LES.' ) then
    begin
        Prc := 4 ;
        A := Op_LES ;
        exit ;
    end else
    if( X = '.GT.' ) then
    begin
        Prc := 4 ;
        A := Op_GT ;
        exit ;
    end else
    if( X = '.GTS.' ) then
    begin
        Prc := 4 ;
        A := Op_GTS ;
        exit ;
    end else
    if( X = '.LT.' ) then
    begin
        Prc := 4 ;
        A := Op_LT ;
        exit ;
    end else
    if( X = '.LTS.' ) then
    begin
        Prc := 4 ;
        A := Op_LTS ;
        exit ;
    end else
    if( X = '.NOT.' ) then
    begin
        Prc := 3 ;
        A := Op_NOT ;
        exit ;
    end ;
    if( X = '.AND.' ) then
    begin
        Prc := 2 ;
        A := Op_AND ;
        exit ;
    end ;
    if( X = '.OR.' ) then
    begin
        Prc := 1 ;
        A := Op_OR ;
        exit ;
    end ;

We first assume that the symbol is an operator and set the flags accordingly. Then we check each possible operator. If found, we set the precedence, and the operator constant in A (A is for "Address", if you're curious. This is code reused from a compiler expression parser), and exit. If we make it past all this, the symbol was not a valid operator. Note: we could have done this by creating a table an iterating through the table, but for a handful of operators, we implemented it as just a series of IFs.

    Flags := UF_Function ;
    if( X = 'F$CONTEXT' ) then
    begin
        A := Function_Context ;
        P := 5 ;
        exit ;
    end ;
    if( X = 'F$CSID' ) then
    begin
        A := Function_CSID ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$CUNITS' ) then
    begin
        A := Function_Cunits ;
        P := 3 ;
        PO := 2 ;
        exit ;
    end ;
    if( X = 'F$CVSI' ) then
    begin
        A := Function_CVSI ;
        P := 3 ;
        exit ;
    end ;
    if( X = 'F$CVTIME' ) then
    begin
        A := Function_Cvtime ;
        P := 3 ;
        PO := 3 ;
        exit ;
    end ;
    if( X = 'F$CVUI' ) then
    begin
        A := Function_Cvui ;
        P := 3 ;
        exit ;
    end ;
    if( X = 'F$DELTA' ) then
    begin
        A := Function_Delta ;
        P := 2 ;
        exit ;
    end ;
    if( X = 'F$DEVICE' ) then
    begin
        A := Function_Device ;
        P := 4 ;
        PO := 4 ;
        exit ;
    end ;
    if( X = 'F$DIRECTORY' ) then
    begin
        A := Function_Directory ;
        exit ;
    end ;
    if( X = 'F$EDIT' ) then
    begin
        A := Function_Edit ;
        P := 2 ;
        exit ;
    end ;
    if( X = 'F$ELEMENT' ) then
    begin
        A := Function_Element ;
        P := 3 ;
        exit ;
    end ;
    if( X = 'F$ENVIRONMENT' ) then
    begin
        A := Function_Environment ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$EXTRACT' ) then
    begin
        A := Function_Extract ;
        P := 3 ;
        exit ;
    end ;
    if( X = 'F$FAO' ) then
    begin
        A := Function_FAO ;
        P := 16 ;
        PO := 15 ;
        exit ;
    end ;
    if( X = 'F$FID_TO_NAME' ) then
    begin
        A := Function_FID_To_Name ;
        P := 2 ;
        exit ;
    end ;
    if( X = 'F$FILE_ATTRIBUTES' ) then
    begin
        A := Function_File_Attributes ;
        P := 2 ;
        exit ;
    end ;
    if( X = 'F$GETDVI' ) then
    begin
        A := Function_GetDVI ;
        P := 3 ;
        PO := 1 ;
        exit ;
    end ;
    if( X = 'F$GETENV' ) then
    begin
        A := Function_Getenv ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$GETJPI' ) then
    begin
        A := Function_GetJPI ;
        P := 2 ;
        exit ;
    end ;
    if( X = 'F$GETQUI' ) then
    begin
        A := Function_Getqui ;
        P := 4 ;
        PO := 3 ;
        exit ;
    end ;
    if( X = 'F$GETSYI' ) then
    begin
        A := Function_Getsyi ;
        P := 3 ;
        PO := 2 ;
        exit ;
    end ;
    if( X = 'F$IDENTIFIER' ) then
    begin
        A := Function_Identifier ;
        P := 2 ;
        exit ;
    end ;
    if( X = 'F$INTEGER' ) then
    begin
        A := Function_Integer ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$LENGTH' ) then
    begin
        A := Function_Length ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$LICENSE' ) then
    begin
        A := Function_License ;
        P := 2 ;
        PO := 1 ;
        exit ;
    end ;
    if( X = 'F$LOCATE' ) then
    begin
        A := Function_Locate ;
        P := 2 ;
        exit ;
    end ;
    if( X = 'F$MATCH_WILD' ) then
    begin
        A := Function_Match_Wild ;
        P := 2 ;
        exit ;
    end ;
    if( X = 'F$MESSAGE' ) then
    begin
        A := Function_Message ;
        P := 2 ;
        PO := 1 ;
        exit ;
    end ;
    if( X = 'F$MODE' ) then
    begin
        A := Function_Mode ;
        exit ;
    end ;
    if( X = 'F$MULTIPATH' ) then
    begin
        A := Function_Multipath ;
        P := 3 ;
        exit ;
    end ;
    if( X = 'F$PARSE' ) then
    begin
        A := Function_Parse ;
        P := 5 ;
        PO := 4 ;
        exit ;
    end ;
    if( X = 'F$PID' ) then
    begin
        A := Function_PID ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$PRIVILEGE' ) then
    begin
        A := Function_Privilege ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$PROCESS' ) then
    begin
        A := Function_Process ;
        exit ;
    end ;
    if( X = 'F$SEARCH' ) then
    begin
        A := Function_Search ;
        P := 2 ;
        PO := 1 ;
        exit ;
    end ;
    if( X = 'F$SETPRV' ) then
    begin
        A := Function_Setprv ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$STRING' ) then
    begin
        A := Function_STRING ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$TIME' ) then
    begin
        A := Function_TIME ;
        exit ;
    end ;
    if( X = 'F$TRNLNM' ) then
    begin
        A := Function_TRNLNM ;
        P := 6 ;
        PO := 5 ;
        exit ;
    end ;
    if( X = 'F$TYPE' ) then
    begin
        A := Function_TYPE ;
        P := 1 ;
        exit ;
    end ;
    if( X = 'F$UNIQUE' ) then
    begin
        A := Function_UNIQUE ;
        exit ;
    end ;
    if( X = 'F$USER' ) then
    begin
        A := Function_USER ;
        exit ;
    end ;
    if( X = 'F$VERIFY' ) then
    begin
        A := Function_VERIFY ;
        P := 2 ;
        PO := 2 ;
        exit ;
    end ;

If we get past the operator checks, we assume the symbol is a function name and we set the flags accordingly. Then, much like we did with the operators, we compare the symbol to each valid function name. If found, we set the "address" that identifies the function, the number of parameters, and the number of optional parameters for the function, and exit.

    // Must be a symbol - look it up...
    if( X = 'THEN' ) then // Reserved word
    begin
        _Result := 4 ;
        exit ;
    end ;

If we get down to this code, the token had better be a symbol. But we check for a token named "THEN". This cannot be used as a symbol because the IF statement in UCL would find "THEN" to be ambiguous. So, if found, we exit with an error. Note that UOS does support symbols named "THEN", and they could be set programmatically. However, such a symbol would be invisible to UCL.

    // Get our PID and our parent's PID...
    Buff := 0 ;
    BufLen := 0 ;
    BufLen1 := 0 ;
    Buff1 := 0 ;
    fillchar( SYS_Descriptor, sizeof( SYS_Descriptor ), 0 ) ;
    SYS_Descriptor[ 0 ].MBO := $FFFF ;
    SYS_Descriptor[ 0 ].MBMO := -1 ;
    SYS_Descriptor[ 0 ].Buffer_Length := sizeof( Buff ) ;
    SYS_Descriptor[ 0 ].Item_Code := JPI_OWNER ;
    SYS_Descriptor[ 0 ].Buffer_Address := integer( @Buff ) ;
    SYS_Descriptor[ 0 ].Return_Length_Address := integer( @BufLen ) ;
    SYS_Descriptor[ 1 ].MBO := $FFFF ;
    SYS_Descriptor[ 1 ].MBMO := -1 ;
    SYS_Descriptor[ 1 ].Buffer_Length := sizeof( Buff1 ) ;
    SYS_Descriptor[ 1 ].Item_Code := JPI_PID ;
    SYS_Descriptor[ 1 ].Buffer_Address := integer( @Buff1 ) ;
    SYS_Descriptor[ 1 ].Return_Length_Address := integer( @BufLen1 ) ;
    SYS_GETJPIW( 0, 0, '', integer( @SYS_Descriptor ), integer( @IOSB ), 0, 0 ) ;
    PID := Buff1 ;
    Parent := Buff ;

Symbols are resolved upon reference in UCL. If a symbol is referenced that is not in the process' symbol table, we look at the parent process' table, and if not there then it's parent, and so on until we run out of processes or we find the symbol. To do this, we need to specify the PID of the process whose table we want to search. This is done via the SYS_GETJPIW call. So, we construct a descriptor array that will return both our PID and our parent's PID. We will look at SYS_GETJPIW in the next article.

    // Try local first...
    setlength( S, 255 ) ;
    fillchar( SYS_Descriptor, sizeof( SYS_Descriptor ), 0 ) ;
    SYS_Descriptor[ 0 ].MBO := $FFFF ;
    SYS_Descriptor[ 0 ].MBMO := -1 ;
    SYS_Descriptor[ 0 ].Buffer_Length := sizeof( Buff ) ;
    SYS_Descriptor[ 0 ].Item_Code := LNM_ATTRIBUTES ;
    SYS_Descriptor[ 0 ].Buffer_Address := integer( @Buff ) ;
    SYS_Descriptor[ 0 ].Return_Length_Address := integer( @BufLen ) ;
    SYS_Descriptor[ 1 ].MBO := $FFFF ;
    SYS_Descriptor[ 1 ].MBMO := -1 ;
    SYS_Descriptor[ 1 ].Buffer_Length := 255 ;
    SYS_Descriptor[ 1 ].Item_Code := LNM_STRING ;
    SYS_Descriptor[ 1 ].Buffer_Address := integer( PAnsiChar( S )[ 0 ] ) ;
    SYS_Descriptor[ 1 ].Return_Length_Address := integer( @BufLen1 ) ;
    N := '$' + inttostr( PID ) ;
    SYS_TRNLNM( LNM_M_CASE_BLIND, PAnsiChar( N ), PAnsiChar( X ), 0, int64( @SYS_Descriptor ) ) ;
    if( ( Buff and LNM_M_EXISTS ) <> 0 ) then // Found it
    begin
        setlength( S, BufLen1 ) ;
        X := S ; // Return symbol value
        Flags := UF_Symbol ;
        exit ;
    end ;

First, we check the process' symbol table, which corresponds to the current scope of the UCL script being run. This table contains the "local" variables. The SYS_TRNLNM function does a symbol lookup. We will look at SYS_TRNLNM in the next article. If found in this table, we set the return value to the symbol's value and exit.

    // Check local symbols at outer levels...
    PID := Parent ;
    if( not No_Local_Symbols ) then
    begin
        Parent := Parent_PID( PID ) ;
        while( Parent <> 0 ) do // Until we get to the top (global) level
        begin
            fillchar( SYS_Descriptor, sizeof( SYS_Descriptor ), 0 ) ;
            SYS_Descriptor[ 0 ].MBO := $FFFF ;
            SYS_Descriptor[ 0 ].MBMO := -1 ;
            SYS_Descriptor[ 0 ].Buffer_Length := sizeof( Buff ) ;
            SYS_Descriptor[ 0 ].Item_Code := LNM_ATTRIBUTES ;
            SYS_Descriptor[ 0 ].Buffer_Address := integer( @Buff ) ;
            SYS_Descriptor[ 0 ].Return_Length_Address := integer( @BufLen ) ;
            SYS_Descriptor[ 1 ].MBO := $FFFF ;
            SYS_Descriptor[ 1 ].MBMO := -1 ;
            SYS_Descriptor[ 1 ].Buffer_Length := 255 ;
            SYS_Descriptor[ 1 ].Item_Code := LNM_STRING ;
            SYS_Descriptor[ 1 ].Buffer_Address := integer( PAnsiChar( S )[ 0 ] ) ;
            SYS_Descriptor[ 1 ].Return_Length_Address := integer( @BufLen1 ) ;
            N := '$' + inttostr( PID ) ;
            SYS_TRNLNM( LNM_M_CASE_BLIND, PAnsiChar( N ), PAnsiChar( X ), 0, int64( @SYS_Descriptor ) ) ;
            if( ( Buff and LNM_M_EXISTS ) <> 0 ) then // Found it
            begin
                setlength( S, BufLen1 ) ;
                X := S ; // Return symbol value
                Flags := UF_Symbol ;
                exit ;
            end ;
            PID := Parent ;
            Parent := Parent_PID( PID ) ;
        end ; // while( Parent <> 0 )
    end ; // if( not No_Local_Symbols )

Before we check local symbols at outer scopes, we check to see if this has been prohibited via the No_Local_Symbols flag. We will discuss this flag in the future. Then we loop through the parent processes until we reach the next-to-topmost process, or we find the symbol. If found, we return the value and exit. Parent_PID is a shortcut function that gets the parent PID of a given PID using SYS_GEJPIW. We will look at that function momentarily.

    // Check global symbol...
    if( not No_Global_Symbols ) then
    begin
        fillchar( SYS_Descriptor, sizeof( SYS_Descriptor ), 0 ) ;
        SYS_Descriptor[ 0 ].MBO := $FFFF ;
        SYS_Descriptor[ 0 ].MBMO := -1 ;
        SYS_Descriptor[ 0 ].Buffer_Length := sizeof( Buff ) ;
        SYS_Descriptor[ 0 ].Item_Code := LNM_ATTRIBUTES ;
        SYS_Descriptor[ 0 ].Buffer_Address := integer( @Buff ) ;
        SYS_Descriptor[ 0 ].Return_Length_Address := integer( @BufLen ) ;
        SYS_Descriptor[ 1 ].MBO := $FFFF ;
        SYS_Descriptor[ 1 ].MBMO := -1 ;
        SYS_Descriptor[ 1 ].Buffer_Length := 255 ;
        SYS_Descriptor[ 1 ].Item_Code := LNM_STRING ;
        SYS_Descriptor[ 1 ].Buffer_Address := integer( PAnsiChar( S )[ 0 ] ) ;
        SYS_Descriptor[ 1 ].Return_Length_Address := integer( @BufLen1 ) ;
        N := '$' + inttostr( PID ) ;
        SYS_TRNLNM( LNM_M_CASE_BLIND, PAnsiChar( N ), PAnsiChar( X ), 0, int64( @SYS_Descriptor ) ) ;
        if( ( Buff and LNM_M_EXISTS ) <> 0 ) then // Found it
        begin
            setlength( S, BufLen1 ) ;
            X := S ; // Return symbol value
            Flags := UF_Symbol ;
            exit ;
        end ;
    end ; // if( not No_Global_Symbols )
    _Result := 4 ;
end ;

If we get this far, the symbol was not found, so we check the topmost ("job") process for the global scoped symbol. However, we make sure that the No_Global_Symbols flag isn't set first. We will discuss this flag in the future. If found, we return the value. If not, we return an error to indicate that the symbol wasn't found.

Just to reiterate, the topmost process' symbols are considered "global" to that process and any child processes. "Local" symbols are those that are defined in a symbol table belonging to a subprocess. That means that in the context of the topmost process, "local" and "global" refer to the same symbols. We will talk about subprocesses in the future.

Now here's the code for the Parent_PID function:

var PP_SYS_Descriptor : array[ 0..1 ] of TSYS_Descriptor ;
    PP_Buff, PP_BufLen : int64 ;
    PP_PID : TPID ;

function Parent_PID( PID : TPID ) : TPID ;

begin
    PP_Buff := 0 ;
    PP_BufLen := 0 ;
    fillchar( PP_SYS_Descriptor, sizeof( PP_SYS_Descriptor ), 0 ) ;
    SYS_Descriptor[ 0 ].MBO := $FFFF ;
    SYS_Descriptor[ 0 ].MBMO := -1 ;
    SYS_Descriptor[ 0 ].Buffer_Length := sizeof( PP_Buff ) ;
    SYS_Descriptor[ 0 ].Item_Code := JPI_OWNER ;
    SYS_Descriptor[ 0 ].Buffer_Address := integer( @PP_Buff ) ;
    SYS_Descriptor[ 0 ].Return_Length_Address := integer( @PP_BufLen ) ;
    PP_PID := PID ;
    SYS_GETJPIW( 0, int64( @PP_PID ), '', integer( @PP_SYS_Descriptor ), integer( @IOSB ), 0, 0 ) ;
    Result := Buff ;
end ;

This function simply wraps a call to SYS_GETJPIW. We've already seen the construction of the descriptor array and the call above, so we'll leave it at that.

function UCL_Strtoint( S : string ) : string ;

var I : int64 ;

begin
    Result := '' ;
    if( copy( S, 1, 2 ) = '%X' ) then
    begin
        S := copy( S, 3, length( S ) ) ;
        if( not Valid_Hex( S ) ) then
        begin
            Result := '0' ;
            exit ;
        end ;
        Result := inttostr( From_Hex( S ) ) ;
        exit ;
    end ;
    if( Valid_Int( S, I ) ) then
    begin
        Result := S ;
        exit ;
    end else
    if( S = '' ) then
    begin
        Result := '0' ;
    end else
    if( pos( S[ 1 ], 'TtYy' ) = 0 ) then
    begin
        Result := '0' ;
    end else
    begin
        Result := '1' ;
    end ;
end ;

That wraps up the expression parsing and expression tree construction. In the next article, we will examine the new systems calls: SYS_TRNLNM and SYS_GETJPIW. After that, we'll look at the expression tree evaluation code.