同期型呼び出しをするサーバアプリケーションの例（COBOL）

トランザクショナル分散オブジェクト基盤　TPBroker Object Transaction Monitor　プログラマーズガイド

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

 
      *****************************************************
      * Operation 'call'
      *****************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. 'call'.
       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).
 
       01 TSC-SEQMAXLEN PIC 9(9) USAGE COMP.
       01 TSC-TC-1 USAGE POINTER.
       01 TSC-SEQENV.
         02 MAJOR PIC 9(9) USAGE COMP.
         02 EXCEP USAGE POINTER.
         02 FUNC-NAME PIC X(256).
       01 TSC-TC-2 USAGE POINTER.
 
      * 必要に応じてデータ宣言を追加できます。
       01 ERR-CODE                 PIC S9(9) COMP.
       01 TYPE-CODE-PTR            USAGE POINTER.
       01 MY-OUT-DATA-LEN          PIC S9(9) COMP.
       01 ELEMENT-NUMBER           PIC S9(9) COMP.
       01 SETOCTETVAL              PIC X.
 
       LINKAGE SECTION.
       01 in_data USAGE POINTER.
       01 out_data USAGE POINTER.
 
      * Do not change signature of this sub-program.
       PROCEDURE DIVISION
           USING
               BY VALUE in_data
               BY REFERENCE out_data.
 
      * Write user own code.
      * ユーザメソッドのコードを記述します。
       DISPLAY 'call method in CBLClass'.
 
      * OUT属性引数の作成
      * Octet TypeCode オブジェクトの作成
       CALL 'Create_CORBA_TypeCode' USING
               BY VALUE     10
               BY VALUE     1
               BY REFERENCE CORBA-ENVIRONMENT
               RETURNING TYPE-CODE-PTR.
      * 例外チェック
       IF NOT CORBA-NO-EXCEPTION THEN
           CALL 'EXCEPTION-HANDLER' USING
                   BY REFERENCE MAJOR OF CORBA-ENVIRONMENT
                   BY REFERENCE CORBA-ENVIRONMENT
           EXIT PROGRAM
       END-IF.
 
      * Octet型Sequenceオブジェクトの生成
       MOVE 999999999 TO MY-OUT-DATA-LEN.
       CALL 'CORBA-SeqAlloc' USING
               BY REFERENCE MY-OUT-DATA-LEN
               BY REFERENCE TYPE-CODE-PTR
               BY REFERENCE out_data
               BY REFERENCE CORBA-ENVIRONMENT.
      * 例外チェック
       IF NOT CORBA-NO-EXCEPTION THEN
           CALL 'EXCEPTION-HANDLER' USING
                   BY REFERENCE MAJOR OF CORBA-ENVIRONMENT
                   BY REFERENCE CORBA-ENVIRONMENT
           EXIT PROGRAM
       END-IF.
 
       MOVE 1 TO ELEMENT-NUMBER.
       MOVE 'A' TO SETOCTETVAL.
       CALL 'CORBA-SeqSet' USING
               BY REFERENCE in_data
               BY REFERENCE ELEMENT-NUMBER
               BY REFERENCE SETOCTETVAL
               BY REFERENCE CORBA-ENVIRONMENT.
      * 例外チェック
       IF NOT CORBA-NO-EXCEPTION THEN
           CALL 'EXCEPTION-HANDLER' USING
                   BY REFERENCE MAJOR OF CORBA-ENVIRONMENT
                   BY REFERENCE CORBA-ENVIRONMENT
           EXIT PROGRAM
       END-IF.
 
       CALL 'CORBA_TypeCode__release' USING
           BY VALUE TYPE-CODE-PTR
           BY REFERENCE CORBA-ENVIRONMENT.
      * 例外チェック
       IF NOT CORBA-NO-EXCEPTION THEN
           CALL 'EXCEPTION-HANDLER' USING
                   BY REFERENCE MAJOR OF CORBA-ENVIRONMENT
                   BY REFERENCE CORBA-ENVIRONMENT
           EXIT PROGRAM
       END-IF.
 
       END PROGRAM 'call'.
 
 
      *****************************************************
      * 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)　サービス登録処理の流れ

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

 
       IDENTIFICATION DIVISION.
       PROGRAM-ID. CORBA-SERVER-MAIN.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
       CLASS CBLClass IS 'ABCfile_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-ABCfile'.
           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ルートアクセプタの生成および各種設定
           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ユーザアクセプタの削除
           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.

6.2.2 同期型呼び出しをするサーバアプリケーションの例（COBOL）

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

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

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

6.2.2　同期型呼び出しをするサーバアプリケーションの例（COBOL）

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

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

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