In this article, we look at the DEFINE CUSP - the next thing used in our shutdown script. UCL allows the user to create symbols with assignment statements. But the DEFINE CUSP provides more flexibility. On VMS, DEFINE was used to create or assign values to logicals. In UOS, it sets/assigns symbols. First the user documentation for the CUSP:

One addition to UOS symbols is that now a symbol can have multiple values. These values are called "equivalence names" on VMS. You can view them as a dynamic (open-ended) array of values for each symbol name. When using a symbol in UCL, only the first equivalence value (offset 0) is used by default. Assigning a symbol in UCL will delete any old one and create a new symbol of only one value. But system services can be used to access the additional values for a symbol. For the DIRECTORY CUSP, if the symbol name is used as a logical, each equivalence value is used, in turn, to list files matching the specification in those equivalence values. In the case of creating a file using the symbol as a logical, the first equivalence value with a valid path is used. In the case of opening an existing file, the all equivalence values are checked to find the file. The first one found is the one used.

The above functionality also expands a little upon the existing UOS behavior by providing the ability to associate flags. Let's look at the program code.

function Run : int64 ;

var C, E : string ;
    OS : POS_UOS ;

begin
    OS := new( POS_UOS, Init ) ;
    C := Get_Symbol( 'define$defaults' ) ;
    E := '' ;
    Result := Do_Define( PChar( OS^.Command_Line ), PChar( C ), E, True ) ;
    if( Result <> 0 ) then
    begin
        OS^.OutputLn( 0, LIB_Get_Exception_Text( 0, Result ) ) ;
        if( E <> '' ) then
        begin
            OS^.OutputLn( 0, '    \' + E + '\' ) ;
        end ;
    end ;
    OS.Free ;
    SYS_EXIT( 0 ) ;
end ;

function Do_Define( Command, Defaults : PChar ; var Extra : string ;
   Standalone : boolean ) : int64 ;

var Descriptors : array[ 0..1023 ] of TSYS_Descriptor ;
    Strings : array[ 0..511 ] of string ;
    Equivalences : TStringList ;
    Equivalences_Flags : TInteger_List ;
    F, Flags : integer ;
    Flag_Array : array[ 0..3 ] of int64 ;
    Index : integer ;
    C, Name, S : string ;
    Log : boolean ;
    Mode, Typ : integer ;
    SL : TStringList ;
    Table : string ;
    OS : POS_UOS ;
    Parameter : string ;


begin
    // Setup...
    C := trim( Defaults + ' ' + Command ) ;
    Mode := PSL_C_USER ;
    Log := True ;
    Table := 'LNM$PROCESS' ;
    Equivalences := TStringList.Create ;
    Equivalences_Flags := TInteger_List.Create ;
    Name := '' ;
    Flags := 0 ;
    Flag_Array[ 0 ] := 0 ;
    Flag_Array[ 1 ] := LNM_M_CONCEALED ;
    Flag_Array[ 2 ] := LNM_M_TERMINAL ;
    Flag_Array[ 3 ] := LNM_M_CONCEALED or LNM_M_TERMINAL ;

    if( Parse_Switch( 'H|ELP', '', C, Parameter ) = 1 ) then
    begin
        Output_Help( 0, 0, 'DEFINE' ) ;
        exit ;
    end ;
    // Process parameters and switches...
    while( C <> '' ) do
    begin
        S := Parse_Item( C, Typ ) ;
        if( Typ = PIT_Switch ) then
        begin
            if( Parse_Switch( 'C|LUSTER_SYSTEM', '', C, Parameter ) = 1 ) then
            begin
                C := '/TABLE=LNM$SYSCLUSTER' ;
            end else
            if( Parse_Switch( 'J|OB', '', C, Parameter ) = 1 ) then
            begin
                C := '/TABLE=LNM$JOB' ;
            end else
            if( Parse_Switch( 'P|ROCESS', '', C, Parameter ) = 1 ) then
            begin
                C := '/TABLE=LNM$PROCESS' ;
            end else
            if( Parse_Switch( 'SY|STEM', '', C, Parameter ) = 1 ) then
            begin
                C := '/TABLE=LNM$SYSTEM' ;
            end ;
            if( Parse_Switch( 'E|XECUTIVE_MODE', '', C, Parameter ) = 1 ) then
            begin
                Mode := PSL_C_EXEC ;
            end else
            if( Parse_Switch( 'E|XECUTIVE_MODE', '', C, Parameter ) = 1 ) then
            begin
                Mode := PSL_C_EXEC ;
            end else
            if( Parse_Switch( 'SU|PERVISOR_MODE', '', C, Parameter ) = 1 ) then
            begin
                Mode := PSL_C_SUPER ;
            end else
            if( Parse_Switch( 'TA}BLE', '', C, Parameter ) = 1 ) then
            begin
                if( Parameter = '' ) then
                begin
                    Result := UUI_REQSWVAL ; // parameter required
                    Extra := '/TABLE' ;
                    exit ;
                end ;
                Table := Parameter ;
            end else
            if( Parse_Switch( 'TR|ANSLATION_ATTRIBUTES', '', C, Parameter ) = 1 ) then
            begin
                if( Equivalences.Count = 0 ) then
                begin
                    Result := UUI_INVQUAP ; // Invalid switch position
                    Extra := C ;
                    exit ;
                end ;
                SL := Parse_List( Parameter ) ;
                F := 0 ;
                for Index := 0 to SL.Count - 1 do
                begin
                    if( MinMatch( 'CONCEALED', SL[ Index ], 1 ) ) then
                    begin
                        F := F or LNM_M_CONCEALED ;
                    end else
                    if( MinMatch( 'TERMINAL', SL[ Index ], 1 ) ) then
                    begin
                        F := F or LNM_M_TERMINAL ;
                    end else
                    begin
                        Result := UUI_INVSWVAL ; // Invalid attribute
                        Extra := SL[ Index ] ;
                        SL.Free ;
                        exit ;
                    end ;
                end ;
                Equivalences_Flags[ Equivalences.Count - 1 ] := F ;
                SL.Free ;
            end else
            if( Parse_Switch( 'N|AME_ATTRIBUTES', '', C, Parameter ) = 1 ) then
            begin
                SL := Parse_List( Parameter ) ;
                for Index := 0 to SL.Count - 1 do
                begin
                    if( MinMatch( 'CONFINE', SL[ Index ], 1 ) ) then
                    begin
                        Flags := Flags or lNM_M_CONFINE ;
                    end else
                    if( MinMatch( 'NO_ALIAS', SL[ Index ], 1 ) ) then
                    begin
                        Flags := Flags or LNM_M_NO_ALIAS ;
                    end else
                    begin
                        Result := UUI_INVSWVAL ; // Invalid attribute
                        Extra := SL[ Index ] ;
                        SL.Free ;
                        exit ;
                    end ;
                end ;
                SL.Free ;
            end else
            begin
                case Parse_Switch( 'L|OG', 'NOL|OG', C, Parameter ) of
                    1 : Log := True ;
                    2 : Log := False ;
                    else
                        begin
                            Result := UUI_IVQUAL ; // Invalid qualifier
                            Extra := C ;
                            exit ;
                        end ;
                end ;
            end ;
        end else

In this code, we are processing the qualifiers that we encounter, exiting if any error occurs. Equivalences_Flags is a list of flags for each equivalence value encountered. If none are specified, the value is 0.

We start the loop with a check for a /HELP qualifier, in which case we show the help and exit.

            if( ( Typ = PIT_Parameter ) or ( Typ = PIT_Delimiter ) ) then
                begin
                if( ( Typ = PIT_Delimiter ) and ( Equivalences.Count = 0 ) ) then
                begin
                    Result := UUI_SYNTAX ;
                    exit ;
                end ;
                if( Name = '' ) then // Must be the symbol name
                begin
                    Name := S ;
                end else
                begin
                    Equivalences.Add( Parse_Quotes( S ) ) ;
                    Equivalences_Flags.Add( 0 ) ;
                    if( 
                         ( C <> '' ) 
                         and 
                         ( copy( C, 1, 1 ) <> '/' ) and ( copy( C, 1, 1 ) <> ',' ) 
                      ) then
                    begin
                        Result := UUI_UNRECPA ;
                        Extra := C ;
                        exit ;
                    end ;
                end ;
            end ;
        end ; // whlie( C <> '' )
        if( Name = '' ) then
        begin
            C := Get_Command( '_Name: ' ) ;
        end else
        if( Equivalences.Count = 0 ) then
        begin
            C := Get_Command( '_Value: ' ) ;
        end ;
    end ;

    // Set up descriptor list...
    fillchar( Descriptors, sizeof( Descriptors ), 0 ) ;
    for Index := 0 to Equivalences_Flags.Count - 1 do
    begin
        Descriptors[ Index * 2 ].MBO := $FFFF ;
        Descriptors[ Index * 2 ].MBMO := -1 ;
        Descriptors[ Index * 2 ].Item_Code := LNM_ATTRIBUTES ;
        Descriptors[ Index * 2 ].Buffer_Length := sizeof( int64 ) ;
        Descriptors[ Index * 2 ].Buffer_Address :=
            int64( @Flag_Array[ Flag_Index( Equivalences_Flags[ Index ] ) ] ) ;
        Descriptors[ Index * 2 + 1 ].MBO := $FFFF ;
        Descriptors[ Index * 2 + 1 ].MBMO := -1 ;
        Descriptors[ Index * 2 + 1 ].Item_Code := LNM_STRING ;
        Descriptors[ Index * 2 + 1 ].Buffer_Length := length( Equivalences[ Index ] ) ;
        Strings[ Index ] := Equivalences[ Index ] ;
        Descriptors[ Index * 2 + 1 ].Buffer_Address := int64( @Strings[ Index ] ) ;
    end ;

Result := CRELNM( Flags, Table, Name, Mode, int64( @Descriptors ) ) ; if( Result = SS_SUPERSEDE ) then begin Result := 0 ; if( Log ) then begin OS := new( POS_UOS, Init ) ; OS^.OutputLn( 0, 'DEFINE-S-DEFINE_SUPERCEDE, Existing symbol superceded' ) ; OS.Free ; end ; end ; end ; // Do_Define

function Flag_Index( I : integer ) : integer ; var L : integer ; begin for L := 0 to 3 do begin if( Flag_Array[ L ] = I ) then begin Result := L ; exit ; end ; end ; Result := 0 ; // Should never get here... end ;

function Parse_List( C : string ) : TstringList ;

var I : integer ;

begin
    Result := TStringList.Create ;
    if( copy( C, 1, 1 ) = '(' ) then
    begin
        C := copy( C, 2, length( C ) ) ;
    end ;
    if( copy( C, length( C ), 1 ) = ')' ) then
    begin
        setlength( C, length( C ) - 1 ) ;
    end ;
    while( C <> '' ) do
    begin
        I := pos( ',', C ) ;
        if( I = 0 ) then
        begin
            Result.Add( lowercase( C ) ) ;
            exit ;
        end ;
        Result.Add( lowercase( copy( C, 1, I - 1 ) ) ) ;
        C := copy( C, I + 1, length( C ) ) ;
    end ;
end ;