Library View Topics Framed Contents Revised Topics Previous Topic Next Topic Search Search ResultsPrevious Topic MatchNext Topic Match Notes List Notes Print Download No PDF Handheld DisconnectedHandheld ConnectedHelp

X 6.2.4.4 BY VALUE Phrase




X The BY VALUE phrase applies to all arguments that follow until overridden
X by another BY REFERENCE or BY CONTENT phrase.


X If the BY VALUE phrase is specified or implied for an argument, the value
X of the argument is passed, not a reference to the sending data item. The
X called program can modify the formal parameter corresponding to the BY
X VALUE argument, but any such changes do not affect the argument since the
X called program has access to a temporary copy of the sending data item.


X While BY VALUE arguments are primarily intended for communication with
X non-COBOL programs (such as C), they can also be used for COBOL-to-COBOL
X invocations. In this case, BY VALUE must be specified or implied for both
X the argument in the CALL USING phrase and the corresponding formal
X parameter in the Procedure Division USING phrase.


X identifier-4

X Must be an elementary data item in the Data Division. It must be one
X of the following:

  • X Binary (USAGE BINARY, COMP, COMP-4, or COMP-5)
  • X Floating point (USAGE COMP-1 or COMP-2)
  • X Pointer (USAGE POINTER)
  • X Procedure-pointer (USAGE PROCEDURE-POINTER)
  • X Object reference (USAGE OBJECT REFERENCE)
  • X Single-byte alphanumeric (such as PIC X or PIC A)
    
    

X The following can also be passed BY VALUE:

  • X Reference modified item with length one
  • X SHIFT-IN and SHIFT-OUT special registers
  • X LINAGE-COUNTER special register when it is usage binary
    
    

X ADDRESS OF Special Register

X An ADDRESS OF special register passed BY VALUE is treated as a
X pointer. For information on the ADDRESS OF special register, see
X "ADDRESS OF" in topic 1.1.3.1.


X LENGTH OF Special Register

X A LENGTH OF special register passed BY VALUE is treated as a PIC 9(9)
X binary. For information on the LENGTH OF special register, see
X "LENGTH OF" in topic 1.1.3.3.


X literal-3

X Must be one of the following:

  • X Numeric literal
  • X ZERO
  • X 1-character nonnumeric literal
  • X Symbolic character
  • X Single byte figurative constant
    • X SPACE
    • X QUOTE
    • X HIGH-VALUE
    • X LOW-VALUE
      
      

X ZERO is treated as a numeric value; a fullword binary zero is passed.


X If literal-3 is a fixed point numeric literal, it must have a
X precision of 9 or less digits. In this case, a fullword binary
X representation of the literal value is passed.


X If literal-3 is a floating point numeric literal, an 8-byte internal
X floating point (COMP-2) representation of the value is passed.


X Literal-3 must not be a DBCS literal.


Previous Topic Next Topic © Copyright IBM Corp. 1991, 1998

IBM Library Server Copyright 1989, 2005 IBM Corporation. All rights reserved.





Return to library:   z/OS | z/OS.e | TPF | z/VSE | z/VM | IBM Hardware | IBM System z Redbooks
Glossary:   IBM terminology
Publications:   How to order publications
Readers:   Download IBM Library Reader | Download IBM Softcopy Reader | Download Adobe® Acrobat® Reader®
Library management:   Download IBM Softcopy Librarian
Contacts:   Contact z/OS


Adobe, the Adobe logo, Acrobat, the Acrobat logo, and Acrobat Reader are registered trademarks of Adobe Systems incorporated.