ASTs

In the last three articles, we discussed the UCL command processing. We will continue with that discussion in the next article, after addressing changes to UCL for getting input prior to parsing and processing. First, let's look at the updated Get_Command function.

function Get_Command( Prefix : string ) : string ;

var IOSB : TIOSB ;
    S : Ansistring ;

begin
    S := LIB_Get_Symbol( '$ucl_prompt' ) ;
    if( S = '' ) then
    begin
        S := '$ ' ;
    end ;
    SYS_QIOW( 0, RH_SysCommand, IO_SETMODE or IOM_CLI_CTRLCAST, integer( @IOSB ), integer( @CC_AST ), 0, 0, 0, 0, 0, 0, 0 ) ;
    SYS_QIOW( 0, RH_SysCommand, IO_SETMODE or IOM_CLI_CTRLYAST, integer( @IOSB ), integer( @CY_AST ), 0, 0, 0, 0, 0, 0, 0 ) ;
    Result := LIB_Get_Command( Prefix + S ) ;
end ;

We've added two new statements. We call SYS_QIOW with the IO_SETMODE function and a flag to indicate that we want to capture control-C (IOM_CLI_CTRLCAST) and control-Y (IOM_CLI_CTRLYAST). These two calls set up ASTs (Asynchronous System Traps). This is VMS terminology for a callback to another ring. The fifth parameter is an address of a routine that will be called when the corresponding condition occurs. For control-C, we have it call CC_AST, and for control-Y, we have it call CY_AST. All AST routines must match the following definition:

type TAST_Target = procedure( P : int64 ) ; stdcall ;

Here are the callback routines:

procedure CC_AST( P : int64 ) ; stdcall ;

begin
    CC_Interrupt := True ;
    SYS_Cancel( RH_SysCommand ) ;
    Output( RH_SYSOutput, CRLF + '*INTERRUPT*' + CRLF ) ;
    SYS_QIOW( 0, RH_SysCommand, IO_SETMODE or IOM_CLI_CTRLCAST, integer( @IOSB ), integer( @CC_AST ), 0, 0, 0, 0, 0, 0, 0 ) ;
end ;


procedure CY_AST( P : int64 ) ; stdcall ;

begin
    CY_Interrupt := True ;
    SYS_Cancel( RH_SysCommand ) ;
    Output( RH_SYSOutput, CRLF + '*INTERRUPT*' + CRLF ) ;
    SYS_QIOW( 0, RH_SysCommand, IO_SETMODE or IOM_CLI_CTRLYAST, integer( @IOSB ), integer( @CC_AST ), 0, 0, 0, 0, 0, 0, 0 ) ;
end ;

When the routines are called, the appropriate flag is set and we cancel all current I/O operations on sys$command. Next the word "*INTERRUPT*" is output, bounded by CRLF so that it appears on its own line, and then we set the AST again. The reason for this is that the existing AST is removed when it is triggered. Note that we call SYS_Cancel before Output, otherwise we might cancel the output of "*INTERRUPT*" before it finishes.

There are two types of interrupt ASTs - one set for user applications (IOM_CTRLCAST and IOM_CTRLYAST) and one set for shells (IOM_CLI_CTRLCAST and IOM_CLI_CTRLYAST). "CLI" indicates "Command Line Interface", which is another way to refer to a textual command-line shell. A user application can use either set, but - by convention - only shells should use the CLI versions. Because UCL is a shell, we are using the CLI versions.

Note: Control-C and control-Y traps can be set on any terminal, but not on other devices.

We add some new constants. For now, we have five AST operations defined, but we will add more in later articles.

// Asynchronous System Traps...

//    Type            Type       Context
//    Mneumonic       Value      Description
//    ---------       -----      -----------
const AST_None      = 0 ; //     N/A
const AST_Control_C = 1 ; //     Terminal device instance
const AST_Control_Y = 2 ; //     Terminal device instance
const AST_CLI_Control_C = 3 ; // Terminal device instance
const AST_CLI_Control_Y = 4 ; // Terminal device instance

    if( ( Func and IO_Function_Mask ) = IO_SETMODE ) then
    begin
        Resource := TResource( Handle ) ;
        AST_Op := 0 ;
        case Func and ( not IO_Function_Mask ) of
            IOM_CTRLCAST : AST_Op := AST_Control_C ;
            IOM_CTRLYAST : AST_Op := AST_Control_Y ;
            IOM_CLI_CTRLCAST : AST_Op := AST_CLI_Control_C ;
            IOM_CLI_CTRLYAST : AST_Op := AST_CLI_Control_Y ;
        end ;
        if( AST_Op <> 0 ) then
        begin
            if( not ( TFiP_File( Resource._File ) is TFiP_Terminal_File ) ) then
            begin
                Set_Last_Error( Create_Error( UOSErr_Invalid_Operation ) ) ;
                IOSB.r_io_64.w_status := UE_Error ;
                exit ;
            end ;

            // Remove old AST, if any, and add new one...
            USC.Remove_AST( Kernel.PID, AST_Op, integer( TFiP_Terminal_File( Resource._File ).Terminal ) ) ;
            if( Astadr <> 0 ) then
            begin
                AST := Create_AST( AST_Op, integer( TFiP_Terminal_File( Resource._File ).Terminal ), Astadr, Astprm ) ;
                USC.Add_AST( Kernel.PID, AST ) ;
            end ;
            exit ;
        end ; // if( AST_Op <> 0 )
        Set_Last_Error( Create_Error( UOSErr_Invalid_Function ) ) ;
        IOSB.r_io_64.w_status := UE_Error ;
        exit ;
    end ;

We've added a function handler in the QIO() function to process IO_SETMODE calls. We get the resource associated with the handle and then determine which AST operation is being defined. If we haven't identified a valid AST operation, we exit with an error.
Next we check to see if the resource is a terminal. If not, we exit with an error, since control-C and control-Y ASTs only apply to terminals. On the other hand, we remove any previous AST for this operation since we can only have one of a given type of control-C/Y AST active at a time for one terminal. Note we can call Remove_AST for an AST that doesn't exist - it simply does nothing. If the passed AST address is 0, then we are done. In other words, calling IO_SETMODE with an address of 0 simply cancels that AST. Otherwise, we create an AST object and add it to the process.

Here is the AST class:

type TAST = class // AST definition
                public
                    AST_Type : int64 ; // Type of AST
                    Context : int64 ; // Context of AST (Depends upon type)
                    Address : int64 ; // Target address to call
                    Parameter : int64 ; // Parameter to pass to target address
            end ;

The AST class is merely a structure that holds the type, context, address and parameter values for the AST. For the control-C and control-Y ASTs, the context is the terminal file (a TFip_Terminal_File).

procedure TUSC.Remove_AST( PID : TPID ; ASTT, ASTP : int64 ) ;

var Process : TProcess ;

begin
    Process := Get_Process( PID ) ;
    Process.Remove_AST( ASTT, ASTP ) ;
end ;

The Remove_AST method we added to the User and Security class simply gets the Process class for the passed process ID and calls the process' Remove_AST method.

The following instance data is added to the TProcess method:

                        ASTs : TList ; // Current ASTs
                        _ASTC : boolean ;
                        _ASTY : boolean ;

ASTs is a list of AST objects associated with the process. The other data are flags that we will address later.

procedure TProcess.Remove_AST( ASTT, ASTP : int64 ) ;

var AST : TAST ;
    I : integer ;

begin
    for I := ASTs.Count - 1 downto 0 do
    begin
        AST := TAST( ASTs[ I ] ) ;
        if( ( AST.AST_Type = ASTT ) and ( AST.Context = ASTP ) ) then
        begin
            ASTs.Delete( I ) ;
            AST.Free ;
            Check_Quota( Quota_ASTLM, -1 ) ;
            exit ;
        end ;
    end ;
end ;

When told to remove an AST, we loop through the ASTs list looking for an AST whose type and context match the passed values. If found, we remove it from the list, then we delete the AST instance and call Check_Quota to reduce the number of current ASTs associated with the process.

function Create_AST( AT, AC, AA, AP : int64 ) : TAST ;

begin
    Result := TAST.Create ;
    Result.AST_Type := AT ;
    Result.Context := AC ;
    Result.Address := AA ;
    Result.Parameter := AP ;
end ;

The Create_AST function constructs an AST instance based on the passed parameters and returns that instance. It is just a coding shortcut.

function TUSC.Add_AST( PID : TPID ; AST : TAST ) : TUnified_Exception ;

var Process : TProcess ;

begin
    Process := Get_Process( PID ) ;
    Result := Process.Add_AST( AST ) ;
end ;

We've added an Add_AST method to the User and Security class. It simply gets the process instance for the passed process ID and then calls its Add_AST method.

function TProcess.Add_AST( AST : TAST ) : TUnified_Exception ;

begin
    Result := nil ;
    if( Check_Quota( Quota_ASTLM, 1 ) ) then
    begin
        Result := Create_Error( UOSErr_Quota_Exceeded, nil, 'AST quota exceeded' ) ;
        exit ;
    end ;
    ASTs.Add( AST ) ;
end ;

The TProcess Add_AST method adds a new AST to the ASTs list. We first check to see if we exceeded the process' ASTLM quota. If so, we exit with an error. Otherwise, the Check_Quota increments the ASTLM. Then we add the AST to the ASTs list. Note that there is no check for multiple ASTs of the same time. That is because it is okay to have multiple ASTs of the same type currently in the list for a given process. But since we can only have one AST at a time for a given terminal and Control-C/Y AST, it is up to the code which calls the Add_AST method to prevent that. In fact, it does so by first calling Remove_AST.

Next we add the SYS_Cancel method to the Sys library unit:

function SYS_Cancel( Handle : int64 ) : int64 ;

var Status : byte ;
    SysRequest : TInteger_Request ;

begin
    fillchar( SysRequest, sizeof( SysRequest ), 0 ) ;
    SysRequest.Request.Subsystem :=  UOS_Subsystem_FIP ;
    SysRequest.Request.Request := UOS_FIP_Cancel ;
    SysRequest.Request.Length := sizeof( SysRequest ) - sizeof( Sysrequest.Request ) ;
    SysRequest.Request.Status := integer( @Status ) ;
    SysRequest.Int := Handle ;

    Call_To_Ring0( integer( @SysRequest ) ) ;
end ;

This routine sets up the system request. This is much like the other system calls we've looked at before.

Now we add handling in the FiP API method:

    UOS_FIP_Cancel:
        begin
            UE := Enter_System_Call( Request, SReq, PID, MMC, sizeof( TInteger_Request ) - sizeof( SReq ), Address ) ;
            if( UE <> nil ) then
            begin
                Set_Last_Error( UE ) ;
                exit ;
            end ;
            try
                Integer_Request := PInteger_Request( Address ) ;
                Cancel_IO( PID, Integer_Request.Int ) ;
            finally
                Exit_System_Call( Request, PID, MMC, sizeof( TInteger_Request ) - sizeof( SReq ) ) ;
            end ;
        end ;

We've already seen the setup and run down for system calls, so need to comment on that here. The only other thing we do is call the Cancel_IO method.

function TUOS_FiP.Cancel_IO( PID : TPID ; Handle : int64 ) : int64 ;

var Resource : TResource ;

begin
    Handle := USC.Translate_Handle( PID, Handle ) ;
    if( not USC.Valid_Handle( PID, Handle ) ) then
    begin
        Set_Last_Error( Create_Error( UOSErr_Invalid_Handle ) ) ;
        Result := UE_Error ;
        exit ;
    end ;
    Resource := TResource( Handle ) ;
    TFiP_File( Resource._File ).Cancel ; // Cancel current operation
    Result := SS_Cancel ;
end ;

We simply translate and validate the handle, get the resource, and then call the file's cancel method to cancel the current operation (if any) happening on that file.

procedure Cancel ; virtual ;


procedure TFiP_File.Cancel ;

begin
    // Do nothing here - descendants will handle
end ;

We add a Cancel method to the TFip_File class. In this class, the method does nothing because it is expected that the descendant classes will handle it. We include it in this class for polymorphism.

Next we add an Cancel method override for the TFiP_Terminal_File class. Here's the definition and the implementation of the method.

                                  procedure Cancel ; override ;


procedure TFiP_Terminal_File.Cancel ;

begin
    Terminal.Cancel ;
end ;

The method simply calls the Terminal instance's Cancel method.

We've added a Cancel method to the TTerminal class. Here is the definition and the implementation:

                        procedure Cancel ;


procedure TTerminal.Cancel ;

begin
    Input_Filter.Cancel := True ;
    Output_Filter.Cancel := True ;
    Resume_Input ;
    Output_Filter.Reset ;
end ;

The method sets the Cancel flag for both the input and output filter, then calls Resume_Input to allow input to continue. Finally, we call the Reset method of the Output_Filter instance to reset the output state.

Next we add Cancel boolean values to the TFilter class, from which the TInput_Filter and TOutput_Filter classes descend. Next we add processing for the Cancel flag to the TDefault_Output class' Write method. At the beginning of the method, we add the following:

    Cancel := False ; // Cancel may be true from a Cancel operation that occured when no output was happening...

We always reset the Cancel flag since it may have been set from a previous cancel operation. We always start the method by clearing the flag.

Then inside the main loop, we add the following code before the rest of the code in the loop:

    if( Cancel ) then
    begin
        Cancel := False ;
        _Buffer.Clear ;
        exit ;
    end ;

This code clears the cancel flag, clears the buffer and immediately exits. This effectively ends the current output operation.

We do something similar in the TDefault_Input_Filter's Read method. At the beginning, we clear the Cancel flag. Then within the loop, we add the following code:

    if( Cancel ) then
    begin
        Cancel := False ;
        Result := '' ;
        _Buffer.Clear ;
        exit ;
    end ;

This clears the Cancel flag, the buffer, and the result string. Then it exits the method, effectively cancelling the current input operation.

Now, let's take a look at changes to the UCL's Run procedure.

procedure Run ;

var S, S1 : string ;

begin
    while( True ) do
    begin
        S := Edit( Get_Command( '' ), 4 or 128 ) ; // Remove CRLF, trailing spaces, etc.
        while(
               ( copy( S, length( S ) - 1, 2 ) = ' -' )
               or
               ( copy( S, length( S ) - 1, 2 ) = HT + '-' )
             ) do // Line continuation
        begin
            if( not End_Within_Quotes( S ) ) then
            begin
                setlength( S, length( S ) - 2 ) ;
                S1 := Edit( Get_Command( '_' ), 4 or 128 ) ;
                if( CC_Interrupt or CY_Interrupt ) then
                begin
                    S := '' ;
                    S1 := '' ;
                end ;
                S := S + S1 ;
            end ;
        end ;

The procedure loops forever. The first thing it does is call Get_Command to get the next command from the input source (usually the terminal), as we discussed above. If the input ends with a space and dash, that indicates a line continuation. So, as long as each line has a continuation, we keep getting it and building up the entire command line. However, this is complicated by the fact that the supposed continuation might actually be inside a quotes and should be treated as literal text. The End_Within_Quotes function determines if this is the case. Within this continuation loop, if the CC_Interrupt or CY_Interrupt flags are set we clear the current line and any accumulated line and the following code handles the interrupt.

        if( Check_Interrupt ) then
        begin
            continue ; // Skip to next command
        end ;
        S := Parse( S ) ;
        if( Check_Interrupt ) then
        begin
            continue ; // Skip to next command
        end ;
        if( Edit( S, 8 or 128 ) <> '' ) then
        begin
            Process( S ) ;
        end ;
    end ; // while( True )
end ; // Run

Next we check the interrupt flags - whether we went through the line continuation loop or not. If either are set, Check_Interrupt processes them and then we continue to read the next input line. Otherwise, we parse the command. Once again we check the interrupt flags in case an interrupt happened during the parsing. If so, we continue. Otherwise we call the Process procedure to execute the command.

    function Check_Interrupt : boolean ;

    begin
        Result := False ;
        if( CC_Interrupt ) then
        begin
            CC_Interrupt := False ;
            Result := True ;
            exit ;
        end else
        if( CY_Interrupt ) then
        begin
            CY_Interrupt := False ;
            Result := True ;
            if( Control_Y <> '' ) then
            begin
                S := Parse( Control_Y ) ;
                Process( S ) ;
            end ;
        end ;
    end ;

This local function sets the result to False so that is returned if we fall through the code without meeting either criteria. First we check for the Control-C interrupt. If set, we clear the interrupt, set the result, and return. Then we check for the Control-Y interrupt. If set, we clear that interrupt and set the result. If Control_Y is not null, we have a command to execute when Control-Y happens, so we parse it and call the Process procedure. Note that we don't check for an interrupt between the Parse and the Process calls. This is because we are already in the interrupt processing, but more importantly we want to give the Control-Y handler a chance to execute after a Control-Y. Otherwise, if the user is auto-repeating Control-Ys, the next one might interrupt the current processing. In general, that shouldn't be a concern, but this approach helps in cases where a command script might not have been carefully constructed in its handling of interrupts. Not that this is bullet-proof, mind you. Users are very good at breaking things...

Finally, let's look at the End_Within_Quotes procedure.

function End_Within_Quotes( S : string ) : boolean ; // True if end of string is within quotes

var I : integer ;

begin
    Result := False ;
    for I := 1 to length( S ) do
    begin
        if( ( copy( S, I, 1 ) = '"' ) and ( copy( S, I + 1, 1 ) <> '"' ) ) then
        begin
            Result := not Result ;
        end ;
    end ;
end ;

This function simply iterates through the passed string, keeping track of starting and ending quotes. When the end of the string is reached, we are either within quotes or not, and so we return the result.

There are other issues related to interrupts, but we will discuss those in a future article as they have to do with script nesting, sub-processes, ending processes and/or programs, and captured terminals. We will be looking at interruption of a script during I/O sometime in the next few articles as well, so we've only scratched the surface of this topic. In the next article, we will continue looking at the command processing of UCL.