CALL, SUBROUTINE, and ENDSUBROUTINE

In a recent article we discussed the @ command, which is the first type of subroutine supported by UCL. In the previous article, we discussed the GOSUB command, which is the second subroutine mechanism supported by UCL. @ executes a different script file and creates a new scope, whereas GOSUB doesn't create a new scope and only calls a subroutine in the current script file. CALL is the third subroutine mechanism and is a cross between @ and GOSUB. Like GOSUB, a local subroutine within the current script file is called. But like @, parameters can be passed to the subroutine, and output can be automatically redirected during subroutine execution. However, because there is no new scope, the P1... symbols are set within the current scope.

I should note the distinction between a nesting level (or "context") and a scope. A scope has to do with a set of symbols that are local to that scope and not available outside of it. Nesting levels can be scoped or unscoped and simply indicate a sublevel of control that will eventually return to the parent nesting level. Thus, scopes are nested, but not all nesting levels are scoped.

In actuality, there is a type of scoping that is used for SUBROUTINEs: labels. Labels used within subroutines are invisible outside of the subroutine. Because a subroutine has a nesting level, the labels defined in it are seen only when in that nesting level. So, labels are scoped by SUBROUTINE, but symbols are not.

The specified label is where the subroutine starts, but that must immediately precede a SUBROUTINE command. Called subroutines must start with SUBROUTINE and end with ENDSUBROUTINE. If SUBROUTINE is encountered in normal execution of the script file, that line and all following lines, up through the matching ENDSUBROUTINE are skipped. The only way to execute the lines within that subroutine is via the CALL command. Note that SUBROUTINES can be nested. Here is the user documentation:

CALL

Transfers control to a labeled subroutine in the current script file without creating a new scope.

Format

CALL label {/OUTPUT=filespec} {parameter {...}}

Parameters

label
Specifies a label that must appear within the command file. The label may follow or precede the CALL command. If there are duplicate labels, the last one encountered is used. If it hasn't been encountered yet, the entire script is searched from the beginning and the first instance found is used. If still not found, an error occurs.

parameter
Specifies one or more optional parameters. The symbols (P1, P2, etc.) are assigned these values during the execution of the specified script. Each parameter is delimited by one or more spaces. A null parameter can be provided by two consecutive quotes (""). Each parameter can contain any characters desired, consistent with the following rules.

If the first parameter starts with a slash, the entire parameter must be surrounded by quotes.

If the parameter includes embedded spaces, the parameter must be enclosed in quotes.

All alphabetic characters are converted to uppercase. If you wish to preserve lowercase characters, the parameter must be enclosed in quotes.

You can enclose quotes within the parameter by using double quotes for each quote.

For instance, the following parameters:
Hello there
will be converted to two parameters as if the following were executed:
P1="HELLO"
P2="THERE"
The following:
"Hello there"
will be converted to a single parameter as if:
P1="Hello there"
The following:
"Hello ""there"""
the value assigned to P1 in this case would be:
Hello "there"

Description

If the command procedure is not coming from a random-access device, CALL will generate an error. Otherwise, control of the script is transferred to the first command immediately following the SUBROUTINE at the specified label. The CALL command operates similarly to the @ command, except that the overhead of opening a new command file and creating a new symbol table is avoided. Execution continues until ENDSUBROUTINE, RETURN, or EXIT is encountered, at which point control returns to the line following the CALL command.

CALL creates a new procedure level, but not a new scope. Parameters are assigned to symbols P1, P2, etc., which are local to the calling level. Local symbols defined in the current procedure level are available to the subroutine called with CALL.

A subroutine has only one entry point - code cannot jump into the middle of a subroutine. And each SUBROUTINE command must have a matching ENDSUBROUTINE command. If SUBROUTINE is encountered during normal execution of the command file (i.e. not as the target of a CALL), all lines up to, and including, the matching ENDSUBROUTINE are skipped.

Qualifier
/OUTPUT=filespec

Using this switch will direct all output to the specified file or device. If not specified, the current output setting is used. Wildcards are not allowed in the filespec. When the subroutine exits, the output is restored to what it was immediately prior to the CALL.

Example:


$ A = 1
$Test1:
$ CALL Test2
$ IF A.LE.10 THEN GOTO Test1
$ EXIT
$Test2:
$ SUBROUTINE
$ WRITE SYS$OUTPUT "This is Test2"
$ CALL Test3
$ A = A + 1
$Test3:
$  SUBROUTINE
$  WRITE SYS$OUTPUT "This is Test3"
$  ENDSUBROUTINE
$ ENDSUBROUTINE

This sample script shows how to use CALL. A is set to 1 and the lines between Test1 and EXIT will loop 10 times. Each time through the loop, control is transferred to the line after Test2, which writes "This is Test2" and then uses CALL to transfer control to the line after Test3, which write "This is Test3". When ENDSUBROUTINE is executed, control is returned to the line after the CALL Test3, which adds 1 to A and then the nested SUBROUTINE is skipped until the ENDSUBROUTINE matching the SUBROUTINE at Test2, which returns to the line after CALL Test2. The output from this will be:

This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3
This is Test2
This is Test3

SUBROUTINE

Indicates the start of a local subroutine in a command file. SUBROUTINE must be the first executable command after the label associated with the subroutine. See the CALL command for more details.

Format

SUBROUTINE

Parameters

None.

Example:


$Test3:
$ SUBROUTINE
$ WRITE SYS$OUTPUT "This is Test3"
$ ENDSUBROUTINE

ENDSUBROUTINE

Indicates the end of a local subroutine in a command file. ENDSUBROUTINE must be the last executable command of a subroutine. See the CALL command for more details.

Format

ENDSUBROUTINE

Parameters

None.

Example:


$Test3:
$ SUBROUTINE
$ WRITE SYS$OUTPUT "This is Test3"
$ ENDSUBROUTINE

            if( Match( Sym, 'subroutine', 4 ) ) then
            begin
                Process_Subroutine ;
                continue ;
            end ;
            if( Waiting_For_Subroutine ) then // Next command we should encounter is SUBROUTINE...
            begin
                Exception( UCL_INVCALL, '' ) ; // ...but it wasn't
                exit ;
            end ;
            if( Sym = 'call' ) then
            begin
                Process_Call ;
            end else
            if( Match( Sym, 'endsubroutine', 4 ) ) then
            begin
                Process_EndSubroutine ;
                exit ;
            end else

This code is added to the Process routine in UCL_Main. It handles encountering the SUBROUTINE, ENDSUBROUTINE, and CALL commands. There are two things to note here. First, the call to Process_Call will set the Waiting_For_Subroutine flag, which is checked before we look for any other command other than SUBROUTINE. This is because the first executable command encountered after a CALL must be SUBROUTINE.

The second thing to note is that the Match routine is used to check the command values. DCL/UCL commands can be abbreviated to the minimum number of characters that is unambiguous with other commands. In these cases, 4 characters is the minimum acceptable length. Match is used to match the command in Sym with the given UCL command with the specified minimum number of characters.

function Match( S, Command : string ; Min : integer ) : boolean ;

begin
    if( length( S ) < Min ) then
    begin
        Result := False ;
    end else
    begin
        Result := copy( Command, 1, length( S ) ) = S ;
    end ;
end ;

This is the new function to do the abbreviated comparison. First we make sure that the minimum length is met. If not, we indicate that this is not a match. Otherwise we compare the passed string (S) with the passed command and return true if S is a subset of the command. If so, we return true, otherwise we return false.


                            Local : boolean ;
                            Start : integer ;

This instance data is added to the TUCL_Context class. The way we are going to implement the CALL mechanism is that we will use the same nesting approach that we used with the @ command insofar as creating a new context for the CALL. However, as we will see in a bit, the creation of a new symbol table and command file reassignment does not happen. But this difference in the use of contexts means that we need to know if a given context is due to @ or CALL. If the Local flag is set, we know it is a CALL context, otherwise it is an @ context. Start is used when searching for labels. Discussed below.

procedure Process_Call ;

var Output, Sym, X : string ;
    E, Err, I, Position : int64 ;
    Has_Quotes : boolean ;
    Loop : integer ;
    Previous : TUCL_Context ;
    Resname, S : string ;
    SL : TStringList ;
    Node, Access, Secondary_Node, Device, Path, Name, Extension, Version : string ;

begin
    if( Interactive ) then
    begin
        Exception( UCL_INVCALL, '' ) ;
        exit ;
    end ;

    // Setup...
    Position := This_UCL_Context.syscommand_line ; // Save our position
    Sym := Get_Token ;
    S := Parser.Grab_Line ;
    Sym := Find_Target_Label( Sym ) ;
    if( Sym = '' ) then
    begin
        exit ; // Aborted
    end ;

This function operates in a similar way to the both the Process_GOSUB and Process_At routines that we covered in past articles. CALL is not allowed in interactive mode so we first check that case and exit with an error if so. Otherwise, we save our current position in the command file, pull the destination label from the parser, and make sure we can find said label. If not, we exit.

    // Process output switch...
    Output := '' ;
    if( Parse_Switch( 'OUTPUT', '', S, Output ) = 1 ) then
    begin
        if( Output = '' ) then
        begin
            Exception( UCL_NULFIL, '' ) ;
            exit ;
        end ;
    end ;
    if( Switch_Present( S ) > 0 ) then
    begin
        Exception( UCL_IVQUAL, '' ) ;
        exit ;
    end ;

Next we process the optional /OUTPUT switch, as we did for the @ command, exiting if there was a problem.

    try
        // Process parameters...
        SL := TStringList.Create ;
        while( S <> '' ) do
        begin
            X := Parse_Parameter( ' ', S ) ;
            if( X <> '' ) then
            begin
                Has_Quotes := False ;
                if( copy( X, 1, 1 ) = '"' ) then
                begin
                    // Trim leading/trailing quotes...
                    Has_Quotes := True ;
                    X := copy( X, 2, length( X ) ) ;
                    if( copy( X, length( X ), 1 ) = '"' ) then
                    begin
                        setlength( X, length( X ) - 1 ) ;
                    end ;
                end ; // if( copy( X, 1, 1 ) = '"' )

                // Handle double-quotes
                I := 1 ;
                while( I < length( X ) ) do
                begin
                    if( copy( X, I, 2 ) = '""' ) then
                    begin
                        delete( X, I + 1, 1 ) ;
                    end ;
                    inc( I ) ;
                end ;
                if( not Has_Quotes ) then
                begin
                    X := Edit( X, 32 or 256 ) ; // Uppercase except within quotes
                end ;
                SL.Add( X ) ;
            end ; // if( X <> '' )
        end ;
        for Loop := 0 to SL.Count - 1 do
        begin
            if( LIB_Set_Symbol( 'P' + inttostr( Loop + 1 ), SL[ Loop ], LNM_PROCESS ) <> 0 ) then
            begin
                Set_Exception( LIB_Get_Exception_Text( 0, E ) ) ;
                exit ;
            end ;
        end ;

We process the parameters in almost the exact same way as we did for the @ command. The difference being that we don't create a new symbol table, since we remain in the same scope. As noted with the @ command, there is no practical limit to the number of parameters that can be passed, which differs from DCL's limit of 8.

        // Create new context...
        Previous := This_UCL_Context ;
        _This_UCL_Context := TUCL_Context.Create ;
        _This_UCL_Context.Local := True ;
        _This_UCL_Context.sysoutput_name := Previous.sysoutput_name ;
        _This_UCL_Context.sysinput_name := Previous.sysinput_name ;
        _This_UCL_Context.syscommand_name := Previous.syscommand_name ;
        _This_UCL_Context.syserror_name := Previous.syserror_name ;
        _This_UCL_Context.syscommand_line := Previous.syscommand_line ;
        Contexts.Add( This_UCL_Context ) ;

Now, we create the new nesting level. Although we don't care about the various redirections, other than sys$output, we still have to appropriately set the various context values since it is possible that the subroutine may use the @ command itself, which will care about these values.

        // Handle output
        if( Output <> '' ) then
        begin
            _This_UCL_Context.sysoutput_name := Output ;
            Err := LIB_Set_Symbol( 'sys$output', Output, LNM_PROCESS ) ;
            if( Err <> 0 ) then
            begin
                Process_Return ;
                E := LIB_Get_Exception( 0 ) ; // Get handle
                Set_Exception( LIB_Get_Exception_Text( 0, E ) ) ;
                exit ;
            end ;
            This_UCL_Context.sysoutput_name := Output ;
        end ;

Next we handle the /OUTPUT switch, in the same manner as the @ command.

        // Push return address onto previous scope and goto subroutine...
        I := Previous.Labels.Indexof( Sym ) ;
        Previous.Stack.Add( Position + 1 ) ;
        This_UCL_Context.Start := Position + 1 ;
        Goto_Line( integer( Previous.Labels.Objects[ I ] ) ) ;
        Waiting_For_Subroutine := True ;
    finally
        SL.Free ;
    end ;
end ; // Process_Call

To finish up this routine, we add the saved position to the previous nesting's stack and position to the destination label. In this way, we are more like the GOSUB command. We also set the Start value in the new context, which tells the Find_Target_Label to start label searches at the beginning of the subroutine. This ensures that any labels within the subroutine take precedence over any duplicates elsewhere in the command file. Finally we set the Waiting_For_Subroutine flag and clean up.

procedure Process_Endsubroutine ;

var Position : int64 ;

begin
    if( Interactive or not This_UCL_Context.Local ) then
    begin
        Exception( UCL_INVCALL, '' ) ;
        exit ;
    end ;
    Process_Return ;
end ;

This routine handles encountering ENDSUBROUTINE. In the case of being interactive or not being in local nesting context, this indicates that we encountered this command without a CALL to the subroutine - most likely indicating a stray ENDSUBROUTINE command that has no matching SUBROUTINE.

procedure Process_Subroutine ;

begin
    if( Interactive ) then
    begin
        Exception( UCL_INVCALL, '' ) ;
        exit ;
    end ;
    if( Waiting_For_Subroutine ) then
    begin
        Waiting_For_Subroutine := False ;
        exit ;
    end ;
    Skip_Subroutine_Block ;
end ;

This routine handles encountering SUBROUTINE during normal processing through the file or in response to a CALL. It is not allowed in interactive mode and we exit with an error in that case. If we are waiting for SUBROUTINE (according to the flag), we clear the flag and exit. In that case, we will return to the main Process loop, to execute the next command - which is the first command within the subroutine. Otherwise, we came across SUBROUTINE while reading through the command file. In this case, we skip past the subroutine block.

procedure Skip_Subroutine_Block ;

var Nest_Level : integer ;
    S : string ;

begin
    Nest_Level := 0 ;
    while( true ) do
    begin
        S := Edit( Get_Command, 8 or 16 or 128 or 256 or 512 ) ;
        if( Match( S, 'endsubroutine', 4 ) ) then
        begin
            dec( Nest_Level ) ;
            if( Nest_Level < 0 ) then
            begin
                exit ;
            end ;
            continue ;
        end else
        if( Match( S, 'subroutine', 4 ) ) then
        begin
            inc( Nest_Level ) ; // In a new SUBROUTINE block
            continue ;
        end else
        if( copy( S, 1, 3 ) = 'if ' ) then
        begin
            Parser.Put_Token( copy( S, 4, length( S ) ) ) ;
            if( Skip_If_Block ) then
            begin
                exit ;
            end ;
        end ;
    end ; // while( true )
end ; // Skip_Subroutine_Block

This routine is similar to the Skip_If_Block that we previously covered in article 129. In fact, we use that routine to properly skip over IF commands that occur within a SUBROUTINE. We exit upon error or upon finding the matching ENDSUBROUTINE. Because SUBROUTINEs can be nested, we keep track of our nesting level.

        if( Match( S, 'subroutine', 4 ) ) then
        begin
            Skip_Subroutine_Block ;
        end else
        if( Match( S, 'endsubroutine', 4 ) ) then
        begin
            Exception( UCL_INVCALL, '' ) ;
            Result := True ;
            exit ;
        end ;

Speaking of the Skip_If_Block routine, we add the above code to the end of that routine to handle encountering the SUBROUTINE or ENDSUBROUTINE commands while looking for the end of an IF block.

if( Contexts.Count > 1 ) then // Nested
begin
//NEW---->
    if( This_UCL_Context.Local ) then // Returning from a local call  //NEW
    begin
        Previous := TUCL_Context( Contexts[ Contexts.Count - 2 ] ) ;
        if( Previous.sysoutput_name <> This_UCL_Context.sysoutput_name ) then
        begin
            Err := LIB_Set_Symbol( 'sys$output', Previous.sysoutput_name, LNM_PROCESS ) ;
            if( Err <> 0 ) then
            begin
                E := LIB_Get_Exception( 0 ) ; // Get handle
                Set_Exception( LIB_Get_Exception_Text( 0, E ) ) ;
            end ;
        end ;

        // Delete the context...
        Contexts.Delete( Contexts.Count - 1 ) ;
        _This_UCL_Context.Free ;
        _This_UCL_Context := Previous ;
        if( This_UCL_Context.Stack.Count = 0 ) then // Nothing to return to - should never happen
        begin
            Exception( UCL_BADRETURN, '' ) ;
            exit ;
        end ;

        // Pop the return location from the stack and go there...
        Position := This_UCL_Context.Stack[ This_UCL_Context.Stack.Count - 1 ] ;
        This_UCL_Context.Stack.Count := This_UCL_Context.Stack.Count - 1 ;
        Goto_Line( Position ) ;
        Parser.Grab_Line ; // Clear any tokens remaining in parser
    end else
    begin
//<----NEW
        // Delete the current scope table and make previous table the default...
        if( Contexts.Count = 2 ) then

The code between the comments is added to the Process_Exit routine to handle the new context of a SUBROUTINE for the EXIT command. If we are in a local subroutine nesting level, we delete the current nesting context, and point back to the previous context, changing sys$output if it was altered by the call, and then we pop the return location from the stack and position to that place. We finish by clearing anything else that may remain in the parser's buffer so that we begin processing the command at the destination location.

    if( This_UCL_Context.Stack.Count = 0 ) then // Nothing to return to
    begin
    //NEW---->
        if( This_UCL_Context.Local ) then // Returning from a local call
        begin
            if( Contexts.Count > 1 ) then // Nested (should always be true)
            begin
                Previous := TUCL_Context( Contexts[ Contexts.Count - 2 ] ) ;
                if( Previous.sysoutput_name <> This_UCL_Context.sysoutput_name ) then
                begin
                    Err := LIB_Set_Symbol( 'sys$output', Previous.sysoutput_name, LNM_PROCESS ) ;
                    if( Err <> 0 ) then
                    begin
                        E := LIB_Get_Exception( 0 ) ; // Get handle
                        Set_Exception( LIB_Get_Exception_Text( 0, E ) ) ;
                    end ;
                end ;

                // Delete the context...
                Contexts.Delete( Contexts.Count - 1 ) ;
                _This_UCL_Context.Free ;
                _This_UCL_Context := Previous ;
                if( This_UCL_Context.Stack.Count = 0 ) then // Nothing to return to - should never happen
                begin
                    Exception( UCL_BADRETURN, '' ) ;
                    exit ;
                end ;

                // Pop the return location from the stack and go there...
                Position := This_UCL_Context.Stack[ This_UCL_Context.Stack.Count - 1 ] ;
                This_UCL_Context.Stack.Count := This_UCL_Context.Stack.Count - 1 ;
                Goto_Line( Position ) ;
                Parser.Grab_Line ; // Clear any tokens remaining in parser
                exit ;
            end ; // if( Contexts.Count > 1 )
        end ;
    //<-----NEW
        Parser.Grab_Line ;
        Exception( UCL_BADRETURN, '' ) ;
        exit ;
    end ;

Likewise, we have to modify RETURN processing to deal with the SUBROUTINE situation. The lines between the comments above are added to the Process_Return routine. They do the same thing as the code in Process_Exit above.

    if( This_UCL_Context.Start <> 0 ) then
    begin
        Goto_Line( This_UCL_Context.Start ) ;
    end ;

This code is added near the beginning of the Find_Target_Label routine so that any label searches begin in the current subroutine (Start will be 0 if we aren't in a SUBROUTINE).

                if( Match( Sym, 'subroutine', 4 ) ) then
                begin
                    Skip_Subroutine_Block ;
                end ;

Finally, we add this code to the Find_Target_Label routine so that any searches for a label will skip over SUBROUTINES, since labels within SUBROUTINES are invisible to any code outside of that subroutine.

In the next article, we will look at the next UCL commands.