6.6.2 TSCThreadを利用するサーバアプリケーションの例(COBOL)

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

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

また,TSCThreadを使用する場合は,ユーザメソッドの第1引数にTSCユーザオブジェクトのポインタを受け取る形式2の雛形ソースが必要です。形式2の雛形ソースを出力するには,tscidl2cblコマンドの-formatオプションに"2"を指定してください。形式1および形式2は,TSCユーザオブジェクトに対してユーザが実装する副プログラムの形式です。詳細は,7章の「ABC_TSCfactimpl(COBOL)」を参照してください。

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

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

(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.

      01 THREAD-PTR         USAGE POINTER.
      01 THREAD-FACT-ID     PIC S9(9) COMP.

      LINKAGE SECTION.
      01 TSC-OBJECT-PTR USAGE POINTER.
      01 in_data USAGE POINTER.
      01 out_data USAGE POINTER.

     * Do not change signature of this sub-program.
      PROCEDURE DIVISION
          USING
              BY VALUE TSC-OBJECT-PTR
              BY VALUE in_data
              BY REFERENCE out_data.

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

     * TSCThreadの取得
      CALL 'TSCObject-TSCThreadGet' USING
              BY VALUE TSC-OBJECT-PTR
              BY REFERENCE CORBA-ENVIRONMENT
          RETURNING THREAD-PTR.
     * Exception process
      IF NOT CORBA-NO-EXCEPTION THEN
          CALL 'OTM-EXCEPTION-HANDLER' USING
                  BY REFERENCE MAJOR OF CORBA-ENVIRONMENT
                  BY REFERENCE CORBA-ENVIRONMENT
          CALL 'TSCSysExcept-DELETE' USING
                  BY VALUE EXCEP OF CORBA-ENVIRONMENT
          EXIT PROGRAM
      END-IF.
     * Get ThreadFactoryID
      CALL 'TSCCBLThread-getThreadFactID' USING
              BY VALUE THREAD-PTR
              BY REFERENCE CORBA-ENVIRONMENT
          RETURNING THREAD-FACT-ID.
     * Exception process
      IF NOT CORBA-NO-EXCEPTION THEN
          CALL 'OTM-EXCEPTION-HANDLER' USING
                  BY REFERENCE MAJOR OF CORBA-ENVIRONMENT
                  BY REFERENCE CORBA-ENVIRONMENT
          CALL 'TSCSysExcept-DELETE' USING
                  BY VALUE EXCEP OF CORBA-ENVIRONMENT
          EXIT PROGRAM
      END-IF.
      DISPLAY 'Thread-Fact-ID = ' THREAD-FACT-ID.

     * 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) サービス登録処理の流れ

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

(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 THREAD-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 THREAD-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ユーザスレッドファクトリの生成および各種設定
     * TSCThreadFactoryの生成
          MOVE 123 TO THREAD-FACT-ID.
          CALL 'TSCCBLThreadFactory-NEW' USING
                  BY VALUE THREAD-FACT-ID
              RETURNING THREAD-FACT-PTR.
          MOVE 1 TO THREAD-CREATE-FLAG.

     * 6. 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'.

     * 7. 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.

     * 8. 実行制御の受け渡し
          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.

     * 9. 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.

     * 10. 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.

     * 11. TSCユーザオブジェクトファクトリ
     *     およびTSCユーザアクセプタの削除
          IF NOT THREAD-FACT-PTR = NULL
          AND THREAD-CREATE-FLAG = 1 THEN
              CALL 'TSCCBLThreadFactory-DELETE' USING
                      BY VALUE THREAD-FACT-PTR
          END-IF.

          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.

     * 12. 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.

     * 13. 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.