?? RIGHT := 110 ??
?? TITLE := 'NOS/VE : Tasking : Task initiation' ??
?? NEWTITLE := '  Global declarations', EJECT ??
MODULE pmm$task_initiation;

{  PURPOSE:
{    This module contains procedures which control the initiation of a new task.
{  DESIGN:
{    The initiation of a new task is divided into two distinct phases.  The first phase occurs
{    in the parent task (the task issuing the PMP$EXECUTE request).  It consists of creating a
{    fundamental task environment and issuing a monitor request to activate the new task.
{    The second phase occurs in the child task (the new task).  It consists of loading the user
{    program into the task's address space and transferring to the user program.  Parameters
{    describing the program to be executed are passed from the parent task to the child task
{    thru job_global data structures.
?? EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$standard_file_names
*copyc mmt$attribute_keyword
*copyc pmt$program_description
*copyc pmt$program_parameters
*copyc pmt$task_control_block
*copyc pmt$os_stack_frame_word
*copyc pmt$task_cp_time
*copyc pmt$task_id
*copyc pmt$user_program
*copyc pmt$task_status
*copyc pmt$loadable_rings
*copyc ost$wait
*copyc ost$status
*copyc osd$code_base_pointer
*copyc ost$execution_control_block
*copyc cyd$cybil_structure_definitions
*copyc jmp$job_boot
*copyc jmp$job_monitor_xcb
*copyc syp$initialize_job
*copyc clp$job_boot
*copyc pmp$trap_handler
*copyc jmp$initialize_jcb
*copyc pmp$initialize_job_xcb_list
*copyc jmv$executing_within_system_job
*copyc ost$caller_identifier
*copyc oss$job_fixed
*copyc pme$execution_exceptions
*copyc pme$target_ring_error
*copyc pme$system_exceptions
*copyc pmc$default_user_stack_size
*copyc osp$generate_message
*copyc sfp$emit_statistic
*copyc pmc$min_scc_program_execution
*copyc osp$reset_heap
*copyc osp$system_error
*copyc osp$set_status_abnormal
*copyc osp$append_status_parameter
*copyc osp$set_signature_lock
*copyc osp$clear_signature_lock
*copyc osp$append_status_integer
*copyc i#move
*copyc i#build_adaptable_seq_pointer
*copyc clp$interpret_commands
*copyc clp$validate_name
*copyc clp$record_child_task
*copyc clp$erase_child_task
*copyc jmp$initialize_job_environment
*copyc jmp$job_begin
*copyc tmp$enable_preemptive_commo
*copyc osp$append_status_integer
*copyc osp$generate_log_message
*copyc pmp$create_shared_stack
*copyc pmp$end_debug_should_be_called
*copyc pmp$push_task_debug_mode
*copyc pmp$task_debug_mode_on
*copyc pmp$debug_abort_file_specified
*copyc pmp$set_task_debug_mode
*copyc pmp$set_task_debug_ring
*copyc pmp$task_debug_ring
*copyc pmp$exit
*copyc pmp$establish_condition_handler
*copyc pmp$continue_to_cause
*copyc pmp$create_task_environment
*copyc pmp$initiate_child_task
*copyc pmp$long_term_wait
*copyc pmp$release_task_environment
*copyc pmp$initialize_tasking_tables
*copyc pmp$find_executing_task_tcb
*copyc pmp$find_task_tcb
*copyc pmp$find_executing_task_xcb
*copyc pmp$call_begin_debug
*copyc pmp$find_prog_options_and_libs
*copyc pmp$find_stack_segment
*copyc pmp$original_caller
*copyc pmp$outward_call
*copyc pmp$update_jmtr_tcb_target_ring
*copyc pmp$update_program_description
*copyc pmp$get_task_cp_time
*copyc syp$initialize_job_template
*copyc lop$load_program
*copyc lop$reset_loader_for_2nd_load
*copyc lov$loader_options
*copyc osv$task_private_heap
*copyc mmv$page_map_offsets
*copyc osv$page_size
*copyc oss$task_private
*copyc oss$task_shared
*copyc oss$job_paged_literal
*copyc pmt$spy_identifier
*copyc pmt$spy_identifiers
*copyc pme$program_services_exceptions
*copyc pmv$debug_logging_enabled
*copyc pmv$job_monitor_tcb_p
*copyc syv$job_initialization_complete
*copyc syv$nosve_job_template
?? POP ??
?? TITLE := '    Global Declarations Declared by this Module.', EJECT ??

  VAR
    initialize_os_stack_frame_word: [STATIC, READ, oss$job_paged_literal] pmt$os_stack_frame_word :=
      [NIL, FALSE, FALSE, FALSE, FALSE, 0];

  VAR
    pmv$enable_inhibit_conditions: [XDCL, #GATE, oss$task_private] pmt$enable_inhibit_conditions;

?? TITLE := '  [XDCL, #GATE] pmp$execute_task', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$execute_task (target_ring: ost$valid_ring;
        program_description: pmt$program_description;
        mpe_description: pmt$loader_description;
        program_parameters: pmt$program_parameters;
        command_file: amt$local_file_name;
        wait: ost$wait;
        cl_task: boolean;
    VAR task_id: pmt$task_id;
    VAR task_status: pmt$task_status;
    VAR status: ost$status);

*copyc pmh$execute_task

{  PURPOSE:
{    This procedure is responsible for creating a new task and making it known to monitor.

    VAR
      pmv$spy_identifiers: [XREF, oss$task_shared] pmt$spy_identifiers,
      spy_identifier: pmt$spy_identifier,
      valid_program_params: ^pmt$program_parameters,
      caller: ost$caller_identifier,
      target_loaded_ring: ost$valid_ring,
      validated_program_description: ^pmt$program_description,
      local_task_id: pmt$task_id,
      local_status: ost$status,
      local_task_status: ^pmt$task_status,
      child_initiated: BOOLEAN;

    #caller_id (caller);

    IF #SIZE (program_description) > 0 THEN
      IF (caller.ring <= target_ring) THEN
        IF (target_ring < osc$tsrv_ring) THEN
          target_loaded_ring := osc$tsrv_ring;
        ELSE
          target_loaded_ring := target_ring;
        IFEND;
        status.normal := TRUE;
        local_status.normal := TRUE;
        PUSH validated_program_description: [[REP #SIZE (program_description) OF cell]];
        validate_program_description (program_description, validated_program_description, local_status);
        PUSH valid_program_params: [[REP #SIZE (program_parameters) OF cell]];
{ Copy them to validate access - if this fails an access violation will occur.
        valid_program_params^ := program_parameters;

        IF local_status.normal THEN
          { Validate write access to task_status from rings 2 or 3 (usually 3)
          local_task_status := ^task_status;
          local_task_status^.complete := FALSE;
          pmp$create_task_environment (validated_program_description, ^mpe_description, valid_program_params,
               ^task_status, target_loaded_ring, NIL, NIL, cl_task, local_task_id, local_status);
          IF local_status.normal THEN
            task_id := local_task_id;
            clp$record_child_task (target_loaded_ring, local_task_id, wait = osc$wait, command_file,
                  local_status);
            IF local_status.normal THEN
              spy_identifier := pmv$spy_identifiers.low_identifier;
              IF spy_identifier > UPPERVALUE (pmt$spy_identifier) THEN
                osp$set_status_abnormal ('PM', pme$invalid_spy_identifier, '', local_status);
                pmp$release_task_environment (local_task_id);
              ELSE
                REPEAT
                  pmp$initiate_child_task (local_task_id, spy_identifier, wait, child_initiated);
                  IF NOT child_initiated THEN
                    pmp$long_term_wait (1000, 1000);
                  IFEND;
                UNTIL child_initiated;
                IF spy_identifier < pmv$spy_identifiers.high_identifier THEN
                  pmv$spy_identifiers.low_identifier := spy_identifier + 1;
                IFEND;
              IFEND;
            ELSE
              pmp$release_task_environment (local_task_id);
            IFEND;
          IFEND;
        IFEND;
        IF NOT local_status.normal THEN
          status := local_status;
        IFEND;
      ELSE
        osp$set_status_abnormal ('PM', pme$target_ring_error, '', status);
      IFEND;
    ELSE
      osp$set_status_abnormal ('PM', pme$prog_description_too_small, 'program attributes', status);
    IFEND;

  PROCEND pmp$execute_task;
?? TITLE := '  [XDCL, #GATE] pmp$execute_procedure_as_task', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$execute_procedure_as_task (target_ring: ost$valid_ring;
        starting_procedure: pmt$user_program;
        program_parameters: pmt$program_parameters;
        critical_frame: ^ost$stack_frame_save_area;
    VAR task_id: pmt$task_id;
    VAR task_status: pmt$task_status;
    VAR status: ost$status);

*copy pmh$execute_procedure_as_task

    VAR
      pmv$spy_identifiers: [XREF, oss$task_shared] pmt$spy_identifiers,
      spy_identifier: pmt$spy_identifier,
      valid_program_params: ^pmt$program_parameters,
      caller: ost$caller_identifier,
      target_loaded_ring: ost$valid_ring,
      local_task_id: pmt$task_id,
      local_status: ost$status,
      local_task_status: ^pmt$task_status,
      previous_save_area: ^ost$stack_frame_save_area,
      os_stack_frame_word: ^pmt$os_stack_frame_word,
      tcb_p: ^pmt$task_control_block,
      valid_critical_frame: BOOLEAN,
      child_initiated: BOOLEAN;

    #caller_id (caller);

{ Validate the critical_frame value.  This value must be the pva of a stack frame save
{ area in the current task or the parameter is in error.

    valid_critical_frame := FALSE;
    previous_save_area := #previous_save_area ();

  /validate_critical_frame/
    WHILE previous_save_area <> NIL DO
      IF critical_frame = NIL THEN
        EXIT /validate_critical_frame/;
      IFEND;

{ Make sure that the critical frame is in the stack and not the one for pmp$original_caller.

      IF (previous_save_area = critical_frame) AND
              (previous_save_area^.minimum_save_area.a2_previous_save_area <> NIL) THEN
        valid_critical_frame := TRUE;
        EXIT /validate_critical_frame/;
      IFEND;
      previous_save_area := previous_save_area^.minimum_save_area.a2_previous_save_area;
    WHILEND /validate_critical_frame/;

    IF NOT valid_critical_frame THEN
      osp$set_status_abnormal ('PM', pme$invalid_critical_frame, '', status);
      RETURN;
    IFEND;

    os_stack_frame_word := critical_frame^.minimum_save_area.a1_current_stack_frame;
    IF critical_frame^.minimum_save_area.frame_descriptor.critical_frame_flag AND
       (os_stack_frame_word^.ada_critical_frame_count >= pmc$max_number_of_tasks) THEN
      osp$set_status_abnormal ('PM', pme$critical_frame_count_limit, '', status);
      RETURN;
    IFEND;

{ Validate the target_ring value.  This value must not be less than that of the caller,
{ and must be equal to the ring of the starting procedure.

    IF (caller.ring <= target_ring) AND (target_ring > osc$tsrv_ring) AND
           (target_ring = #RING (starting_procedure)) THEN
      target_loaded_ring := target_ring;
      status.normal := TRUE;
      local_status.normal := TRUE;

      PUSH valid_program_params: [[REP #SIZE (program_parameters) OF cell]];
{ Copy the parameters to validate access - if this fails an access violation will occur.
      valid_program_params^ := program_parameters;

{ Validate write access to task_status from rings 2 or 3 (usually 3).

      local_task_status := ^task_status;
      local_task_status^.complete := FALSE;

{ Use the program description and mpe description from the parent task.

      pmp$find_executing_task_tcb (tcb_p);
      pmp$create_task_environment (tcb_p^.nosve.program_description,
             tcb_p^.nosve.mpe_description, valid_program_params, ^task_status,
                  target_loaded_ring, critical_frame, starting_procedure,
                       FALSE, local_task_id, local_status);
      IF local_status.normal THEN
        task_id := local_task_id;

{ Record this child task with SCL.

        clp$record_child_task (target_loaded_ring, local_task_id, FALSE, osc$null_name, local_status);
        IF local_status.normal THEN
          spy_identifier := pmv$spy_identifiers.low_identifier;
          IF spy_identifier > UPPERVALUE (pmt$spy_identifier) THEN
            osp$set_status_abnormal ('PM', pme$invalid_spy_identifier, '', local_status);
            pmp$release_task_environment (local_task_id);
          ELSE

{ Generate the OS stack frame word entry for this instance for this critical frame

            critical_frame^.minimum_save_area.frame_descriptor.critical_frame_flag := TRUE;
            IF NOT critical_frame^.minimum_save_area.frame_descriptor.on_condition_flag THEN;
              critical_frame^.minimum_save_area.frame_descriptor.on_condition_flag := TRUE;
              os_stack_frame_word^ := initialize_os_stack_frame_word;
            IFEND;

{ We can add this instance to the frame count because we are executing below the recognition ring.

            os_stack_frame_word^.ada_critical_frame_count :=
                                  os_stack_frame_word^.ada_critical_frame_count + 1;
            os_stack_frame_word^.ada_critical_frame := TRUE;

{ Initiate this child task.

            REPEAT
              pmp$initiate_child_task (local_task_id, spy_identifier, osc$nowait, child_initiated);
              IF NOT child_initiated THEN
                pmp$long_term_wait (1000, 1000);
              IFEND;

            UNTIL child_initiated;
            IF spy_identifier < pmv$spy_identifiers.high_identifier THEN
              pmv$spy_identifiers.low_identifier := spy_identifier + 1;
            IFEND;
          IFEND;

        ELSE
          pmp$release_task_environment (local_task_id);
        IFEND;
      IFEND;

      IF NOT local_status.normal THEN
        status := local_status;
      IFEND;
    ELSE
      osp$set_status_abnormal ('PM', pme$target_ring_error, '', status);
    IFEND;

  PROCEND pmp$execute_procedure_as_task;
?? TITLE := '  [XDCL, #GATE] pmp$execute_within_task', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$execute_within_task (
        program_description: pmt$program_description;
        program_parameters: pmt$program_parameters;
    VAR status: ost$status);

    VAR
      first_time_called: [STATIC, oss$task_private] BOOLEAN := TRUE,
      validated_program_description: ^pmt$program_description,
      valid_program_params: ^pmt$program_parameters,
      code_base_pointer: ^ost$external_code_base_pointer,
      target_ring: ost$ring,
      tcb_p: ^pmt$task_control_block;

    status.normal := TRUE;

    IF NOT first_time_called THEN
      osp$set_status_abnormal ('PM', pme$2nd_call_to_execute_within, '', status);
      RETURN;
    IFEND;
    first_time_called := FALSE;

    PUSH validated_program_description: [[REP #SIZE (program_description) OF cell]];
    validate_program_description (program_description, validated_program_description, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH valid_program_params: [[REP #SIZE (program_parameters) OF cell]];
    { Copy them to validate access - if this fails an access violation will occur.
    valid_program_params^ := program_parameters;

    lop$reset_loader_for_2nd_load (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$find_executing_task_tcb (tcb_p);
    load_user_code_base_ptr (tcb_p^.target_ring, validated_program_description, NIL,
          FALSE, code_base_pointer);

{ The task is now the new task.  So, update it's program description.  There is
{ no reason to update the program parameters.

    pmp$update_program_description (validated_program_description^);

    target_ring := #RING (code_base_pointer^.code_pva);

    call_user_program (target_ring, code_base_pointer, valid_program_params);

    { The above procedure is not expected to return. }

    osp$system_error ('outward call error - pmp$execute_within_task', NIL);


  PROCEND pmp$execute_within_task;
?? TITLE := '  validate_program_description', EJECT ??

  PROCEDURE validate_program_description (program_description_value: pmt$program_description;
    VAR validated_program_description: ^pmt$program_description;
    VAR status {control} : ost$status);


{  NOTE:
{    This procedure assumes that the size of the program_description pointed to by
{    validated_program_description is the same as the size of program_description_value.


    TYPE
      valid_termination_error_level = set of pmt$termination_error_level,
      valid_preset_options = set of pmt$initialization_value;

    VAR
      program_description: ^pmt$program_description,
      program_attributes: ^pmt$program_attributes,
      validated_program_attributes: ^pmt$program_attributes,
      object_file_list: ^pmt$object_file_list,
      validated_object_file_list: ^pmt$object_file_list,
      i: pmt$number_of_object_files,
      module_list: ^pmt$module_list,
      validated_module_list: ^pmt$module_list,
      library_list: ^pmt$object_library_list,
      validated_library_list: ^pmt$object_library_list,
      j: pmt$number_of_libraries,
      valid_name: boolean,
      enable_inhibit_conditions: ^pmt$enable_inhibit_conditions,
      validated_conditions: ^pmt$enable_inhibit_conditions,
      name: ost$name;


    program_description := ^program_description_value;
    validated_program_description^ := program_description^;

    RESET program_description;
    RESET validated_program_description;

    NEXT program_attributes IN program_description;
    IF program_attributes = NIL THEN
      osp$set_status_abnormal ('PM', pme$prog_description_too_small, 'program_attributes', status);
      RETURN
    ELSE
      NEXT validated_program_attributes IN validated_program_description;
    IFEND;
?? EJECT ??
    IF pmc$object_file_list_specified IN program_attributes^.contents THEN
      IF (program_attributes^.number_of_object_files = 0) OR (program_attributes^.number_of_object_files >
            UPPERVALUE (pmt$number_of_object_files)) THEN
        osp$set_status_abnormal ('PM', pme$invalid_list_length, 'object files', status);
        osp$append_status_integer (' ', UPPERVALUE (pmt$number_of_object_files), 10, FALSE, status);
        RETURN
      ELSE
        NEXT object_file_list: [1 .. program_attributes^.number_of_object_files] IN program_description;
        IF object_file_list = NIL THEN
          osp$set_status_abnormal ('PM', pme$prog_description_too_small, 'object_file_list', status);
          RETURN
        ELSE
          NEXT validated_object_file_list: [1 .. program_attributes^.number_of_object_files] IN
                validated_program_description;
          FOR i := 1 TO program_attributes^.number_of_object_files DO
            clp$validate_name (object_file_list^ [i], name, valid_name);
            IF valid_name THEN
              validated_object_file_list^ [i] := name;
            ELSE
              osp$set_status_abnormal ('PM', pme$invalid_file_name, object_file_list^ [i], status);
              osp$append_status_parameter (' ', 'object', status);
              RETURN
            IFEND;
          FOREND;
        IFEND;
      IFEND;
    IFEND;

    IF pmc$module_list_specified IN program_attributes^.contents THEN
      IF (program_attributes^.number_of_modules = 0) OR (program_attributes^.number_of_modules > UPPERVALUE
            (pmt$number_of_modules)) THEN
        osp$set_status_abnormal ('PM', pme$invalid_list_length, 'modules', status);
        osp$append_status_integer (' ', UPPERVALUE (pmt$number_of_modules), 10, FALSE, status);
        RETURN
      ELSE
        NEXT module_list: [1 .. program_attributes^.number_of_modules] IN program_description;
        IF module_list = NIL THEN
          osp$set_status_abnormal ('PM', pme$prog_description_too_small, 'module_list', status);
          RETURN
        ELSE
          NEXT validated_module_list: [1 .. program_attributes^.number_of_modules] IN
                validated_program_description;
        IFEND;
      IFEND;
    IFEND;
?? EJECT ??
    IF pmc$library_list_specified IN program_attributes^.contents THEN
      IF (program_attributes^.number_of_libraries = 0) OR (program_attributes^.number_of_libraries >
            UPPERVALUE (pmt$number_of_libraries)) THEN
        osp$set_status_abnormal ('PM', pme$invalid_list_length, 'libraries', status);
        osp$append_status_integer (' ', UPPERVALUE (pmt$number_of_libraries), 10, FALSE, status);
        RETURN
      ELSE
        NEXT library_list: [1 .. program_attributes^.number_of_libraries] IN program_description;
        IF library_list = NIL THEN
          osp$set_status_abnormal ('PM', pme$prog_description_too_small, 'object_library_list', status);
          RETURN
        ELSE
          NEXT validated_library_list: [1 .. program_attributes^.number_of_libraries] IN
                validated_program_description;
          FOR j := 1 TO program_attributes^.number_of_libraries DO
            clp$validate_name (library_list^ [j], name, valid_name);
            IF valid_name THEN
              validated_library_list^ [j] := name;
            ELSE
              osp$set_status_abnormal ('PM', pme$invalid_file_name, library_list^ [j], status);
              osp$append_status_parameter (' ', 'library', status);
              RETURN
            IFEND;
          FOREND;
        IFEND;
      IFEND;
    IFEND;

    IF pmc$load_map_file_specified IN program_attributes^.contents THEN
      clp$validate_name (program_attributes^.load_map_file, name, valid_name);
      IF NOT valid_name THEN
        osp$set_status_abnormal ('PM', pme$invalid_file_name, program_attributes^.load_map_file, status);
        osp$append_status_parameter (' ', 'load map', status);
        RETURN
      ELSE
        validated_program_attributes^.load_map_file := name;
      IFEND;
    IFEND;

    IF pmc$load_map_options_specified IN program_attributes^.contents THEN
      IF (pmc$no_load_map IN program_attributes^.load_map_options) AND ((program_attributes^.load_map_options
            - $pmt$load_map_options [pmc$no_load_map]) <> $pmt$load_map_options []) THEN
        osp$set_status_abnormal ('PM', pme$map_option_conflict, '', status);
        RETURN
      IFEND;
    IFEND;

?? EJECT ??
    IF pmc$term_error_level_specified IN program_attributes^.contents THEN
      IF NOT (program_attributes^.termination_error_level IN - $valid_termination_error_level []) THEN
        osp$set_status_abnormal ('PM', pme$invalid_term_error_level, '', status);
        RETURN
      IFEND;
    IFEND;

    IF pmc$preset_specified IN program_attributes^.contents THEN
      IF NOT (program_attributes^.preset IN - $valid_preset_options []) THEN
        osp$set_status_abnormal ('PM', pme$invalid_preset_option, '', status);
        RETURN
      IFEND;
    IFEND;

    IF pmc$max_stack_size_specified IN program_attributes^.contents THEN
      IF (program_attributes^.maximum_stack_size > UPPERVALUE (ost$segment_length)) OR (program_attributes^.
            maximum_stack_size = 0) THEN
        osp$set_status_abnormal ('PM', pme$invalid_stack_size_option, '', status);
        RETURN
      IFEND;
    IFEND;

    IF pmc$abort_file_specified IN program_attributes^.contents THEN
      clp$validate_name (program_attributes^.abort_file, name, valid_name);
      IF NOT valid_name THEN
        osp$set_status_abnormal ('PM', pme$invalid_file_name, program_attributes^.abort_file, status);
        osp$append_status_parameter (' ', 'abort', status);
        RETURN
      ELSE
        validated_program_attributes^.abort_file := name;
      IFEND;
    IFEND;
?? EJECT ??
    IF pmc$debug_input_specified IN program_attributes^.contents THEN
      clp$validate_name (program_attributes^.debug_input, name, valid_name);
      IF NOT valid_name THEN
        osp$set_status_abnormal ('PM', pme$invalid_file_name, program_attributes^.debug_input, status);
        osp$append_status_parameter (' ', 'debug input', status);
        RETURN
      ELSE
        validated_program_attributes^.debug_input := name;
      IFEND;
    IFEND;

    IF pmc$debug_output_specified IN program_attributes^.contents THEN
      clp$validate_name (program_attributes^.debug_output, name, valid_name);
      IF NOT valid_name THEN
        osp$set_status_abnormal ('PM', pme$invalid_file_name, program_attributes^.debug_output, status);
        osp$append_status_parameter (' ', 'debug output', status);
        RETURN
      ELSE
        validated_program_attributes^.debug_output := name;
      IFEND;
    IFEND;

    IF pmc$condition_specified IN program_attributes^.contents THEN
      NEXT enable_inhibit_conditions IN program_description;
      IF enable_inhibit_conditions = NIL THEN
        osp$set_status_abnormal ('PM', pme$prog_description_too_small, 'enable_inhibit_conditions', status);
        RETURN
      ELSE
        NEXT validated_conditions IN validated_program_description;
      IFEND;
    IFEND;

  PROCEND validate_program_description;
?? TITLE := '  [XDCL] pmp$task_begin', EJECT ??

  PROGRAM pmp$task_begin;

{  PURPOSE:
{    This procedure receives control in a newly initiated task.  It is responsible for completing
{    the task environment and then loading and executing a specified program.
{  NOTE:
{    When this procedure receives control the full task_services environment is not intact.
{    Until this environment is completed, the activities which may be undertaken are limited.
{    The specific limitations are dependent on packaging and therefore are not itemized here.
*copyc pmv$job_initialization_complete

    VAR
      job_monitor_task: boolean,
      job_monitor_initial_ring: ost$ring,
      job_monitor_program_description: ^pmt$program_description,
      job_monitor_parameters: ^pmt$program_parameters,
      code_base_pointer: ^ost$external_code_base_pointer,
      target_ring: ost$ring,
      tcb_p: ^pmt$task_control_block,
      xcb: ^ost$execution_control_block,
      local_status: ost$status,
      ignore_status: ost$status;

    VAR
      gtid_converter: record
        case boolean of
        = false =
          global_task_id: ost$global_task_id,
        = true =
          integer_value: 0..0ffffff(16),
        casend,
      recend;

    VAR
      converter: record
        case 0 .. 1 of
        = 0 =
          procedure_pointer: pmt$user_program,
        = 1 =
          code_base_pointer: ^ost$external_code_base_pointer,
        casend,
      recend,

      maskable_system_conditions: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
        [pmc$system_conditions, $pmt$system_conditions [pmc$divide_fault, pmc$arithmetic_overflow,
        pmc$exponent_overflow, pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
        pmc$arithmetic_significance, pmc$invalid_bdp_data], * ],
      maskable_descriptor: pmt$established_handler;

?? NEWTITLE := '    handle_maskable_conditions' ??
?? EJECT ??

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

{     PURPOSE:
{       The purpose of this procedure is to ensure that any maskable system
{       condition arising in pmp$task_begin is reported and causes the task
{       to be terminated.  The condition mechanism (PMM$DISPOSE_OF_CONDITIONS,
{       PMP$DISPOSE_UCR_CONDITIONS) assumes that any maskable condition
{       arising in a procedure whose A2 register is NIL, arose because that
{       condition was inhibited and the original caller is the procedure
{       in which the condition arose (i.e., task begin appears to be the
{       original caller).

      VAR
        ignore_status: ost$status;

      status.normal := TRUE;
      pmp$continue_to_cause (pmc$execute_standard_procedure, ignore_status);
    PROCEND handle_maskable_conditions;
?? OLDTITLE ??
?? TITLE := '    find_job_monitor_code_base_ptr', EJECT ??

  PROCEDURE [INLINE] find_job_monitor_code_base_ptr (VAR code_base_pointer: ^ost$external_code_base_pointer);


    VAR
      converter: record
        case 0 .. 1 of
        = 0 =
          procedure_pointer: ^procedure,
        = 1 =
          code_base_pointer: ^ost$external_code_base_pointer,
        casend,
      recend;


    converter.procedure_pointer := ^clp$interpret_commands;

    code_base_pointer := converter.code_base_pointer;


  PROCEND find_job_monitor_code_base_ptr;
?? EJECT ??

    pmp$find_executing_task_xcb (xcb);
    job_monitor_task := xcb = jmp$job_monitor_xcb ();

    IF job_monitor_task THEN
      syp$initialize_job;

{ NOTE: The job_monitor_initial_ring returned from the following call is not the target ring
{       of the outward call.  The target ring of the outward call is returned from the
{       later call to JMP$JOB_BEGIN.  This is because of a chicken and egg problem.  We need
{       to setup the tasking tables before enabling preemptive conditions but be can't know
{       the target ring until validation is done in JMP$JOB_BEGIN.  As a result, we simply
{       use a "temporary" value and update it before the outward call is done.

      IF NOT syv$job_initialization_complete THEN
        jmp$initialize_job_environment (job_monitor_initial_ring, job_monitor_program_description,
              job_monitor_parameters, local_status);
        IF NOT local_status.normal THEN
          osp$system_error ('unexpected abnormal status', ^local_status);
        IFEND;

        pmp$initialize_tasking_tables (job_monitor_initial_ring, job_monitor_program_description,
              job_monitor_parameters);
      ELSE
        jmp$initialize_jcb;
        pmp$initialize_job_xcb_list (pmv$job_monitor_tcb_p^.task_id, pmv$job_monitor_tcb_p,
              ^pmp$trap_handler);
      IFEND;
    IFEND;

    IF (NOT job_monitor_task) OR
       (NOT syv$job_initialization_complete) THEN
      initialize_task_private;
    IFEND;


    {The establishment of the handler for maskable system conditions is postponed until now, because if any
    {condition arose before this point it cannot be processed in the absence of the task private segment. In
    {fact any arising condition before this point will cause a recursion of of invalid segment faults.

    pmp$establish_condition_handler (maskable_system_conditions, ^handle_maskable_conditions,
          ^maskable_descriptor, ignore_status);

    tmp$enable_preemptive_commo;
    pmp$find_executing_task_tcb (tcb_p);

    IF job_monitor_task THEN
      IF NOT syv$job_initialization_complete THEN
        jmp$job_boot;
      IFEND;

{ The following is condition based on the system attribute ENABLE_PM_DEBUG_LOGGING.

      IF pmv$debug_logging_enabled THEN
        IF xcb = NIL THEN
          osp$system_error ('task XCB lost', NIL);
        ELSE
          gtid_converter.global_task_id := xcb^.global_task_id;
          osp$set_status_abnormal ('PM', pme$task_begin_information, { task_name } xcb^.save9, local_status);
          osp$append_status_integer (osc$status_parameter_delimiter, gtid_converter.integer_value, 16,
                true, local_status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$system_log], local_status, ignore_status);
        IFEND;
      IFEND;

      clp$job_boot; {Does not return}
      osp$system_error ('outward call error', NIL);

    ELSEIF tcb_p^.nosve.ada_starting_procedure <> NIL THEN

      load_user_code_base_ptr (tcb_p^.target_ring, tcb_p^.nosve.program_description,
            tcb_p^.nosve.mpe_description, TRUE, code_base_pointer);
      converter.procedure_pointer := tcb_p^.nosve.ada_starting_procedure;
      code_base_pointer := converter.code_base_pointer;
      target_ring := #RING (code_base_pointer^.code_pva);
    ELSE
      load_user_code_base_ptr (tcb_p^.target_ring, tcb_p^.nosve.program_description,
            tcb_p^.nosve.mpe_description, FALSE,code_base_pointer);
      target_ring := #RING (code_base_pointer^.code_pva);
    IFEND;

{ The following is condition based on the system attribute ENABLE_PM_DEBUG_LOGGING.

    IF pmv$debug_logging_enabled THEN
      IF xcb = NIL THEN
        osp$system_error ('task XCB lost', NIL);
      ELSE
        gtid_converter.global_task_id := xcb^.global_task_id;
        osp$set_status_abnormal ('PM', pme$task_begin_information, { task_name } xcb^.save9, local_status);
        osp$append_status_integer (osc$status_parameter_delimiter, gtid_converter.integer_value, 16,
              true, local_status);
        osp$generate_log_message ($pmt$ascii_logset [pmc$system_log], local_status, ignore_status);
      IFEND;
    IFEND;

    call_user_program (target_ring, code_base_pointer, tcb_p^.nosve.program_parameters);

{   The above procedure is not expected to return.

    osp$system_error ('outward call error', NIL);


  PROCEND pmp$task_begin;
?? TITLE := '  initialize_task_private', EJECT ??

  PROCEDURE initialize_task_private;
*copyc pmv$task_template

    VAR
      i: integer,
      of_execution: cell,
      task_private_segment: ^cell;

    FOR i := 1 TO UPPERBOUND (pmv$task_template^.segment) DO
      task_private_segment := #address (#ring (^of_execution), pmv$task_template^.segment [i].number, 0);
    IF syv$nosve_job_template THEN
      i#move (pmv$task_template^.segment [i].content, task_private_segment, #SIZE (pmv$task_template^.segment
            [i].content^));
    ELSE
      {Initialize task templates
      syp$initialize_job_template (FALSE, NIL);
    IFEND;
    FOREND;
    osp$reset_heap (osv$task_private_heap, 3fffffff(16), FALSE, 1);
  PROCEND initialize_task_private;


?? TITLE := '    load_user_code_base_ptr', EJECT ??

  PROCEDURE load_user_code_base_ptr (
        target_ring: ost$ring;
        task_program_description: ^pmt$program_description;
        mpe_description: ^pmt$loader_description;
        ada_asynchronous_procedure: boolean;
    VAR user_program_cbp: ^ost$external_code_base_pointer);


    VAR
      enable_inhibit_conditions: ^pmt$enable_inhibit_conditions,
      program_description: ^pmt$program_description,
      program_attributes: ^pmt$program_attributes,
      segment_attributes: ARRAY [1 .. 5] of mmt$attribute_descriptor,
      starting_procedure: pmt$program_name,
      object_file_list: ^pmt$object_file_list,
      module_list: ^pmt$module_list,
      execute_library_list: ^pmt$object_library_list,
      prog_options_and_libraries: ^pmt$prog_options_and_libraries,
      tcb_p: ^pmt$task_control_block,
      loader_options: lot$loader_options,
      end_debug_should_be_called: boolean,
      ignore_status: ost$status,
      local_status: ost$status;


    sfp$emit_statistic (pml$task_begin, '', NIL, local_status);
    IF NOT local_status.normal THEN
      osp$generate_message (local_status, local_status);
    IFEND;

    program_description := task_program_description;

    RESET program_description;
    NEXT program_attributes IN program_description;

    pmp$find_prog_options_and_libs (prog_options_and_libraries);
    fix_program_options (program_attributes^, prog_options_and_libraries^.default_options^, loader_options);


    IF pmp$task_debug_mode_on () AND (pmp$task_debug_ring () <= osc$tsrv_ring) THEN
      pmp$call_begin_debug (NIL);
    IFEND;


    IF pmc$starting_proc_specified IN program_attributes^.contents THEN
      starting_procedure := program_attributes^.starting_procedure;
    ELSE
      starting_procedure := osc$null_name;
    IFEND;
?? EJECT ??

    IF pmc$object_file_list_specified IN program_attributes^.contents THEN
      NEXT object_file_list: [1 .. program_attributes^.number_of_object_files] IN program_description;
    ELSEIF NOT (pmc$starting_proc_specified IN program_attributes^.contents) AND NOT
          (pmc$module_list_specified IN program_attributes^.contents) THEN
      PUSH object_file_list: [1 .. 1];
      object_file_list^ [1] := 'LGO';
    ELSE
      object_file_list := NIL;
    IFEND;


    IF pmc$module_list_specified IN program_attributes^.contents THEN
      NEXT module_list: [1 .. program_attributes^.number_of_modules] IN program_description;
    ELSE
      module_list := NIL;
    IFEND;


    IF pmc$library_list_specified IN program_attributes^.contents THEN
      NEXT execute_library_list: [1 .. program_attributes^.number_of_libraries] IN program_description;
    ELSE
      execute_library_list := NIL;
    IFEND;

    IF pmc$condition_specified IN program_attributes^.contents THEN
      NEXT enable_inhibit_conditions IN program_description;
      pmv$enable_inhibit_conditions.enable_system_conditions := prog_options_and_libraries^.default_options^
            .conditions_enabled + enable_inhibit_conditions^.enable_system_conditions -
            enable_inhibit_conditions^.inhibit_system_conditions;
      pmv$enable_inhibit_conditions.inhibit_system_conditions := prog_options_and_libraries^.
            default_options^.conditions_inhibited + enable_inhibit_conditions^.inhibit_system_conditions -
            enable_inhibit_conditions^.enable_system_conditions;
    ELSE
      pmv$enable_inhibit_conditions.enable_system_conditions := prog_options_and_libraries^.default_options^
            .conditions_enabled;
      pmv$enable_inhibit_conditions.inhibit_system_conditions := prog_options_and_libraries^.
            default_options^.conditions_inhibited;
    IFEND;

?? EJECT ??

    pmp$find_executing_task_tcb (tcb_p);
    IF tcb_p^.nosve.ada_starting_procedure = NIL THEN
      record_loader_statistics (pml$call_loader);
      lop$load_program (object_file_list, module_list, execute_library_list, prog_options_and_libraries^.
          job_library_list, starting_procedure, target_ring, loader_options, mpe_description,
          user_program_cbp, local_status);
      record_loader_statistics (pml$return_from_loader);
    ELSE
      segment_attributes [1].keyword := mmc$kw_preset_value;
      segment_attributes [2].keyword := mmc$kw_segment_access_control;
      segment_attributes [3].keyword := mmc$kw_ring_numbers;
      segment_attributes [4].keyword := mmc$kw_max_segment_length;
      segment_attributes [5].keyword := mmc$kw_software_attributes;
      segment_attributes [1].preset_value := pmc$initialize_to_zero;
      segment_attributes [2].access_control.cache_bypass := FALSE;
      segment_attributes [2].access_control.execute_privilege := osc$non_executable;
      segment_attributes [2].access_control.read_privilege := osc$read_uncontrolled;
      segment_attributes [2].access_control.write_privilege := osc$write_uncontrolled;
      segment_attributes [3].r1 := tcb_p^.target_ring;
      segment_attributes [3].r2 := tcb_p^.target_ring;
      segment_attributes [4].max_length := loader_options.maximum_stack_size;
      segment_attributes [5].software_attri_set := $mmt$software_attribute_set [mmc$sa_stack];
      pmp$create_shared_stack (^segment_attributes, local_status);
      IF NOT local_status.normal THEN
        pmp$exit (local_status);
      IFEND;
    IFEND;

    IF NOT local_status.normal THEN
      pmp$end_debug_should_be_called (end_debug_should_be_called);
      IF end_debug_should_be_called THEN
        pmp$push_task_debug_mode (pmc$debug_mode_off, ignore_status);
      IFEND;
      pmp$exit (local_status);
    IFEND;


  PROCEND load_user_code_base_ptr;

?? OLDTITLE ??
?? TITLE := '  fix_program_options', EJECT ??

  PROCEDURE fix_program_options (program_attributes: pmt$program_attributes;
        job_default_program_options: pmt$program_options;
    VAR loader_options: lot$loader_options);
*copyc mmv$preset_conversion_table
*copyc pmp$get_processor_attributes
*copyc pmp$fix_initial_debug

    VAR
      task_debug_mode: pmt$debug_mode,
      processor_attributes: pmt$processor_attributes,
      debug_input: amt$local_file_name,
      debug_output: amt$local_file_name,
      abort_file: amt$local_file_name,
      local_status: ost$status;

?? EJECT ??

    IF (pmc$debug_input_specified IN program_attributes.contents) THEN
      debug_input := program_attributes.debug_input;
    ELSE
      debug_input := job_default_program_options.debug_input;
    IFEND;
    IF (pmc$debug_mode_specified IN program_attributes.contents) THEN
      task_debug_mode := (program_attributes.debug_mode AND (debug_input <> clc$null_file));
    ELSE
      task_debug_mode := (job_default_program_options.debug_mode AND (debug_input <> clc$null_file));
    IFEND;
    IF (pmc$debug_output_specified IN program_attributes.contents) THEN
      debug_output := program_attributes.debug_output;
    ELSE
      debug_output := job_default_program_options.debug_output;
    IFEND;
    IF (pmc$abort_file_specified IN program_attributes.contents) THEN
      abort_file := program_attributes.abort_file;
    ELSE
      abort_file := job_default_program_options.abort_file;
    IFEND;
    pmp$set_task_debug_ring;
    pmp$fix_initial_debug (task_debug_mode, debug_input, debug_output, abort_file);

    pmp$set_task_debug_mode (task_debug_mode, local_status);
    IF NOT local_status.normal THEN
      pmp$exit (local_status);
    IFEND;

    IF pmc$load_map_file_specified IN program_attributes.contents THEN
      loader_options.map_file := program_attributes.load_map_file;
    ELSE
      loader_options.map_file := job_default_program_options.map_file;
    IFEND;
    IF pmc$load_map_options_specified IN program_attributes.contents THEN
      IF pmc$no_load_map IN program_attributes.load_map_options THEN
        loader_options.map := $pmt$load_map_options [pmc$no_load_map];
      ELSE
        loader_options.map := program_attributes.load_map_options;
      IFEND;
    ELSE
      loader_options.map := job_default_program_options.map_options;
    IFEND;
?? EJECT ??
    IF pmc$term_error_level_specified IN program_attributes.contents THEN
      loader_options.termination_error_level := program_attributes.termination_error_level;
    ELSE
      loader_options.termination_error_level := job_default_program_options.termination_error_level;
    IFEND;
    IF pmc$preset_specified IN program_attributes.contents THEN
      loader_options.preset := mmv$preset_conversion_table [program_attributes.preset];
    ELSE
      loader_options.preset := job_default_program_options.preset;
    IFEND;
    IF pmc$max_stack_size_specified IN program_attributes.contents THEN
      IF (program_attributes.maximum_stack_size > pmc$maximum_user_stack_size) THEN
        loader_options.maximum_stack_size := pmc$maximum_user_stack_size;
      ELSE
        pmp$get_processor_attributes (processor_attributes, local_status);
        IF NOT local_status.normal THEN
          pmp$exit (local_status);
        IFEND;
        IF ((program_attributes.maximum_stack_size MOD processor_attributes.page_size) = 0) THEN
          loader_options.maximum_stack_size := program_attributes.maximum_stack_size;
        ELSE
          loader_options.maximum_stack_size := ((program_attributes.maximum_stack_size DIV
                processor_attributes.page_size) + 1) * processor_attributes.page_size;
        IFEND;
      IFEND;
    ELSE
      loader_options.maximum_stack_size := job_default_program_options.maximum_stack_size;
    IFEND;
    loader_options.debug_ring := pmp$task_debug_ring ();
  PROCEND fix_program_options;
?? NEWTITLE := '    record_loader_statisitics', EJECT ??

  PROCEDURE record_loader_statistics (kind: sft$statistic_code);


    VAR
      cp_time: pmt$task_cp_time,
      xcb: ^ost$execution_control_block,
      loader_statistics: [STATIC] array [1 .. 7] of sft$counter,
      local_status: ost$status,
      ignore_status: ost$status;

    local_status.normal := TRUE;

    pmp$find_executing_task_xcb (xcb);

    pmp$get_task_cp_time (cp_time, local_status);

    IF kind = pml$call_loader THEN
      IF local_status.normal THEN
        loader_statistics [1] := cp_time.task_time;
        loader_statistics [2] := cp_time.monitor_time;
      ELSE
        loader_statistics [1] := 0;
        loader_statistics [2] := 0;
      IFEND;

      loader_statistics [3] := xcb^.paging_statistics.page_fault_count;
      loader_statistics [4] := xcb^.paging_statistics.page_in_count;
      loader_statistics [5] := xcb^.paging_statistics.pages_reclaimed_from_queue;
      loader_statistics [6] := xcb^.paging_statistics.new_pages_assigned;
      loader_statistics [7] := xcb^.paging_statistics.pages_from_server;

      sfp$emit_statistic (pml$call_loader, '', NIL, ignore_status);

    ELSEIF kind = pml$return_from_loader THEN
      IF local_status.normal THEN
        loader_statistics [1] := cp_time.task_time - loader_statistics [1];
        loader_statistics [2] := cp_time.monitor_time - loader_statistics [2];
      ELSE
        loader_statistics [1] := 0;
        loader_statistics [2] := 0;
      IFEND;
      loader_statistics [3] := xcb^.paging_statistics.page_fault_count - loader_statistics [3];
      loader_statistics [4] := xcb^.paging_statistics.page_in_count - loader_statistics [4];
      loader_statistics [5] := xcb^.paging_statistics.pages_reclaimed_from_queue - loader_statistics [5];
      loader_statistics [6] := xcb^.paging_statistics.new_pages_assigned - loader_statistics [6];
      loader_statistics [7] := xcb^.paging_statistics.pages_from_server - loader_statistics [7];

      sfp$emit_statistic (pml$return_from_loader, xcb^.save9, ^loader_statistics,
            ignore_status);
    IFEND;


  PROCEND record_loader_statistics;
?? TITLE := '  call_user_program', EJECT ??

  PROCEDURE call_user_program (target_ring: ost$ring;
        user_program_cbp: ^ost$external_code_base_pointer;
        program_parameters: ^pmt$program_parameters);


    VAR
      converter: record
        case 0 .. 1 of
        = 0 =
          procedure_pointer: ^procedure (p1: ^ost$external_code_base_pointer;
            p2: ^pmt$program_parameters),
        = 1 =
          code_base_pointer: ^ost$external_code_base_pointer,
        casend,
      recend,


{ This variable is defined only to be used to take up space in the stack. }
      space_variable: ^array [*] of cell,

      stack_segment: ^pmt$stack_segment,
      tcb_p: ^pmt$task_control_block,
      original_caller_cbp: ^ost$external_code_base_pointer,
      local_status: ost$status;


{   NOTE:  The following variable declaration is sensitive to CYBIL argument list format.

    VAR
      original_caller_param_list: ^record
        right_just_val1: 0 .. 0ffff(16),
        user_program_cbp: ^ost$external_code_base_pointer,
        program_parameters_left: ^^pmt$program_parameters,
        left_just_val1: 0 .. 0ffff(16),
        program_parameters: ^pmt$program_parameters,
      recend;

 ?? EJECT ??

    pmp$find_executing_task_tcb (tcb_p);
    IF target_ring > osc$tsrv_ring THEN
      IF tcb_p^.nosve.ada_starting_procedure = NIL THEN
        pmp$find_stack_segment (target_ring, stack_segment);
      ELSE
        stack_segment := tcb_p^.nosve.ada_shared_stack_pointer.seq_pointer;
      IFEND;

      RESET stack_segment;
      NEXT original_caller_param_list IN stack_segment;
      original_caller_param_list^.user_program_cbp := user_program_cbp;

      IF #SIZE (program_parameters^) > 0 THEN
        NEXT original_caller_param_list^.program_parameters: [[REP #SIZE (program_parameters^) OF cell]] IN
              stack_segment;
      ELSE
        i#build_adaptable_seq_pointer (#ring (stack_segment), #segment (stack_segment), 0, 0, 0,
              original_caller_param_list^.program_parameters);
      IFEND;

      original_caller_param_list^.program_parameters^ := program_parameters^;
      original_caller_param_list^.program_parameters_left := ^original_caller_param_list^.program_parameters;
      converter.procedure_pointer := ^pmp$original_caller;
      original_caller_cbp := converter.code_base_pointer;
      pmp$outward_call (original_caller_cbp, target_ring, original_caller_param_list,
            NIL, stack_segment); { does not return }


    ELSEIF target_ring = osc$tsrv_ring THEN
      pmp$original_caller (user_program_cbp, program_parameters);

    ELSE
      osp$set_status_abnormal ('PM', pme$transfer_address_ring_error, '', local_status);
      pmp$exit (local_status);
    IFEND;

  PROCEND call_user_program;

MODEND pmm$task_initiation;
