1 Introduction
2 Ground Rules

Building a File System
3 File Systems
4 File Content Data Structure
5 Allocation Cluster Manager
6 Exceptions and Emancipation
7 Base Classes, Testing, and More
8 File Meta Data
9 Native File Class
10 Our File System
11 Allocation Table
12 File System Support Code
13 Initializing the File System
14 Contiguous Files
15 Rebuilding the File System
16 Native File System Support Methods
17 Lookups, Wildcards, and Unicode, Oh My
18 Finishing the File System Class

The Init Program
19 Hardware Abstraction and UOS Architecture
20 Init Command Mode
21 Using Our File System
22 Hardware and Device Lists
23 Fun with Stores: Partitions
24 Fun with Stores: RAID
25 Fun with Stores: RAM Disks
26 Init wrap-up

The Executive
27 Overview of The Executive
28 Starting the Kernel
29 The Kernel
30 Making a Store Bootable
31 The MMC
32 The HMC
33 Loading the components
34 Using the File Processor
35 Symbols and the SSC
36 The File Processor and Device Management
37 The File Processor and File System Management
38 Finishing Executive Startup

Users and Security
39 Introduction to Users and Security
40 More Fun With Stores: File Heaps
41 File Heaps, part 2
42 SysUAF
43 TUser
44 SysUAF API

Terminal I/O
45 Shells and UCL
46 UOS API, the Application Side
47 UOS API, the Executive Side
48 I/O Devices
49 Streams
50 Terminal Output Filters
51 The TTerminal Class
52 Handles
53 Putting it All Together
54 Getting Terminal Input
55 QIO
56 Cooking Terminal Input
57 Putting it all together, part 2
58 Quotas and I/O

UCL
59 UCL Basics
60 Symbol Substitution
61 Command execution
62 Command execution, part 2
63 Command Abbreviation
64 ASTs
65 Expressions, Part 1
66 Expressions, Part 2: Support code
67 Expressions, part 3: Parsing
68 SYS_GETJPIW and SYS_TRNLNM
69 Expressions, part 4: Evaluation

UCL Lexical Functions
70 PROCESS_SCAN
71 PROCESS_SCAN, Part 2
72 TProcess updates
73 Unicode revisted
74 Lexical functions: F$CONTEXT
75 Lexical functions: F$PID
76 Lexical Functions: F$CUNITS
77 Lexical Functions: F$CVSI and F$CVUI
78 UOS Date and Time Formatting
79 Lexical Functions: F$CVTIME
80 LIB_CVTIME
81 Date/Time Contexts
82 SYS_GETTIM, LIB_Get_Timestamp, SYS_ASCTIM, and LIB_SYS_ASCTIM
83 Lexical Functions: F$DELTA_TIME
84 Lexical functions: F$DEVICE
85 SYS_DEVICE_SCAN
86 Lexical functions: F$DIRECTORY
87 Lexical functions: F$EDIT and F$ELEMENT
88 Lexical functions: F$ENVIRONMENT
89 SYS_GETUAI
90 Lexical functions: F$EXTRACT and F$IDENTIFIER
91 LIB_FAO and LIB_FAOL
92 LIB_FAO and LIB_FAOL, part 2
93 Lexical functions: F$FAO
94 File Processing Structures
95 Lexical functions: F$FILE_ATTRIBUTES
96 SYS_DISPLAY
97 Lexical functions: F$GETDVI
98 Parse_GetDVI
99 GetDVI
100 GetDVI, part 2
101 GetDVI, part 3
102 Lexical functions: F$GETJPI

Glossary/Index


Download sources
Download binaries

SYS_DISPLAY

In the previous article, we covered the F$FILE_ATTRIBUTES lexical function. Now we will look a the SYS_DISPLAY system service that it uses.

function SYS_DISPLAY( FAB, Err, Success : int64 ) : int64 ;

var Status : byte ;
    SysRequest : TInteger3_Request ;

begin
    fillchar( SysRequest, sizeof( SysRequest ), 0 ) ;
    SysRequest.Request.Subsystem := UOS_Subsystem_FIP ;
    SysRequest.Request.Request := UOS_FIP_Display ;
    SysRequest.Request.Length := sizeof( TInteger3_Request ) - sizeof( SysRequest.Request ) ;
    SysRequest.Request.Status := integer( @Status ) ;
    SysRequest.Int1 := FAB ;
    SysRequest.Int2 := Err ;
    SysRequest.Int3 := Success ;

    Call_To_Ring0( integer( @SysRequest ) ) ;
    Result := Status ;
end ;
We add the SYS_DISPLAY function to the RMS unit. When we get to supporting RMS, we will update this to handle RMS-specific information.

      UOS_FIP_Display:
          begin
              UE := Enter_System_Call( Request, SReq, PID, MMC, sizeof( TInteger3_Request ) - sizeof( SReq ), 
                  Address ) ;
              if( UE <> nil ) then
              begin
                  Set_Last_Error( UE ) ;
                  exit ;
              end ;
              try
                  Integer3_Request := PInteger3_Request( Address ) ;

                  // Read input into caller's buffer...
                  Display( PID, Integer3_Request.Int1, Integer3_Request.Int2, Integer3_Request.Int3, 
                      IOSB ) ;
                  Status := Write_User_int64( Kernel, PID, Integer3_Request.Request.Status, 
                      IOSB.r_io_64.r_bcnt_32.l_bcnt ) ;
              finally
                  Exit_System_Call( integer( Integer3_Request ), PID, MMC, 
                      sizeof( TInteger3_Request ) - sizeof( SReq ) ) ;
              end ;
          end ;
This code is added to the FIP.API method.

procedure TUOS_FiP.Display( PID : TPID ; _FAB, Err, Succ : int64 ;
    var IOSB : TIOSB ) ;

var P : integer ;
    Prefix : packed record
                 Code : byte ;
                 Length : byte ;
             end ;
    Device : TDevice ;
    Dummy : integer ;
    Info : TUOS_File_Info ;
    FAB : TFAB ;
    NAM : TNAML ;
    Dev, Dir, Name, Node, Extension, Ver : string ;
    Next : int64 ;
    UE : TUnified_Exception ;
    XABALL : TXABALL ;
    XABDAT : TXABDAT ;
    XABFHC : TXABFHC ;
    XABITM : TXABITM ;
    XABKEY : TXABKEY ;
    XABPRO : TXABPRO ;
    XABRDT : TXABRDT ;
    XABSUM : TXABSUM ;
    XABTRM : TXABTRM ;

begin
    // Get file specification parts...
    if( _FAB = 0 ) then
    begin
        exit ;
    end ;
    fillchar( FAB, sizeof( FAB ), 0 ) ;
    Get_User_Data( Kernel, PID, _FAB, 1, FAB, IOSB.r_io_64.w_status ) ; // Get FAB length
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
    if( FAB.FAB_B_BLN > sizeof( FAB ) ) then
    begin
        FAB.FAB_B_BLN := sizeof( FAB ) ;
    end ;
    Get_User_Data( Kernel, PID, _FAB, FAB.FAB_B_BLN, FAB, IOSB.r_io_64.w_status ) ; // Get FAB
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
The Display method first checks for a FAB address. If 0, we exit immediately (this is a no-op). Next, we zero-fill the FAB so that any unsupplied fields are 0 - in the case when the caller passes only part of the structure. We then get the first byte of the FAB from the caller's memory. This is the FAB length value. We exit immediately if there was an error reading that value. We then make sure that the passed size doesn't excede the actual FAB length. Then we read the entire (provided) FAB structure from the caller's memory - and exit if there was an error.

    //TODO:Handle file handle
    if( FAB.FAB_L_NAM = 0 ) then // No name block
    begin
        exit ;
    end ;
    Get_NAM( Kernel, PID, FAB.FAB_L_NAM, NAM, IOSB.r_io_64.w_status ) ;
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
On VMS, this system call only works on files that are open. In UOS, we avoid the overhead of having to open a file if all we want is some information on it. UOS will support open files as well (in fact, some return values only apply to files that are currently open), but doesn't require them. For now, we'll ignore the case where the file is already open, and when a file handle is passed instead of a name.
If the pointer to the NAML structure is null, we exit since we have no file name that we can use to retrieve information. Otherwise, we use the Get_NAM function to obtain the NAML block, and exit if there's an error.

    Dev := Get_FAB_String( Kernel, PID, NAM.NAML_L_LONG_DEV, NAM.NAML_B_LONG_DEV_SIZE, 
        IOSB.r_io_64.w_status ) ;
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
    Dir := Get_FAB_String( Kernel, PID, NAM.NAML_L_LONG_DIR, NAM.NAML_L_LONG_DIR_SIZE, 
        IOSB.r_io_64.w_status ) ;
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
    Name := Get_FAB_String( Kernel, PID, NAM.NAML_L_LONG_NAME, NAM.NAML_L_LONG_NAME_SIZE, 
       IOSB.r_io_64.w_status ) ;
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
    Node := Get_FAB_String( Kernel, PID, NAM.NAML_L_LONG_NODE, NAM.NAML_L_LONG_NODE_SIZE, 
        IOSB.r_io_64.w_status ) ;
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
    Extension := Get_FAB_String( Kernel, PID, NAM.NAML_L_LONG_TYPE, NAM.NAML_L_LONG_TYPE_SIZE, 
        IOSB.r_io_64.w_status ) ;
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
    Ver := Get_FAB_String( Kernel, PID, NAM.NAML_L_LONG_VER, NAM.NAML_L_LONG_VER_SIZE, 
        IOSB.r_io_64.w_status ) ;
    if( IOSB.r_io_64.w_status <> 0 ) then
    begin
        exit ;
    end ;
Next, we pull all the component parts of the file specification from the NAML block using the Get_FAB_String function.

    if( Dev = '' ) then // No device specified
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UOSErr_Invalid_Device_Name ) ;
        exit ;
    end ;

    if( ( Dir = '' ) and ( Name = '' ) and ( Extension = '' ) and ( Ver = '' ) ) then // Only device
    begin
        Device := Get_Device( Dev ) ;
        if( Device = nil ) then
        begin
            IOSB.r_io_64.w_status := UE_Error ;
            Generate_Exception( UOSErr_Device_Not_Found ) ;
            exit ;
        end ;
        FAB.FAB_L_DEV := Device.Info.Flags ;
        IOSB.r_io_64.w_status := Write_User( Kernel, PID, _FAB, FAB.FAB_B_BLN, FAB ) ;
        exit ;
    end ;
Once we've parsed the specification, we ensure that there is a device specified. We cannot find a file unless we know which device it resides on. So, if the device name is null, we exit with an error.
Next we check for a special case: a device name by itself. Generally, if one wants device information, the GETDVI system service is used. However, we handle the situation here by checking that the device name corresponds to an actual device (if not, we return an error). Then we set the FAB_L_DEV flags from the device flags and exit.

    // Normalize name...
    if( copy( Dev, length( Dev ), 1 ) <> ':' ) then
    begin
        Dev := Dev + ':' ;
    end ;
    Dev := Resolve_Symbol( PID, Dev ) ;
    P := pos( ':', Dev ) ;
    if( ( P > 0 ) and ( P < length( Dev ) ) ) then
    begin
        Dir := Append_Path( copy( Dev, P + 1, length( Dev ) ), Dir ) ;
        Dev := copy( Dev, 1, P ) ;
    end ;
    Dummy := pos( ':', Dev ) ;
    if( Dummy < 2 ) then // Missing device
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UOSErr_Device_Not_Found ) ;
        exit ;
    end ;
    if( copy( Dir, 1, 1 ) <> '\' ) then
    begin
        Dir := '\' + Dir ;
    end ;
    if( copy( Dir, length( Dir ), 1 ) <> '\' ) then
    begin
        Dir := Dir + '\' ;
    end ;
Now we normalize the specification. First we make sure the device name ends with a colon. Then we resolve the symbol in case the device is actually a logical name. Then we copy anything after the colon to the start of the directory name and trim it from the device name. If there is no colon after the symbol resolution, we exit with an error because no device was specified. Then we make sure that the directory name begins and ends with a backslash.

    // Get device and its file system...
    Device := Get_Device( copy( Dev, 1, Dummy ) ) ;
    if( Device = nil ) then
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UOSErr_Device_Not_Found ) ;
        exit ;
    end ;
    if( not Device.Mounted ) then
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UOSErr_Device_Not_Mounted ) ;
        exit ;
    end ;
    if( Device.FS = nil ) then
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UOSErr_Device_Not_File_Structured ) ;
        exit ;
    end ;
    if( ( Extension <> '' ) and ( copy( Extension, 1, 1 ) <> '.' ) ) then
    begin
        Extension := '.' + Extension ;
    end ;
Next we get the device instance for the specified device, and exit if there is none. Then we check to make sure the device is mounted and has an associated file system. If either case isn't true, we exit with an error. Finally, we normalize the file extension by making sure it starts with a dot, unless it is null. At this point, we have a completely normalized specification - although, granted, it is in component pieces.

    // Get file information...
    Info := Device.FS.Get_File_Info( PChar( Dir + Name + Extension ), 0 ) ;
    UE := Device.FS.Last_Error ;
    if( ( UE <> nil ) and ( UE.Get_Error <> 0 ) ) then
    begin
        IOSB.r_io_64.w_status := UE_Error ;
        Generate_Exception( UE.Get_Error ) ;
        exit ;
    end ;
Now we ask the file system for information about the file (combining the components into a single string). If there was an error, we exit.

    // Return information...
    Next := FAB.FAB_L_XAB ;
    while( Next <> 0 ) do // Until end of XAB chain
    begin
        // Get XAB code...
        Get_User_Data( Kernel, PID, Next, sizeof( Prefix ), Prefix, IOSB.r_io_64.w_status ) ;
        if( IOSB.r_io_64.w_status <> 0 ) then
        begin
            exit ;
        end ;
We will now follow the XAB chain, starting with the FAB_L_XAB pointer, and fill the various XAB fields with information. Next contains the current pointer that we are following. Once we hit a null pointer, the loop ends. The first thing we do in the loop is obtain the prefix (type and length) of the XAB and exit if there was a error obtaining it from the caller's memory. Because a given XAB may be one of several types (see previous articles), we have to get the XAB prefix first to determine which type of XAB to process.

        // Based on type of XAB...
        if( Prefix.Code = XAB_C_ALL ) then
        begin
            fillchar( XABALL, sizeof( XABALL ), 0 ) ;
            if( Prefix.Length > sizeof( XABALL ) ) then
            begin
                Prefix.Length := sizeof( XABALL ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABALL, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABALL.XAB_L_NXT ;
        end else
        if( Prefix.Code = XAB_C_DAT ) then
        begin
            fillchar( XABDAT, sizeof( XABDAT ), 0 ) ;
            if( Prefix.Length > sizeof( XABDAT ) ) then
            begin
                Prefix.Length := sizeof( XABDAT ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABDAT, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            XABDAT.XAB_Q_BDT := Info.Last_Backup ; // Backup date and time
            XABDAT.XAB_Q_CDT := Info.Creation ; // Creation date and time
            XABDAT.XAB_Q_EDT := Info.Expiration ; // Expiration date and time
            XABDAT.XAB_Q_RDT := Info.Last_Modified ; // Revision date and time
            XABDAT.XAB_Q_ACC := Info.Last_Access ; // Last access date and time
            IOSB.r_io_64.w_status := Write_User( Kernel, PID, Next, Prefix.Length, XABDAT ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABDAT.XAB_L_NXT ;
        end else
XABALL blocks have to do with RMS allocation information, so there is nothing we do with that block type, except to get the pointer to the next XAB in the chain. XABDAT blocks contain date/time information for the file, all of which we can set from the UOS file information structure that we obtained above.
In either case, we zero out the appropriate XAB structure and then make sure the block size doesn't exceed the XAB structure's actual size. Next we zero-out the structure (in case the caller's structure is smaller than the actual XAB). Then we copy the XAB from the caller's memory to our local structure. After updating the XABDAT structure, we write the update back to the caller's memory. Obviously, we exit if there was an error reading or writing the caller's structure.

        if( Prefix.Code = XAB_C_FHC ) then
        begin
            fillchar( XABFHC, sizeof( XABFHC ), 0 ) ;
            if( Prefix.Length > sizeof( XABFHC ) ) then
            begin
                Prefix.Length := sizeof( XABFHC ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABFHC, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            XABFHC.XAB_Q_EOF := Info.EOF ; // End-of-file (logical file length)
            XABFHC.XAB_W_VERLIMIT := Info.Version_Limit ; // Version limit for the file
            XABFHC.XAB_W_MRS := Info.Record_Size ;
            XABFHC.XAB_Q_SIZ := Info.Size ; // Size on disk
            XABFHC.XAB_Q_USZ := Info.Uncompressed_Size ; // Uncompressed size
            XABFHC.XAB_L_CLS := Info.Clustersize ; // Clustersize
            XABFHC.XAB_L_CRE := Info.Creator ; // Creator UIC
            XABFHC.XAB_W_FLG := Info.Flags and $FFFF ; // Flags (not including protection codes)
            IOSB.r_io_64.w_status := Write_User( Kernel, PID, Next, Prefix.Length, XABFHC ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABFHC.XAB_L_NXT ;
        end else
For the XABFHC structure, we zero-out and read the structure as we did for the previous two XAB types. Then we update the non-RMS fields and write the structure back.

        if( Prefix.Code = XAB_C_ITM ) then
        begin
            fillchar( XABITM, sizeof( XABITM ), 0 ) ;
            if( Prefix.Length > sizeof( XABITM ) ) then
            begin
                Prefix.Length := sizeof( XABITM ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABITM, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABITM.XAB_L_NXT ;
        end else
        if( Prefix.Code = XAB_C_KEY ) then
        begin
            fillchar( XABKEY, sizeof( XABKEY ), 0 ) ;
            if( Prefix.Length > sizeof( XABKEY ) ) then
            begin
                Prefix.Length := sizeof( XABKEY ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABKEY, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABKEY.XAB_L_NXT ;
        end else
The XABITM and XABKEY structures are also ignored, for now, and treated as is the XABALL structure above.

        if( Prefix.Code = XAB_C_PRO ) then
        begin
            fillchar( XABPRO, sizeof( XABPRO ), 0 ) ;
            if( Prefix.Length > sizeof( XABPRO ) ) then
            begin
                Prefix.Length := sizeof( XABPRO ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABPRO, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            XABPRO.XAB_L_UIC := Info.Owner ; // File owner
            XABPRO.XAB_W_PRO := ( Info.Flags shr 16 ) and $FFFF ; // File protection
            IOSB.r_io_64.w_status := Write_User( Kernel, PID, Next, Prefix.Length, XABPRO ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABPRO.XAB_L_NXT ;
        end else
The XABPRO structure only has two non-RMS fields. We update those appropriately. Note that we shift the file flags right to get the file protection code into the XAB_W_PRO field.

        if( Prefix.Code = XAB_C_RDT ) then
        begin
            fillchar( XABRDT, sizeof( XABRDT ), 0 ) ;
            if( Prefix.Length > sizeof( XABRDT ) ) then
            begin
                Prefix.Length := sizeof( XABRDT ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABRDT, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABRDT.XAB_L_NXT ;
        end else
        if( Prefix.Code = XAB_C_SUM ) then
        begin
            fillchar( XABSUM, sizeof( XABSUM ), 0 ) ;
            if( Prefix.Length > sizeof( XABSUM ) ) then
            begin
                Prefix.Length := sizeof( XABSUM ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABSUM, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABSUM.XAB_L_NXT ;
        end else
        if( Prefix.Code = XAB_C_TRM ) then
        begin
            fillchar( XABTRM, sizeof( XABTRM ), 0 ) ;
            if( Prefix.Length > sizeof( XABTRM ) ) then
            begin
                Prefix.Length := sizeof( XABTRM ) ;
            end ;
            Get_User_Data( Kernel, PID, Next, Prefix.Length, XABTRM, IOSB.r_io_64.w_status ) ;
            if( IOSB.r_io_64.w_status <> 0 ) then
            begin
                exit ;
            end ;
            Next := XABTRM.XAB_L_NXT ;
        end else
        begin
            break ; // Unrecognized XAB code
        end ;
    end ;
end ; // TUOS_FiP.Display
The XABRDT, XABSUM, and XABTRM structures are ignored for now other than as links in the XAB chain.

procedure Get_NAM( Kernel : TUOS_Kernel ; PID : TPID ; Address : int64 ;
    var NAM : TNAML ; var Status : integer ) ;

var I : integer ;

begin
    fillchar( NAM, sizeof( NAM ), 0 ) ;
    Get_User_Data( Kernel, PID, Address, 2, NAM, Status ) ; // Get type and length
    if( Status <> 0 ) then
    begin
        exit ;
    end ;
    I := NAM.NAML_B_BLN ;
    if( I > sizeof( NAM ) ) then
    begin
        I := sizeof( NAM ) ;
    end ;
    Get_User_Data( Kernel, PID, Address, I, NAM, Status ) ; // Get type and length
    if( Status <> 0 ) then
    begin
        exit ;
    end ;
end ;
This function obtains a NAML structure from the caller.

function Get_FAB_String( Kernel : TUOS_Kernel ; PID : TPID ; Address, Len : int64 ;
    var Status : integer ) : string ;

var SRB : TSRB ;
    US : TUOS_String ;

begin
    SRB.Buffer := Address ;
    SRB.Length := Len ;
    US := Get_User_String( Kernel, PID, SRB, Status ) ;
    Result := '' ;
    if( ( US <> nil ) and ( Status = 0 ) ) then
    begin
        Result := trim( US.Contents ) ;
    end ;
    US.Free ;
end ;
This function obtains a string specified by an address and length. We construct a TSRB structure and use the Get_User_String function to obtain the string.

function Append_Path( S1, S2 : string ) : string ;

begin
    if( ( S1 <> '' ) and ( S2 <> '' ) ) then
    begin
        if( ( copy( S2, 1, 1 ) <> '\' ) and ( copy( S1, length( S1 ), 1 ) <> '\' ) ) then
        begin
            S1 := S1 + '\' ;
        end ;
    end ;
    Result := S1 + S2 ;
end ;
This function appends two parts of a path, making sure that the parts are combined with a single backslash.

That finishes our F$FILE_ATTRIBUTES and SYS_DISPLAY code for the time being. In the next article, we'll look at the next lexical function.

 

Copyright © 2020 by Alan Conroy. This article may be copied in whole or in part as long as this copyright is included.