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 UCL Command execution
62 UCL Command execution, part 2
63 UCL Command Abbreviation
64 ASTs
65 UCL Expressions, Part 1
66 UCL Expressions, Part 2: Support code
67 UCL Expressions, part 3: Parsing
68 SYS_GETJPIW and SYS_TRNLNM
69 UCL 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 UCL Lexical functions: F$GETDVI
98 Parse_GetDVI

Glossary/Index


Download sources
Download binaries

Lexical functions - F$ENVIRONMENT

The next lexical function is F$ENVIRONMENT. Here is the function description:

F$ENVIRONMENT returns information about the current UCL/process environment.

Format
F$ENVIRONMENT(item)

Return Value
The information corresponding to the specified item.

Arguments
item

A keyword indicating the type of information to return. The following are the valid keywords:
ValueMeaning
CAPTIVETRUE if the process is logged into a captive account.
CONTROLThe control characters currently enabled. Multiple characters are delimited with commas. Null is returned if no control characters are enabled.
DEFAULTThe current default disk and directory.
DISIMAGETRUE if the logged-in account does not allow direct image invocation (eg the RUN command).
INTERACTIVETRUE if the process is interactive.
KEY_STATECurrent locked keypad state.
MAX_DEPTHMaximum allowable command procedure depth.
MESSAGECurrent setting of SET MESSAGE qualifiers.
NOCONTROLThe control characters currently disabled. Multiple characters are delimited with commas. Null is returned if no control characters are disabled.
ON_CONTROL_YWithin a command procedure, this returns TRUE if ON_CONTROL_Y is set and FALSE otherwise.
ON_SEVERITYWithin a command procedure, this returns the severity level at which the action specified with the ON command was specified.
OUTPUT_RATEDelta time of the batch job default output rate. Returns null if used interactively.
PROCEDURESpecification of current command file. If interactive, the terminal device name is returned.
PROMPTCurrent DCL prompt.
PROMPT_CONTROLTRUE if prompt is preceded by a CRLF.
PROTECTIONCurrent default file protection.
RESTRICTEDTRUE if in a restricted account, FALSE otherwise.
SYMBOL_SCOPEIndicates the current symbol scoping state: [NO]LOCAL or [NO]GLOBAL.
VERB_SCOPEIndicates the current verb scoping state: [NO]LOCAL or [NO]GLOBAL.
VERIFY_IMAGETRUE if image verification is set. FALSE otherwise.
VERIFY_PREFIXReturns prefix control string.
VERIFY_PROCEDURETrue if SET_VERIFY=PROCEDURE is set.

Example
$ X = F$ENVIRONMENT("PROMPT")
This would return the current UCL prompt.

        Function_Environment : begin
                                   if( Missing_Parentheses( '(' ) ) then
                                   begin
                                       exit ;
                                   end ;
                                   if( Parse_Environment( Err, Context ) ) then
                                   begin
                                       exit ;
                                   end ;
                                   if( Missing_Parentheses( ')' ) ) then
                                   begin
                                       exit ;
                                   end ;
                                   S := Context ;
                               end ;
We add handling for this lexical function in Function_Reference. The Parse_Environment function provides a kind of hodge-podge of information about the environment that UCL is running in. It pulls data from symbol tables, process info, and internal UCL values.

function Parse_Environment( var Err : integer ; var Context : string ) : boolean ;

var Flags, Index, P, Start : int64 ;
    S, S1 : string ;

begin
    Result := False ;
    S1 := Get_Parameter( Err, Context ) ;
    if( Err <> 0 ) then
    begin
        Result := True ; // Assume error
        exit ;
    end ;
    S := lowercase( trim( S1 ) ) ;
The Parse_Environment function starts by getting the parameter and converting it to lowercase.

    if( S = 'captive' ) then
    begin
        Flags := Get_UAF( UAI_FLAGS, Err ) ;
        if( ( Flags and UAI_V_CAPTIVE ) <> 0 ) then
        begin
            Context := 'TRUE' ;
        end else
        begin
            Context := 'FALSE' ;
        end ;
    end else
    if( S = 'control' ) then
    begin
        Context := '' ;//TODO
    end else
    if( S = 'default' ) then
    begin
        Context := LIB_Get_Symbol( 'sys$disk:' ) + GETDDIR ;
    end else
    if( S = 'depth' ) then
    begin
        Context := '0' ;//TODO
    end else
    if( S = 'disimage' ) then
    begin
        Flags := Get_UAF( UAI_FLAGS, Err ) ;
        if( ( Flags and UAI_V_DISIMAGE ) <> 0 ) then
        begin
            Context := 'TRUE' ;
        end else
        begin
            Context := 'FALSE' ;
        end ;
    end else
    if( S = 'interactive' ) then
    begin
        if( Interactive ) then
        begin
            Context := 'TRUE' ;
        end else
        begin
            Context := 'FALSE' ;
        end ;
    end else
    if( S = 'keystate' ) then
    begin
        Context := 'DEFAULT' ;//TODO
    end else
    if( S = 'max_depth' ) then
    begin
        Context := '14' ;//TODO
    end else
    if( S = 'message' ) then
    begin
        Context := Message_Switches ;
    end else
    if( S = 'nocontrol' ) then
    begin
        Context := '' ;//TODO
    end else
    if( S = 'on_control_y' ) then
    begin
        if( Interactive ) then
        begin
            Context := 'FALSE' ;
        end else
        begin
            Context := 'INTERACTIVE' ;
        end ;
    end else
    if( S = 'on_severity' ) then
    begin
        if( Interactive ) then
        begin
            Context := 'NONE' ;
        end else
        begin
            Context := 'NONE' ;//TODO
        end ;
    end else
    if( S = 'output_rate' ) then
    begin
        if( Interactive ) then
        begin
            Context := '' ;
        end else
        begin
            Context := '+0:0:0:0.1' ;//TODO
        end ;
    end else
    if( S = 'procedure' ) then
    begin
        Context := Get_Symbol_Value( '', 'sys$command' ) ;
    end else
    if( S = 'prompt' ) then
    begin
        S := LIB_Get_Symbol( '$ucl_prompt' ) ;
        if( S = '' ) then
        begin
            S := '$ ' ;
        end ;
        Context := S ;
    end else
    if( S = 'prompt_control' ) then
    begin
        Context := 'TRUE' ; //TODO
    end else
    if( S = 'protection' ) then
    begin
        P := Get_JPI( JPI_RMS_FILEPROT ) ;
        Context := Protection_To_Text( P ) ;
    end else
    if( S = 'restricted' ) then
    begin
        Flags := Get_UAF( UAI_FLAGS, Err ) ;
        if( ( Flags and UAI_V_RESTRICTED ) <> 0 ) then
        begin
            Context := 'TRUE' ;
        end else
        begin
            Context := 'FALSE' ;
        end ;
    end else
    if( S = 'symbol_scope' ) then
    begin
        if( No_Local_Symbols ) then
        begin
            Context := 'NOLOCAL' ;
        end else
        begin
            Context := 'LOCAL' ;
        end ;
        if( No_Global_Symbols ) then
        begin
            Context := Context + ',' + 'NOGLOBAL' ;
        end else
        begin
            Context := Context + ',' + 'GLOBAL' ;
        end ;
    end else
    if( S = 'verb_scope' ) then
    begin
        if( No_Local_Verbs ) then
        begin
            Context := 'NOLOCAL' ;
        end else
        begin
            Context := 'LOCAL' ;
        end ;
        if( No_Global_Verbs ) then
        begin
            Context := Context + ',' + 'NOGLOBAL' ;
        end else
        begin
            Context := Context + ',' + 'GLOBAL' ;
        end ;
    end else
    if( S = 'verify_image' ) then
    begin
        Context := 'FALSE' ;//TODO
    end else
    if( S = 'verify_prefix' ) then
    begin
        Context := '' ;//TODO
    end else
    if( S = 'verify_procedure' ) then
    begin
        Context := 'FALSE' ;//TODO
    end else
    begin
        Result := True ; // Assume error
        Err := UCL_IVKEYW ;
        Context := S1 ;
        exit ;
    end ;
end ; // Parse_Environment
Next we check the parameter value against the various valid keywords for F$ENVIRONMENT. There is no need to go over each in detail. But I do want to point out the //TODO comments at the end of some of the lines. These relate to features of UCL that we haven't addressed yet, so they are placeholders that we will update in the future. Many of these cases have to do with differences between VMS and UOS. Some of them may simply be left as they are if there is no straight-forward way to convert into VMS-compatible values. But I don't want to bog down this article by getting into those cases right now.

function Get_JPI( Index : int64 ) : int64 ;

var PP_SYS_Descriptor : array[ 0..1 ] of TSYS_Descriptor ;
    Buff, BufLen : int64 ;
    PP : TPID ;

begin
    Buff := 0 ;
    BufLen := 0 ;
    fillchar( PP_SYS_Descriptor, sizeof( PP_SYS_Descriptor ), 0 ) ;
    PP_SYS_Descriptor[ 0 ].MBO := $FFFF ;
    PP_SYS_Descriptor[ 0 ].MBMO := -1 ;
    PP_SYS_Descriptor[ 0 ].Buffer_Length := sizeof( Buff ) ;
    PP_SYS_Descriptor[ 0 ].Item_Code := Index ;
    PP_SYS_Descriptor[ 0 ].Buffer_Address := integer( @Buff ) ;
    PP_SYS_Descriptor[ 0 ].Return_Length_Address := integer( @BufLen ) ;
    PP := 0 ;
    GETJPIW( 0, int64( @PP ), '', integer( @PP_SYS_Descriptor ), integer( @IOSB ), 0, 0 ) ;
    Result := Buff ;
end ;
This function provides a simplified interface to the SYS_GETJPIW system call. It returns an integer value for a given job/process information index.

function Get_UAF( Index : int64 ; Err : integer ) : int64 ;

var Descriptors : array[ 0..1 ] of TDVI_Descriptor ;
    Length : int64 ;

begin
    fillchar( Descriptors, sizeof( Descriptors ), 0 ) ;
    Descriptors[ 0 ].Item_Code := Index ;
    Descriptors[ 0 ].Buffer_Length := sizeof( Result ) ;
    Descriptors[ 0 ].Buffer_Address := int64( @Result ) ;
    Descriptors[ 0 ].Return_Length_Address := int64( @Length ) ;
    Result := 0 ;
    Length := 0 ;
    Err := GETUAI( 0, '', int64( @Descriptors ) ) ;
end ;
Like Get_JPI, this is a simplified interface to a system call - SYS_GETUAI in this case.

function Get_Symbol_Value( const Table, Nam : string ) : string ;

var BufLen, BufLen1, BufLen2, size : int64 ;

begin
    setlength( Result, 255 ) ;
    BufLen := 0 ;
    Buflen1 := 0 ;
    Buflen2 := 0 ;
    Size := 0 ;
    fillchar( SYS_Descriptor, sizeof( SYS_Descriptor ), 0 ) ;
    SYS_Descriptor[ 0 ].MBO := $FFFF ;
    SYS_Descriptor[ 0 ].MBMO := -1 ;
    SYS_Descriptor[ 0 ].Buffer_Length := sizeof( Buff ) ;
    SYS_Descriptor[ 0 ].Item_Code := LNM_ATTRIBUTES ;
    SYS_Descriptor[ 0 ].Buffer_Address := integer( @Buff ) ;
    SYS_Descriptor[ 0 ].Return_Length_Address := integer( @BufLen ) ;
    SYS_Descriptor[ 1 ].MBO := $FFFF ;
    SYS_Descriptor[ 1 ].MBMO := -1 ;
    SYS_Descriptor[ 1 ].Buffer_Length := length( Result ) ;
    SYS_Descriptor[ 1 ].Item_Code := LNM_STRING ;
    SYS_Descriptor[ 1 ].Buffer_Address := int64( PAnsiChar( Result ) ) ;
    SYS_Descriptor[ 1 ].Return_Length_Address := integer( @BufLen1 ) ;
    SYS_Descriptor[ 2 ].MBO := $FFFF ;
    SYS_Descriptor[ 2 ].MBMO := -1 ;
    SYS_Descriptor[ 2 ].Buffer_Length := sizeof( Size ) ;
    SYS_Descriptor[ 2 ].Item_Code := LNM_LENGTH ;
    SYS_Descriptor[ 2 ].Buffer_Address := int64( @Size ) ;
    SYS_Descriptor[ 2 ].Return_Length_Address := integer( @BufLen2 ) ;
    TRNLNM( LNM_M_CASE_BLIND, Table, Nam, 0, int64( @SYS_Descriptor ) ) ;
    if( Size > 255 ) then // Buffer wasn't large enough to contain symbol value
    begin
        setlength( Result, Size ) ;
        fillchar( SYS_Descriptor, sizeof( SYS_Descriptor ), 0 ) ;
        SYS_Descriptor[ 0 ].MBO := $FFFF ;
        SYS_Descriptor[ 0 ].MBMO := -1 ;
        SYS_Descriptor[ 0 ].Buffer_Length := length( Result ) ;
        SYS_Descriptor[ 0 ].Item_Code := LNM_STRING ;
        SYS_Descriptor[ 0 ].Buffer_Address := int64( PAnsiChar( Result ) ) ;
        SYS_Descriptor[ 0 ].Return_Length_Address := integer( @BufLen1 ) ;
        TRNLNM( LNM_M_CASE_BLIND, Table, Nam, 0, int64( @SYS_Descriptor ) ) ;
    end ;
    if( ( Buff and LNM_M_EXISTS ) <> 0 ) then // Found it
    begin
        setlength( Result, BufLen1 ) ;
        exit ;
    end ;
end ; // Get_Symbol_Value


function Symbol_Value( const Nam : string ) : string ; //TODO:Include in article

var N : string ;

begin
    N := '$' + inttostr( PID ) ;
    Result := Get_Symbol_Value( N, Nam ) ;
end ;
Symbol_Value was used by code we've covered in previous articles, but we didn't include this function until now. It simply wraps Get_Symbol_Value, which obtains the value of a symbol, passing the process table name. If a table name is passed to Get_Symbol_Value, the symbol is looked up in that table. If table is null, all tables are checked starting with the current process symbol table on up to the cluster table, until the symbol is found (or not). We set a 255-byte buffer to receive the symbol contents. Along with the symbol value, we request the symbol length. If the actual length exceeds 255, we resize the buffer appropriately and call TRNLNM again to get the full value. The hope is that the second call won't be needed most of the time. The idea here is to reduce the number of calls to ring 0. If the symbol fits in the 255-byte buffer, we've saved a call. Otherwise, we'd have to make a call to get the length, then another call to get the data, meaning that we'd have two calls every single time.

                    JPI_RMS_FILEPROT: // RMS File Protection
                         begin
                             if( Len > sizeof( Value ) ) then
                             begin
                                 Len := sizeof( Value ) ;
                             end ;
                             Process := Get_Process( Target_PID ) ;
                             if( Process = nil ) then // Process doesn't exist
                             begin
                                 Generate_Exception( UOSErr_Nonexistent_Process ) ;
                                 exit ;
                             end ;
                             Value := Process.Protection ;
                             Write_User( Kernel, PID, Descriptor.Buffer_Address, Len, Value ) ;
                             Write_User( Kernel, PID, Descriptor.Return_Length_Address, sizeof( Len ), 
                                 Len ) ;
                         end ;
This code is added to the USC.Get_Job_Process_Info method to handle obtaining the current default file protection code for the process.

    Protection := PROTECTION_SYSTEM_READ or PROTECTION_SYSTEM_WRITE or
        PROTECTION_SYSTEM_EXECUTE or PROTECTION_SYSTEM_DELETE or
        PROTECTION_OWNER_READ or PROTECTION_OWNER_WRITE or
        PROTECTION_OWNER_EXECUTE or PROTECTION_OWNER_DELETE or
        PROTECTION_GROUP_READ or PROTECTION_GROUP_EXECUTE ;
And this code is added to the end of the TProcess constructor to set up the default file protection mask for all processes.

In the next article, we'll look at the SYS_GETUAI system call.

 

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