?? NEWTITLE := 'NOS/VE SCL Interpreter : Block Stack Manager' ??
MODULE clm$f_block_stack_manager;
?? RIGHT := 110 ??

{
{ PURPOSE:
{   This module contains the procedures that manage the Block stack which is used to keep track of the
{   current state of the SCL formatter blocks.
{

?? NEWTITLE := 'Global Declarations' ??
?? NEWTITLE := 'Block Stack', EJECT ??
*copyc clt$f_block
?? OLDTITLE, EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_control_statement
*copyc cle$ecc_miscellaneous
*copyc ose$heap_full_exceptions
*copyc oss$job_paged_literal
*copyc ost$status
?? SKIP := 3 ??

{
{ PURPOSE:
{   The following procedure exists solely to provide a "shelter" for the
{   declarations contained in certain decks that are *COPYC'd into this
{   deck.  For example, this module defines an XDCL'd variable that is
{   referenced by an INLINE procedure.  In order to make the deck containing
{   the INLINE procedure "self-contained" it *COPYCs the deck containing the
{   XREF declaration of the variable.  Since the INLINE procedure is needed
{   in this module, both the XDCL and XREF declaration will appear in this
{   module.  The following "dummy" procedure is used to hide the XREF
{   declaration of the variable form the rest of the module.
{

  PROCEDURE [INLINE] dummy;

*copyc clp$f_find_task_block_1st_time
*copyc clv$f_current_task_block

  PROCEND dummy;
?? SKIP := 3 ??
?? POP ??
*copyc clp$f_find_current_block
*copyc clp$f_find_task_block
*copyc clp$f_output_line_number
*copyc clp$f_set_command_header_type
*copyc osp$append_status_parameter
*copyc osp$generate_message
*copyc osp$set_status_abnormal
*copyc pmp$abort
*copyc pmp$exit

?? TITLE := 'clv$f_current_task_block', EJECT ??

{
{ PURPOSE:
{   This variable contains the pointer to the clc$task_block for the current task.
{   It is initialized by clp$f_find_task_block_1st_time (see below).
{

  VAR
    clv$f_current_task_block: [XDCL, #GATE] ^clt$f_block := NIL;

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

{
{ PURPOSE:
{   This procedure is called the first time in a task that the task's clc$task_block is needed.
{   It is only called by clp$f_find_task_block.
{   If the task list is empty, then this procedure assumes it is being called within the job monitor task
{   for a job and creates a task block for itself and initializes the task list to contain that block.
{

  PROCEDURE [XDCL, #GATE] clp$f_find_task_block_1st_time
    (VAR task_block: ^clt$f_block;
     VAR status: ost$status);

    VAR
      ignore_task_link: ^^clt$f_block;

    status.normal := TRUE;
    IF clv$f_current_task_block = NIL THEN
      create_block (clc$task_block, FALSE, osc$null_name, NIL, clv$f_current_task_block, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;
    clv$f_current_task_block^.current_block := clv$f_current_task_block;
    task_block := clv$f_current_task_block;

  PROCEND clp$f_find_task_block_1st_time;
?? TITLE := 'clp$f_push_block_stack', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$f_push_block_stack
    (    block_kind: clt$block_kind;
         block_label: ost$name;
     VAR current_block: ^clt$f_block);

    VAR
      task_block: ^clt$f_block,
      block: ^clt$f_block,
      status: ost$status;

    IF (block_kind < LOWERVALUE (clt$block_kind)) OR (block_kind > UPPERVALUE (clt$block_kind)) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$f_push_block_stack', status);
      pmp$abort (status);
    IFEND;

    clp$f_find_task_block (task_block, status);
    IF NOT status.normal THEN
      pmp$abort (status);
    IFEND;

    create_block (block_kind, TRUE, block_label, task_block, block, status);
    IF NOT status.normal THEN
      pmp$abort (status);
    IFEND;

    IF (block_kind <> clc$utility_block) AND (block_kind <> clc$var_block) THEN
      clp$f_set_command_header_type (clc$control_statement_begin);
      IF block_kind = clc$if_block THEN
        block^.if_else_allowed := TRUE;
      ELSEIF block_kind = clc$case_block THEN
        block^.case_else_allowed := TRUE;
      IFEND;
    IFEND;

    task_block^.current_block := block;
    current_block := block;

  PROCEND clp$f_push_block_stack;
?? TITLE := 'create_block', EJECT ??

  PROCEDURE create_block
    (    block_kind: clt$block_kind;
         synchronous_with_parent: boolean;
         block_label: ost$name;
         task_block: ^clt$f_block;
     VAR new_block: ^clt$f_block;
     VAR status: ost$status);

    VAR
      block_kind_names: [STATIC, READ, oss$job_paged_literal] array [clt$block_kind] of string (14) :=
            ['BLOCK', 'command', 'CASE', 'FOR', 'JOB', 'LOGIN', 'PIPE', 'TASK', 'UTILITY', 'IF', 'input',
            'LOOP', 'PROC', 'REPEAT', 'sub_parameters', 'task', 'utility', 'VAR', 'WHEN', 'WHILE'],
      block_kind_end_names: [STATIC, READ, oss$job_paged_literal] array [clt$block_kind] of string (18) :=
            ['BLOCKEND', 'command_end', 'CASEND', 'FOREND', 'JOBEND', 'LOGOUT', 'PIPEND', 'TASKEND',
            'UTILITYEND', 'IFEND', 'end_of_input', 'LOOPEND', 'PROCEND', 'UNTIL', 'sub_parameters_end',
            'end_of_task', 'end_of_utility', 'VAREND', 'WHENEND', 'WHILEND'],
      var_block: ^clt$f_block,
      input_block: ^clt$f_block;

    status.normal := TRUE;
    ALLOCATE new_block: [block_kind];
    IF new_block = NIL THEN
      osp$set_status_abnormal ('CL', ose$task_shared_full, 'Block Stack', status);
      RETURN; {----->
    IFEND;

    IF task_block <> NIL THEN
      new_block^.previous_block := task_block^.current_block;
    ELSE
      new_block^.previous_block := NIL;
      new_block^.interpreter_mode := clc$interpret_mode;
      input_block := NIL;
    IFEND;

    new_block^.output_line_number := clp$f_output_line_number ();
    new_block^.label := block_label;
    new_block^.kind_name := block_kind_names [block_kind];
    new_block^.kind_end_name := block_kind_end_names [block_kind];

  PROCEND create_block;
?? TITLE := 'clp$f_pop_block_stack', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$f_pop_block_stack
    (VAR current_block: ^clt$f_block);

    VAR
      issued_waiting_message: boolean,
      task_block: ^clt$f_block,
      old_block: ^clt$f_block,
      status: ost$status,
      ignore_status: ost$status,
      ignore_ready_index: integer;

    clp$f_find_task_block (task_block, status);
    IF NOT status.normal THEN
      pmp$abort (status);
    ELSEIF task_block^.current_block = task_block THEN
      RETURN; {----->
    IFEND;
    old_block := task_block^.current_block^.previous_block;

    IF (task_block^.current_block^.kind <> clc$utility_block) AND
          (task_block^.current_block^.kind <> clc$var_block) THEN
      clp$f_set_command_header_type (clc$control_statement_end);
    IFEND;
    free_block (task_block^.current_block);

    task_block^.current_block := old_block;
    current_block := old_block;

  PROCEND clp$f_pop_block_stack;
?? TITLE := 'free_block', EJECT ??

  PROCEDURE free_block
    (VAR block {input} : ^clt$f_block);


    FREE block;

  PROCEND free_block;
?? TITLE := 'clp$f_find_cycle_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$f_find_cycle_block
    (    target_label: ost$name;
     VAR current_block: ^clt$f_block;
     VAR target_block: ^clt$f_block;
     VAR status: ost$status);

    status.normal := TRUE;
    clp$f_find_current_block (current_block);
    target_block := current_block;

  /find_block_to_be_cycled/
    WHILE target_block <> NIL DO
      CASE target_block^.kind OF
      = clc$block_block, clc$var_block =
        IF (target_label <> '') AND (target_label = target_block^.label) THEN
          osp$set_status_abnormal ('CL', cle$statement_cant_be_cycled, 'BLOCK', status);
          RETURN; {----->
        IFEND;
      = clc$for_block, clc$loop_block, clc$repeat_block, clc$while_block =
        IF (target_label = '') OR (target_label = target_block^.label) THEN
          RETURN; {----->
        IFEND;
      = clc$if_block, clc$case_block =
        ;
      ELSE
        target_block := NIL;
        EXIT /find_block_to_be_cycled/; {----->
      CASEND;
      target_block := target_block^.previous_block;
    WHILEND /find_block_to_be_cycled/;
    IF target_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'CYCLE', status);
      IF target_label <> '' THEN
        osp$append_status_parameter (' ', target_label, status);
      IFEND;
      RETURN; {----->
    IFEND;

  PROCEND clp$f_find_cycle_block;

MODEND clm$f_block_stack_manager;
