HP OpenVMS Systems Documentation

/*
** This DEC C program accepts and parses the command line of a CREATE/DIRECTORY
** command.  This program uses the LIB$GET_FOREIGN call to acquire the command
** line from the CLI and parse it with LIB$TABLE_PARSE, leaving the necessary
** information in its global data base.  The command line is of
** the following format:
**
**      CREATE/DIR DEVICE:[MARANTZ.ACCOUNT.OLD]
**                 /OWNER_UIC=[2437,25]
**                 /ENTRIES=100
**                 /PROTECTION=(SYSTEM:R,OWNER:RWED,GROUP:R,WORLD:R)
**
** The three qualifiers are optional.  Alternatively, the command
** may take the form:
**
**       CREATE/DIR DEVICE:[202,31]
**
** using any of the optional qualifiers.
**
** The source for this program can be found in:
**
**       SYS$EXAMPLES:LIB$TABLE_PARSE_DEMO.COM
**
*/

/*
** Specify the required header files
*/

# include <tpadef.h>
# include <descrip.h>
# include <starlet.h>
# include <lib$routines.h>

/*
** Specify macro definitions
*/

# define max_name_count 8
# define max_token_size 9
# define uic_string_size 6
# define command_buffer_size 256


/*
** Specify persistent data that's local to this module
*/

static
  union
    uic_union {
      __int32 bits;
      struct {
        char first;
        char second;
        } bytes;
      struct {
        __int16 first;
        __int16 second;
        } words;
      }
      file_owner;                             /* Actual file owner UIC */

static
  int
    name_count;                               /* Number of directory names */

static
  char
    uic_string[ uic_string_size + 1 ];        /* Buffer for string */

static
  struct
    dsc$descriptor_s
      name_vector[ max_name_count ];          /* Vector of descriptors */

/*
** Specify persistent data that's global to this module.
** This data is referenced externally by the state table definitions.
*/

union
  uic_union
    uic_group,                                /* Tempt for UIC group */
    uic_member;                               /* Tempt for UIC member */


int
  parser_flags,                               /* Keyword flags */
  entry_count,                                /* Space to preallocate */
  file_protect;                               /* Directory file protection */

struct
  dsc$descriptor_s
    device_string =                           /* Device string descriptor */
      { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, (char *) 0 };

/*
** Specify the user action routines.
**
** Please note that if it were LIB$TPARSE being called, the user action
** routines would have to be coded as follows:
**
**       int user_action_routine( __int32 psuedo_ap )
**         {
**         struct tpadef
**           *tparse_block = (tpadef *) (&psuedo_ap - 1);
**         printf( "Parameter value: %d\n",
**                 tparse_block->tpa$l_param
**                 );
**         }
*/

/*
** Shut off explicit blank processing after passing the command name.
*/

int blanks_off( struct tpadef *tparse_block ) {
  tparse_block->tpa$v_blanks = 0;
  return( 1 );
  }

/*
** Check the UIC for legal value range.
*/

int check_uic( struct tpadef *tparse_block ) {
  if ( (uic_group.words.second != 0) ||
       (uic_member.words.second != 0)
       )
    return( 0 );


  file_owner.words.first = uic_member.words.first;
  file_owner.words.second = uic_group.words.first;

  return( 1 );
  }

/*
** Store a directory name component.
*/

int store_name( struct tpadef *tparse_block ) {
  if ( (name_count >= max_name_count) ||
       (tparse_block->tpa$l_tokencnt > max_token_size)
       )
    return( 0 );

  name_vector[ name_count ].dsc$w_length = tparse_block->tpa$l_tokencnt;
  name_vector[ name_count ].dsc$b_dtype = DSC$K_DTYPE_T;
  name_vector[ name_count ].dsc$b_class = DSC$K_CLASS_S;
  name_vector[ name_count++ ].dsc$a_pointer = tparse_block->tpa$l_tokenptr;

  return( 1 );
  }

/*
** Convert a UIC into its equivalent directory file name.
*/

int make_uic( struct tpadef *tparse_block ) {

  $DESCRIPTOR( control_string, "!OB!OB" );
  $DESCRIPTOR( dirname, uic_string );

  if ( (uic_group.bytes.second != '\0') ||
       (uic_member.bytes.second != '\0')
       )
    return( 0 );

  sys$fao( &control_string,
           &dirname.dsc$w_length,
           &dirname,
           uic_group.bytes.first,
           uic_member.bytes.first
           );


  return( 1 );
  }

/*
** The main program section starts here.
*/

main( ) {

/*
** This program creates a directory. It gets the command
** line from the CLI and parses it with LIB$TABLE_PARSE.
*/

extern
  char
    ufd_state,
    ufd_key;

char
  command_buffer[ command_buffer_size + 1 ];

int
  status;

$DESCRIPTOR( prompt, "Command> " );
$DESCRIPTOR( command_descriptor, command_buffer );

struct
  tpadef
    tparse_block = { TPA$K_COUNT0,            /* Longword count */
                     TPA$M_ABBREV             /* Allow abbreviation */
                          |
                     TPA$M_BLANKS             /* Process spaces explicitly */
                     };

status = lib$get_foreign( &command_descriptor,
                          &prompt,
                          &command_descriptor.dsc$w_length
                          );

if ( (status & 1) == 0 )
  return( status );


/*
** Copy the input string descriptor into the control block
** and then call LIB$TABLE_PARSE. Note that impure storage is assumed
** to be zero.
*/

tparse_block.tpa$l_stringcnt = command_descriptor.dsc$w_length;
tparse_block.tpa$l_stringptr = command_descriptor.dsc$a_pointer;

return( status = lib$table_parse( &tparse_block, &ufd_state, &ufd_key ) );

}
      

   .TITLE        CREATE_DIR_TABLES - Create Directory File (tables)
        .IDENT        "X-1"

;+
;
; This module defines the state tables for the preceding
; sample program, which accepts and parses the command line of the
; CREATE/DIRECTORY command. The command line has the following format:
;
;        CREATE/DIR DEVICE:[MARANTZ.ACCOUNT.OLD]
;                /OWNER_UIC=[2437,25]
;                /ENTRIES=100
;                /PROTECTION=(SYSTEM:R,OWNER:RWED,GROUP:R,WORLD:R)
;
; The three qualifiers are optional. Alternatively, the command
; may take the form
;
;        CREATE/DIR DEVICE:[202,31]
;
; using any of the optional qualifiers.
;
;-

;+
;
; Global data, control blocks, etc.
;
;-
         .PSECT  IMPURE,WRT,NOEXE
;+
; Define control block offsets
;-

        $CLIDEF
        $TPADEF

         .EXTRN BLANKS_OFF, -            ; No explicit blank processing
                CHECK_UIC, -             ; Validate and assemble UIC
                STORE_NAME, -            ; Store next directory name
                MAKE_UIC                 ; Make UIC into directory name


;+
; Define parser flag bits for flags longword
;-

UIC_FLAG            = 1        ; /UIC seen
ENTRIES_FLAG        = 2        ; /ENTRIES seen
PROT_FLAG           = 4        ; /PROTECTION seen

        .SBTTL        Parser State Table

;+
; Assign values for protection flags to be used when parsing protection
; string.
;-

SYSTEM_READ_FLAG = ^X0001
SYSTEM_WRITE_FLAG = ^X0002
SYSTEM_EXECUTE_FLAG = ^X0004
SYSTEM_DELETE_FLAG = ^X0008
OWNER_READ_FLAG = ^X0010
OWNER_WRITE_FLAG = ^X0020
OWNER_EXECUTE_FLAG = ^X0040
OWNER_DELETE_FLAG = ^X0080
GROUP_READ_FLAG = ^X0100
GROUP_WRITE_FLAG = ^X0200
GROUP_EXECUTE_FLAG = ^X0400
GROUP_DELETE_FLAG = ^X0800
WORLD_READ_FLAG = ^X1000
WORLD_WRITE_FLAG = ^X2000
WORLD_EXECUTE_FLAG = ^X4000
WORLD_DELETE_FLAG = ^X8000

$INIT_STATE     UFD_STATE,UFD_KEY

;+
; Read over the command name (to the first blank in the command).
;-

        $STATE       START
        $TRAN        TPA$_BLANK,,BLANKS_OFF
        $TRAN        TPA$_ANY,START


;+
; Read device name string and trailing colon.
;-

        $STATE
        $TRAN        TPA$_SYMBOL,,,,DEVICE_STRING

        $STATE
        $TRAN        ':'
;+
; Read directory string, which is either a UIC string or a general
; directory string.
;-

        $STATE
        $TRAN        !UIC,,MAKE_UIC
        $TRAN        !NAME

;+
; Scan for options until end of line is reached
;-

        $STATE        OPTIONS
        $TRAN        '/'
        $TRAN        TPA$_EOS,TPA$_EXIT

        $STATE
        $TRAN        'OWNER_UIC',PARSE_UIC,,UIC_FLAG,PARSER_FLAGS
        $TRAN        'ENTRIES',PARSE_ENTRIES,,ENTRIES_FLAG,PARSER_FLAGS
        $TRAN        'PROTECTION',PARSE_PROT,,PROT_FLAG,PARSER_FLAGS

;+
; Get file owner UIC.
;-

        $STATE        PARSE_UIC
        $TRAN        ':'
        $TRAN        '='

        $STATE
        $TRAN        !UIC,OPTIONS


;+
; Get number of directory entries.
;-

        $STATE        PARSE_ENTRIES
        $TRAN        ':'
        $TRAN        '='

        $STATE
        $TRAN        TPA$_DECIMAL,OPTIONS,,,ENTRY_COUNT

;+
; Get directory file protection. Note that the bit masks generate the
; protection in complement form. It will be uncomplemented by the main
; program.
;-

        $STATE        PARSE_PROT
        $TRAN        ':'
        $TRAN        '='

        $STATE
        $TRAN        '('

        $STATE        NEXT_PRO
        $TRAN        'SYSTEM', SYPR
        $TRAN        'OWNER',  OWPR
        $TRAN        'GROUP',  GRPR
        $TRAN        'WORLD',  WOPR

        $STATE        SYPR
        $TRAN        ':'
        $TRAN        '='

        $STATE        SYPRO
        $TRAN        'R',SYPRO,,SYSTEM_READ_FLAG,FILE_PROTECT
        $TRAN        'W',SYPRO,,SYSTEM_WRITE_FLAG,FILE_PROTECT
        $TRAN        'E',SYPRO,,SYSTEM_EXECUTE_FLAG,FILE_PROTECT
        $TRAN        'D',SYPRO,,SYSTEM_DELETE_FLAG,FILE_PROTECT
        $TRAN        TPA$_LAMBDA,ENDPRO

        $STATE        OWPR
        $TRAN        ':'
        $TRAN        '='


        $STATE        OWPRO
        $TRAN        'R',OWPRO,,OWNER_READ_FLAG,FILE_PROTECT
        $TRAN        'W',OWPRO,,OWNER_WRITE_FLAG,FILE_PROTECT
        $TRAN        'E',OWPRO,,OWNER_EXECUTE_FLAG,FILE_PROTECT
        $TRAN        'D',OWPRO,,OWNER_DELETE_FLAG,FILE_PROTECT
        $TRAN        TPA$_LAMBDA,ENDPRO

        $STATE        GRPR
        $TRAN        ':'
        $TRAN        '='

        $STATE        GRPRO
        $TRAN        'R',GRPRO,,GROUP_READ_FLAG,FILE_PROTECT
        $TRAN        'W',GRPRO,,GROUP_WRITE_FLAG,FILE_PROTECT
        $TRAN        'E',GRPRO,,GROUP_EXECUTE_FLAG,FILE_PROTECT
        $TRAN        'D',GRPRO,,GROUP_DELETE_FLAG,FILE_PROTECT
        $TRAN        TPA$_LAMBDA,ENDPRO

        $STATE        WOPR
        $TRAN        ':'
        $TRAN        '='

        $STATE        WOPRO
        $TRAN        'R',WOPRO,,WORLD_READ_FLAG,FILE_PROTECT
        $TRAN        'W',WOPRO,,WORLD_WRITE_FLAG,FILE_PROTECT
        $TRAN        'E',WOPRO,,WORLD_EXECUTE_FLAG,FILE_PROTECT
        $TRAN        'D',WOPRO,,WORLD_DELETE_FLAG,FILE_PROTECT
        $TRAN        TPA$_LAMBDA,ENDPRO

        $STATE        ENDPRO
        $TRAN        <','>,NEXT_PRO
        $TRAN        ')',OPTIONS

;+
; Subexpression to parse a UIC string.
;-

        $STATE        UIC
        $TRAN        '['

        $STATE
        $TRAN        TPA$_OCTAL,,,,UIC_GROUP


        $STATE
        $TRAN        <','>        ; The comma character must be
                                  ;   surrounded by angle brackets
                                  ;   because MACRO restricts the use
                                  ;   of commas in arguments to macros.

        $STATE
        $TRAN        TPA$_OCTAL,,,,UIC_MEMBER

        $STATE
        $TRAN        ']',TPA$_EXIT,CHECK_UIC

;+
; Subexpression to parse a general directory string
;-

        $STATE        NAME
        $TRAN        '['

        $STATE        NAMEO
        $TRAN        TPA$_STRING,,STORE_NAME

        $STATE
        $TRAN        '.',NAMEO
        $TRAN        ']',TPA$_EXIT
        $END_STATE

 .END
      

MODULE CREATE_DIR (                        ! Create directory file
                IDENT = 'X0000',
                MAIN = CREATE_DIR) =
BEGIN

 !+
 ! This OpenVMS BLISS program accepts and parses the command line
 ! of a CREATE/DIRECTORY command.  This program uses the
 ! LIB$GET_FOREIGN call to acquire the command line from
 ! the CLI and parse it with LIB$TPARSE, leaving the necessary
 ! information in its global data base.  The command line is of
 ! the following format:
 !
 !      CREATE/DIR DEVICE:[MARANTZ.ACCOUNT.OLD]
 !                 /UIC=[2437,25]
 !                 /ENTRIES=100
 !                 /PROTECTION=(SYSTEM:R,OWNER:RWED,GROUP:R,WORLD:R)
 !
 ! The three qualifiers are optional.  Alternatively, the command
 ! may take the form
 !
 !       CREATE/DIR DEVICE:[202,31]
 !
 ! using any of the optional qualifiers.
 !-

 !+
 ! Global data, control blocks, etc.
 !-

LIBRARY 'SYS$LIBRARY:STARLET';
LIBRARY 'SYS$LIBRARY:TPAMAC.L32';

 !+
 ! Macro to make the LIB$TPARSE control block addressable as a block
 ! through the argument pointer.
 !-

MACRO
        TPARSE_ARGS =
                BUILTIN AP;
                MAP AP : REF BLOCK [,BYTE];
                %;
 !+
 ! Declare routines in this module.
 !-

FORWARD ROUTINE
        CREATE_DIR,                      ! Mail program
        BLANKS_OFF,                      ! No explicit blank processing
        CHECK_UIC,                       ! Validate and assemble UIC
        STORE_NAME,                      ! Store next directory name
        MAKE_UIC;                        ! Make UIC into directory name

 !+
 ! Define parser flag bits for flags longword.
 !-

LITERAL
        UIC_FLAG        = 0,                 ! /UIC seen
        ENTRIES_FLAG    = 1,                 ! /ENTRIES seen
        PROT_FLAG       = 2;                 ! /PROTECTION seen
OWN
 !+
 ! This is the LIB$GET_FOREIGN descriptor block to get the command line.
 !-

        COMMAND_DESC        : BLOCK [DSC$K_S_BLN, BYTE],
        COMMAND_BUFF        : VECTOR [256, BYTE],

 !+
 ! This is the LIB$TPARSE argument block.
 !-

        TPARSE_BLOCK        : BLOCK [TPA$K_LENGTH0, BYTE]
                INITIAL (TPA$K_COUNT0,     ! Longword count
                        TPA$M_ABBREV       ! Allow abbreviation
                        OR TPA$M_BLANKS),  ! Process spaces explicitly

 !+
 ! Parser global data:
 !-

        PARSER_FLAGS   : BITVECTOR [32], ! Keyword flags
        DEVICE_STRING  : VECTOR [2],     ! Device string descriptor
        ENTRY_COUNT,                     ! Space to preallocate
        FILE_PROTECT,                    ! Directory file protection
        UIC_GROUP,                       ! Temp for UIC group
        UIC_MEMBER,                      ! Temp for UIC member
        FILE_OWNER,                      ! Actual file owner UIC
        NAME_COUNT,                      ! Number of directory names
        UIC_STRING     : VECTOR [6, BYTE],   ! Buffer for string

        NAME_VECTOR    : BLOCKVECTOR [0, 2], ! Vector of descriptors

        DIRNAME1        : VECTOR [2],         ! Name descriptor 1
        DIRNAME2        : VECTOR [2],         ! Name descriptor 2
        DIRNAME3        : VECTOR [2],         ! Name descriptor 3
        DIRNAME4        : VECTOR [2],         ! Name descriptor 4
        DIRNAME5        : VECTOR [2],         ! Name descriptor 5
        DIRNAME6        : VECTOR [2],         ! Name descriptor 6
        DIRNAME7        : VECTOR [2],         ! Name descriptor 7
        DIRNAME8        : VECTOR [2];         ! Name descriptor 8

 !+
 ! Structure macro to reference the descriptor fields in the vector of
 ! descriptors.
 !-

MACRO
        STRING_COUNT       = 0, 0, 32, 0%,         ! Count field
        STRING_ADDR        = 1, 0, 32, 0%;         ! Address field

 !+
 ! LIB$TPARSE state table to parse the command line
 !-

$INIT_STATE        (UFD_STATE, UFD_KEY);

 !+
 ! Read over the command name (to the first blank in the command).
 !-

$STATE  (START,
        (TPA$_BLANK, , BLANKS_OFF),
        (TPA$_ANY, START)
        );
 !+
 ! Read device name string and trailing colon.
 !-

$STATE  (,
        (TPA$_SYMBOL,,,, DEVICE_STRING)
        );

$STATE  (,
        (':')
        );


 !+
 ! Read directory string, which is either a UIC string or a general
 ! directory string.
 !-

$STATE  (,
        ((UIC),, MAKE_UIC),
        ((NAME))
        );

 !+
 ! Scan for options until end of line is reached.
 !-

$STATE  (OPTIONS,
        ('/'),
        (TPA$_EOS, TPA$_EXIT)
        );

$STATE  (,
        ('UIC', PARSE_UIC,, 1^UIC_FLAG, PARSER_FLAGS),
        ('ENTRIES', PARSE_ENTRIES,, 1^ENTRIES_FLAG, PARSER_FLAGS),
        ('PROTECTION', PARSE_PROT,, 1^PROT_FLAG, PARSER_FLAGS)
        );

 !+
 ! Get file owner UIC.
 !-

$STATE  (PARSE_UIC,
        (':'),
        ('=')
        );

$STATE  (,
        ((UIC), OPTIONS)
        );
 !+
 ! Get number of directory entries.
 !-

$STATE  (PARSE_ENTRIES,
        (':'),
        ('=')

        );

$STATE  (,
        (TPA$_DECIMAL, OPTIONS,,, ENTRY_COUNT)
        );

 !+
 ! Get directory file protection. Note that the bit masks generate the
 ! protection in complement form. It will be uncomplemented by the main
 ! program.
 !-

$STATE  (PARSE_PROT,
        (':'),
        ('=')
        );

$STATE  (,
        ('(')
        );

$STATE  (NEXT_PRO,
        ('SYSTEM', SYPR),
        ('OWNER',  OWPR),
        ('GROUP',  GRPR),
        ('WORLD',  WOPR)
        );

$STATE  (SYPR,
        (':'),
        ('=')
        );

$STATE  (SYPR0,
        ('R', SYPR0,, %X'0001', FILE_PROTECT),
        ('W', SYPR0,, %X'0002', FILE_PROTECT),
        ('E', SYPR0,, %X'0004', FILE_PROTECT),
        ('D', SYPR0,, %X'0008', FILE_PROTECT),
        (TPA$_LAMBDA, ENDPRO)
        );

$STATE  (OWPR,
        (':'),
        ('=')
        );


$STATE  (OWPR0,
        ('R', OWPR0,, %X'0010', FILE_PROTECT),
        ('W', OWPR0,, %X'0020', FILE_PROTECT),
        ('E', OWPR0,, %X'0040', FILE_PROTECT),
        ('D', OWPR0,, %X'0080', FILE_PROTECT),
        (TPA$_LAMBDA, ENDPRO)
        );

$STATE  (GRPR,
        (':'),
        ('=')
        );

$STATE  (GRPR0,
        ('R', GRPR0,, %X'0100', FILE_PROTECT),
        ('W', GRPR0,, %X'0200', FILE_PROTECT),
        ('E', GRPR0,, %X'0400', FILE_PROTECT),
        ('D', GRPR0,, %X'0800', FILE_PROTECT),
        (TPA$_LAMBDA, ENDPRO)
        );

$STATE  (WOPR,
        (':'),
        ('=')
        );

$STATE  (WOPR0,
        ('R', WOPR0,, %X'1000', FILE_PROTECT),
        ('W', WOPR0,, %X'2000', FILE_PROTECT),
        ('E', WOPR0,, %X'4000', FILE_PROTECT),
        ('D', WOPR0,, %X'8000', FILE_PROTECT),
        (TPA$_LAMBDA, ENDPRO)
        );

$STATE  (ENDPRO,
        (', ', NEXT_PRO),
        (')', OPTIONS)
        );

 !+
 ! Subexpression to parse a UIC string.
 !-

$STATE  (UIC,

        ('[')
        );

$STATE  (,
        (TPA$_OCTAL,,,, UIC_GROUP)
        );

$STATE  (,
        (', ')
        );

$STATE  (,
        (TPA$_OCTAL,,,, UIC_MEMBER)
        );

$STATE  (,
        (']', TPA$_EXIT, CHECK_UIC)
        );

 !+
 ! Subexpression to parse a general directory string
 !-

$STATE  (NAME,
        ('[')
        );

$STATE  (NAME0,
        (TPA$_STRING,, STORE_NAME)
        );

$STATE  (,
        ('.', NAME0),
        (']', TPA$_EXIT)
        );
PSECT OWN = $OWN$;
PSECT GLOBAL = $GLOBAL$;


GLOBAL ROUTINE CREATE_DIR (START_ADDR, CLI_CALLBACK) =

BEGIN

 !+
 ! This program creates a directory. It gets the command

 ! line from the CLI and parses it with LIB$TPARSE.
 !-

LOCAL
        STATUS,                 ! Status from LIB$TPARSE
        OUT_LEN  : WORD;        ! length of returned command line
EXTERNAL
        SS$_NORMAL;

EXTERNAL ROUTINE
        LIB$GET_FOREIGN   : ADDRESSING_MODE (GENERAL),
        LIB$TPARSE        : ADDRESSING_MODE (GENERAL);

                COMMAND_DESC [DSC$W_LENGTH]  = 256;
                COMMAND_DESC [DSC$B_DTYPE]   = DSC$K_DTYPE_T;
                COMMAND_DESC [DSC$B_CLASS]   = DSC$K_CLASS_S;
                COMMAND_DESC [DSC$A_POINTER] = COMMAND_BUFF;


        STATUS = LIB$GET_FOREIGN (COMMAND_DESC,
                                %ASCID'COMMAND: ',
                                OUT_LEN
                                );
        IF NOT .STATUS
                THEN
                SIGNAL (STATUS);


 !+
 ! Copy the input string descriptor into the LIB$TPARSE control block
 ! and call LIB$TPARSE. Note that impure storage is assumed to be zero.
 !-


TPARSE_BLOCK[TPA$L_STRINGCNT] = .OUT_LEN;
TPARSE_BLOCK[TPA$L_STRINGPTR] = .COMMAND_DESC[DSC$A_POINTER];

STATUS = LIB$TPARSE (TPARSE_BLOCK, UFD_STATE, UFD_KEY);
IF NOT .STATUS
THEN
        RETURN 0;
RETURN SS$_NORMAL
END;                                         ! End of routine CREATE_DIR

 !+

 ! Parser action routines
 !-

 !+
 ! Shut off explicit blank processing after passing the command name.
 !-

ROUTINE BLANKS_OFF =
    BEGIN
    TPARSE_ARGS;

    AP[TPA$V_BLANKS] = 0;
    1
    END;

 !+
 ! Check the UIC for legal value range.
 !-

ROUTINE CHECK_UIC =
    BEGIN
    TPARSE_ARGS;

    IF .UIC_GROUP<16,16> NEQ 0
    OR .UIC_MEMBER<16,16> NEQ 0
    THEN RETURN 0;

    FILE_OWNER<0,16> = .UIC_MEMBER;
    FILE_OWNER<16,16> = .UIC_GROUP;
    1
    END;

 !+
 ! Store a directory name component.
 !-

ROUTINE STORE_NAME =
    BEGIN
    TPARSE_ARGS;

    IF .NAME_COUNT GEQU 8
    OR .AP[TPA$L_TOKENCNT] GTRU 9
    THEN RETURN 0;
    NAME_COUNT = .NAME_COUNT + 1;
    NAME_VECTOR [.NAME_COUNT, STRING_COUNT] = .AP[TPA$L_TOKENCNT];

    NAME_VECTOR [.NAME_COUNT, STRING_ADDR] = .AP[TPA$L_TOKENPTR];
    1
    END;

 !+
 ! Convert a UIC into its equivalent directory file name.
 !-

ROUTINE MAKE_UIC =
    BEGIN
    TPARSE_ARGS;

    IF .UIC_GROUP<8,8> NEQ 0
    OR .UIC_MEMBER<8,8> NEQ 0
    THEN RETURN 0;
    DIRNAME1[0] = 0;
    DIRNAME1[1] = UIC_STRING;
    $FAOL (CTRSTR = UPLIT (6, UPLIT BYTE ('!OB!OB')),
           OUTBUF = DIRNAME1,
           PRMLST = UIC_GROUP
           );
    1
    END;
END
ELUDOM                               ! End of module CREATE_DIR