Your Browser is not longer supported

Please use Google Chrome, Mozilla Firefox or Microsoft Edge to view the page correctly
Loading...

{{viewport.spaceProperty.prod}}

COBOL program

The COBOL program HELLO is implemented in the Hello.cob file as follows:

>>SOURCE FREE
>>IMP LISTING-OPTIONS MERGE-DIAGNOSTICS
ID DIVISION.
PROGRAM-ID. HELLO.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
ARGUMENT-NUMBER IS ARGNUM
ARGUMENT-VALUE IS ARGVAL
TERMINAL IS T.
DATA DIVISION.
WORKING-STORAGE SECTION.
*> Types and constants
COPY JCI-TYPEDEFS.
01 JCIConstants.
COPY JCI-CONST.
*> Constant strings
01 optCP.
05 PIC S9(9) COMP-5 VALUE 80.
05 PIC X(80) VALUE '-Djava.class.path=.:/myhome/jcitest'.
01 OptEnc.
05 PIC S9(9) COMP-5 VALUE 40.
05 PIC X(40) VALUE '-Dfile.encoding=OSD_EBCDIC_DF04_15'.
01 className.
05 PIC S9(9) COMP-5 VALUE 30.
05 PIC X(30) VALUE 'Hello'.
01 methodName.
05 PIC S9(9) COMP-5 VALUE 30.
05 PIC X(30) VALUE 'hello'.
01 methodSig.
05 PIC S9(9) COMP-5 VALUE 80.
05 PIC X(80) VALUE '(Ljava/lang/String;)V'.
LOCAL-STORAGE SECTION.
*> JCI structures
01 JVMOptions.
COPY JCI-VMOPT REPLACING == <max-options> == BY 2.
01 MethodArgs.
COPY JCI-METHODARGS REPLACING == <max-arguments> == BY 4.
01 MethodRes.
COPY JCI-METHODRES.
*> String structures
01 myName.
05 len PIC S9(9) COMP-5 VALUE 30.
05 txt PIC X(30).
*> Objects and handles
01 classObj TYPE JCI-object.
01 methodId TYPE JCI-handle.
*> Error handling
01 ErrIdent    PIC X(10) VALUE SPACE.
01 RetcodeSave PIC S9(9) COMP-5 VALUE 0.
01 errorInf.
05 len PIC S9(9) COMP-5 VALUE 300.
05 txt PIC X(300).
PROCEDURE DIVISION.
>>CALL-CONVENTION ILCS-SET-RETURN-CODE
*>
*> get name from terminal
*>
DISPLAY ">> Please enter name" UPON T
ACCEPT txt IN myName FROM T
*>
*> Prepare VM options
*>
MOVE 2 TO VMOptnum.
SET IGNORE-UNRECOGNIZED TO FALSE.
SET VMOptVstring(1) TO ADDRESS OF optCP
SET VMOptVstring(2) TO ADDRESS OF optEnc
*>
*> Create the Java VM
*>
CALL 'JCI_CreateJavaVM' USING JVMOptions
IF RETURN-CODE NOT = JCI-RET-OK
MOVE 'CreateVM' TO ErrIdent
GO TO ERROR-EXIT
END-IF.
*>
*> Get class Hello
*>
CALL 'JCI_FindClass' USING className classObj
IF RETURN-CODE NOT = JCI-RET-OK
MOVE 'FindClass' TO ErrIdent
GO TO ERROR-EXIT
END-IF.
*>
*> Get method hello
*>
CALL 'JCI_GetStaticMethodID' USING classObj methodName
methodSig methodId
IF RETURN-CODE NOT = JCI-RET-OK
MOVE 'GetMethod' TO ErrIdent
GO TO ERROR-EXIT
END-IF.
*>
*> Call Java method
*>
MOVE 1 TO CallArgNum
SET RES-VOID TO TRUE
SET ARG-ANUM-STRING(1) IGNORE-TRAILING-SPACES(1) TO TRUE
SET ArgValAddr(1) TO ADDRESS OF myName
CALL 'JCI_CallStaticMethod' USING classObj methodId MethodArgs MethodRes
IF RETURN-CODE NOT = JCI-RET-OK
MOVE 'CallMeth' TO ErrIdent
GO TO ERROR-EXIT
END-IF.
*>
*> Destroy Java VM
*>
CALL 'JCI_DestroyJavaVM' 
IF RETURN-CODE NOT = JCI-RET-OK
MOVE 'DestroyVM' TO ErrIdent
GO TO ERROR-EXIT
END-IF.
GOBACK.
*>
*> Error exit
*>
ERROR-EXIT.
MOVE RETURN-CODE TO RetcodeSave
CALL 'JCI_GetErrorInformation' USING errorInf
IF len IN errorInf > 0
DISPLAY 'Message from ' ErrIdent ': "' txt IN errorInf(1:len IN errorInf) '"' 
UPON T
END-IF
CALL 'JCI_ExceptionCheck'
IF RETURN-CODE = JCI-RET-TRUE
CALL 'JCI_ExceptionDescribe'
CALL 'JCI_ExceptionClear'
END-IF
CALL 'JCI_DestroyJavaVM' 
MOVE RetcodeSave  TO RETURN-CODE
GOBACK.
END PROGRAM HELLO.