 |
HP OpenVMS RTL Library (LIB$) Manual
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 ) );
}
|
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
|
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
|
Example 3
The following MACRO assembly language program accepts and parses the
command line of a CREATE/DIRECTORY command using LIB$TPARSE. It also
defines the state table for the parser.
|
.TITLE CREATE_DIR - Create Directory File
.IDENT "X0000"
;+
;
; This is a sample OpenVMS MACRO program that accepts and parses the command
; line of the CREATE/DIRECTORY command. This program contains the OpenVMS
; call to acquire the command line from the command interpreter
; and parse it with LIB$TPARSE, leaving the necessary information in
; its global data base. 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
;+
; Define parser flag bits for flags longword
;-
UIC_FLAG = 1 ; /UIC seen
ENTRIES_FLAG = 2 ; /ENTRIES seen
PROT_FLAG = 4 ; /PROTECTION seen
;+
; LIB$GET_FOREIGN string descriptors to get the line to be parsed
;-
STRING_LEN = 256
STRING_DESC:
.WORD STRING_LEN
.BYTE DSC$K_DTYPE_T
.BYTE DSC$K_CLASS_S
.ADDRESS STRING_AREA
STRING_AREA:
.BLKB STRING_LEN
PROMPT_DESC:
.WORD PROMPT_LEN
.BYTE DSC$K_DTYPE_T
.BYTE DSC$K_CLASS_S
.ADDRESS PROMPT
PROMPT:
.ASCII /qualifiers: /
PROMPT_LEN = .-PROMPT
;+
; TPARSE argument block
;-
TPARSE_BLOCK:
.LONG TPA$K_COUNT0 ; Longword count
.LONG TPA$M_ABBREV!- ; Allow abbreviation
TPA$M_BLANKS ; Process spaces explicitly
.BLKB TPA$K_LENGTH0-8 ; Remainder set at run time
;+
; Parser global data
;-
RET_LEN: .BLKW 1 ; LENGTH OF RETURNED COMMAND LINE
PARSER_FLAGS: .BLKL 1 ; Keyword flags
DEVICE_STRING: .BLKL 2 ; Device string descriptor
ENTRY_COUNT: .BLKL 1 ; Space to preallocate
FILE_PROTECT: .BLKL 1 ; Directory file protection
UIC_GROUP: .BLKL 1 ; Temp for UIC group
UIC_MEMBER: .BLKL 1 ; Temp for UIC member
UIC_STRING: .BLKB 6 ; String to receive converted UIC
FILE_OWNER: .BLKL 1 ; Actual file owner UIC
NAME_COUNT: .BLKL 1 ; Number of directory names
DIRNAME1: .BLKL 2 ; Name descriptor 1
DIRNAME2: .BLKL 2 ; Name descriptor 2
DIRNAME3: .BLKL 2 ; Name descriptor 3
DIRNAME4: .BLKL 2 ; Name descriptor 4
DIRNAME5: .BLKL 2 ; Name descriptor 5
DIRNAME6: .BLKL 2 ; Name descriptor 6
DIRNAME7: .BLKL 2 ; Name descriptor 7
DIRNAME8: .BLKL 2 ; Name descriptor 8
.SBTTL Main Program
;+
; This program gets the CREATE/DIRECTORY command line from
; the command interpreter and parses it.
;-
.PSECT CODE,EXE,NOWRT
CREATE_DIR::
.WORD ^M<R2,R3,R4,R5> ; Save registers
;+
; Call the command interpreter to obtain the command line.
;-
PUSHAW RET_LEN
PUSHAQ PROMPT_DESC
PUSHAQ STRING_DESC
CALLS #3,G^LIB$GET_FOREIGN ; Call to get command line
BLBC R0, SYNTAX_ERR
;+
; Copy the input string descriptor into the TPARSE control block
; and call LIB$TPARSE. Note that impure storage is assumed to be zero.
;-
MOVZWL RET_LEN, TPARSE_BLOCK+TPA$L_STRINGCNT
MOVAL STRING_AREA, TPARSE_BLOCK+TPA$L_STRINGPTR
PUSHAL UFD_KEY
PUSHAL UFD_STATE
PUSHAL TPARSE_BLOCK
CALLS #3,G^LIB$TPARSE
BLBC R0,SYNTAX_ERR
;+
; Parsing is complete.
;
; You can include here code to process the string just parsed, to call
; another program to process the command, or to return control to
; a calling program, if any.
;-
SYNTAX_ERR:
;+
; Code to handle parsing errors.
;-
RET
.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
.SBTTL Parser Action Routines
.PSECT CODE,EXE,NOWRT
;+
; Shut off explicit blank processing after passing the command name.
;-
BLANKS_OFF:
.WORD 0 ; No registers saved (or used)
BBCC #TPA$V_BLANKS,TPA$L_OPTIONS(AP),10$
10$: RET
;+
; Check the UIC for legal value range.
;-
CHECK_UIC:
.WORD 0 ; No registers saved (or used)
TSTW UIC_GROUP+2 ; UIC components are 16 bits
BNEQ 10$
TSTW UIC_MEMBER+2
BNEQ 10$
MOVW UIC_GROUP,FILE_OWNER+2 ; Store actual UIC
MOVW UIC_MEMBER,FILE_OWNER ; after checking
RET
10$: CLRL R0 ; Value out of range - fail
RET ; the transition
;+
; Store a directory name component.
;-
STORE_NAME:
.WORD 0 ; No registers saved (or used)
MOVL NAME_COUNT,R1 ; Get count of names so far
CMPL R1,#8 ; Maximum of 8 permitted
BGEQU 10$
INCL NAME_COUNT ; Count this name
MOVAQ DIRNAME1[R1],R1 ; Address of next descriptor
MOVQ TPA$L_TOKENCNT(AP),(R1) ; Store the descriptor
CMPL (R1),#9 ; Check the length of the name
BGTRU 10$ ; Maximum is 9
RET
10$: CLRL R0 ; Error in directory name
RET
;+
; Convert a UIC into its equivalent directory file name.
;-
MAKE_UIC:
.WORD 0 ; No registers saved (or used)
TSTB UIC_GROUP+1 ; Check UIC for byte values,
BNEQ 10$ ; because UIC type directories
TSTB UIC_MEMBER+1 ; are restricted to this form
BNEQ 10$
MOVL #6,DIRNAME1 ; Directory name is 6 bytes
MOVAL UIC_STRING,DIRNAME1+4 ; Point to string buffer
$FAOL CTRSTR=FAO_STRING,- ; Convert UIC to octal string
OUTBUF=DIRNAME1,-
PRMLST=UIC_GROUP
RET
10$: CLRL R0 ; Range error - fail it
RET
FAO_STRING: .LONG STRING_END-STRING_START
STRING_START: .ASCII '!OB!OB'
STRING_END:
.END CREATE_DIR
|
|
