Document revision date: 19 July 1999
[Compaq] [Go to the documentation home page] [How to order documentation] [Help on this site] [How to contact us]
[OpenVMS documentation]

OpenVMS RTL Library (LIB$) Manual


Previous Contents Index

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

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]


Previous Next Contents Index

  [Go to the documentation home page] [How to order documentation] [Help on this site] [How to contact us]  
  privacy and legal statement  
5932PRO_048.HTML