TUOS_File_Wrapper

In the previous article, we discussed the GETMSG system call, which uses an instance of a descendent of the TCOM_File64 class. The descendent class is TUOS_File_Wrapper, which we will address in this article.

function Open_Binary_File( const Name : string ; Flags : int64 ) : TCOM_File64 ;

var S : string ;
    SRB : TSRB ;

begin
    S := Name ;
    Set_String( S, SRB ) ;
    Result := Open_File( int64( @SRB ), Flags ) ;
end ;

This function, in PasStarlet, is the Pascal interface to Open_File. It simply wraps the string in a TSRB structure and makes the call.

function Open_File( Name, Flags : int64 ) : TCOM_File64 ;

var SRB : PSRB ;
    FName : string ;
    I : integer ;
    Res : TUOS_File_Wrapper ;
    Status : int64 ;
    SysRequest : TS1I3_Request ;
    Node, Access, Secondary_Node, Device, Path, FileName, Extension, Version : string ;
    S : string ;
    _SRB : TSRB ;

begin
    // Setup...
    SRB := PSRB( Name ) ;
    FName := Get_String( SRB^ ) ;
    UOS_Util.Parse_Filename( Fname, Node, Access, Secondary_Node, Device, Path,
        FileName, Extension, Version ) ;
    if( Node = '' ) then // Current node
    begin
        if( Device = '' ) then
        begin
            Device := LIB_Get_Symbol( 'sys$disk:' ) ;
        end ;
        S := LIB_Get_Symbol( Device ) ;
        if( S <> '' ) then
        begin
            I := pos( ':', S ) ;
            if( I = 0 ) then // No device in translated logical
            begin
                Device := LIB_Get_Symbol( 'sys$disk:' ) ;
            end else
            begin
                Device := copy( S, 1, I ) ;
                S := copy( S, I + 1, length( S ) ) ;
                Path := S + Path ;
            end ;
        end ;
        if( copy( Path, 1, 1 ) <> '\' ) then
        begin
            Path := GETDDIR + Path ;
        end ;
        FName := Node + Device + Path + FileName + Extension + Version ;
        Set_String( FName, _SRB ) ;
        SRB := PSRB( @_SRB ) ;
    end ;

This function returns an instance of TUOS_File_Wrapper for accessing the specified file (or nil if the file wasn't opened). First, we parse the filename and if the node wasn't specified, we default the device and/or path. Note that the executive has no concept of a "default" device for each process. That is handled by ring 3 code, such as Starlet. SYS$DISK contains the default disk device, and GETDDIR returns the current path.

    Res := TUOS_File_Wrapper.Create ;
    Result := Res ;
    Res.FAB.FAB_B_BID := FAB_C_BID ;
    Res.FAB.FAB_B_BLN := sizeof( Res.FAB ) ;
    Res.FAB.FAB_L_NAM := integer( @Res.NAML ) ;
    Res.NAML.NAML_B_BID := NAML_C_BID ;
    Res.NAML.NAML_B_BLN := sizeof( Res.NAML ) ;
    Res._Name := FName ;
    Res.FAB.FAB_L_FNA := int64( PChar( Res._Name ) ) ;
    Res.FAB.FAB_B_FNS := length( Res._Name ) ;
    Res.FAB.FAB_L_FOP := FAB_V_UFO or Flags ; // Non-RMS
    Res.FAB.FAB_B_FAC := Flags and FAB_V_ACMODE_MASK ;
    Res.FAB.FAB_L_XAB := int64( @Res.XABFHC ) ;
    Res.XABFHC.XAB_B_COD := XAB_C_FHC ;
    Res.XABFHC.XAB_B_BLN := sizeof( Res.XABFHC ) ;

The UOS file services use the FAB, etc. structures that we briefly covered in the past. Here, we create an instance of the file wrapper class, which contains a FAB, NAML, and XABFHC structure. Construction of the class sets these all to zeroes, so we only have to set the fields that are non-zero. We set up the FAB ID and size fields and then point it to the NAML block, and we set up the NAML ID and size. We set the file wrapper instance name to the file name and point the FAB to that. We set the FAB file operation field (FAB_L_FOP) to the passed flags and make sure the FAB_V_UFO bit is set. This indicates that this is a binary file that bypasses any and all RMS pre/post processing. We set the FAB_C_FAC field to contain the access mode bits from the flags. Then we point the FAB to the XABFHC structure and initialize that one's code and size. At this point, our three structures are properly set up and linked together. This linking should not need to change for the life of the file wrapper instance.

    // Call SYS_OPEN...
    Status := 0 ;
    fillchar( SysRequest, sizeof( SysRequest ), 0 ) ;
    SysRequest.Request.Subsystem := UOS_Subsystem_FIP ;
    SysRequest.Request.Request := UOS_FIP_Open ;
    SysRequest.Request.Length :=
        sizeof( SysRequest ) - sizeof( SysRequest.Request ) ;
    SysRequest.Request.Status := integer( @Status ) ;
    SysRequest.SRB.Buffer := SRB.Buffer ;
    SysRequest.SRB.Length := SRB.Length ;
    SysRequest.Integer1 := int64( @Res.FAB ) ;
    SysRequest.Integer2 := int64( @Res.IOSB ) ;
    SysRequest.Integer3 := int64( @Res.FAB.FAB_Q_HANDLE ) ;

    Call_To_Ring0( integer( @SysRequest ) ) ;
    if( Res.FAB.FAB_Q_HANDLE = 0 ) then // Not opened
    begin
        FreeandNil( Result ) ;
        exit ;
    end ;
end ; // Open_File

We set up a system request structure for the FIP_Open service. We point members of this structure to the FAB and the FAB.FAB_Q_HANDLE field. This field is used to receive the handle to the file. VMS doesn't use file handles. It uses channels (0 to 16383). The user chooses the channel to open the file on and uses that channel for I/O operations. Instead, UOS, like Windows, uses a unique handle that directly identifies the resource.

We make the call and check that the file handle was set. If it is 0, the open failed and we free the instance and exit with a nil. Otherwise the result is the file wrapper object. We will cover the OPEN system call in the next article.

type TUOS_File_Wrapper = class( TCOM_File64 )
                             public // Constructors
                                 constructor Create ;
                                 destructor Destroy ; override ;

                             private
                                 Temp : string ;
                                 _FilePos : int64 ;
                                 _Name : string ;
                                 BufSize : cardinal ; { Size of file buffer }
                                 BufPos : cardinal ; { Position in buffer }
                                 BufEnd : cardinal ; { Current end of buffer }
                                 BufPtr : PAnsiChar ; { Pointer to file buffer }
                                 Text_Buffer : array[ 0..127 ] of Ansichar ; { Default file buffer }
                                 _N : Ansichar ; { terminating null for Text_Buffer }

                                 // UOS structures...
                                 IOSB : TIOSB ;
                                 FAB : TFAB ;
                                 NAML : TNAML ;
                                 XABFHC : TXABFHC ;

                             protected // Internal utility routines...
                                 function Read_Text_Buffer( Eat_Delimiters : boolean ) : Ansistring ;

We show only the first part of the class definition, because the rest is simply overriding the base class methods. We'll only cover the methods that are used for the current purposes of reading the messages file. We'll cover other methods in the future.

// Constructors and destructors...

constructor TUOS_File_Wrapper.Create ;

begin
    inherited Create ;

    BufSize := sizeof( Text_Buffer ) ;
    BufPos := BufSize + 1 ;
    BufEnd := 0 ;
    BufPtr := @Text_Buffer ;
end ;


destructor TUOS_File_Wrapper.Destroy ;

begin
    Close ;

    inherited Destroy ;
end ;

The constructor for the class simply initializes from instance data. The destructor calls the Close method to make sure the file is closed before the instance is destructed.

function TUOS_File_Wrapper.Facility : int64 ;

begin
    Result := 152 ;
end ;


function TUOS_File_Wrapper.Version : int64 ;

begin
    Result := 10 ; // V1.0
end ;


function TUOS_File_Wrapper.Facility_Name : PAnsiChar ;

begin
    Temp := 'UOS_File_Wrapper' ;
    Result := PAnsiChar( Temp ) ;
end ;


function TUOS_File_Wrapper.FileName : PAnsiChar ;

begin>
    Result := PAnsiChar( _Name ) ;
end ;

These instance-support methods are straight-forward.

function TUOS_File_Wrapper.Opened : boolean ;

begin
    Result := FAB.FAB_Q_HANDLE <> 0 ;
end ;

This function indicates whether the file is currently open or not. If FAB_Q_HANDLE is 0, no file is open. Otherwise it is.

procedure TUOS_File_Wrapper.Close ;

begin
    if( FAB.FAB_Q_HANDLE <> 0 ) then // If open
    begin
        SYS_CLOSE( int64( @FAB ), 0, 0 ) ;
    end ;
end ;

This method calls the CLOSE system service if the file is open. We will cover the CLOSE service in a future article.

function TUOS_File_Wrapper.EOF : boolean ;

begin
    Result := ( _FilePos >= Get_Size ) and ( BufPos >= BufEnd ) ;
end ;


function TUOS_File_Wrapper.FilePos : int64 ;

begin
    Result := _FilePos ;
end ;

The _FilePos instance data is the current byte offset within the file. This class keeps track of our position in the file using this value. The FilePos method returns our current position.

If we called the executive for each character we wanted to read from the file, the number of calls across rings would be horrendous. So, we buffer some of the file's data. This is done via the TextBuffer instance data. The BufSize, BufEnd, and BufPos data tells us the size of the buffer, the logical end of the data in the buffer, and the last position processed as we process through the buffer. If _FilePos is past the end of the file, and we have reached the end of our internal buffer, that means that our position is at the end of the file (EOF). The EOF method is used to determine if this is the case.

procedure TUOS_File_Wrapper.Seek( Pos : int64 ) ;

var S : int64 ;

begin
    if( Pos < 0 ) then
    begin
        Pos := 0 ;
    end ;
    S := Get_Size ;
    if( Pos > S ) then
    begin
        Pos := S ;
    end ;
    _FilePos := Pos ;
    BufPos := BufEnd ;
end ;


function TUOS_File_Wrapper.SeekEOF : Boolean ;

begin
    _FilePos := Get_Size ;
    BufPos := BufEnd ;
end ;

The Seek and SeekEOF methods manipulate the file position. Normal reading of the file will automatically update the positions, but these methods can be called to manually alter the current position. Note that either kind of seek operation will invalidate the internal buffer position so that new data will be read when needed.

procedure TUOS_File_Wrapper.Readln( var Buffer : PAnsiChar ) ;

begin
    Temp := Read_Text_Buffer( True ) ;
    Buffer := PAnsiChar( Temp ) ;
end ;

This method is used to read a line of input. A "line" is considered to be the data in the file from the current position to the first line delimiter, which are CR (carriage return or Enter), LF (linefeed), and ETX ASCII values (in other words, new lines). ETX (control-Z) is treated as a logical end of file when reading a file as text. The Read_Text_Buffer internal method is called to do the actual work.

function TUOS_File_Wrapper.Read_Text_Buffer( Eat_Delimiters : boolean ) : Ansistring ;

label Next_Char ;

var S : Ansistring ;
    R : int64 ;

begin
    if( ( BufPos > BufSize + 1 ) or ( BufEnd > BufSize ) ) then
    begin
        exit ;
    end ;
    S := '' ;

The first comparison is just a sanity check on the Buffer size and position values. We will accumulate the next line in S, so we initialize it to null.

Next_Char:
    if( BufPos > BufEnd ) then
    begin // Need to fill buffer
        Blockread( BufPtr[ 0 ], BufSize, R ) ;
        BufEnd := R ;
        if( ( BufPos > BufSize + 1 ) or ( BufEnd > BufSize ) ) then
        begin
            exit ;
        end ;
        if( BufEnd = 0 ) then
        begin
            if( length( S ) > 0 ) then // There was something at the end of the file
            begin
                Read_Text_Buffer := S ;
            end ;
            exit ;
        end else
        begin
            dec( BufEnd ) ;
        end ;
        BufPos := 0 ;
        _FilePos := _FilePos + R ;
    end ; // if( BufPos > BufEnd )

If we have proceeded beyond the end of the current buffer (which is the case if this is the first read operation), we need to read the next chunk of data into our buffer. The buffer end (BufEnd) is set to the actual amount read into the buffer, which may be less than the size of our buffer, if we're near the end of the file. If nothing was obtained (because we're at the end of the file), we simply return what we've already accumulated. Otherwise, we reset the buffer pointer (BufPos) and seek to the next offset in the file.

    S := S + BufPtr[ BufPos ] ;
    inc( BufPos ) ;
    if(
        ( S[ length( S ) ] <> #26 )
        and
        ( S[ length( S ) ] <> CR )
        and
        ( S[ length( S ) ] <> LF )
      ) then // No delimeter yet
    begin
        goto Next_Char ;
    end ;

Now we accumulate the next character. If it isn't a delimiter, we loop back to get the next character. Take a good look, this may be the only goto statement you will see in UOS code. Yes, I could have done this in a loop, but this is actually old code from another application, so I've left it, because it is actually clearer than using a while loop.

    if( Eat_Delimiters ) then
    begin
        if( S[ length( S ) ] = CR ) then // Swallow CRLF
        begin
            if( BufPos > BufEnd ) then
            begin // Need to fill buffer
                Blockread( BufPtr^, BufSize, R ) ;
                BufEnd := R ;
                if( BufEnd > 0 ) then
                begin
                    BufPos := 0 ;
                    dec( BufEnd ) ;
                end ;
            end ;
            if( BufPtr[ BufPos ] = LF ) then
            begin
                inc( BufPos ) ; // Eat LF
            end ;
        end ;
    end else
    begin
        if( ( S[ length( S ) ] = CR ) or ( S[ length( S ) ] = LF ) ) then
        begin
            dec( BufPos ) ; // Don't advance past delimiter
        end ;
    end ;
    if( S[ length( S ) ] = #26 ) then
    begin
        dec( BufPos ) ; // Don't advance past control-Z
    end ;
    Read_Text_Buffer := copy( S, 1, length( S ) - 1 ) ; // Return string
end ; // TUOS_File_Wrapper.Read_Text_Buffer

If the Eat_Delimiters parameter is true, we advance the internal buffer position past the delimiter. If a CR was found, we treat a LF that immediately follows the CR as part of a CRLF pair. Then we return the accumulated string, minus the delimiter that terminated the line. We especially don't want to advance past control-Z (ETX) because that is, and remains, the logical end of a text file.

procedure TUOS_File_Wrapper.Blockread( var Buf ; Count : int64 ;
   var Res : int64 ) ;

var RAB : TRAB ;

begin
    fillchar( RAB, sizeof( RAB ), 0 ) ;
    RAB.RAB_Size := sizeof( RAB ) ;
    RAB.RAB_L_BKT := _FilePos ;
    RAB.RAB_W_ISI := FAB.FAB_Q_HANDLE ;
    RAB.RAB_L_UBF := int64( @Buf ) ; // User buffer address
    RAB.RAB_W_USZ := Count ; // Record size
    SYS_READ( int64( @RAB ), 0, 0 ) ;
    Res := RAB.RAB_W_RSZ ;
end ;

This method reads an arbitrary amount of data from an arbitrary position in the file. This is done by setting up a RAB structure and making a call to the READ system service, which we will cover in a future article.

In the next article, we will look at the OPEN system service.