MODULE nam$clock_me;
?? LEFT := 1, RIGHT := 110 ??
?? PUSH (LISTEXT:=ON) ??
*copyc clt$parameter_list
*copyc nat$bcd_time
*copyc nat$gt_interface
*copyc nat$gt_event
*copyc nat$network_message_priority
*copyc nlt$protocol
?? POP ??
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc i#move
*copyc nap$condition_handler_trace
*copyc nap$display_message
*copyc nap$gt_accept_connection
*copyc nap$gt_await_activity_complete
*copyc nap$gt_close_sap
*copyc nap$gt_disconnect
*copyc nap$gt_open_sap
*copyc nap$gt_receive_connect_event
*copyc nap$gt_receive_connection_event
*copyc nap$gt_send_data
*copyc nap$gt_reject_connection
*copyc nlp$register_title
*copyc nlp$delete_registered_title
*copyc osp$establish_block_exit_hndlr
*copyc pmp$compute_date_time_increment
*copyc pmp$get_compact_date_time
*copyc pmp$log

  CONST
    nac$clock_me_title = '$I_CLOCK_ME',
    nac$clock_title_password = 0,
    nac$max_clock_pdu_size = 51,
    nac$max_clock_trip_delay = 500,
    nac$max_connections = 1000,
    version = 1;

  CONST
    { Disconnect Reason Codes
    clock_synch_successful = 1,
    protocol_version_mismatch = 2,
    clock_synch_failed = 3,
    clock_me_busy = 4,
    clock_me_terminated = 5;

  TYPE
    clock_synchronization_pdu = record
      length: 0 .. 0ff(16),
      version_number: 0 .. 0ff(16),
      time_stamp: nat$bcd_time,
      system_address: nat$system_address,
      system_title: string (31),
    recend;

  TYPE
    connection_information = record
      activity_status: ost$activity_status,
      connection_id: nat$gt_connection_id,
      data_area: array [1 .. 1] of nat$data_fragment,
      data_buffer: SEQ (REP 40(16) of cell),
      date_time: ost$date_time,
      user_connection_id: nat$user_connection_id,
      sync_attempts: 0 .. 3,
      next_connection: ^connection_information,
      event: nat$gt_event,
    recend;


  VAR
    active_connections: 0 .. nac$max_connections := 0,
    connection_list: ^connection_information := NIL,
    max_connections: 1 .. nac$max_connections,
    temp_data_frag: array [1 .. 1] of nat$data_fragment,
    user_identifier: ost$name := nac$clock_me_title,
    wait_list: ^nat$gt_wait_list,
    wait_list_seq: ^SEQ ( * );

  ?? TITLE := 'exit_condition_handler', EJECT ??

  PROGRAM nap$clock_me (parameter_list: clt$parameter_list;
    VAR status: ost$status);



    PROCEDURE exit_condition_handler (condition: pmt$condition;
          condition_descriptor: ^pmt$condition_information;
          save_area: ^ost$stack_frame_save_area;
      VAR handler_status: ost$status);

      VAR
        local_status: ost$status,
        output_data: array [1 .. 1] of nat$data_fragment;

      nap$condition_handler_trace (condition, save_area);
      nlp$delete_registered_title (nac$clock_me_title, nac$clock_title_password, directory_title_id,
            local_status);
      IF NOT local_status.normal THEN
        nap$display_message (local_status);
      IFEND;
      disconnect_reason := clock_me_terminated;
      output_data [1].address := ^disconnect_reason;
      output_data [1].length := #SIZE (disconnect_reason);
      WHILE connection_list <> NIL DO
        nap$gt_disconnect (connection_list^.connection_id, output_data, {ignore} local_status);
        delete_connection (connection_list);
      WHILEND;
      nap$gt_close_sap (sap, {ignore} local_status);

    PROCEND exit_condition_handler;
?? TITLE := 'nap$clock_me', EJECT ??

    VAR
      activity_status: ost$activity_status,
      address: nat$internet_address,
      connection: ^connection_information,
      connect_buffer: [STATIC] SEQ (REP 20(16) of cell),
      connect_data: [STATIC] array [1 .. 1] of nat$data_fragment := [[^connect_buffer, #SIZE
        (connect_buffer)]],
      connect_event: nat$gt_connect_event,
      clock_pdu: ^clock_synchronization_pdu,
      data: ^SEQ ( * ),
      date_time: ost$date_time,
      directory_title_id: nat$directory_entry_identifier,
      disconnect_reason: 0 .. 0ff(16),
      index: integer,
      length: integer,
      log_message: [STATIC] string (35) := 'TRIP DELAY    SEC,      MILLISECOND',
      new_connection: ^connection_information,
      output_data: array [1 .. 1] of nat$data_fragment,
      sap: nat$gt_sap_identifier,
      trip_delay: pmt$time_increment;


    process_parameters (parameter_list, max_connections, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^exit_condition_handler);

    nap$gt_open_sap (max_connections, nac$system_message_priority, FALSE, sap, address, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    register_title (address, sap, directory_title_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE wait_list_seq: [[REP (max_connections + 1) OF nat$gt_activity]];
    RESET wait_list_seq;
    NEXT wait_list: [1 .. 1] IN wait_list_seq;

    wait_list^ [1].activity := nac$gt_await_connect_request;
    wait_list^ [1].sap_id := sap;
    nap$gt_receive_connect_event (sap, connect_data, osc$nowait, connect_event, activity_status, status);
    IF NOT status.normal THEN
      nap$display_message (status);
      EXIT nap$clock_me;
    IFEND;

  /main_loop/
    WHILE TRUE DO
      nap$gt_await_activity_complete (wait_list^, index, status);
      IF status.normal THEN
        disconnect_reason := clock_me_busy;
        output_data [1].address := ^disconnect_reason;
        output_data [1].length := #SIZE (disconnect_reason);
        IF index = 1 THEN
          IF activity_status.status.normal AND (active_connections < max_connections) THEN
            ALLOCATE new_connection;
            IF new_connection = NIL THEN
              nap$gt_reject_connection (connect_event.connection, output_data, status);
              IF NOT status.normal THEN
                nap$display_message (status);
              IFEND;
            ELSE
              new_connection^.connection_id := connect_event.connection;
              new_connection^.data_area [1].address := ^new_connection^.data_buffer;
              new_connection^.data_area [1].length := #SIZE (new_connection^.data_buffer);
              new_connection^.next_connection := connection_list;
              new_connection^.sync_attempts := 1;
              output_data [1].address := NIL;
              output_data [1].length := 0;
              nap$gt_accept_connection (new_connection^.connection_id, output_data, NIL, status);
              IF status.normal THEN
                active_connections := active_connections + 1;
                connection_list := new_connection;
                update_wait_list (connect_event.connection);
                send_clock_pdu (address, new_connection^);
              ELSE
                nap$display_message (status);
                FREE new_connection;
                nap$gt_reject_connection (connect_event.connection, output_data, status);
                IF NOT status.normal THEN
                  nap$display_message (status);
                IFEND;
              IFEND;
            IFEND;
          ELSEIF activity_status.status.normal THEN
            pmp$log ('CK - CONNECTION REJECTED', status);
            nap$gt_reject_connection (connect_event.connection, output_data, status);
            IF NOT status.normal THEN
              nap$display_message (status);
            IFEND;
          IFEND;
          nap$gt_receive_connect_event (sap, connect_data, osc$nowait, connect_event, activity_status,
                status);
          IF NOT status.normal THEN
            nap$display_message (status);
            EXIT nap$clock_me;
          IFEND;
        ELSE
          find_connection (wait_list^ [index].receive_connection_id, connection);
          IF (connection <> NIL) AND connection^.activity_status.status.normal THEN
            CASE connection^.event.kind OF
            = nac$gt_data_event =
              data := ^connection^.data_buffer;
              RESET data;
              NEXT clock_pdu IN data;
              IF (clock_pdu^.version_number = version) AND (clock_pdu^.length = nac$max_clock_pdu_size - 1)
                    AND (connection^.event.data.data_length = nac$max_clock_pdu_size) THEN
                pmp$get_compact_date_time (date_time, status);
                pmp$compute_date_time_increment (connection^.date_time, date_time, trip_delay, status);
                log_message (12, 3) := '   ';
                log_message (20, 4) := '    ';
                STRINGREP (log_message (12, 3), length, trip_delay.second);
                STRINGREP (log_message (20, 4), length, trip_delay.millisecond);
                pmp$log (log_message, status);
                IF NOT synchronization_successful (trip_delay) THEN
                  IF connection^.sync_attempts < 3 THEN
                    connection^.sync_attempts := connection^.sync_attempts + 1;
                    send_clock_pdu (address, connection^);
                  ELSE
                    disconnect_reason := clock_synch_failed;
                    nap$gt_disconnect (connection^.connection_id, output_data, status);
                    IF NOT status.normal THEN
                      nap$display_message (status);
                    IFEND;
                    delete_connection (connection);
                  IFEND;
                ELSE
                  pmp$log ('CLOCK SYNC SUCCESSFUL', status);
                  disconnect_reason := clock_synch_successful;
                  nap$gt_disconnect (connection^.connection_id, output_data, status);
                  IF NOT status.normal THEN
                    nap$display_message (status);
                  IFEND;
                  delete_connection (connection);
                IFEND;
              ELSE
                pmp$log ('CK - INVALID CLOCK PDU', status);
                disconnect_reason := protocol_version_mismatch;
                nap$gt_disconnect (connection^.connection_id, output_data, status);
                IF NOT status.normal THEN
                  nap$display_message (status);
                IFEND;
                delete_connection (connection);
              IFEND;

            = nac$gt_expedited_data_event =
              pmp$log ('CK - X-DATA EVENT', status);
              nap$gt_disconnect (connection^.connection_id, output_data, status);
              IF NOT status.normal THEN
                nap$display_message (status);
              IFEND;
              delete_connection (connection);

            = nac$gt_disconnect_event =
              delete_connection (connection);
              pmp$log ('CK - UNEXPECTED DISCONNECT EVENT', status);
            CASEND;
          ELSE
            nap$gt_disconnect (wait_list^ [index].receive_connection_id, output_data, status);
            IF NOT status.normal THEN
              nap$display_message (status);
            IFEND;
            IF connection <> NIL THEN
              delete_connection (connection);
            ELSE
              pmp$log ('CK - DATA ON NON-EXISTENT CONNECTION', status);
            IFEND;
          IFEND;
        IFEND;
      ELSE
        EXIT /main_loop/;
      IFEND;
    WHILEND /main_loop/;
  PROCEND nap$clock_me;

?? TITLE := 'delete_connection', EJECT ??

  PROCEDURE delete_connection (connect_info: ^connection_information);

    VAR
      connection: ^connection_information,
      connection_link: ^^connection_information,
      i: 1 .. nac$max_connections;

    connection := connect_info;

  /forloop/
    FOR i := 2 TO UPPERBOUND (wait_list^) DO
      IF (wait_list^ [i].activity = nac$gt_await_receive_event) AND (wait_list^ [i].receive_connection_id =
            connection^.connection_id) THEN
        wait_list^ [i].activity := nac$gt_null_activity;
        EXIT /forloop/;
      IFEND;
    FOREND /forloop/;
    IF i = UPPERBOUND (wait_list^) THEN
      WHILE wait_list^ [i].activity = nac$gt_null_activity DO
        i := i - 1;
      WHILEND;
      RESET wait_list_seq;
      NEXT wait_list: [1 .. i] IN wait_list_seq;
    IFEND;

    connection_link := ^connection_list;
    WHILE (connection_link^ <> NIL) AND (connection_link^ <> connection) DO
      connection_link := ^connection_link^^.next_connection;
    WHILEND;
    IF connection_link^ <> NIL THEN
      connection_link^ := connection^.next_connection;
      FREE connection;
      active_connections := active_connections - 1;
    IFEND;
  PROCEND delete_connection;
?? TITLE := 'find_connection', EJECT ??

  PROCEDURE [INLINE] find_connection (connection_id: nat$gt_connection_id;
    VAR connection: ^connection_information);

    connection := connection_list;
    WHILE (connection <> NIL) AND (connection^.connection_id <> connection_id) DO
      connection := connection^.next_connection;
    WHILEND;
  PROCEND find_connection;

?? TITLE := 'send_clock_pdu', EJECT ??

  PROCEDURE send_clock_pdu (address: nat$internet_address;
    VAR connection: connection_information);

    VAR
      clock_pdu: clock_synchronization_pdu,
      date_time: ost$date_time,
      local_status: ost$status,
      output_data: array [1 .. 1] of nat$data_fragment;

    clock_pdu.length := nac$max_clock_pdu_size;
    clock_pdu.version_number := version;
    clock_pdu.system_address.network := address.network;
    clock_pdu.system_address.system := address.system;
    clock_pdu.system_title := '';
    pmp$get_compact_date_time (date_time, local_status);
    connection.date_time := date_time;
    clock_pdu.time_stamp.date.year1 := (date_time.year MOD 100) DIV 10;
    clock_pdu.time_stamp.date.year2 := date_time.year MOD 10;
    clock_pdu.time_stamp.date.month1 := date_time.month DIV 10;
    clock_pdu.time_stamp.date.month2 := date_time.month MOD 10;
    clock_pdu.time_stamp.date.day1 := date_time.day DIV 10;
    clock_pdu.time_stamp.date.day2 := date_time.day MOD 10;
    clock_pdu.time_stamp.time.hours1 := date_time.hour DIV 10;
    clock_pdu.time_stamp.time.hours2 := date_time.hour MOD 10;
    clock_pdu.time_stamp.time.minutes1 := date_time.minute DIV 10;
    clock_pdu.time_stamp.time.minutes2 := date_time.minute MOD 10;
    clock_pdu.time_stamp.time.seconds1 := date_time.second DIV 10;
    clock_pdu.time_stamp.time.seconds2 := date_time.second MOD 10;
    clock_pdu.time_stamp.time.milliseconds1 := date_time.millisecond DIV 100;
    clock_pdu.time_stamp.time.milliseconds2 := (date_time.millisecond MOD 100) DIV 10;
    clock_pdu.time_stamp.time.milliseconds3 := date_time.millisecond MOD 10;
    clock_pdu.time_stamp.time.fill := 0;

    output_data [1].address := ^clock_pdu;
    output_data [1].length := #SIZE (clock_pdu);
    nap$gt_send_data (connection.connection_id, output_data, TRUE, osc$wait, connection.activity_status,
          local_status);
    IF NOT local_status.normal THEN
      nap$display_message (local_status);
    IFEND;
    temp_data_frag [1].address := connection.data_area [1].address;
    temp_data_frag [1].length := connection.data_area [1].length;
    nap$gt_receive_connection_event (connection.connection_id, temp_data_frag, osc$nowait, connection.event,
          connection.activity_status, local_status);
    IF NOT local_status.normal THEN
      nap$display_message (local_status);
      delete_connection (^connection);
    IFEND;
  PROCEND send_clock_pdu;

?? TITLE := 'register_title', EJECT ??

  PROCEDURE register_title (address: nat$internet_address;
        sap: nat$gt_sap_identifier;
    VAR directory_identifier: nat$directory_entry_identifier;
    VAR status: ost$status);

    VAR
      class: nat$title_class,
      distribute: boolean,
      domain: nat$title_domain,
      osi_address: nat$osi_registration_address,
      priority: nat$directory_priority,
      service: nat$protocol;


    status.normal := TRUE;
    osi_address.kind := nac$osi_transport_address;
    osi_address.transport_selector := sap.osi_sap_identifier;
    service := nac$cdna_transport; { same value as for nac$osi_transport }
    priority := nac$max_directory_priority;
    domain.kind := nac$catenet_domain;
    distribute := FALSE;
    class := nac$cdna_internal;

    nlp$register_title (nac$clock_me_title, osi_address, service, NIL, 0, priority, domain,
          distribute, class, nac$clock_title_password, user_identifier, directory_identifier, status);
  PROCEND register_title;

?? TITLE := 'synchronization_successful', EJECT ??

  FUNCTION synchronization_successful (trip_delay: pmt$time_increment): boolean;

    synchronization_successful := ((trip_delay.millisecond <= nac$max_clock_trip_delay) AND (trip_delay.second
          = 0) AND (trip_delay.minute = 0) AND (trip_delay.hour = 0) AND (trip_delay.day = 0) AND (trip_delay.
          month = 0));

  FUNCEND synchronization_successful;

?? TITLE := 'process_parameters', EJECT ??

  PROCEDURE process_parameters (parameter_list: clt$parameter_list;
    VAR max_connections: 1 .. nac$max_connections;
    VAR status: ost$status);

{      PDT clock_me_pdt (
{      maximum_connections,mc:integer 1..nac$max_connections = 1000
{      status)

?? PUSH (LISTEXT := ON) ??

    VAR
      clock_me_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^clock_me_pdt_names,
        ^clock_me_pdt_params];

    VAR
      clock_me_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['MAXIMUM_CONNECTIONS', 1], ['MC', 1], ['STATUS', 2]];

    VAR
      clock_me_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ MAXIMUM_CONNECTIONS MC }
      [[clc$optional_with_default, ^clock_me_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$integer_value, 1, nac$max_connections]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      clock_me_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := '1000';

?? POP ??


    VAR
      value: clt$value;

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, clock_me_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('MAXIMUM_CONNECTIONS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    max_connections := value.int.value;

  PROCEND process_parameters;

?? TITLE := 'update_wait_list', EJECT ??

  PROCEDURE [INLINE] update_wait_list (connection_id: nat$gt_connection_id);

    VAR
      i: 1 .. nac$max_connections;

  /forloop/
    FOR i := 1 TO UPPERBOUND (wait_list^) DO
      IF wait_list^ [i].activity = nac$gt_null_activity THEN
        wait_list^ [i].activity := nac$gt_await_receive_event;
        wait_list^ [i].receive_connection_id := connection_id;
        EXIT /forloop/;
      IFEND;
    FOREND /forloop/;

    { Last entry in wait_list is always in use.}

    IF i = UPPERBOUND (wait_list^) THEN
      RESET wait_list_seq;
      NEXT wait_list: [1 .. UPPERBOUND (wait_list^) + 1] IN wait_list_seq;
      wait_list^ [UPPERBOUND (wait_list^)].activity := nac$gt_await_receive_event;
      wait_list^ [UPPERBOUND (wait_list^)].receive_connection_id := connection_id;
    IFEND;

  PROCEND update_wait_list;

MODEND nam$clock_me;
