COBOL-Programm

Das COBOL-Programm HELLO sei in der Datei Hello.cob folgendermaßen implementiert:

       >>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 ">> Bitte Name eingeben" 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.