6.3.2 非応答型呼び出しをするサーバアプリケーションの例(COBOL)

非応答型呼び出しをするサーバアプリケーションの処理の流れとコードの例を示します。斜体で示しているコードは,雛形クラスとして自動生成される部分です。太字で示しているコードは,同期型呼び出しのコードと異なる部分です。

サーバアプリケーションの作成時には,ユーザは,自動生成された雛形クラスCBLClass_TSCimplにTSCユーザオブジェクトのコードを記述します。また,雛形クラスCBLClass_TSCfactにTSCユーザオブジェクトファクトリのコードを記述します。

なお,非応答型呼び出しをするサーバアプリケーションの例外処理は,同期型呼び出しの場合と同様です。「6.2.3 例外処理のコードの例(COBOL)」を参照してください。

<この項の構成>
(1) TSCユーザオブジェクト(CBLClass_TSCimpl)とTSCユーザオブジェクトファクトリ(CBLClass_TSCfact)のコード
(2) サービス登録処理の流れ
(3) サービス登録処理のコード

(1) TSCユーザオブジェクト(CBLClass_TSCimpl)とTSCユーザオブジェクトファクトリ(CBLClass_TSCfact)のコード

     *****************************************************
     * Operation 'callOnly'
     *****************************************************
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'callOnly'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      01 CORBA-ENVIRONMENT.
       02 MAJOR                   PIC 9(9) COMP.
        88 CORBA-NO-EXCEPTION         VALUE 0.
        88 CORBA-USER-EXCEPTION       VALUE 1.
        88 CORBA-SYSTEM-EXCEPTION     VALUE 2.
       02 EXCEP                   USAGE POINTER.
       02 FUNC-NAME               PIC X(256).

      LINKAGE SECTION.
      01 in_data PIC S9(9) COMP.

     * Do not change signature of this sub-program.
      PROCEDURE DIVISION
          USING
              BY VALUE in_data.

     * Write user own code.
     * ユーザメソッドのコードを記述します。
      DISPLAY 'callOnly method in CBLClass'.

      END PROGRAM 'callOnly'.

     *****************************************************
     * Constructor of 'CBLClass_TSCimpl'
     *****************************************************
     * Constructor of OTM Object Implement.
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'CBLClass_TSCimpl-NEW'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      LINKAGE SECTION.
      01 SKELETON-POINTER USAGE POINTER.
     * You can change signature of this sub-program.
      PROCEDURE DIVISION
          RETURNING SKELETON-POINTER.

     * Write user own code, if necessary.
     * 必要に応じてユーザ独自のコードを追加できます。
     * コンストラクタの引数の数および型を変更することもできます。

     * This sub-program must return a pointer
     * that 'CBLClass_TSCsk-NEW' sub-program returns.
          CALL 'CBLClass_TSCsk-NEW'
              RETURNING SKELETON-POINTER.
      END PROGRAM 'CBLClass_TSCimpl-NEW'.

     *****************************************************
     * Destructor of 'CBLClass_TSCimpl'
     *****************************************************
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'CBLClass_TSCimpl-DEL'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      LINKAGE SECTION.
      01 SKELETON-POINTER USAGE POINTER.
     * You can change signature of this sub-program.
      PROCEDURE DIVISION USING
              BY VALUE SKELETON-POINTER.

     * Write user own code, if necessary.
     * 必要に応じてユーザ独自のコードを追加できます。

     * This sub-program must call
     * 'CBLClass_TSCsk-DEL' sub-program.
          CALL 'CBLClass_TSCsk-DEL' USING
              BY VALUE SKELETON-POINTER.
      END PROGRAM 'CBLClass_TSCimpl-DEL'.

     *****************************************************
     * Constructor of CBLClass_TSCfact
     *****************************************************
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'CBLClass_TSCfact-NEW'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      LINKAGE SECTION.
      01 FACTORY-POINTER USAGE POINTER.
     * You can change signature of this sub-program.
      PROCEDURE DIVISION
          RETURNING FACTORY-POINTER.

     * Write user own code, if necessary.
     * 必要に応じてユーザ独自のコードを追加できます。
     * 引数の数および型を変更することもできます。

     * This sub-program must return a pointer that
     * 'CBLClass_TSCfact-get' sub-program returns.
          CALL 'CBLClass_TSCfact-get'
              RETURNING FACTORY-POINTER.
      END PROGRAM 'CBLClass_TSCfact-NEW'.


     *****************************************************
     * Destructor of CBLClass_TSCfact
     *****************************************************
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'CBLClass_TSCfact-DEL'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      LINKAGE SECTION.
      01 FACTORY-POINTER USAGE POINTER.
      PROCEDURE DIVISION USING
              BY VALUE FACTORY-POINTER.

     * Write user own code, if necessary.
     * 必要に応じてユーザ独自のコードを追加できます。
     * This sub-program must call
     * 'CBLClass_TSCfact-rls'.sub-program.
          CALL 'CBLClass_TSCfact-rls' USING
              BY VALUE FACTORY-POINTER.
      END PROGRAM 'CBLClass_TSCfact-DEL'.


     *****************************************************
     * 'create' method of CBLClass_TSCfact
     *****************************************************
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'CBLClass_TSCfact-crt'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      LINKAGE SECTION.
      01 FACTORY-POINTER USAGE POINTER.
      01 OBJECT-POINTER USAGE POINTER.
     * Do not change signature of this sub-program.
      PROCEDURE DIVISION USING
              BY VALUE FACTORY-POINTER
          RETURNING OBJECT-POINTER.

    * Write user own code, if necessary.
     * サーバオブジェクトを生成するコードを記述します。
     * 必要に応じて変更してください。

     * This sub-program must return pointer that
     * 'CBLClass_TSCimpl-NEW' returns.
          CALL 'CBLClass_TSCimpl-NEW'
              RETURNING OBJECT-POINTER.
      END PROGRAM 'CBLClass_TSCfact-crt'.


     *****************************************************
     * 'destroy' method of CBLClass_TSCfact
     *****************************************************
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'CBLClass_TSCfact-dst'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      LINKAGE SECTION.
      01 FACTORY-POINTER USAGE POINTER.
      01 OBJECT-POINTER USAGE POINTER.
     * Do not change signature of this sub-program.
      PROCEDURE DIVISION USING
              BY VALUE FACTORY-POINTER
              BY VALUE OBJECT-POINTER.

     * Write user own code, if necessary.
     * サーバオブジェクトを削除するコードを記述します。
     * 必要に応じて変更してください。

     * This sub-program must return pointer that
     * 'CBLClass_TSCimpl-DEL' returns.
          CALL 'CBLClass_TSCimpl-DEL' USING
              BY VALUE OBJECT-POINTER.
      END PROGRAM 'CBLClass_TSCfact-dst'.


     *****************************************************
     * TSCCBLThread-beginThread of
     *     TSCCBLThread
     *****************************************************
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'TSCCBLThread-beginThread'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      01 BEGIN-THREAD-PTR USAGE POINTER.
      01 END-THREAD-PTR USAGE POINTER.
     * Do not change signature of this sub-program.
      LINKAGE SECTION.
     01 THREAD-FACTORY-ID PIC S9(9) COMP.
      PROCEDURE DIVISION USING
              BY VALUE THREAD-FACTORY-ID.

     * Write user own code.
     * スレッド開始処理を記述します。
     * 必要に応じて変更してください。

      END PROGRAM 'TSCCBLThread-beginThread'.


     *****************************************************
     * TSCCBLThread-endThread of
     *     TSCCBLThreadFactory
     *****************************************************
      IDENTIFICATION DIVISION.
      PROGRAM-ID. 'TSCCBLThread-endThread'.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
     * Do not change signature of this sub-program.
      LINKAGE SECTION.
      01 THREAD-FACTORY-ID PIC S9(9) COMP.
      PROCEDURE DIVISION USING
              BY VALUE THREAD-FACTORY-ID.

     * Write user own code.
     * スレッド終了処理を記述します。
     * 必要に応じて変更してください。

      END PROGRAM 'TSCCBLThread-endThread'.

(2) サービス登録処理の流れ

  1. COBOL adapter for TPBrokerの初期化処理
  2. TPBroker OTMの初期化処理
  3. TSCデーモンへの接続
  4. TSCユーザアクセプタの生成および各種設定
  5. TSCルートアクセプタの生成および各種設定
  6. TSCルートアクセプタの活性化
  7. 実行制御の受け渡し
  8. TSCルートアクセプタの非活性化
  9. TSCルートアクセプタの削除
  10. TSCユーザオブジェクトファクトリおよびTSCユーザアクセプタの削除
  11. TSCデーモンへの接続解放
  12. TPBroker OTMの終了処理

(3) サービス登録処理のコード

      IDENTIFICATION DIVISION.
      PROGRAM-ID. CORBA-SERVER-MAIN.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.
      REPOSITORY.
      CLASS CBLClass IS 'XYZfile_s'.
      DATA DIVISION.
     * The following are the ORB pointers.
     * These are necessary for all servers.
      WORKING-STORAGE SECTION.
      01 ORB-PTR        USAGE POINTER.

      01 DOMAIN-PTR            USAGE POINTER.
      01 SERVER-PTR            USAGE POINTER.
      01 FACTORY-PTR           USAGE POINTER.
      01 ACCEPTOR-PTR          USAGE POINTER.
      01 R-ACCEPTOR-PTR        USAGE POINTER.
      01 THREAD-FACT-PTR       USAGE POINTER.
      01 THREAD-FACT-ID        PIC S9(9) COMP.
      01 MY-DOMAIN-NAME        PIC X(10).
      01 MY-DOMAIN-NAME-PTR    USAGE POINTER.
      01 MY-DOMAIN-NAME-LEN    PIC S9(9) COMP.
      01 MY-TSCID              PIC X(10).
      01 MY-TSCID-PTR          USAGE POINTER.
      01 MY-TSCID-LEN          PIC S9(9) COMP.
      01 MY-DOMAIN-FLAG        PIC S9(9) COMP.
      01 ACCEPTOR-NAME-PTR     USAGE POINTER.
      01 ACCEPTOR-ID           PIC S9(9) COMP.
      01 P-COUNT               PIC S9(9) COMP.
      01 DEACT-MODE            PIC S9(9) COMP.
      01 R-ACCEPTOR-NAME       PIC X(10).
      01 R-ACCEPTOR-NAME-PTR   USAGE POINTER.
      01 R-ACCEPTOR-NAME-LEN   PIC S9(9) COMP VALUE 30.

      01 INIT-SERVER-FLAG      PIC S9(9) COMP.
      01 DOMAIN-CREATE-FLAG    PIC S9(9) COMP.
      01 GET-SERVER-FLAG       PIC S9(9) COMP.
      01 TSCFACT-CREATE-FLAG   PIC S9(9) COMP.
      01 TSCACPT-CREATE-FLAG   PIC S9(9) COMP.
      01 RACPT-CREATE-FLAG     PIC S9(9) COMP.
      01 RACPT-ACTIVATE-FLAG   PIC S9(9) COMP.

      01 CORBA-ENVIRONMENT.
       02 MAJOR PIC 9(9) USAGE COMP.
        88 CORBA-NO-EXCEPTION     VALUE 0.
        88 CORBA-USER-EXCEPTION   VALUE 1.
        88 CORBA-SYSTEM-EXCEPTION VALUE 2.
       02 EXCEP USAGE POINTER.
       02 FUNC-NAME PIC X(256).

      LINKAGE SECTION.
      01 ARGC PIC S9(9) USAGE COMP.
      01 ARGV USAGE POINTER.

      PROCEDURE DIVISION USING
              BY VALUE ARGC
              BY VALUE ARGV.

          MOVE 0 TO RETURN-CODE.
          MOVE 0 TO INIT-SERVER-FLAG.
          MOVE 0 TO DOMAIN-CREATE-FLAG.
          MOVE 0 TO GET-SERVER-FLAG.
          MOVE 0 TO TSCFACT-CREATE-FLAG.
          MOVE 0 TO TSCACPT-CREATE-FLAG.
          MOVE 0 TO RACPT-CREATE-FLAG.
          MOVE 0 TO RACPT-ACTIVATE-FLAG.

     * 1. COBOL adapter for TPBrokerの初期化処理
     * First, call the skeleton and class initializers.
          CALL 'CORBA-SKEL-INIT-XYZfile'.
          CALL 'CBLClass-CLASS-INIT' USING BY VALUE CBLClass.

     * ORBの初期化
          CALL 'CORBA_orb_init' USING
              BY REFERENCE ARGC
              BY REFERENCE ARGV
              BY REFERENCE CORBA-ENVIRONMENT
              RETURNING    ORB-PTR.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'CORBA_FreeException' USING
                      EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success CORBA_orb_init'.

     * 2. TPBroker OTMの初期化処理
          CALL 'TSCAdm-initServer' USING
                  BY REFERENCE ARGC
                  BY REFERENCE ARGV
                  BY VALUE      ORB-PTR
                  BY REFERENCE CORBA-ENVIRONMENT.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'OTM-EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'TSCSysExcept-DELETE' USING
                  BY VALUE EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success TSCAdm-initServer'.
          MOVE 1 TO INIT-SERVER-FLAG.

     * 3. TSCデーモンへの接続
          SET MY-DOMAIN-NAME-PTR TO NULL.
          SET MY-TSCID-PTR TO NULL.
          MOVE 1 TO MY-DOMAIN-FLAG.
          CALL 'TSCDomain-NEW' USING
                  BY VALUE MY-DOMAIN-NAME-PTR
                  BY VALUE MY-TSCID-PTR
                  BY VALUE MY-DOMAIN-FLAG
                  BY REFERENCE CORBA-ENVIRONMENT
              RETURNING DOMAIN-PTR.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'OTM-EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'TSCSysExcept-DELETE' USING
                      BY VALUE EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success TSCDomain-NEW'.
          MOVE 1 TO DOMAIN-CREATE-FLAG.

     * TSCServerの取得
          CALL 'TSCAdm-getTSCServer' USING
                  BY VALUE DOMAIN-PTR
                  BY REFERENCE CORBA-ENVIRONMENT
              RETURNING SERVER-PTR.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'OTM-EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'TSCSysExcept-DELETE' USING
                      BY VALUE EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success TSCAdm-getTSCServer'.
          MOVE 1 TO GET-SERVER-FLAG.

     * 4. TSCユーザアクセプタの生成および各種設定
     * CBLClass_TSCfactの生成
          CALL 'CBLClass_TSCfact-NEW'
              RETURNING FACTORY-PTR.
          DISPLAY 'Success CBLClass_TSCfact-NEW'.
          MOVE 1 TO TSCFACT-CREATE-FLAG.

     * TSCAcceptorの生成
          SET ACCEPTOR-NAME-PTR TO NULL.
          CALL 'CBLClass_TSCacpt-NEW' USING
                  BY VALUE FACTORY-PTR
                  BY VALUE ACCEPTOR-NAME-PTR
                  BY REFERENCE CORBA-ENVIRONMENT
              RETURNING ACCEPTOR-PTR.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'OTM-EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'TSCSysExcept-DELETE' USING
                      BY VALUE EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success CBLClass_TSCacpt-NEW'.
          MOVE 1 TO TSCACPT-CREATE-FLAG.

     * 5. TSCルートアクセプタの生成および各種設定
     *    TSCRootAcceptorの生成
          SET THREAD-FACT-PTR TO NULL.
          CALL 'TSCRAcceptor-create' USING
                  BY VALUE SERVER-PTR
                  BY VALUE THREAD-FACT-PTR
                  BY REFERENCE CORBA-ENVIRONMENT
              RETURNING R-ACCEPTOR-PTR.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'OTM-EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'TSCSysExcept-DELETE' USING
                  BY VALUE EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success TSCRAcceptor-create'.
          MOVE 1 TO RACPT-CREATE-FLAG.

     * TSCユーザアクセプタの登録
          CALL 'TSCRAcceptor-registerAcceptor' USING
                  BY VALUE R-ACCEPTOR-PTR
                  BY VALUE ACCEPTOR-PTR
                  BY REFERENCE CORBA-ENVIRONMENT
              RETURNING ACCEPTOR-ID.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'OTM-EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'TSCSysExcept-DELETE' USING
                  BY VALUE EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success TSCRAcceptor-registerAcceptor'.

     * 6. TSCルートアクセプタの活性化
          MOVE 'serviceX' TO R-ACCEPTOR-NAME.
          CALL 'CORBA_string_set' USING
                  BY REFERENCE R-ACCEPTOR-NAME-PTR
                  BY REFERENCE R-ACCEPTOR-NAME-LEN
                  BY REFERENCE R-ACCEPTOR-NAME.
          CALL 'TSCRAcceptor-activate' USING
                  BY VALUE R-ACCEPTOR-PTR
                  BY VALUE R-ACCEPTOR-NAME-PTR
                  BY REFERENCE CORBA-ENVIRONMENT.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'OTM-EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'TSCSysExcept-DELETE' USING
                  BY VALUE EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success TSCRAcceptor-activate'.
          MOVE 1 TO RACPT-ACTIVATE-FLAG.

     * 7. 実行制御の受け渡し
          DISPLAY 'Start TSCAdm-serverMainloop'.
          CALL 'TSCAdm-serverMainloop' USING
                  BY REFERENCE CORBA-ENVIRONMENT.
     * 例外チェック
          IF NOT CORBA-NO-EXCEPTION THEN
              CALL 'OTM-EXCEPTION-HANDLER' USING
                      BY REFERENCE MAJOR
                      BY REFERENCE CORBA-ENVIRONMENT
              CALL 'TSCSysExcept-DELETE' USING
                  BY VALUE EXCEP OF CORBA-ENVIRONMENT
              MOVE 1 TO RETURN-CODE
              GO TO PROG-END
          END-IF.
          DISPLAY 'Success TSCAdm-serverMainloop'.

      PROG-END.

     * 8. TSCルートアクセプタの非活性化
          IF RACPT-ACTIVATE-FLAG = 1 THEN
              MOVE 0 TO DEACT-MODE
              CALL 'TSCRAcceptor-deactivate' USING
                      BY VALUE R-ACCEPTOR-PTR
                      BY VALUE DEACT-MODE
                      BY REFERENCE CORBA-ENVIRONMENT
     * 例外チェック
              IF NOT CORBA-NO-EXCEPTION THEN
                  CALL 'OTM-EXCEPTION-HANDLER' USING
                          BY REFERENCE MAJOR
                          BY REFERENCE CORBA-ENVIRONMENT
                  CALL 'TSCSysExcept-DELETE' USING
                          BY VALUE EXCEP OF CORBA-ENVIRONMENT
                  MOVE 1 TO RETURN-CODE
              ELSE
                  DISPLAY 'Success TSCRAcceptor-deactivate'
              END-IF
          END-IF.

     * 9. TSCルートアクセプタの削除
          IF RACPT-CREATE-FLAG = 1 THEN
              CALL 'TSCRAcceptor-destroy' USING
                      BY VALUE R-ACCEPTOR-PTR
                      BY REFERENCE CORBA-ENVIRONMENT
     * 例外チェック
              IF NOT CORBA-NO-EXCEPTION THEN
                  CALL 'OTM-EXCEPTION-HANDLER' USING
                          BY REFERENCE MAJOR
                          BY REFERENCE CORBA-ENVIRONMENT
                  CALL 'TSCSysExcept-DELETE' USING
                          BY VALUE EXCEP OF CORBA-ENVIRONMENT
                  MOVE 1 TO RETURN-CODE
              ELSE
                  DISPLAY 'Success TSCRAcceptor-destroy'
              END-IF
          END-IF.

     * 10. TSCユーザオブジェクトファクトリおよび
     *     TSCユーザアクセプタの削除
          IF TSCACPT-CREATE-FLAG = 1 THEN
              CALL 'CBLClass_TSCacpt-DEL' USING
                      BY VALUE ACCEPTOR-PTR
                      BY REFERENCE CORBA-ENVIRONMENT
     * 例外処理
              IF NOT CORBA-NO-EXCEPTION THEN
                  CALL 'OTM-EXCEPTION-HANDLER' USING
                          BY REFERENCE MAJOR
                          BY REFERENCE CORBA-ENVIRONMENT
                  CALL 'TSCSysExcept-DELETE' USING
                      BY VALUE EXCEP OF CORBA-ENVIRONMENT
                  MOVE 1 TO RETURN-CODE
              END-IF
          END-IF.

     * 領域の解放
          IF TSCFACT-CREATE-FLAG = 1 THEN
              CALL 'CBLClass_TSCfact-DEL' USING
                      BY VALUE FACTORY-PTR
          END-IF.

     * 11. TSCデーモンへの接続解放
          IF GET-SERVER-FLAG = 1 THEN
              CALL 'TSCAdm-releaseTSCServer' USING
                      BY VALUE SERVER-PTR
                      BY REFERENCE CORBA-ENVIRONMENT
     * 例外チェック
              IF NOT CORBA-NO-EXCEPTION THEN
                  CALL 'OTM-EXCEPTION-HANDLER' USING
                          BY REFERENCE MAJOR
                          BY REFERENCE CORBA-ENVIRONMENT
                  CALL 'TSCSysExcept-DELETE' USING
                      BY VALUE EXCEP OF CORBA-ENVIRONMENT
                  MOVE 1 TO RETURN-CODE
              ELSE
                  DISPLAY 'Success TSCAdm-releaseTSCServer'
              END-IF
          END-IF.

          IF DOMAIN-CREATE-FLAG = 1 THEN
              CALL 'TSCDomain-DELETE' USING
                      BY VALUE DOMAIN-PTR
                      BY REFERENCE CORBA-ENVIRONMENT
     * 例外チェック
              IF NOT CORBA-NO-EXCEPTION THEN
                  CALL 'OTM-EXCEPTION-HANDLER' USING
                          BY REFERENCE MAJOR
                          BY REFERENCE CORBA-ENVIRONMENT
                  CALL 'TSCSysExcept-DELETE' USING
                      BY VALUE EXCEP OF CORBA-ENVIRONMENT
                  MOVE 1 TO RETURN-CODE
              END-IF
          END-IF.

     * 12. TPBroker OTMの終了処理
          IF INIT-SERVER-FLAG = 1 THEN
              CALL 'TSCAdm-endServer' USING
                      BY REFERENCE CORBA-ENVIRONMENT
     * 例外チェック
              IF NOT CORBA-NO-EXCEPTION THEN
                  CALL 'OTM-EXCEPTION-HANDLER' USING
                          BY REFERENCE MAJOR
                          BY REFERENCE CORBA-ENVIRONMENT
                  CALL 'TSCSysExcept-DELETE' USING
                      BY VALUE EXCEP OF CORBA-ENVIRONMENT
                  MOVE 1 TO RETURN-CODE
              ELSE
                  DISPLAY 'Success TSCAdm-endServer'
              END-IF
          END-IF.

      END PROGRAM CORBA-SERVER-MAIN.