 |
OpenVMS RTL Library (LIB$) Manual
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
|
LIB$TRAVERSE_TREE
The Traverse a Balanced Binary Tree routine calls an action routine for
each node in a binary tree.
Note
No support for arguments passed by 64-bit address reference or for use
of 64-bit descriptors, if applicable, is planned for this routine.
|
Format
LIB$TRAVERSE_TREE treehead ,user-action-procedure [,user-data-address]
RETURNS
OpenVMS usage: |
cond_value |
type: |
longword (unsigned) |
access: |
write only |
mechanism: |
by value |
Arguments
treehead
OpenVMS usage: |
address |
type: |
address |
access: |
read only |
mechanism: |
by reference |
Tree head of the binary tree. The treehead argument is
the address of an unsigned longword that is the tree head in the binary
tree traversal.
user-action-procedure
OpenVMS usage: |
procedure |
type: |
procedure value |
access: |
function call (before return) |
mechanism: |
by value |
User-supplied action routine called by LIB$TRAVERSE_TREE for each node
in the tree. The user-action-procedure argument must
return a success status for LIB$TRAVERSE_TREE to continue traversal.
For more information, see Call Format for an Action Routine in the Description section.
user-data-address
OpenVMS usage: |
user_arg |
type: |
longword (unsigned) |
access: |
read only |
mechanism: |
by reference |
User data that LIB$TRAVERSE_TREE passes to your action routine. The
user-data-address argument contains the address of
this user data. This is an optional argument; the default value is 0.
Description
LIB$TRAVERSE_TREE calls a user-supplied action routine for each node to
traverse a balanced binary tree.
Call Format for an Action Routine
The format of the call is as follows:
user-action-procedure node ,user-data-address
|
LIB$TRAVERSE_TREE passes the node and
user-data-address arguments to your action routine by
reference.
This action routine is defined by you to fit your own purposes. A
common use of an action routine here is to print the contents of each
node during the tree traversal.
The following is one example of a user-supplied action routine.
struct Full_node
{
void* left_link;
void* right_link;
short reserved;
char Text[80];
};
static long Print_Node(struct Full_node* Node, void* dummy)
{
/*
** Print the string contained in the current node
*/
printf("%s\n", Node->Text);
return LIB$_NORMAL;
}
|
Condition Values Returned
LIB$_NORMAL
|
Routine successfully completed.
|
Any condition value returned by your action routine.
Example
The C example provided in the description of LIB$INSERT_TREE also
demonstrates the use of LIB$TRAVERSE_TREE. Refer to that example for
assistance in using this routine.
LIB$TRAVERSE_TREE_64 (Alpha Only)
The Traverse a Balanced Binary Tree routine calls an action routine for
each node in a binary tree.
Format
LIB$TRAVERSE_TREE_64 treehead ,user-action-procedure
[,user-data-address]
RETURNS
OpenVMS usage: |
cond_value |
type: |
longword (unsigned) |
access: |
write only |
mechanism: |
by value |
Arguments
treehead
OpenVMS usage: |
address |
type: |
address |
access: |
read only |
mechanism: |
by reference |
Tree head of the binary tree. The treehead argument is
the address of an unsigned quadword that is the tree head in the binary
tree traversal.
user-action-procedure
OpenVMS usage: |
procedure |
type: |
procedure value |
access: |
function call (before return) |
mechanism: |
by value |
User-supplied action routine called by LIB$TRAVERSE_TREE_64 for each
node in the tree. The user-action-procedure argument
must return a success status for LIB$TRAVERSE_TREE_64 to continue
traversal.
For more information, see Call Format for an Action Routine in the Description section.
user-data-address
OpenVMS usage: |
user_arg |
type: |
quadword (unsigned) |
access: |
read only |
mechanism: |
by reference |
User data that LIB$TRAVERSE_TREE_64 passes to your action routine. The
user-data-address argument contains the address of
this user data. This is an optional argument; the default value is 0.
Description
LIB$TRAVERSE_TREE_64 calls a user-supplied action routine for each node
to traverse a balanced binary tree.
Call Format for an Action Routine
The format of the call is as follows:
user-action-procedure node ,user-data-address
|
LIB$TRAVERSE_TREE_64 passes the node and
user-data-address arguments to your action routine by
reference.
This action routine is defined by you to fit your own purposes. A
common use of an action routine here is to print the contents of each
node during the tree traversal.
The following is one example of a user-supplied action routine.
struct Full_node
{
void* left_link;
void* right_link;
short reserved;
char Text[80];
};
static long Print_Node(struct Full_node* Node, void* dummy)
{
/*
** Print the string contained in the current node
*/
printf("%s\n", Node->Text);
return LIB$_NORMAL;
}
|
Condition Values Returned
LIB$_NORMAL
|
Routine successfully completed.
|
Any condition value returned by your action routine.
Example
The C example provided in the description of LIB$INSERT_TREE_64 also
demonstrates the use of LIB$TRAVERSE_TREE_64. Refer to that example for
assistance in using this routine.
LIB$TRA_ASC_EBC
The Translate ASCII to EBCDIC routine translates an ASCII string to an
EBCDIC string.
Format
LIB$TRA_ASC_EBC source-string ,byte-integer-dest-string
RETURNS
OpenVMS usage: |
cond_value |
type: |
longword (unsigned) |
access: |
write only |
mechanism: |
by value |
Arguments
source-string
OpenVMS usage: |
char_string |
type: |
character string |
access: |
read only |
mechanism: |
by descriptor |
Source string (ASCII) to be translated by LIB$TRA_ASC_EBC. The
source-string argument contains the address of a
descriptor pointing to this source string.
byte-integer-dest-string
OpenVMS usage: |
char_string |
type: |
character string |
access: |
write only |
mechanism: |
by descriptor |
Destination string (EBCDIC). The
byte-integer-dest-string argument contains the address
of a descriptor pointing to this destination string.
Description
LIB$TRA_ASC_EBC translates an ASCII string to an EBCDIC string. If the
destination string is a fixed-length string, its length must match the
length of the input string. The length of both the source and
destination strings is limited to 65,535 characters. No filling is done.
A similar operation can be accomplished by specifying the ASCII to
EBCDIC translation table, LIB$AB_ASC_EBC, in a routine using LIB$MOVTC,
but no testing for untranslatable characters is done under those
circumstances.
The LIB$TRA_ASC_EBC routine uses the ASCII to EBCDIC translation table.
ASCII to EBCDIC Translation Table
- The numbers on the left represent the low-order bits of the ASCII
characters in hexadecimal notation.
- The numbers across the top represent the high-order bits of the
ASCII characters in hexadecimal notation.
- The numbers in the body of the table represent the equivalent
EBCDIC characters in hexadecimal notation.
Figure lib-24 is the ASCII to EBCDIC translation table.
Figure lib-24 LIB$AB_ASC_EBC
All ASCII graphics are translated to their equivalent EBCDIC graphics
except for the graphics noted in Figure lib-25.
Figure lib-25 ASCII Graphics Not Translated to EBCDIC
Equivalent by LIB$TRA_ASC_EBC
Condition Values Returned
SS$_NORMAL
|
Routine successfully completed.
|
LIB$_INVARG
|
If the destination string is a fixed-length string and its length is
not the same as the source string length, or if the length of the input
string is greater than 65,535 characters, no translation is attempted.
|
LIB$_INVCHA
|
One or more occurrences of an untranslatable character have been
detected during the translation.
|
Example
This COBOL program uses LIB$TRA_ASC_EBC to translate an ASCII string to
EBCDIC. If successful, it then uses LIB$MOVTC to translate the EBCDIC
string back to ASCII.
|
IDENTIFICATION DIVISION.
PROGRAM-ID. TRANS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 INPUT-STRING PIC X(4).
01 EBCDIC-STRING PIC X(4).
01 OUT-STRING PIC X(4).
01 FILL-CHAR PIC X VALUE "@".
01 SS-STATUS PIC S9(9) COMP.
88 SS-NORMAL VALUE 01.
01 EBCDIC-TABLE.
05 FILLER PIC X(16) VALUE "@@@@@@@@@@@@@@@@".
05 FILLER PIC X(16) VALUE "@@@@@@@@@@@@@@@@".
05 FILLER PIC X(16) VALUE "@@@@@@@@@@@@@@@@".
05 FILLER PIC X(16) VALUE "@@@@@@@@@@@@@@@@".
05 FILLER PIC X(16) VALUE " @@@@@@@@@@.<(+|".
05 FILLER PIC X(16) VALUE "&@@@@@@@@@!$*);@".
05 FILLER PIC X(16) VALUE "-/@@@@@@@@@,%_>?".
05 FILLER PIC X(16) VALUE "@@@@@@@@@@:#@'=""".
05 FILLER PIC X(16) VALUE "@abcdefghi@@@@@@".
05 FILLER PIC X(16) VALUE "@jklmnopqr@@@@@@".
05 FILLER PIC X(16) VALUE "@@stuvwxyz@@@@@@".
05 FILLER PIC X(16) VALUE "@@@@@@@@@@@@@@@@".
05 FILLER PIC X(16) VALUE "@ABCDEFGHI@@@@@@".
05 FILLER PIC X(16) VALUE "!JKLMNOPQR@@@@@@".
05 FILLER PIC X(16) VALUE "@@STUVWXYZ@@@@@@".
05 FILLER PIC X(16) VALUE "0123456789@@@@@@".
ROUTINE DIVISION.
001-MAIN.
DISPLAY " ".
DISPLAY "ENTER 4 CHARACTERS TO BE TRANSLATED ASCII TO EBCDIC: "
WITH NO ADVANCING.
ACCEPT INPUT-STRING
AT END STOP RUN.
IF INPUT-STRING = "EXIT" OR "exit" OR " "
STOP RUN.
CALL "LIB$TRA_ASC_EBC"
USING BY DESCRIPTOR INPUT-STRING, EBCDIC-STRING
GIVING SS-STATUS.
IF SS-NORMAL
CALL "LIB$MOVTC"
USING BY DESCRIPTOR EBCDIC-STRING,
FILL-CHAR,
EBCDIC-TABLE,
OUT-STRING,
GIVING SS-STATUS
IF SS-NORMAL
DISPLAY "ASCII ENTERED WAS: " INPUT-STRING
DISPLAY "EBCDIC TRANSLATED IS: " OUT-STRING
ELSE
DISPLAY "*** LIB$MOVTC TRANSLATION UNSUCCESSFUL ***"
ELSE
DISPLAY "*** LIB$TRA_ASC_EBC TRANSLATION UNSUCCESSFUL ***".
GO TO 001-MAIN.
|
To exit from this program, you must press Ctrl/Z. The output generated
by this COBOL program is as follows:
$ RUN TRANS
ENTER 4 CHARACTERS TO BE TRANSLATED ASCII TO EBCDIC: abdc
ASCII ENTERED WAS: abdc
EBCDIC TRANSLATED IS: abdc
ENTER 4 CHARACTERS TO BE TRANSLATED ASCII TO EBCDIC: ~=b&
ASCII ENTERED WAS: ~=b&
EBCDIC TRANSLATED IS: @=b&
ENTER 4 CHARACTERS TO BE TRANSLATED ASCII TO EBCDIC: 8^%$
ASCII ENTERED WAS: 8^%$
EBCDIC TRANSLATED IS: 8@%$
ENTER 4 CHARACTERS TO BE TRANSLATED ASCII TO EBCDIC:
/x\}
ASCII ENTERED WAS: /x\}
EBCDIC TRANSLATED IS: /x@!
ENTER 4 CHARACTERS TO BE TRANSLATED ASCII TO EBCDIC: [Ctrl/Z]
|
|