OpenVMS RTL Library (LIB$) Manual

Updated: 11 December 1998

OpenVMS RTL Library (LIB$) Manual

Contents

Index

4 Data Representation
This section describes the binary representation and allocation of a LIB$T[ABLE_]PARSE state table and a keyword table. While this information is not required to use LIB$T[ABLE_]PARSE, it may be useful in debugging your program.

4.1 State Table Representation
Each state consists of its transitions concatenated in memory. LIB$T[ABLE_]PARSE equates the state label to the address of the first byte of the first transition. A marker in the last transition identifies the end of the state. The LIB$T[ABLE_]PARSE table macros build the state table in the PSECT _LIB$STATE$.

Each transition in a state consists of 2 to 23 bytes containing the arguments of the transition. The state table generation macros do not allocate storage for arguments not specified in the transition macro. This allows simple transitions to be represented efficiently. For example, the following transition, which simply accepts the character "?" and falls through to the next state, is represented in two bytes:

$TRAN '?'

In this section, pointers described as self-relative are signed displacements from the address following the end of the pointer (this is identical to branch displacements in the OpenVMS VAX instruction set).

Table lib-12 describes the elements of a state transition in the order in which they appear, if present, in the transition. If a transition does not include a specific option, no bytes are assigned to the option within the transition.

Table lib-12 Binary Representation of a LIB$T [ABLE_]PARSE State Transition
Transition Element No. of Bytes Description

Symbol type 1 The first byte of a transition always contains the binary coding of the symbol type accepted by this transition. Flag bit 0 in the flags byte controls the interpretation of the type byte. If the flag is clear, the type byte represents a single character (the ' x' construct). If the flag bit is set, the type byte is one of the other type codes (keyword, number, and so on). The following table lists the symbol types accepted by LIB$T[ABLE_]PARSE:

Symbol Type Binary Encoding

' x' ASCII code of the character (8 bits)

' keyword' The keyword index (0 to 219)

TPA$_DECIMAL_64 (Alpha only) 228

TPA$_OCTAL_64 (Alpha only) 229

TPA$_HEX_64 (Alpha only) 230

TPA$_NODE_ACS 231

TPA$_NODE_PRIMARY 232

TPA$_NODE 233

TPA$_FILESPEC 234

TPA$_UIC 235

TPA$_IDENT 236

TPA$_ANY 237

TPA$_ALPHA 238

TPA$_DIGIT 239

TPA$_STRING 240

TPA$_SYMBOL 241

TPA$_BLANK 242

TPA$_DECIMAL 243

TPA$_OCTAL 244

TPA$_HEX 245

TPA$_LAMBDA 246

TPA$_EOS 247

TPA$_SUBEXPR 248 (subexpression call)

(Other codes are reserved for expansion)

Use of the TPA$_FILESPEC, TPA$_NODE, TPA$_NODE_PRIMARY, or TPA$_NODE_ACS symbol type results in calls to the $FILESCAN system service. Use of the symbol type TPA$_IDENT results in calls to the $ASCTOID system service. If your application of LIB$T[ABLE_]PARSE runs in an environment other than OpenVMS user mode, you must carefully evaluate whether use of these services is consistent with your environment.

First flags byte 1 This byte contains the following bits, which specify the options of the transition. It is always present.

Bit Description

0 Set if the type byte is not a single character.

1 Set if the second flags byte is present.

2 Set if this is the last transition in the state.

3 Set if a subexpression pointer is present.

4 Set if an explicit target state is present.

5 Set if the mask longword is present.

6 Set if the msk-adr longword is present.

7 Set if an action routine address is present.

Second flags byte 1 This byte is present if any of its flag bits is set. It contains an additional flag describing the transition. It is used as follows:

Bit Description

0 Set if the action routine argument is present.

Subexpression pointer 2 This word is present in transitions that are subexpression calls. It is a 16-bit signed self-relative pointer to the starting state of the subexpression.

Argument longword 4 This longword field contains the 32-bit action routine argument, when specified.

Action routine address 4 This longword contains a self-relative pointer to the action routine, when specified.

Bit mask 4 This longword contains the mask argument, when specified.

Mask address 4 This longword, when specified, contains a self-relative pointer through which the mask, or data that depends on the symbol type, is to be stored. Because the pointer is self-relative, when it points to an absolute location, the state table is not PIC (position-independent code).

Transition target 2 This word, when specified, contains the address of the target state of the transition. The address is stored as a 16-bit signed self-relative pointer. The final state TPA$_EXIT is coded as a word whose value is --1; the failure state TPA$_FAIL is coded as a word whose value is --2.

4.2 Keyword Table Representation
The keyword table is a vector of 16-bit signed pointers that address locations in the keyword string area, relative to the start of the keyword vector. It is the structure to which the $INIT_STATE macro equates its second argument.

The LIB$T[ABLE_]PARSE macros assign an index number to each keyword. The index number is stored in the symbol type byte in the transition; it locates the associated keyword vector entry. The keyword strings are stored in the order encountered in the state table. Each keyword string is terminated by a byte containing the value --1. Between the keywords of adjacent states is an additional --1 byte to stop the ambiguous keyword scan.

To ensure that the keyword vector is adjacent to the keyword string area, the keyword vector is located in PSECT _LIB$KEY0$ and the keyword strings and stored in PSECT _LIB$KEY1$.

Your program should not use any of the three PSECTs used by LIB$T[ABLE_]PARSE (_LIB$STATE$, _LIB$KEY0$, and _LIB$KEY1$). The PSECTs _LIB$KEY0$ and _LIB$KEY1$ refer to each other using 16-bit displacements, so user PSECTs inserted between them can cause truncation errors from the linker.

Condition Values Returned

SS$_NORMAL Routine successfully completed. LIB$T[ABLE_]PARSE has executed a transition to TPA$_EXIT at main level, not within a subexpression.

LIB$_SYNTAXERR Parse completed with syntax error. LIB$T[ABLE_]PARSE has encountered a state at main level in which none of the transitions match the input string, or in which a transition to TPA$_FAIL was executed.

LIB$_INVTYPE State table error. LIB$T[ABLE_]PARSE has encountered an invalid entry in the state table.

Other If an action routine returns a failure status other than zero, and the parse consequently fails, LIB$T[ABLE_]PARSE returns the status returned by the action routine.

Examples

Example 1a
The following DEC C program accepts and parses the command line of a CREATE/DIRECTORY command using LIB$TABLE_PARSE. It uses the state table defined in Example 1b.


/* 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 ) ); }

/* 
** 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 ) ); 
 
}

Example 1b
The following MACRO assembly language program module defines the state tables for the preceding sample program.


.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

   .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

Example 2
The following OpenVMS BLISS program accepts and parses the command line of a CREATE/DIRECTORY command using LIB$TPARSE.


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

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

Previous Next Contents Index

Copyright © Compaq Computer Corporation 1998. All rights reserved.
Legal

5932PRO_047.HTML

SS$_NORMAL	Routine successfully completed. LIB$T[ABLE_]PARSE has executed a transition to TPA$_EXIT at main level, not within a subexpression.
LIB$_SYNTAXERR	Parse completed with syntax error. LIB$T[ABLE_]PARSE has encountered a state at main level in which none of the transitions match the input string, or in which a transition to TPA$_FAIL was executed.
LIB$_INVTYPE	State table error. LIB$T[ABLE_]PARSE has encountered an invalid entry in the state table.
Other	If an action routine returns a failure status other than zero, and the parse consequently fails, LIB$T[ABLE_]PARSE returns the status returned by the action routine.