?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : WHEN/WHENEND Condition Manager' ??
MODULE clm$when_condition_manager;

{
{ PURPOSE:
{   This module contains the procedures that manage WHEN condition processing information.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$compiling_for_test_harness
*copyc cle$ecc_control_statement
*copyc cle$unexpected_call_to
*copyc clt$collect_statement_area
*copyc clt$condition_processed_state
*copyc clt$established_handler_index
*copyc clt$established_handlers
*copyc clt$when_conditions
*copyc oss$task_shared
*copyc ost$caller_identifier
*copyc ost$status
?? POP ??
*copyc clp$create_procedure_variable
*copyc clp$find_current_block
*copyc clp$pop_input_stack
*copyc clp$save_collect_statement_area
*copyc clp$trimmed_string_size
*copyc osp$decrement_locked_variable
*copyc osp$fetch_locked_variable
*copyc osp$increment_locked_variable
*copyc osp$set_status_abnormal
*copyc osp$verify_system_privilege
*copyc osv$task_shared_heap
?? TITLE := 'clv$execution_fault_hndlr_count', EJECT ??

{ This variable is used to keep track of whether there are any WHEN/WHENEND
{ condition handlers established specifically for clc$wc_EXECUTION_FAULT.
{ This information is used to optimize the processing of abnormally
{ terminating commands in the absence of such a handler.  This variable must
{ always be accessed using the "locked variable" interfaces.

  VAR
    clv$execution_fault_hndlr_count: [STATIC, oss$task_shared] integer := 0;

?? TITLE := 'clp$continue', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$continue
    (    continue_when_condition_option: clt$condition_processed_state;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      target_block: ^clt$block;


    ?IF NOT clc$compiling_for_test_harness THEN
      osp$verify_system_privilege;
    ?IFEND;

    status.normal := TRUE;
    clp$find_current_block (block);
    target_block := block;

  /find_when_block/
    WHILE target_block <> NIL DO
      CASE target_block^.kind OF
      = clc$block_block, clc$command_block, clc$for_block, clc$if_block, clc$input_block, clc$loop_block,
            clc$repeat_block, clc$while_block =
        target_block := target_block^.previous_block;
      = clc$when_block =
        EXIT /find_when_block/;
      ELSE
        target_block := NIL;
        EXIT /find_when_block/;
      CASEND;
    WHILEND /find_when_block/;

    IF target_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'CONTINUE', status);
      RETURN;
    IFEND;

    WHILE TRUE DO
      block^.interpreter_mode := clc$skip_mode;
      block^.being_exited := TRUE;
      IF block = target_block THEN
        block^.when_condition^.condition_processed_state := continue_when_condition_option;
        RETURN;
      IFEND;
      block := block^.previous_block;
    WHILEND;

  PROCEND clp$continue;
?? TITLE := 'clp$disestablish_cond_handler', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$disestablish_cond_handler
    (    any_condition: boolean;
         any_fault: boolean;
         specific_conditions: ^clt$when_conditions);

    VAR
      block: ^clt$block;


    ?IF NOT clc$compiling_for_test_harness THEN
      osp$verify_system_privilege;
    ?IFEND;

    find_block_for_handler (block);
    IF (block = NIL) OR (NOT handlers_in_block (block)) THEN
      RETURN;
    IFEND;

    disestablish_cond_handler (any_condition, any_fault, specific_conditions, block);

  PROCEND clp$disestablish_cond_handler;
?? TITLE := 'clp$establish_condition_handler', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$establish_condition_handler
    (    any_condition: boolean;
         any_fault: boolean;
         specific_conditions: ^clt$when_conditions;
         statement_area: ^clt$collect_statement_area;
         can_be_echoed: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier,
      i: clt$established_handler_index,
      ignore_count: integer,
      handler_statements: ^clt$established_handler_stmnts,
      new_established_handlers: ^clt$established_handlers;

?? NEWTITLE := 'eliminate_duplicate_handlers', EJECT ??

    PROCEDURE [INLINE] eliminate_duplicate_handlers
      (VAR specific_handler_count {input, output} : clt$established_handler_count;
       VAR specific_handlers {input, output} : clt$established_handlers);

      VAR
        duplicate_count: clt$established_handler_count,
        i: clt$established_handler_index,
        j: clt$established_handler_index;


      i := 1;
      WHILE i < specific_handler_count DO
        j := i + 1;
        WHILE (j <= specific_handler_count) AND (specific_handlers [i].condition =
              specific_handlers [j].condition) DO
          free_handler_statements (specific_handlers [j].statements);
          j := j + 1;
        WHILEND;
        duplicate_count := j - i - 1;
        IF duplicate_count > 0 THEN
          WHILE j <= specific_handler_count DO
            specific_handlers [j - duplicate_count] := specific_handlers [j];
            j := j + 1;
          WHILEND;
          specific_handler_count := specific_handler_count - duplicate_count;
        IFEND;
        i := i + 1;
      WHILEND;

    PROCEND eliminate_duplicate_handlers;
?? TITLE := 'sort_handlers', EJECT ??

    PROCEDURE [INLINE] sort_handlers
      (    specific_handler_count: clt$established_handler_count;
       VAR specific_handlers {input, output} : clt$established_handlers);

      VAR
        current: -clc$max_established_handlers .. clc$max_established_handlers,
        gap: clt$established_handler_index,
        start: clt$established_handler_index,
        swap: clt$established_handler;

      VAR
        duplicate_count: clt$established_handler_count,
        i: clt$established_handler_index,
        j: clt$established_handler_index;


{ Use shell sort technique to sort the specific_handlers array.

      gap := specific_handler_count;
      WHILE gap > 1 DO
        gap := 2 * (gap DIV 4) + 1;
        FOR start := 1 TO specific_handler_count - gap DO
          current := start;
          WHILE (current > 0) AND (specific_handlers [current].condition >
                specific_handlers [current + gap].condition) DO
            swap := specific_handlers [current];
            specific_handlers [current] := specific_handlers [current + gap];
            specific_handlers [current + gap] := swap;
            current := current - gap;
          WHILEND;
        FOREND;
      WHILEND;

    PROCEND sort_handlers;
?? OLDTITLE, EJECT ??

    ?IF NOT clc$compiling_for_test_harness THEN
      osp$verify_system_privilege;
    ?IFEND;

    status.normal := TRUE;
    #CALLER_ID (caller_id);

    find_block_for_handler (block);
    IF block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$establish_condition_handler', status);
      RETURN;
    IFEND;

    IF handlers_in_block (block) THEN
      disestablish_cond_handler (any_condition, any_fault, specific_conditions, block);
    IFEND;

    ALLOCATE handler_statements: [[REP #SIZE (statement_area^) OF cell]] IN osv$task_shared_heap^;
    handler_statements^.established_count := 0;
    handler_statements^.establishing_ring := caller_id.ring;
    handler_statements^.can_be_echoed := can_be_echoed;
    handler_statements^.statement_area := statement_area^;

    IF any_condition THEN
      block^.established_handler_info.any_condition_handler := handler_statements;
      handler_statements^.established_count := handler_statements^.established_count + 1;
    IFEND;

    IF any_fault THEN
      block^.established_handler_info.any_fault_handler := handler_statements;
      handler_statements^.established_count := handler_statements^.established_count + 1;
    IFEND;

    IF specific_conditions <> NIL THEN
      IF block^.established_handler_info.specific_handler_count = 0 THEN
        ALLOCATE block^.established_handler_info.specific_handlers:
              [1 .. UPPERBOUND (specific_conditions^)] IN osv$task_shared_heap^;
      ELSEIF (block^.established_handler_info.specific_handler_count + UPPERBOUND (specific_conditions^)) >
            UPPERBOUND (block^.established_handler_info.specific_handlers^) THEN
        ALLOCATE new_established_handlers: [1 .. block^.established_handler_info.
              specific_handler_count + UPPERBOUND (specific_conditions^)] IN osv$task_shared_heap^;
        FOR i := 1 TO block^.established_handler_info.specific_handler_count DO
          new_established_handlers^ [i] := block^.established_handler_info.specific_handlers^ [i];
        FOREND;
        FREE block^.established_handler_info.specific_handlers IN osv$task_shared_heap^;
        block^.established_handler_info.specific_handlers := new_established_handlers;
      IFEND;

      FOR i := 1 TO UPPERBOUND (specific_conditions^) DO
        block^.established_handler_info.specific_handler_count :=
              block^.established_handler_info.specific_handler_count + 1;
        block^.established_handler_info.specific_handlers^ [block^.established_handler_info.
              specific_handler_count].condition := specific_conditions^ [i];
        block^.established_handler_info.specific_handlers^ [block^.established_handler_info.
              specific_handler_count].statements := handler_statements;
        handler_statements^.established_count := handler_statements^.established_count + 1;
        IF specific_conditions^ [i] = clc$wc_execution_fault THEN
          osp$increment_locked_variable (clv$execution_fault_hndlr_count, 0, ignore_count);
        IFEND;
      FOREND;

      sort_handlers (block^.established_handler_info.specific_handler_count,
            block^.established_handler_info.specific_handlers^);
      eliminate_duplicate_handlers (block^.established_handler_info.specific_handler_count,
            block^.established_handler_info.specific_handlers^);
    IFEND;

  PROCEND clp$establish_condition_handler;
?? TITLE := 'clp$execution_fault_handler_est', EJECT ??

  FUNCTION [XDCL, #GATE, UNSAFE] clp$execution_fault_handler_est: boolean;

    VAR
      count: integer;


    osp$fetch_locked_variable (clv$execution_fault_hndlr_count, count);
    clp$execution_fault_handler_est := count > 0;

  FUNCEND clp$execution_fault_handler_est;
?? TITLE := 'clp$free_all_handlers', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$free_all_handlers;

    VAR
      block: ^clt$block;


    find_block_for_handler (block);
    IF (block = NIL) OR (NOT handlers_in_block (block)) THEN
      clp$find_current_block (block);
      IF (block^.kind <> clc$task_block) OR (block^.task_kind <> clc$job_monitor_task) OR
            (NOT handlers_in_block (block)) THEN
        RETURN;
      IFEND;
    IFEND;

    clp$free_all_handlers_in_block (block);

  PROCEND clp$free_all_handlers;
?? TITLE := 'clp$free_all_handlers_in_block', EJECT ??

  PROCEDURE [XDCL] clp$free_all_handlers_in_block
    (    block: ^clt$block);

    VAR
      i: clt$established_handler_index;


    IF block^.established_handler_info.any_condition_handler <> NIL THEN
      free_handler_statements (block^.established_handler_info.any_condition_handler);
    IFEND;

    IF block^.established_handler_info.any_fault_handler <> NIL THEN
      free_handler_statements (block^.established_handler_info.any_fault_handler);
    IFEND;

    IF block^.established_handler_info.specific_handlers <> NIL THEN
      FOR i := 1 TO block^.established_handler_info.specific_handler_count DO
        free_handler_statements (block^.established_handler_info.specific_handlers^ [i].statements);
      FOREND;
      FREE block^.established_handler_info.specific_handlers IN osv$task_shared_heap^;
    IFEND;

    block^.established_handler_info.specific_handler_count := 0;

  PROCEND clp$free_all_handlers_in_block;
?? TITLE := 'disestablish_cond_handler', EJECT ??

  PROCEDURE disestablish_cond_handler
    (    any_condition: boolean;
         any_fault: boolean;
         specific_conditions: ^clt$when_conditions;
         block: ^clt$block);

    VAR
      handler_found: boolean,
      handler_index: clt$established_handler_index,
      i: clt$established_handler_index,
      ignore_count: integer,
      ignore_count_error: boolean;


    IF any_condition AND (block^.established_handler_info.any_condition_handler <> NIL) THEN
      free_handler_statements (block^.established_handler_info.any_condition_handler);
    IFEND;

    IF any_fault AND (block^.established_handler_info.any_fault_handler <> NIL) THEN
      free_handler_statements (block^.established_handler_info.any_fault_handler);
    IFEND;

    IF (block^.established_handler_info.specific_handler_count > 0) AND (specific_conditions <> NIL) THEN
      FOR i := 1 TO UPPERBOUND (specific_conditions^) DO
        search_established_handlers (specific_conditions^ [i],
              block^.established_handler_info.specific_handlers,
              block^.established_handler_info.specific_handler_count, handler_index, handler_found);

        IF handler_found THEN
          free_handler_statements (block^.established_handler_info.specific_handlers^ [handler_index].
                statements);
          FOR handler_index := handler_index + 1 TO block^.established_handler_info.specific_handler_count DO
            block^.established_handler_info.specific_handlers^ [handler_index - 1] :=
                  block^.established_handler_info.specific_handlers^ [handler_index];
          FOREND;
          block^.established_handler_info.specific_handler_count :=
                block^.established_handler_info.specific_handler_count - 1;
          IF specific_conditions^ [i] = clc$wc_execution_fault THEN
            osp$decrement_locked_variable (clv$execution_fault_hndlr_count, 1, ignore_count,
                  ignore_count_error);
          IFEND;
        IFEND;
      FOREND;
    IFEND;

    IF (block^.established_handler_info.specific_handler_count = 0) AND
          (block^.established_handler_info.specific_handlers <> NIL) THEN
      FREE block^.established_handler_info.specific_handlers IN osv$task_shared_heap^;
    IFEND;

  PROCEND disestablish_cond_handler;
?? TITLE := 'find_block_for_handler', EJECT ??

  PROCEDURE [INLINE] find_block_for_handler
    (VAR block: ^clt$block);


    clp$find_current_block (block);

    WHILE block <> NIL DO
      CASE block^.kind OF

      = clc$command_proc_block, clc$function_proc_block, clc$when_block =
        RETURN;

      = clc$input_block =
        IF (block^.associated_utility <> NIL) OR ((block^.previous_block^.kind = clc$task_block) AND
              ((block^.previous_block^.task_kind = clc$task_statement_task) OR
              (block^.previous_block^.task_kind = clc$job_monitor_task))) THEN
          RETURN;
        IFEND;

      ELSE
        ;
      CASEND;

      block := block^.previous_block;
    WHILEND;

  PROCEND find_block_for_handler;
?? TITLE := 'free_handler_statements', EJECT ??

  PROCEDURE [INLINE] free_handler_statements
    (VAR handler_statements {input, output} : ^clt$established_handler_stmnts);


    handler_statements^.established_count := handler_statements^.established_count - 1;

    IF handler_statements^.established_count <= 0 THEN
      FREE handler_statements IN osv$task_shared_heap^;
    IFEND;

    handler_statements := NIL;

  PROCEND free_handler_statements;
?? TITLE := 'handlers_in_block', EJECT ??

  FUNCTION [INLINE] handlers_in_block
    (    block: ^clt$block): boolean;


    handlers_in_block := (block^.established_handler_info.any_condition_handler <> NIL) OR
          (block^.established_handler_info.any_fault_handler <> NIL) OR
          (block^.established_handler_info.specific_handler_count > 0);

  FUNCEND handlers_in_block;
?? TITLE := 'search_established_handlers', EJECT ??

  PROCEDURE [INLINE] search_established_handlers
    (    condition: clt$when_condition;
         handlers: ^clt$established_handlers;
         handler_count: clt$established_handler_count;
     VAR handler_index: clt$established_handler_index;
     VAR handler_found: boolean);

    VAR
      low_index: 1 .. clc$max_established_handlers + 1,
      temp: integer,
      high_index: 0 .. clc$max_established_handlers;


    handler_found := FALSE;

    IF (handlers <> NIL) AND (handler_count > 0) THEN
      low_index := 1;
      high_index := handler_count;
      REPEAT
        temp := low_index + high_index;
        handler_index := temp DIV 2;
        IF condition = handlers^ [handler_index].condition THEN
          handler_found := TRUE;
        ELSEIF condition > handlers^ [handler_index].condition THEN
          low_index := handler_index + 1;
        ELSE
          high_index := handler_index - 1;
        IFEND;
      UNTIL handler_found OR (low_index > high_index);
    IFEND;

  PROCEND search_established_handlers;

MODEND clm$when_condition_manager;
