In this article, we look at the CRELNM system service. On VMS, CRELNM creates a logical, while on UOS it creates a symbol. We've discussed symbol creation before, using the Set_Symbol service, which isn't in VMS. To follow the VMS specification, we need to define the CRELNM service, which will wrap the Set_Symbol service. However, there are some additional features we will be adding to symbols, as described in the previous article, to support all of the CRELNM options. First the documentation.

function CRELNM( Attr : int64 ; Tabnam, Lognam : string ;
    ACMode, itmlst : int64 ) : int64 ;

var LogNam_SRB, TabNam_SRB : TSRB ;

begin
    Set_String( Tabnam, TabNam_SRB ) ;
    Set_String( Lognam, LogNam_SRB ) ;

    Result := SYS_CRELNM( int64( @Attr ), int64( @Tabnam_SRB ),
        int64( @Lognam_SRB ), int64( @AcMode ), Itmlst ) ;
end ;

function SYS_CRELNM( Attr, Tabnam, Lognam, ACMode, itmlst : int64 ) : int64 ;

var Status : int64 ;
    SysRequest : TS2I3_Request ;
    LogNam_SRB, TabNam_SRB : PSRB ;

begin
    LogNam_SRB := PSRB( pointer( Lognam ) ) ;
    Tabnam_SRB := PSRB( pointer( Tabnam ) ) ;

    SysRequest.Request.Subsystem :=  UOS_Subsystem_SSC ;
    SysRequest.Request.Request := UOS_SSC_CRELNM ;
    SysRequest.Request.Length := sizeof( SysRequest ) - sizeof( Sysrequest.Request ) ;
    SysRequest.Request.Status := int64( @Status ) ;
    SysRequest.SRB1.Buffer := LogNam_SRB.Buffer ;
    SysRequest.SRB2.Buffer := Tabnam_SRB.Buffer ;
    SysRequest.SRB1.Length := LogNam_SRB.Length ;
    SysRequest.SRB2.Length := Tabnam_SRB.Length ;
    SysRequest.Integer1 := Attr ;
    SysRequest.Integer2 := Itmlst ;
    SysRequest.Integer3 := AcMode ;

    Call_To_Ring0( integer( @SysRequest ) ) ;

    Result := Status ;
end ;

        UOS_SSC_CRELNM:
            begin
                UE := Enter_System_Call( Request, SReq, PID, MMC, 
                    sizeof( TS3I5_Request ) - sizeof( TSystem_Request ), Base ) ;
                if( UE <> nil ) then
                begin
                    Set_Last_Error( UE ) ;
                    exit ;
                end ;

                try
                    PS3I5 := PS3I5_Request( Base ) ;
                    PS3I5.Request.Status := CRELNM( Kernel, PID, PS3I5.SRB1,
                        PS3I5.SRB2, PS3I5.Integer2, PS3I5.Integer1,
                        PS3I5.Integer3 ) ;
                finally
                    Exit_System_Call( Base, PID, MMC, sizeof( TS3I5_Request ) ) ;
                end ;
            end ;

function TUOS_SSC.CRELNM( Kernel : TUOS_Kernel ; PID : TPID ; LogNam, TabNam : TSRB ;
    Attr, Itemlst, AcMode : int64 ) : int64 ;

var Table_Name, Logical_Name : string ;
    Status : integer ;
    SRB : TSRB ;
    US : TUOS_String ;

begin
    // Get and validate parameters...
    US := Get_User_String( Kernel, PID, TabNam, Status ) ;
    if( Status = UE_Error ) then
    begin
        Result := Status ;
        exit ;
    end ;
    Table_Name := trim( US.Contents ) ;
    if( Table_Name = '' ) then
    begin
        Result := SS_BADPARAM ;
        exit ;
    end ;

    US := Get_User_String( Kernel, PID, LogNam, Status ) ;
    if( Status = UE_Error ) then
    begin
        Result := Status ;
        exit ;
    end ;
    Logical_Name := trim( US.Contents ) ;
    if( Logical_Name = '' ) then
    begin
        Result := SS_BADPARAM ;
        exit ;
    end ;

    if( Attr <> 0 ) then
    begin
        Attr := Get_User_Integer( Kernel, PID, Attr, Status ) ;
        if( Status = UE_Error ) then // Error reading user value
        begin
            Result := Status ;
            exit ;
        end ;
    end ;

    if( AcMode = 0 ) then
    begin
        AcMode := USC.Access_Mode( PID ) ;
    end else
    begin
        AcMode := Get_User_Integer( Kernel, PID, AcMode, Status ) ;
        if( Status = UE_Error ) then // Error reading user value
        begin
            Result := Status ;
            exit ;
        end ;
    end ;
    if( AcMode < USC.Access_Mode( PID ) ) then // More privileged than process
    begin
        if( ( USC.Get_Process_Info( PID, JPI_CURPRIV ) and SYSNAM ) <> 0 ) then
        begin
            AcMode := USC.Access_Mode( PID ) ;
        end ;
    end ;
    if( AcMode > PSL_C_USER ) then
    begin
        Result := SS_BADPARAM ;
        exit ;
    end ;
    Result := Create_Symbol( Kernel, PID, PChar( Logical_Name ),
        PChar( Table_Name ), Attr, Itemlst, AcMode ) ;
end ; // TUOS_SSC.CRELNM

function TUOS_SSC.Create_Symbol( Kernel : TUOS_Kernel ; PID : TPID ;
    LogNam, TabNam : PChar ; Attr, Itemlst, AcMode : int64 ) : int64 ;

var Buff : PAnsiChar ;
    Change : int64 ;
    Current_Attributes : integer ;
    Descriptor : TSYS_Descriptor ;
    I, Index : integer ;
    I64 : int64 ;
    Offset : integer ;
    Logical_Name, Table_Name : string ;
    S : string ;
    SRB : TSRB ;
    Status : integer ;
    Symbol : TUOS_Symbol ;
    Table : TSymbol_Table ;
    US : TUOS_String ;
    Value : string ;
    Values : TStringList ;

begin
    Result := 0 ; // Assume success
    Logical_Name := string( LogNam ) ;
    Table_Name := string( TabNam ) ;
    if( Validate_String( Logical_Name, 
      '0123456789_$abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' ) = -1 ) then
    begin
        Result := SS_BADPARAM ;
        exit ;
    end ;
    if( ( AcMode > 3 ) or ( AcMode < 0 ) ) then
    begin
        Result := SS_BADPARAM ;
        exit ;
    end ;
    if( AcMode < USC.Access_Mode( PID ) ) then
    begin
        AcMode := USC.Access_Mode( PID ) ;
    end ;
    if( ( PID <> 0 ) and ( AcMode < PSL_C_SUPER ) ) then
    begin
        if( ( USC.Get_Process_Info( PID, JPI_CURPRIV ) and SYSNAM ) = 0 ) then
        begin
            Result := SS_NOPRIV ; // User must have SYSNAM to use KERNEL or EXECUTIVE access mode
            exit ;
        end ;
    end ;
    Value := '' ;

    // Find table...
    Table_Name := Translate_Table_Name( Table_Name ) ;
    _Kernel.Lock( Spinlock_Symbol_Tables ) ;
    for I := 0 to Symbol_Tables.Count - 1 do
    begin
        Table := TSymbol_Table( Symbol_Tables[ I ] ) ;
        if( lowercase( Table.Name ) = lowercase( Table_Name ) ) then
        begin
            break ;
        end ;
        Table := TSymbol_Table( Table.Get_Table( PChar( Table_Name ) ) ) ;
        if( Table <> nil ) then
        begin
            break ;
        end ;
    end ;
    if( Table = nil ) then // Table not found
    begin
        Result := SS_NOLOGTAB ;
        _Kernel.Unlock( Spinlock_Symbol_Tables ) ;
        exit ;
    end ;
    Table.Attach ;
    _Kernel.Unlock( Spinlock_Symbol_Tables ) ;  
    while( not Enter_Unshared_Section( int64( @Table.Locked ) ) ) do
    begin
        Kernel.Yield ; // Wait a bit
    end ;
    if( ( PID <> 0 )
        and
        not USC.Validate_Protection( PID, FAB_V_UPD, Table.Owner, Table.Protection, 0 )
      ) then
    begin
        Result := SS_NOPRIV ;
        Exit_Unshared_Section( int64( @Table.Locked ) ) ;
        exit ;
    end ;

The order of operations here is important. First we spinlock the system symbol table lists (Spinlock_Symbol_Tables) to prevent the deletion of the table before we can lock it. Next we find the table in question. If not found, we release the spinlock and exit. Otherwise, the next thing we do is attach to the table. This increments the table reference count. The table will not be deleted until its reference count goes to 0, indicating that no one else is using it. This essentially "locks" it, in terms of it being deleted. Once we've attached to it, we can release the spinlock which allows other processes to modify the system symbol tables list.

Next we loop until we succeed in locking the table via Enter_Unshared_Section. Unlike attaching, which is not exclusive to us, this lock is exclusive - which prevents other users from deleting any symbols in this table. If the table is already locked, we wait until we can obtain the exclusive table lock. On each failed attempt, we reschedule ourself. We do this because we cannot do anything until the table is unlocked, so constantly trying to lock the table until we lose our quantum is inefficient. By allowing other processes to get their quantum, the CPU can get more work done and perhaps when we are scheduled to run again, the table lock will be free. Eventually, the lock will be released and we can continue.

I should also mention that setting a system spinlock will prevent the process from being unscheduled until the spinlock is released. Otherwise, we run into the same problem with a spinlock being held for a long time. If this process is low priority and loses its quantum, the spinlock remains active until the process runs again.

So, there are three types of locks involved here: the system spinlock, the table reference count, and the table lock. The first prevents anyone from deleting tables. The second prevents the specific table from being deleted. The third prevents other processes from deleting any symbols from the table. The first is necessary to prevent us from getting a valid pointer to a table, then having it deleted by another process, and then trying to use the pointer which is no longer valid. The third is necessary to prevent us from getting a pointer to a symbol in the table and then having that symbol deleted, leaving us unknowingly using an invalid pointer.

    // Make sure there are no more-privileged symbols with LNM_M_NO_ALIAS...
    I := AcMode - 1 ;
    while( I >= 0 ) do
    begin
        Symbol := Table.Get_Symbol( PChar( Logical_Name ), I, True ) ;
        if( Symbol <> nil ) then
        begin
            if( ( Symbol.Flags and LNM_M_NO_ALIAS ) <> 0 ) then
            begin
                Result := SS_DUPLNAM ;
                Exit_Unshared_Section( int64( @Table.Locked ) ) ;
                exit ;
            end ;
        end ;
        dec( I ) ;
    end ;

    // Process descriptor list...
    Values := TStringList.Create ;
    while( True ) do
    begin
        Offset := MMC.Lock_Pages( PID, Itemlst, sizeof( Descriptor ) ) ;
        Buff := PAnsiChar( MMC.Map_Pages( PID, 0, ItemLst, sizeof( Descriptor ), 
            MAM_Read or MAM_Lock ) ) ;
        if( Buff = nil ) then
        begin
            if( MMC.Last_Error = nil ) then
            begin
                Generate_Exception( UOSErr_Memory_Address_Error ) ;
            end ;
            Exit_Unshared_Section( int64( @Table.Locked ) ) ;
            exit ;
        end ;
        move( Buff[ Offset ], Descriptor, sizeof( Descriptor ) ) ;
        if(
            ( Descriptor.Buffer_Length = 0 )
            or
            ( Descriptor.Buffer_Address = 0 )
          ) then // End of list
        begin
            break ;
        end ;
        Itemlst := Itemlst + sizeof( Descriptor ) ;

        case Descriptor.Item_Code of
            LNM_ATTRIBUTES : begin
                                 if(
                                     ( Descriptor.Buffer_Length = 0 )
                                     or
                                     ( Descriptor.Buffer_Address = 0 )
                                   ) then
                                 begin
                                     Result := SS_BADPARAM ;
                                     Exit_Unshared_Section( int64( @Table.Locked ) ) ;
                                     exit ;
                                 end ;
                                 Current_Attributes :=
                                     Get_User_Integer( Kernel, PID, Current_Attributes, Status ) ;
                                 if( Status = UE_Error ) then // Error reading user value
                                 begin
                                     Result := Status ;
                                     exit ;
                                 end ;
                                 if( ( Current_Attributes < 0 ) or ( Current_Attributes > 3 ) ) then
                                 begin
                                     Result := SS_BADPARAM ;
                                     Exit_Unshared_Section( int64( @Table.Locked ) ) ;
                                     exit ;
                                 end ;
                             end ;
            LNM_STRING : begin
                             SRB.Buffer := Descriptor.Buffer_Address ;
                             SRB.Length := Descriptor.Buffer_Length ;
                             US := Get_User_String( Kernel, PID, SRB, Status ) ;
                             if( Status = UE_Error ) then
                             begin
                                 Result := Status ;
                                 Exit_Unshared_Section( int64( @Table.Locked ) ) ;
                                 exit ;
                             end ;
                             Value := US.Contents ;
                             Values.AddObject( Value, pointer( Current_Attributes ) ) ;
                         end ;
            LNM_TABLE : begin
                            if( Descriptor.Buffer_Address <> 0 ) then
                            begin
                                S := Table.Name ;
                                if( length( S ) > Descriptor.Buffer_Length ) then
                                begin
                                    setlength( S, Descriptor.Buffer_Length ) ;
                                    Result := SS_BUFFEROVF ;
                                end ;
                                Status := Write_User( Kernel, PID, Descriptor.Buffer_Address, 
                                    length( S ), PChar( S )[ 0 ] ) ;
                                if( Status = 0 ) then
                                begin
                                    I64 := length( S ) ;
                                    I := sizeof( I64 ) ;
                                    Status := Write_User( Kernel, PID, 
                                        Descriptor.Return_Length_Address, I64, I ) ;
                                end ;
                                if( Status = UE_Error ) then // Error reading user value
                                begin
                                    Result := Status ;
                                    Exit_Unshared_Section( int64( @Table.Locked ) ) ;
                                    exit ;
                                end ;
                            end ;
                        end ;
            LNM_TABLELENGTH : begin
                                   if( Descriptor.Buffer_Address <> 0 ) then
                                   begin
                                       I64 := length( Table.Name ) ;
                                       I := sizeof( int64 ) ;
                                       if( I > Descriptor.Buffer_Length ) then
                                       begin
                                           I := Descriptor.Buffer_Length ;
                                           Result := SS_BUFFEROVF ;
                                       end ;
                                       Status := Write_User( Kernel, PID, Descriptor.Buffer_Address, 
                                           I, I64 ) ;
                                       if( Status = UE_Error ) then // Error writing to user buffer
                                       begin
                                           Result := Status ;
                                           Exit_Unshared_Section( int64( @Table.Locked ) ) ;
                                           exit ;
                                       end ;
                                   end ;
                               end ;
            LNM_CHAIN : ; // Ignore
            else begin
                     Result := Generate_Exception( UOSErr_Bad_Parameter ) ;
                     Exit_Unshared_Section( int64( @Table.Locked ) ) ;
                     exit ;
                 end ;
        end ; // case
    end ; // while( true )

    // Ensure quota...
    Change := 0 ;
    I64 := 0 ;
    if( Table.Quota > 0 ) then
    begin
        // Determine what the change in usage will be...
        Symbol := Table.Get_Symbol( PChar( Logical_Name ), AcMode, True ) ;
        if( Symbol <> nil ) then
        begin
            Change := Change - Symbol.Size ;
        end ;
        if( ( Attr and LNM_M_NO_ALIAS ) <> 0 ) then // No alias flag
        begin
            I := AcMode + 1 ;
            while( I <= PSL_C_USER ) do
            begin
                Symbol := Table.Get_Symbol( PChar( Logical_Name ), I, True ) ;
                Change := Change - Symbol.Size ;
                inc( I ) ;
            end ;
        end ;

        Change := Change + Values.Count * sizeof( pointer ) * 2 ;
        for I := 0 to Values.Count - 1 do
        begin
            I64 := I64 + length( Values[ I ] ) ;
        end ;
        if( Table.Used + Change + I64 > Table.Quota ) then
        begin
            Result := Generate_Exception( SS_EXLNMQUOTA ) ;
            Exit_Unshared_Section( int64( @Table.Locked ) ) ;
            exit ;
        end ;
    end ; // if( _Quota > 0 )

Note that all these checks and processing of descriptors are done before we actually update the symbol. This is because we want an all-or-nothing operation. We don't want to delete the old symbol(s) and then fail due to quotas, for instance. So, if we get past this code, we are ready to update the table.

    // Delete existing symbol(s)...
    if( Table.Delete( PChar( Logical_Name ), True, AcMode ) ) then
    begin
        Result := SS_SUPERSEDE ;
    end ;
    if( ( Attr and LNM_M_NO_ALIAS ) <> 0 ) then // No alias flag
    begin
        // Delete symbols with same name and less privileges...
        I := AcMode + 1 ;
        while( I <= PSL_C_USER ) do
        begin
            if( Table.Delete( PChar( Logical_Name ), False, I ) ) then
            begin
                Result := SS_SUPERSEDE ;
            end ;
            inc( I ) ;
        end ;
    end ;

    // Define symbol...
    Table.Set_Value( PChar( Logical_Name ), nil, 0, ACMode ) ; // Create symbol
    Symbol := Table.Get_Symbol( PChar( Logical_Name ), AcMode, True ) ;
    Symbol.Flags := Attr ;
    Symbol.Values.Free ; // Delete initial value
    Symbol.Values := Values ; // Assign equivalence values
    if( Table.Quota > 0 ) then
    begin
        Table.Used := Table.Used + Change + I64 ;
    end ; // if( _Quota > 0 )
    Exit_Unshared_Section( int64( @Table.Locked ) ) ;
end ; // TUOS_SSC.Create_Symbol

    function Enter_Unshared_Section( Addr : int64 ) : boolean ;

    begin
        Result := True ; // Assume success
        if( PID <> 0 ) then
        begin
            Result := USC.Process_Lock( PID, Addr, False ) ;
        end ;
    end ;


    procedure Exit_Unshared_Section( Addr : int64 ) ;

    begin
        if( PID <> 0 ) then
        begin
            USC.Process_Unlock( PID, Addr ) ;
        end ;
        Table.Detach ;
    end ;

    function Translate_Table_Name( Table_Name : string ) : string ;

    var Count : integer ;
        I : integer ;
        U : TUOS_String ;

    begin
        // Setup...
        Result := Table_Name ;
        Count := 1 ;

        while( Count <= 10 ) do // Up to ten translations
        begin
            // Look for name in symbol tables...
            for I := 0 to Symbol_Tables.Count - 1 do
            begin
                Table := TSymbol_Table( Symbol_Tables[ I ] ) ;
                if( lowercase( Table.Name ) = lowercase( Table_Name ) ) then
                begin
                    Result := Table_Name ; // Found
                    exit ;
                end ;
            end ;

            // Didn't find the table, try iterating...
            U := Get_Symbol( nil, PID, PAnsiChar( Table_Name ),
                False, True, AcMode ) ;
            if( U = nil ) then
            begin
                exit ; // No more translations
            end ;
            Table_Name := U.Contents ;
            U.Free ;
            if( Table_Name = '' ) then
            begin
                exit ; // No more translations
            end ;

            inc( Count ) ;
        end ;
    end ;