?? TITLE := 'NOS/VE : Default loader parameter management' ??
MODULE pmm$default_loader_param_mgmt;
?? RIGHT := 110 ??

{  PURPOSE:
{    This module contains procedures to define and fetch defaults for loader parameters which
{    apply to all program loads occurring within a job, unless explicitly overridden.

?? NEWTITLE := '  Global declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$local_file_name
*copyc clt$environment_object_contents
*copyc clt$environment_object_size
*copyc clt$env_object_pop_reason
*copyc clt$env_object_push_reason
*copyc fsc$compiling_for_test_harness
*copyc loc$task_services_library_name
*copyc lot$loader_type_definitions
*copyc osd$virtual_address
*copyc ost$status
*copyc pmc$default_user_stack_size
*copyc pme$execution_exceptions
*copyc pmt$prog_options_and_libraries
*copyc pmt$default_prog_options_change
*copyc pmt$program_description
*copyc pmt$program_options
?? POP ??
*copyc amp$get_file_attributes
*copyc clp$convert_str_to_path_handle
*copyc clp$convert_string_to_file
*copyc clp$validate_name
*copyc osp$set_status_abnormal
*copyc osp$append_status_parameter
*copyc osv$page_size
*copyc osv$task_shared_heap
*copyc pmp$find_prog_options_and_libs
?? EJECT ??

{!  The following variable should be defined in this module (and XDCLed) once the CYBIL
{!  can initialize 64 bit integers.  This data should reside in a read_only section readable
{!  from all rings.
*copyc pmv$preset_conversion_table
?? TITLE := '  [XDCL] pmp$init_default_prog_options', EJECT ??

  PROCEDURE [XDCL] pmp$init_default_prog_options
    (VAR default_program_options: ^pmt$program_options;
     VAR status: ost$status);

{
{    The purpose of this procedure is to allocate and initialize the default program options
{ which apply to all program loads within the job.
{
{       PMP$INIT_DEFAULT_PROG_OPTIONS (DEFAULT_PROGRAM_OPTIONS, STATUS)
{
{ DEFAULT_PROGRAM_OPTIONS: (output) This parameter specifies a pointer to the default
{       program options record.
{
{ STATUS: (output) This parameter specifies the request status.
{

    VAR
      program_options: ^pmt$program_options,
      load_map: clt$file;


    status.normal := TRUE;
    default_program_options := NIL;

    ALLOCATE program_options IN osv$task_shared_heap^;

    clp$convert_string_to_file ('$LOCAL.LOADMAP', load_map, status);
    IF NOT status.normal THEN
      FREE program_options IN osv$task_shared_heap^;
      RETURN; {----->
    IFEND;

    program_options^.map_file := load_map.local_file_name;
    program_options^.map_options := $pmt$load_map_options [];
    program_options^.termination_error_level := pmc$error_load_errors;
    program_options^.preset := 0;
    pmp$change_maximum_stack_size (pmc$default_user_stack_size, program_options^.maximum_stack_size);

{ debug_input, debug_output, and the abort_file are assigned in clp$store_std_path_handle_names

    program_options^.debug_input := osc$null_name;
    program_options^.debug_output := osc$null_name;
    program_options^.abort_file := osc$null_name;

    program_options^.debug_mode := FALSE;
    program_options^.conditions_enabled := $pmt$system_conditions
          [pmc$arithmetic_overflow, pmc$arithmetic_significance, pmc$divide_fault, pmc$exponent_overflow,
          pmc$exponent_underflow, pmc$fp_indefinite, pmc$invalid_bdp_data];
    program_options^.conditions_inhibited := $pmt$system_conditions [pmc$fp_significance_loss];

    default_program_options := program_options;

  PROCEND pmp$init_default_prog_options;
?? TITLE := '  [INLINE] pmp$change_maximum_stack_size', EJECT ??

  PROCEDURE [INLINE] pmp$change_maximum_stack_size
    (    maximum_stack_size: ost$segment_length;
     VAR actual_maximum_stack_size: ost$segment_length);

{
{ PURPOSE:
{   This procedure changes the maximum stack size in the default program
{   options which apply to all program loads within the job.
{

    IF (maximum_stack_size > pmc$maximum_user_stack_size) OR fsc$compiling_for_test_harness THEN
      actual_maximum_stack_size := pmc$maximum_user_stack_size;
    ELSE
      actual_maximum_stack_size := ((maximum_stack_size + osv$page_size - 1) DIV osv$page_size) *
            osv$page_size;
    IFEND;

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

  PROCEDURE [XDCL, #GATE] pmp$change_default_prog_options
    (    change: pmt$default_prog_options_change;
     VAR status {control} : ost$status);

*copyc pmh$change_default_prog_options

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

    VAR
      valid_name: boolean,
      name: ost$name,
      debug_input_name: ost$name,
      debug_output_name: ost$name,
      abort_file_name: ost$name,
      prog_options_and_libraries: ^pmt$prog_options_and_libraries,
      default_program_options: ^pmt$program_options;


    status.normal := TRUE;

{ Validate change.

    IF pmc$load_map_file_specified IN change.contents THEN
      clp$validate_name (change.map_file, name, valid_name);
      IF NOT valid_name THEN
        osp$set_status_abnormal ('PM', pme$invalid_file_name, change.map_file, status);
        osp$append_status_parameter (' ', 'load map', status);
        RETURN; {----->
      IFEND;
    IFEND;
    IF pmc$term_error_level_specified IN change.contents THEN
      IF NOT (change.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 change.contents THEN
      IF NOT (change.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 change.contents THEN
      IF (change.maximum_stack_size > UPPERVALUE (ost$segment_length)) OR (change.maximum_stack_size = 0) THEN
        osp$set_status_abnormal ('PM', pme$invalid_stack_size_option, '', status);
        RETURN; {----->
      IFEND;
    IFEND;
    IF pmc$debug_input_specified IN change.contents THEN
      clp$validate_name (change.debug_input, debug_input_name, valid_name);
      IF NOT valid_name THEN
        osp$set_status_abnormal ('PM', pme$invalid_file_name, change.debug_input, status);
        osp$append_status_parameter (' ', 'debug input', status);
        RETURN; {----->
      IFEND;
    IFEND;
    IF pmc$debug_output_specified IN change.contents THEN
      clp$validate_name (change.debug_output, debug_output_name, valid_name);
      IF NOT valid_name THEN
        osp$set_status_abnormal ('PM', pme$invalid_file_name, change.debug_output, status);
        osp$append_status_parameter (' ', 'debug output', status);
        RETURN; {----->
      IFEND;
    IFEND;
    IF pmc$abort_file_specified IN change.contents THEN
      clp$validate_name (change.abort_file, abort_file_name, valid_name);
      IF NOT valid_name THEN
        osp$set_status_abnormal ('PM', pme$invalid_file_name, change.abort_file, status);
        osp$append_status_parameter (' ', 'abort file', status);
        RETURN; {----->
      IFEND;
    IFEND;

{ Record validated change.

    pmp$find_prog_options_and_libs (prog_options_and_libraries);
    default_program_options := prog_options_and_libraries^.default_options;

    IF pmc$load_map_file_specified IN change.contents THEN
      default_program_options^.map_file := name;
    IFEND;
    IF pmc$load_map_options_specified IN change.contents THEN
      IF pmc$no_load_map IN change.map_options THEN
        default_program_options^.map_options := $pmt$load_map_options [];
        IF (change.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);
        IFEND;
      ELSE
        default_program_options^.map_options := change.map_options;
      IFEND;
    IFEND;

    IF pmc$term_error_level_specified IN change.contents THEN
      default_program_options^.termination_error_level := change.termination_error_level;
    IFEND;

    IF pmc$preset_specified IN change.contents THEN
      default_program_options^.preset := pmv$preset_conversion_table [change.preset];
    IFEND;

    IF pmc$max_stack_size_specified IN change.contents THEN
      pmp$change_maximum_stack_size (change.maximum_stack_size, default_program_options^.maximum_stack_size);
    IFEND;

    IF pmc$debug_input_specified IN change.contents THEN
      default_program_options^.debug_input := debug_input_name;
    IFEND;
    IF pmc$debug_output_specified IN change.contents THEN
      default_program_options^.debug_output := debug_output_name;
    IFEND;
    IF pmc$abort_file_specified IN change.contents THEN
      default_program_options^.abort_file := abort_file_name;
    IFEND;
    IF pmc$debug_mode_specified IN change.contents THEN
      default_program_options^.debug_mode := change.debug_mode;
    IFEND;

    IF pmc$condition_specified IN change.contents THEN
      default_program_options^.conditions_enabled := default_program_options^.conditions_enabled +
            change.conditions_enabled - change.conditions_inhibited;
      default_program_options^.conditions_inhibited := default_program_options^.conditions_inhibited +
            change.conditions_inhibited - change.conditions_enabled;
    IFEND;

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

  PROCEDURE [XDCL, #GATE] pmp$change_job_library_list
    (    delete_libraries: ^pmt$object_library_list;
         add_libraries: ^pmt$object_library_list;
     VAR status: ost$status);

*copyc pmh$change_job_library_list

    VAR
      prog_options_and_libraries: ^pmt$prog_options_and_libraries;

    pmp$find_prog_options_and_libs (prog_options_and_libraries);
    change_library_list (delete_libraries, add_libraries, prog_options_and_libraries^.job_library_list,
          status);

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

  PROCEDURE [XDCL, #GATE] pmp$change_debug_library_list
    (    delete_libraries: ^pmt$object_library_list;
         add_libraries: ^pmt$object_library_list;
     VAR status: ost$status);

*copyc pmh$change_debug_library_list

    VAR
      prog_options_and_libraries: ^pmt$prog_options_and_libraries;


    pmp$find_prog_options_and_libs (prog_options_and_libraries);
    change_library_list (delete_libraries, add_libraries, prog_options_and_libraries^.debug_library_list,
          status);

  PROCEND pmp$change_debug_library_list;
?? TITLE := '  change_library_list', EJECT ??

  PROCEDURE change_library_list
    (    delete_libraries: ^pmt$object_library_list;
         add_libraries: ^pmt$object_library_list;
     VAR library_list: ^pmt$object_library_list;
     VAR status: ost$status);

{
{ PURPOSE:
{   The purpose of this procedure is to add or delete libraries from the
{   given library list.
{

    VAR
      contains_data: boolean,
      current_attributes: array [1 .. 2] of amt$get_item,
      current_list_length: pmt$number_of_libraries,
      evaluated_file_reference: fst$evaluated_file_reference,
      existing_file: boolean,
      free_list: ^pmt$object_library_list,
      i: pmt$number_of_libraries,
      j: pmt$number_of_libraries,
      library_index: pmt$number_of_libraries,
      local_file: boolean,
      name: ost$name,
      new_library_list: ^pmt$object_library_list,
      path_handle_name: fst$path_handle_name,
      valid_name: boolean;


    status.normal := TRUE;

    IF delete_libraries <> NIL THEN
      IF (UPPERBOUND (delete_libraries^) = 1) AND (delete_libraries^ [1] = 'ALL') THEN
        free_list := library_list;
        library_list := NIL;
        IF free_list <> NIL THEN
          FREE free_list IN osv$task_shared_heap^;
        IFEND;
      ELSE
        IF library_list = NIL THEN
          osp$set_status_abnormal ('PM', pme$empty_library_list, '', status);
          RETURN; {----->
        IFEND;

        FOR i := 1 TO UPPERBOUND (delete_libraries^) DO
          IF library_list <> NIL THEN
            clp$validate_name (delete_libraries^ [i], name, valid_name);
            IF NOT valid_name THEN
              osp$set_status_abnormal ('PM', pme$invalid_file_name, delete_libraries^ [i], status);
              osp$append_status_parameter (' ', 'library', status);
              RETURN; {----->
            IFEND;

            IF name <> loc$task_services_library_name THEN
              clp$convert_str_to_path_handle (name, FALSE, TRUE, FALSE, path_handle_name,
                    evaluated_file_reference, status);
              IF NOT status.normal THEN
                RETURN; {----->
              IFEND;
              name := path_handle_name;
            IFEND;

            IF (UPPERBOUND (library_list^) = 1) THEN
              IF (library_list^ [1] = name) THEN
                free_list := library_list;
                library_list := NIL;
                IF free_list <> NIL THEN
                  FREE free_list IN osv$task_shared_heap^;
                IFEND;
              ELSE
                osp$set_status_abnormal ('PM', pme$unknown_delete_library, delete_libraries^ [i], status);
                RETURN; {----->
              IFEND;
            ELSE
              ALLOCATE new_library_list: [1 .. (UPPERBOUND (library_list^) - 1)] IN osv$task_shared_heap^;
              library_index := 0;

              FOR j := 1 TO UPPERBOUND (library_list^) DO
                IF library_list^ [j] <> name THEN
                  IF library_index < UPPERBOUND (new_library_list^) THEN
                    library_index := library_index + 1;
                    new_library_list^ [library_index] := library_list^ [j];
                  ELSE
                    osp$set_status_abnormal ('PM', pme$unknown_delete_library, delete_libraries^ [i], status);
                    FREE new_library_list IN osv$task_shared_heap^;
                    RETURN; {----->
                  IFEND;
                IFEND;
              FOREND;

              free_list := library_list;
              library_list := new_library_list;
              IF free_list <> NIL THEN
                FREE free_list IN osv$task_shared_heap^;
              IFEND;
            IFEND;
          ELSE
            osp$set_status_abnormal ('PM', pme$unknown_delete_library, delete_libraries^ [i], status);
            RETURN; {----->
          IFEND;
        FOREND;
      IFEND;
    IFEND;


    IF add_libraries <> NIL THEN
      current_attributes [1].key := amc$file_contents;
      current_attributes [2].key := amc$file_structure;

      FOR i := UPPERBOUND (add_libraries^) DOWNTO 1 DO
        clp$validate_name (add_libraries^ [i], name, valid_name);
        IF NOT valid_name THEN
          osp$set_status_abnormal ('PM', pme$invalid_file_name, add_libraries^ [i], status);
          osp$append_status_parameter (' ', 'library', status);
          RETURN; {----->
        IFEND;

        IF name <> loc$task_services_library_name THEN
          clp$convert_str_to_path_handle (name, FALSE, TRUE, FALSE, path_handle_name,
                evaluated_file_reference, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
          name := path_handle_name;
        IFEND;

        amp$get_file_attributes (name, current_attributes, local_file, existing_file, contains_data, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

        IF (name <> loc$task_services_library_name) THEN
          IF NOT existing_file OR NOT contains_data OR (current_attributes [1].file_contents <> amc$object) OR
                (current_attributes [2].file_structure <> amc$library) THEN
            osp$set_status_abnormal ('PM', pme$file_not_existing_library, add_libraries^ [i], status);
            RETURN; {----->
          IFEND;

        ELSEIF existing_file THEN
          osp$set_status_abnormal ('PM', pme$reserved_library_name, add_libraries^ [i], status);
          RETURN; {----->
        IFEND;

        IF library_list = NIL THEN
          current_list_length := 0;
        ELSE
          current_list_length := UPPERBOUND (library_list^);
        IFEND;

        FOR j := 1 TO current_list_length DO
          IF name = library_list^ [j] THEN
            osp$set_status_abnormal ('PM', pme$duplicate_add_library, add_libraries^ [i], status);
            RETURN; {----->
          IFEND;
        FOREND;

        ALLOCATE new_library_list: [1 .. (current_list_length + 1)] IN osv$task_shared_heap^;
        new_library_list^ [1] := name;
        FOR j := 2 TO UPPERBOUND (new_library_list^) DO
          new_library_list^ [j] := library_list^ [j - 1];
        FOREND;

        free_list := library_list;
        library_list := new_library_list;
        IF free_list <> NIL THEN
          FREE free_list IN osv$task_shared_heap^;
        IFEND;
      FOREND;
    IFEND;

  PROCEND change_library_list;
?? TITLE := '  [XDCL] pmp$eo_size_program_attributes', EJECT ??

  FUNCTION [XDCL] pmp$eo_size_program_attributes: clt$environment_object_size;

{
{ PURPOSE:
{   This function is called during job initialization to provide the
{   environment object manager with the size of the PROGRAM_ATTRIBUTES
{   environment object.
{
{ NOTE:
{   For a complete description of the interface to this procedure see module
{   CLM$ENVIRONMENT_OBJECT_DATA.
{


    pmp$eo_size_program_attributes := #SIZE (pmt$prog_options_and_libraries);

  FUNCEND pmp$eo_size_program_attributes;
?? TITLE := '  [XDCL] pmp$eo_init_program_attributes', EJECT ??

  PROCEDURE [XDCL] pmp$eo_init_program_attributes
    (    object: ^clt$environment_object_contents);

{
{ PURPOSE:
{   This procedure is called during job initialization to provide an initial
{   value for the PROGRAM_ATTRIBUTES environment object.
{
{ NOTE:
{   For a complete description of the interface to this procedure see module
{   CLM$ENVIRONMENT_OBJECT_DATA.
{

    VAR
      prog_options_and_libraries: ^pmt$prog_options_and_libraries;


    prog_options_and_libraries := object;

    prog_options_and_libraries^.default_options := NIL;
    prog_options_and_libraries^.job_library_list := NIL;
    prog_options_and_libraries^.debug_library_list := NIL;

  PROCEND pmp$eo_init_program_attributes;
?? TITLE := '  [XDCL] pmp$eo_push_program_attributes', EJECT ??

  PROCEDURE [XDCL] pmp$eo_push_program_attributes
    (    push_reason: clt$env_object_push_reason;
         new_object: ^clt$environment_object_contents;
         new_object_in_current_task: boolean;
         pushed_object_in_current_task: boolean;
         pushed_object: ^clt$environment_object_contents;
     VAR status: ost$status);

{
{ PURPOSE:
{   This procedure is called when the PROGRAM_ATTRIBUTES environment object is
{   being pushed.  It makes copies of the program options, job library list and
{   debug library list.
{
{ NOTE:
{   For a complete description of the interface to this procedure see module
{   CLM$ENVIRONMENT_OBJECT_DATA.
{

    VAR
      new_debug_library_list: ^pmt$object_library_list,
      new_default_program_options: ^pmt$program_options,
      new_job_library_list: ^pmt$object_library_list,
      new_prog_options_and_libraries: ^pmt$prog_options_and_libraries,
      old_prog_options_and_libraries: ^pmt$prog_options_and_libraries;


    status.normal := TRUE;

    new_prog_options_and_libraries := new_object;
    old_prog_options_and_libraries := pushed_object;

    IF old_prog_options_and_libraries^.default_options <> NIL THEN
      ALLOCATE new_default_program_options IN osv$task_shared_heap^;
      new_default_program_options^ := old_prog_options_and_libraries^.default_options^;
    ELSE
      new_default_program_options := NIL;
    IFEND;

    IF old_prog_options_and_libraries^.job_library_list <> NIL THEN
      ALLOCATE new_job_library_list: [1 .. UPPERBOUND (old_prog_options_and_libraries^.job_library_list^)] IN
            osv$task_shared_heap^;
      new_job_library_list^ := old_prog_options_and_libraries^.job_library_list^;
    ELSE
      new_job_library_list := NIL;
    IFEND;

    IF old_prog_options_and_libraries^.debug_library_list <> NIL THEN
      ALLOCATE new_debug_library_list: [1 .. UPPERBOUND (old_prog_options_and_libraries^.
            debug_library_list^)] IN osv$task_shared_heap^;
      new_debug_library_list^ := old_prog_options_and_libraries^.debug_library_list^;
    ELSE
      new_debug_library_list := NIL;
    IFEND;

    new_prog_options_and_libraries^.default_options := new_default_program_options;
    new_prog_options_and_libraries^.job_library_list := new_job_library_list;
    new_prog_options_and_libraries^.debug_library_list := new_debug_library_list;

  PROCEND pmp$eo_push_program_attributes;
?? TITLE := '  [XDCL] pmp$eo_pop_program_attributes', EJECT ??

  PROCEDURE [XDCL] pmp$eo_pop_program_attributes
    (    pop_reason: clt$env_object_pop_reason;
         object: ^clt$environment_object_contents;
         object_in_current_task: boolean;
         pushed_object_in_current_task: boolean;
         pushed_object: ^clt$environment_object_contents;
     VAR status: ost$status);

{
{ PURPOSE:
{   This procedure is called when the PROGRAM_ATTRIBUTES environment object is
{   being popped.  It releases the space for the program options, job library
{   list and debug library list.
{
{ NOTE:
{   For a complete description of the interface to this procedure see module
{   CLM$ENVIRONMENT_OBJECT_DATA.
{

    VAR
      prog_options_and_libraries: ^pmt$prog_options_and_libraries;


    status.normal := TRUE;

    prog_options_and_libraries := object;

    IF prog_options_and_libraries^.default_options <> NIL THEN
      FREE prog_options_and_libraries^.default_options IN osv$task_shared_heap^;
    IFEND;
    IF prog_options_and_libraries^.job_library_list <> NIL THEN
      FREE prog_options_and_libraries^.job_library_list IN osv$task_shared_heap^;
    IFEND;
    IF prog_options_and_libraries^.debug_library_list <> NIL THEN
      FREE prog_options_and_libraries^.debug_library_list IN osv$task_shared_heap^;
    IFEND;

  PROCEND pmp$eo_pop_program_attributes;

MODEND pmm$default_loader_param_mgmt;
