PROCEDURE doit (
  destination_mainframe_is, dmi: key
      (client, c)
      (server, s)
      (loop, l)
    keyend = loop
  destination_mainframe_id, dmid: name 1..17 = $optional
  number_of_monitor_queue_entries, nomqe: integer 0..126 = 50
  number_of_task_queue_entries, notqe: integer 1..126 = 4
  number_of_pps, nopp: key
      one, dual
    keyend = one
  dma: boolean = TRUE
  new_send_channel, nsc: name 3..6 = $optional
  new_receive_channel, nrc: name 3..6 = $optional
  divisions_per_mainframe, dpm: integer 1..16 = 8
  timeout_interval, ti: integer 1..255 = 10
  maximum_request_timeout_count, mrtc: integer 1..255 = 5
  maximum_retransmission_count, mrc: integer 1..255 = 5
  activate, a: boolean = TRUE
  define_served_family, defsf: boolean = FALSE
  family_name, fn: any of
      key
        none
      keyend
      name
    anyend = $optional
  family_access, fa: key
      (file_access, fa)
      (leveled_access, la)
      (login, l)
      none
    keyend = login
  data_transfer_size, dts: key
      #16k, #32k, #65k, #131k, #262k
    keyend = #262k
  side_door_port, sdp: list 0..2 of list 1..3 of name = () " Hardcoded defaults used if () and running on VIOLET, COBALT "
  preallocate_image_size, pis: integer = 0
  change_eval_ring, cer: boolean = FALSE  " Allows UUTL IOTESTP to run. Do 1st time only."
  system_debug_ring, sdr: integer 0..15 = 6
  gen_application_support_procs, gasp: boolean = FALSE
  status)

" This procedure provides the information needed to define the file server connections for the NOS/VE
" development hands-on mainframes.
" This procedure defines one connection to another mainframe.  In loopback mode both client and server
" are defined.
" Changes in this procedure should be reflected in the test procedures TTM$DEFINE_A_CLIENT and
" TTM$DEFINE_A_SERVER.

  "$FORMAT=OFF"
  VAR
    accessed_family: name
    destination_mainframe_name: name
    ignore: status
    iou: name = $name('IOU0')    "    Note that COBALT uses channels on IOU1, not IOU0."
    receive_channel: name
    send_channel: name
    served_family: name
    source_id_number: integer
    stornet_status: status
    test_loopback: (XDCL) string
  VAREND
  "$FORMAT=ON"

" ======= BASIC SETUP COMMANDS =========================================

  set_system_attribute enable_pm_debug_logging 1 status=ignore
  set_system_attribute system_debug_ring system_debug_ring status=ignore
  IF ignore.normal THEN
    display_value ' System_debug_ring =  '//system_debug_ring o=$response
  IFEND

  set_system_attribute file_server_debug_enabled 1 status=ignore
  IF ignore.normal THEN
    display_value ' File_Server_Debug_Enabled ' o=$response
  IFEND

" This allows more tests to run - namely the UUTL test IOTESTP

  IF change_eval_ring THEN
    ADMINISTER_VALIDATION
      use_validation_file :testing.$system.$validations
      CHANGE_USER eval
        change_ring_privilege minr=6
      QUIT
    QUIT
  IFEND

  include_line 'ved file_server ' status=ignore
  ignore.normal = true

" Turn on the equipment.

  display_value ' Turning STORNET on...' o=$response
  LOGICAL_CONFIGURATION_UTILITY
    change_element_state stornet state=on
  QUIT

" Create variables which enable easier testing.

  IF NOT $variable(cl, defined) THEN
    "$FORMAT=OFF"
    VAR
      cl: (JOB) name = $name($mainframe(id))
    VAREND
    "$FORMAT=ON"
  IFEND
  IF NOT $variable(s, defined) THEN
    "$FORMAT=OFF"
    VAR
      s: (JOB) name = $SYSTEM_0990_7777
    VAREND
    "$FORMAT=ON"
  IFEND

" ===== DEFINE_STORNET_CONNECTION =====================================
"  STORNET WORDS -
"          DECIMAL       OCTAL
"         --------      -------
"           524288      2000000
"          1048576      4000000
"          2097152     10000000        Any value larger than 8388608(10)
"          4194304     20000000        requires that the half_ecs_switch
"          8388608     40000000        parameter value be TRUE.
"         16777216    100000000

  base_flag = 0
" Note that STORNET base_address must be multiple of 1000 octal, or zero.
  base_address = 0
  display_value ' Defining STORNET connection...' o=$response
  IF NOT $nil(side_door_port) THEN
    "$FORMAT=OFF"
    define_stornet_connection ..
          element_name=stornet ..
          memory_size=4194304 ..
          memory_base=base_address ..
          flag_base=base_flag ..
          half_ecs_switch=no ..
          number_of_mainframes=8 ..
          divisions_per_mainframe=divisions_per_mainframe ..
          data_transfer_size= data_transfer_size ..
          side_door_port = side_door_port ..
          status=stornet_status
    "$FORMAT=ON"
  ELSEIF $mainframe(id) = '$SYSTEM_0860_0302' THEN
    "$FORMAT=OFF"
    define_stornet_connection ..
          element_name=stornet ..
          memory_size=4194304 ..
          memory_base=base_address ..
          flag_base=base_flag ..
          half_ecs_switch=no ..
          number_of_mainframes=8 ..
          divisions_per_mainframe=divisions_per_mainframe ..
          data_transfer_size= data_transfer_size ..
          side_door_port = ((ch24 $system_0860_0302 iou0)) ..
          status=stornet_status
    "$FORMAT=ON"
  ELSEIF $mainframe(id) = '$SYSTEM_9603_0102' THEN
    "$FORMAT=OFF"
    define_stornet_connection ..
          element_name=stornet ..
          memory_size=4194304 ..
          memory_base=base_address ..
          flag_base=base_flag ..
          half_ecs_switch=no ..
          number_of_mainframes=8 ..
          divisions_per_mainframe=divisions_per_mainframe ..
          data_transfer_size= data_transfer_size ..
          side_door_port = ((cch18 $system_9603_0102 iou1)) ..
          status=stornet_status
    "$FORMAT=ON"
  ELSE
    "$FORMAT=OFF"
    define_stornet_connection ..
          element_name=stornet ..
          memory_size=4194304 ..
          memory_base=base_address ..
          flag_base=base_flag ..
          half_ecs_switch=no ..
          number_of_mainframes=8 ..
          divisions_per_mainframe=divisions_per_mainframe ..
          data_transfer_size= data_transfer_size ..
          status=stornet_status
    "$FORMAT=ON"
  IFEND

  IF NOT stornet_status.normal THEN
    IF $condition_name(stornet_status.condition) = 'DFE$STORNET_ALREADY_DEFINED' THEN
      display_value ' Stornet already defined - Continuing with defining client/server ' o=$response
    ELSE
      EXIT_PROC WITH stornet_status
    IFEND
  IFEND

" ==== DETERMINE DESTINATION MAINFRAME =======================

  IF $specified(destination_mainframe_id) THEN
    destination_mainframe_name = destination_mainframe_id
  ELSEIF destination_mainframe_is = 'LOOP' THEN
    destination_mainframe_name = $name($mainframe(id))
  ELSE " Default mainframe id
    IF $mainframe(id) = '$SYSTEM_0860_0302' THEN
      destination_mainframe_name = $name('$SYSTEM_0830_0604')
    ELSE
      destination_mainframe_name = $name('$SYSTEM_0860_0302')
    IFEND
  IFEND

" ======== DETERMINE ID AND CHANNELS   =========================

" Unless number_of_pps parameter is 'DUAL' the SEND channel is used in
" single PP configuration for both sending ang receiving.

  " === Default values for $SYSTEM_0860_0302 ( VIOLET ) ===
  midn_0860_0302 = 1
  snd_ch_0860_0302 = $name('CCH0a')
  rcv_ch_0860_0302 = $name('CH24')

  " === Default values for $SYSTEM_9603_0102 ( COBALT ) ===
  midn_9603_0102 = 2
  snd_ch_9603_0102 = $name('CCH5')
  rcv_ch_9603_0102 = $name('CCH18')

  " === Default values for $SYSTEM_0830_0604 ( RED ) ===
  midn_0830_0604 = 3
  snd_ch_0830_0604 = $name('CH9')
  rcv_ch_0830_0604 = $name('CH9')

  " === Default values for $SYSTEM_9303_0121 ( PEWTER ) ===
  midn_9303_0121 = 4
  snd_ch_9303_0121 = $name('CH2')
  rcv_ch_9303_0121 = $name('CH2')

  " === Default values for $SYSTEM_0835_0104 ( MAUVE ) ===
  midn_0835_0104 = 5
  snd_ch_0835_0104 = $name('CH3')
  rcv_ch_0835_0104 = $name('CH3')

  " === Default values for $SYSTEM_20S1_0101/$SYSTEM_20V1_0101 ( ZUBA ) ===
  midn_20s1_0101 = 6
  snd_ch_20s1_0101 = $name('CCH16')
  rcv_ch_20s1_0101 = $name('CCH16')

  IF $mainframe(id) = '$SYSTEM_0860_0302' THEN
    source_id_number = midn_0860_0302
    accessed_family = $name('TESTVE860302')
    IF $specified(new_send_channel) THEN
      snd_ch_0860_0302 = new_send_channel
    IFEND
    IF $specified(new_receive_channel) THEN
      rcv_ch_0860_0302 = new_receive_channel
    IFEND
    send_channel = snd_ch_0860_0302
    IF number_of_pps = 'DUAL' THEN
      receive_channel = rcv_ch_0860_0302
    ELSE
      IF dma THEN
        " Since we just happen to know that the default send channel is DMA -
        " (assumes default send channel is dma)"
        send_channel = snd_ch_0860_0302
      IFEND
      receive_channel = send_channel
    IFEND

  ELSEIF $mainframe(id) = '$SYSTEM_9603_0102' THEN
  "    Note that COBALT uses channels on IOU1, not IOU0.
    iou = $name('IOU1')
    source_id_number = midn_9603_0102
    accessed_family = $name('TESTVE960102')
    IF $specified(new_send_channel) THEN
      snd_ch_9603_0102 = new_send_channel
    IFEND
    IF $specified(new_receive_channel) THEN
      rcv_ch_9603_0102 = new_receive_channel
    IFEND
    send_channel = snd_ch_9603_0102
    IF number_of_pps = 'DUAL' THEN
      receive_channel = rcv_ch_9603_0102
    ELSE
      IF dma THEN
        " Since we just happen to know that the default send channel is DMA -
        " (assumes default send channel is dma)"
        send_channel = rcv_ch_9603_0102
      IFEND
      receive_channel = send_channel
    IFEND

  ELSEIF $mainframe(id) = '$SYSTEM_0830_0604' THEN
    accessed_family = $name('TESTVE830604')
    IF $specified(new_send_channel) THEN
      snd_ch_0830_0604 = new_send_channel
    IFEND
    IF $specified(new_receive_channel) THEN
      rcv_ch_0830_0604 = new_receive_channel
    IFEND
    source_id_number = midn_0830_0604
    send_channel = snd_ch_0830_0604
    IF number_of_pps = 'DUAL' THEN
      receive_channel = rcv_ch_0830_0604
    ELSE
      receive_channel = send_channel
    IFEND

  ELSEIF $mainframe(id) = '$SYSTEM_9303_0121' THEN
    source_id_number = midn_9303_0121
    accessed_family = $name('TESTVE930121')
    IF $specified(new_send_channel) THEN
      snd_ch_9303_0121 = new_send_channel
    IFEND
    IF $specified(new_receive_channel) THEN
      rcv_ch_9303_0121 = new_receive_channel
    IFEND
    send_channel = snd_ch_9303_0121
    IF number_of_pps = 'DUAL' THEN
      receive_channel = rcv_ch_9303_0121
    ELSE
      receive_channel = send_channel
    IFEND

  ELSEIF $mainframe(id) = '$SYSTEM_0835_0104' THEN
    source_id_number = midn_0835_0104
    accessed_family = $name('TESTVE835104')
    IF $specified(new_send_channel) THEN
      snd_ch_0835_0104 = new_send_channel
    IFEND
    IF $specified(new_receive_channel) THEN
      rcv_ch_0835_0104 = new_receive_channel
    IFEND
    send_channel = snd_ch_0835_0104
    IF number_of_pps = 'DUAL' THEN
      receive_channel = rcv_ch_0835_0104
    ELSE
      receive_channel = send_channel
    IFEND

    ELSEIF $mainframe(id) = '$SYSTEM_20S1_0101' THEN
      source_id_number = midn_20s1_0101
      accessed_family = $name('TESTVE20S101')
      IF $specified(new_send_channel) THEN
        snd_ch_20s1_0101 = new_send_channel
      IFEND
      IF $specified(new_receive_channel) THEN
        rcv_ch_20s1_0101 = new_receive_channel
      IFEND
      send_channel = snd_ch_20s1_0101
      IF number_of_pps = 'DUAL' THEN
        receive_channel = rcv_ch_20s1_0101
      ELSE
        IF dma THEN
          " Since we just happen to know that the default send channel is DMA -
          " (assumes default send channel is dma)"
          send_channel = snd_ch_20s1_0101
        IFEND
        receive_channel = send_channel
      IFEND

    ELSEIF $mainframe(id) = '$SYSTEM_20V1_0101' THEN
      source_id_number = midn_20s1_0101
      accessed_family = $name('TESTVE20V101')
      IF $specified(new_send_channel) THEN
        snd_ch_20s1_0101 = new_send_channel
      IFEND
      IF $specified(new_receive_channel) THEN
        rcv_ch_20s1_0101 = new_receive_channel
      IFEND
      send_channel = snd_ch_20s1_0101
      IF number_of_pps = 'DUAL' THEN
        receive_channel = rcv_ch_20s1_0101
      ELSE
        IF dma THEN
          " Since we just happen to know that the default send channel is DMA -
          " (assumes default send channel is dma)"
          send_channel = snd_ch_20s1_0101
        IFEND
        receive_channel = send_channel
      IFEND

  ELSE
    EXIT_PROC WITH $status(false, 'DF', 333, ' --- Unknown mainframe: '//$name($mainframe(id)))
  IFEND

  display_value ' Send channel = '//send_channel o=$response
  display_value ' Receive channel = '//receive_channel o=$response

  IF destination_mainframe_name = '$SYSTEM_0860_0302' THEN
    destination_id_number = midn_0860_0302
    served_family = $name('TESTVE860302')
  ELSEIF destination_mainframe_name = '$SYSTEM_0830_0604' THEN
    destination_id_number = midn_0830_0604
    served_family = $name('TESTVE830604')
  ELSEIF destination_mainframe_name = '$SYSTEM_9603_0102' THEN
    destination_id_number = midn_9603_0102
    served_family = $name('TESTVE960102')
  ELSEIF destination_mainframe_name = '$SYSTEM_9303_0121' THEN
    destination_id_number = midn_9303_0121
    served_family = $name('TESTVE930121')
  ELSEIF destination_mainframe_name = '$SYSTEM_0835_0104' THEN
    destination_id_number = midn_0835_0104
    served_family = $name('TESTVE835104')
  ELSEIF destination_mainframe_name = '$SYSTEM_20S1_0101' THEN
    destination_id_number = midn_20s1_0101
    served_family = $name('TESTVE20S101')
  ELSEIF destination_mainframe_name = '$SYSTEM_20V1_0101' THEN
    destination_id_number = midn_20s1_0101
    served_family = $name('TESTVE20V101')
  ELSE
    EXIT_PROC WITH $status(false, 'DF', 333, ..
          ' --- Unknown destination mainframe: '//destination_mainframe_name)
  IFEND

  IF destination_mainframe_is = 'LOOP' THEN
" NOTE: SERVER mainframe name is hard-coded in the deck DFC$LOOPBACK_MAINFRAME_NAME "
    destination_mainframe_name = $name('$SYSTEM_0990_7777')
    served_family = $name('TESTING')
    accessed_family = $name('TESTING')
  IFEND

" ======== DEFINE CLIENT OR SERVER AS NEEDED ==================

  IF destination_mainframe_is = 'SERVER' THEN
    display_value ' Defining server: '//destination_mainframe_name o=$response
    s = destination_mainframe_name
    "$FORMAT=OFF"
    define_server  ..
          server_mainframe_identifier= destination_mainframe_name ..
          client_id_number= source_id_number ..
          server_id_number= destination_id_number ..
          number_of_monitor_queue_entries= number_of_monitor_queue_entries ..
          number_of_task_queue_entries= number_of_task_queue_entries ..
          connection_type= stornet ..
          element_name= stornet ..
          send_channel= (send_channel, iou) ..
          receive_channel= (receive_channel, iou) ..
          dma_available= dma ..
          timeout_interval= timeout_interval ..
          maximum_request_timeout_count= maximum_request_timeout_count ..
          maximum_retransmission_count= maximum_retransmission_count..
          users_wait_on_terminated= FALSE ..
          preallocate_image_size= preallocate_image_size
    "$FORMAT=ON"

    IF define_served_family THEN
      define_served_family server_mainframe_identifier=destination_mainframe_name family=served_family
    IFEND
  IFEND

  IF destination_mainframe_is = 'CLIENT' THEN
    IF $specified(family_name) THEN
      IF family_name <> 'NONE' THEN
        display_value ' Changing client access...' o=$response
        "$FORMAT=OFF"
        change_client_access ..
              client_mainframe_identifier=destination_mainframe_name ..
              family=family_name ..
              family_access=family_access ..
              status=ignore
        "$FORMAT=ON"
        IF NOT ignore.normal THEN
          display_value ' -- WARNING -- CHANGE_CLIENT_ACCESS encountered the following error:' o=$response
          display_value ignore o=$response
          display_value '   Continuing with procedure DOIT...' o=$response
        IFEND
      IFEND
    ELSE
      display_value ' Changing client access...' o=$response
      "$FORMAT=OFF"
      change_client_access ..
            client_mainframe_identifier=destination_mainframe_name ..
            family=accessed_family ..
            family_access=family_access ..
            status=ignore
      "$FORMAT=ON"
      IF NOT ignore.normal THEN
        display_value ' -- WARNING -- CHANGE_CLIENT_ACCESS encountered the following error:' o=$response
        display_value ignore o=$response
        display_value '   Continuing with procedure DOIT...' o=$response
      IFEND
    IFEND

    display_value ' Defining client: '//destination_mainframe_name o=$response
    cl = destination_mainframe_name
    "$FORMAT=OFF"
    define_client ..
          client_mainframe_identifier=destination_mainframe_name ..
          client_id_number= destination_id_number ..
          server_id_number= source_id_number ..
          number_of_monitor_queue_entries= number_of_monitor_queue_entries ..
          number_of_task_queue_entries= number_of_task_queue_entries ..
          connection_type= stornet ..
          element_name= stornet ..
          send_channel= (send_channel, iou) ..
          receive_channel= (receive_channel, iou) ..
          dma_available= dma
    "$FORMAT=ON"
  IFEND

  IF destination_mainframe_is = 'LOOP' THEN
    IF $specified(family_name) THEN
      IF family_name <> 'NONE' THEN
        display_value ' Changing client access...' o=$response
        "$FORMAT=OFF"
        change_client_access ..
              client_mainframe_identifier=$name($mainframe(id)) ..
              family=family_name ..
              family_access=family_access ..
              status=ignore
        "$FORMAT=ON"
        IF NOT ignore.normal THEN
          display_value ' -- WARNING -- CHANGE_CLIENT_ACCESS encountered the following error:' o=$response
          display_value ignore o=$response
          display_value '   Continuing with procedure DOIT...' o=$response
        IFEND
      IFEND
    ELSE
      display_value ' Changing client access...' o=$response
      "$FORMAT=OFF"
      change_client_access ..
            client_mainframe_identifier=$name($mainframe(id)) ..
            family=accessed_family ..
            family_access=family_access ..
            status=ignore
      "$FORMAT=ON"
      IF NOT ignore.normal THEN
        display_value ' -- WARNING -- CHANGE_CLIENT_ACCESS encountered the following error:' o=$response
        display_value ignore o=$response
        display_value '   Continuing with procedure DOIT...' o=$response
      IFEND
    IFEND

    display_value ' Defining client: '//$mainframe(id) o=$response
    cl = $name($mainframe(id))
    "$FORMAT=OFF"
    define_client ..
          client_mainframe_identifier= $name($mainframe(id)) ..
          number_of_monitor_queue_entries= number_of_monitor_queue_entries ..
          number_of_task_queue_entries= number_of_task_queue_entries ..
          connection_type= stornet ..
          element_name= stornet ..
          send_channel= (send_channel, iou) ..
          receive_channel= (receive_channel, iou) ..
          client_id_number= source_id_number ..
          server_id_number= source_id_number ..
          dma_available= dma
    "$FORMAT=ON"

    display_value ' Defining server: '//destination_mainframe_name o=$response
    s = destination_mainframe_name
    "$FORMAT=OFF"
    define_server  ..
          server_mainframe_identifier=destination_mainframe_name ..
          client_id_number= source_id_number ..
          server_id_number= source_id_number  ..
          number_of_monitor_queue_entries= number_of_monitor_queue_entries ..
          number_of_task_queue_entries= number_of_task_queue_entries ..
          connection_type= stornet ..
          element_name= stornet ..
          send_channel= (send_channel, iou) ..
          receive_channel= (receive_channel, iou) ..
          dma_available= dma ..
          timeout_interval= timeout_interval ..
          maximum_request_timeout_count= maximum_request_timeout_count ..
          maximum_retransmission_count= maximum_retransmission_count ..
          users_wait_on_terminated= FALSE ..
          preallocate_image_size= preallocate_image_size
    "$FORMAT=ON"

    IF define_served_family THEN
      define_served_family server_mainframe_identifier=destination_mainframe_name family=testing
    IFEND
  IFEND

  IF (destination_mainframe_is = 'LOOP') OR (destination_mainframe_is = 'CLIENT') THEN
    IF gen_application_support_procs THEN
      TASK r=3
        copy_file $user.osf$builtin_library $user.doit_app_lib
        change_file_attributes $user.doit_app_lib ra=(3, 3, 3) status=ignore
      TASKEND
      IF ignore.normal THEN
        "$FORMAT=OFF"
        define_application_rpc ..
               application_name=doit_app ..
               library=$user.doit_app_lib ..
               remote_procedure=((dfp$server_test_app_support, false, cwfv, false, 11, true)) ..
               client_mainframe_identifier=cl ..
               state_change_procedure=dfp$scp1 ..
               status=ignore
        "$FORMAT=ON"
      IFEND
      IF ignore.normal THEN
        display_value ' DOIT_APP defined' o=$response
      ELSE
        display_value ignore o=$response
        ignore.normal = true
      IFEND
    IFEND
  IFEND

  IF activate THEN
    IF destination_mainframe_is = 'SERVER' THEN
      display_value ' Activating server: '//destination_mainframe_name o=$response
      activate_server destination_mainframe_name
    IFEND

    IF destination_mainframe_is = 'CLIENT' THEN
      display_value ' Activating client: '//destination_mainframe_name o=$response
      activate_client destination_mainframe_name
    IFEND

    IF destination_mainframe_is = 'LOOP' THEN
      display_value ' Activating client: '//$mainframe(id) o=$response
      activate_client $name($mainframe(id))

      display_value ' Activating server: '//destination_mainframe_name o=$response
      activate_server destination_mainframe_name
    IFEND
  IFEND

  display_value ' Setting queue location...' o=$response
  include_line 'set_queue_location stornet send_channel source_id_number ' status=ignore

  display_value ' Procedure DOIT complete.' o=$response

PROCEND doit
