?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Object Library Generator' ??
MODULE ocm$object_module_scanners;

{ PURPOSE:
{   This module contains the procs which scan thru object modules.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cyd$run_time_error_condition
*copyc cle$ecc_proc_declaration
*copyc llt$deferred_common_blocks
*copyc llt$deferred_entry_points
*copyc llt$load_module
*copyc oce$library_generator_errors
*copyc oct$changed_info
*copyc oct$code_section_ids
*copyc oct$cpu_object_module_header
*copyc oct$display_toggles
*copyc oct$external_declaration_list
*copyc oct$external_reference_list
*copyc oct$header
*copyc oct$module_description
*copyc oct$name_list
*copyc oct$open_file_list
?? POP ??
*copyc clp$define_scl_procedure
*copyc i#current_sequence_position
*copyc ocp$convert_information_element
*copyc ocp$generate_message
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$establish_condition_handler
*copyc pmp$get_legible_date_time
*copyc pmp$position_object_library
*copyc ocv$olg_scratch_seq
*copyc ocv$olg_working_heap
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$build_scl_directory', EJECT ??

  PROCEDURE [XDCL] ocp$build_scl_directory
    (    file_name: amt$local_file_name;
         file_descriptor: ^oct$open_file_list;
     VAR status: ost$status);


    VAR
      scl_header: ^llt$library_member_header,
      alias_list: ^array [1 .. * ] of pmt$program_name,
      aliases: ^array [1 .. * ] of pmt$program_name,
      file_position: amt$file_position,
      procedure_name: pmt$program_name,
      command_or_function: clt$command_or_function,
      availability: clt$named_entry_availability,
      command_kind: llt$command_kind,
      command_log_option: clt$command_log_option,
      sequence: ^SEQ ( * ),
      scl_procedure: ^clt$scl_procedure,
      scl_proc: ^clt$scl_procedure,
      size: 0 .. 0ffffffff(16),

      count: integer,
      reset_value: ^SEQ ( * ),
      temp_seq: ^SEQ ( * ),
      work_area: ^SEQ ( * ),
      module_description: ^oct$module_description,
      directory: ^array [1 .. * ] of oct$module_description,
      local_status: ost$status,
      i: integer,
      j: integer;


    reset_value := ocv$olg_scratch_seq;
    file_position := amc$boi;
    count := 0;

  /loop/
    WHILE file_position <> amc$eoi DO
      temp_seq := ocv$olg_scratch_seq;
      NEXT work_area: [[REP (#SIZE (ocv$olg_scratch_seq^) -
            i#current_sequence_position (ocv$olg_scratch_seq)) OF cell]] IN temp_seq;
      clp$define_scl_procedure (file_descriptor^.identifier, work_area, procedure_name, alias_list,
            command_or_function, availability, command_kind, command_log_option, scl_procedure, file_position,
            status);
      IF NOT status.normal THEN
        IF status.condition = cle$expecting_proc THEN
          IF file_position = amc$eoi THEN
            status.normal := TRUE;
            EXIT /loop/;
          ELSEIF file_position = amc$eop THEN
            CYCLE /loop/;
          IFEND;
        IFEND;
        ocp$generate_message (status);
        osp$set_status_abnormal (oc, oce$e_invalid_scl_proc, file_name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, (count + 1), 10, FALSE, status);
        RETURN;
      IFEND;

      size := #SIZE (scl_procedure^) + #SIZE (llt$library_member_header);

      IF alias_list <> NIL THEN
        size := size + #SIZE (alias_list^);
      IFEND;

      ALLOCATE sequence: [[REP size OF cell]] IN ocv$olg_working_heap^;
      IF sequence = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;

      RESET sequence;
      NEXT scl_header IN sequence;

      scl_header^.name := procedure_name;

      CASE command_or_function OF
      = clc$command =
        scl_header^.kind := llc$command_procedure;
      = clc$function =
        scl_header^.kind := llc$function_procedure;
      CASEND;

      pmp$get_legible_date_time (osc$mdy_date, scl_header^.date_created, osc$hms_time,
            scl_header^.time_created, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      scl_header^.generator_id := llc$object_library_generator;
      scl_header^.generator_name_vers := occ$generator_name CAT llc$object_library_version;
      scl_header^.commentary := osc$null_name;


      IF alias_list <> NIL THEN
        NEXT aliases: [1 .. UPPERBOUND (alias_list^)] IN sequence;
        aliases^ := alias_list^;
        scl_header^.aliases := #REL (aliases, sequence^);
        scl_header^.number_of_aliases := UPPERBOUND (alias_list^);
      ELSE
        scl_header^.number_of_aliases := 0;
      IFEND;

      scl_header^.command_function_availability := availability;
      scl_header^.command_function_kind := command_kind;

      CASE command_or_function OF
      = clc$command =
        scl_header^.command_log_option := command_log_option;
      = clc$function =
        scl_header^.command_log_option := clc$manually_log;
      CASEND;

      NEXT scl_proc: [[REP #SIZE (scl_procedure^) OF cell]] IN sequence;
      scl_proc^ := scl_procedure^;
      scl_header^.member := #REL (scl_proc, sequence^);
      scl_header^.member_size := #SIZE (scl_proc^);

      count := count + 1;

      NEXT module_description IN ocv$olg_scratch_seq;
      IF module_description = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;

      module_description^.name := procedure_name;
      module_description^.source := occ$file;
      module_description^.file := sequence;

      CASE command_or_function OF
      = clc$command =
        module_description^.kind := occ$command_procedure;
        module_description^.command_procedure_header := scl_header;
      = clc$function =
        module_description^.kind := occ$function_procedure;
        module_description^.function_procedure_header := scl_header;
      CASEND;

    WHILEND /loop/;

    IF count = 0 THEN
      osp$set_status_abnormal (oc, oce$e_empty_object_file, file_descriptor^.name, status);
      RETURN;
    ELSE
      ocv$olg_scratch_seq := reset_value;
      NEXT directory: [1 .. count] IN ocv$olg_scratch_seq;

      FOR i := 1 TO (UPPERBOUND (directory^) - 1) DO
        IF (directory^ [i].name <> osc$null_name) THEN
          FOR j := (i + 1) TO UPPERBOUND (directory^) DO
            IF (directory^ [i].name = directory^ [j].name) THEN
              osp$set_status_abnormal (oc, oce$w_duplicate_module_on_file, directory^ [i].name, local_status);
              osp$append_status_parameter (osc$status_parameter_delimiter, file_descriptor^.name,
                    local_status);
              ocp$generate_message (local_status);

              directory^ [j].name := osc$null_name;
              count := count - 1;
            IFEND;
          FOREND;
        IFEND;
      FOREND;

      ALLOCATE file_descriptor^.directory: [1 .. count] IN ocv$olg_working_heap^;
      IF file_descriptor^.directory = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      ELSE
        j := 1;
        FOR i := 1 TO count DO
          WHILE (directory^ [j].name = osc$null_name) AND (j < UPPERBOUND (directory^)) DO
            j := j + 1;
          WHILEND;

          file_descriptor^.directory^ [i] := directory^ [j];
          j := j + 1;
        FOREND;
      IFEND;
    IFEND;


    file_descriptor^.current_module := 1;
    file_descriptor^.entry_point_dictionary := NIL;


  PROCEND ocp$build_scl_directory;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$build_library_directory' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$build_library_directory
    (VAR sequence: ^SEQ ( * );
     VAR file_descriptor: ^oct$open_file_list;
     VAR status: ost$status);


    VAR
      object_library_header: ^llt$object_library_header,
      object_library_hdr: ^llt$object_library_header_v1_0,
      library_dictionary: ^llt$object_library_dictionaries,

      module_dictionary: ^llt$module_dictionary,
      number_of_modules: 0 .. llc$max_modules_in_library,

      entry_point_dictionary: ^llt$entry_point_dictionary,
      number_of_entry_points: 0 .. llc$max_entry_points_in_library,

      load_module_header: ^llt$load_module_header,
      identification: ^llt$identification,
      library_member_header: ^llt$library_member_header,
      new_application_member_header: ^llt$application_member_header,
      old_application_member_header: ^llt$application_member_header,
      old_library_member_header: ^llt$library_member_header,
      new_library_member_header: ^llt$library_member_header,

      object_text_descriptor: ^llt$object_text_descriptor,
      obsolete_library_version: boolean,
      i: 1 .. llc$max_modules_in_library,
      j: 1 .. llc$max_commands_in_library;


    RESET sequence;

    NEXT object_library_header IN sequence;
    IF object_library_header = NIL THEN
      osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
      RETURN;
    IFEND;

{ It is not possible for a current version of a library to have a module version
{ that is "obsolete."  Therefore, certain operations can be optimized when scanning
{ a current version library.

    obsolete_library_version := object_library_header^.version <> llc$object_library_version;
    IF NOT obsolete_library_version THEN

      NEXT library_dictionary: [1 .. object_library_header^.number_of_dictionaries] IN sequence;
      IF library_dictionary = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      number_of_modules := 0;
      number_of_entry_points := 0;

      FOR j := LOWERBOUND (library_dictionary^) TO UPPERBOUND (library_dictionary^) DO
        CASE library_dictionary^ [j].kind OF
        = llc$module_dictionary =
          module_dictionary := #PTR (library_dictionary^ [j].module_dictionary, sequence^);
          number_of_modules := UPPERBOUND (module_dictionary^);
        = llc$entry_point_dictionary =
          entry_point_dictionary := #PTR (library_dictionary^ [j].entry_point_dictionary, sequence^);
          number_of_entry_points := UPPERBOUND (entry_point_dictionary^);
        ELSE
        CASEND;
      FOREND;

    ELSEIF object_library_header^.version = 'V1.0' THEN

      RESET sequence;

      NEXT object_library_hdr IN sequence;
      IF object_library_hdr = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      number_of_modules := object_library_hdr^.number_of_modules;

      module_dictionary := #PTR (object_library_hdr^.module_dictionary, sequence^);
      IF module_dictionary = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      number_of_entry_points := object_library_hdr^.number_of_entry_points;

      IF number_of_entry_points <> 0 THEN
        entry_point_dictionary := #PTR (object_library_hdr^.entry_point_dictionary, sequence^);
        IF entry_point_dictionary = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;
      IFEND;

    ELSE
      osp$set_status_abnormal (oc, oce$e_invalid_library_version, object_library_header^.version, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, file_descriptor^.name, status);
      RETURN;
    IFEND;

    IF number_of_modules = 0 THEN
      osp$set_status_abnormal (oc, oce$e_no_modules_on_library, file_descriptor^.name, status);
      RETURN;
    IFEND;

    ALLOCATE file_descriptor^.directory: [1 .. number_of_modules] IN ocv$olg_working_heap^;
    IF file_descriptor^.directory = NIL THEN
      osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
      RETURN;
    IFEND;

    FOR i := 1 TO number_of_modules DO
      file_descriptor^.directory^ [i].name := module_dictionary^ [i].name;
      file_descriptor^.directory^ [i].source := occ$library;
      file_descriptor^.directory^ [i].file := sequence;

      CASE module_dictionary^ [i].kind OF
      = llc$load_module =
        file_descriptor^.directory^ [i].kind := occ$load_module;

        file_descriptor^.directory^ [i].load_module_header :=
              #PTR (module_dictionary^ [i].module_header, sequence^);
        IF file_descriptor^.directory^ [i].load_module_header = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

      = llc$ppu_object_module =
        file_descriptor^.directory^ [i].kind := occ$ppu_object_module;

        object_text_descriptor := #PTR (module_dictionary^ [i].ppu_header, sequence^);
        IF object_text_descriptor = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

        RESET sequence TO object_text_descriptor;
        NEXT object_text_descriptor IN sequence;
        NEXT file_descriptor^.directory^ [i].ppu_object_module_header IN sequence;
        IF file_descriptor^.directory^ [i].ppu_object_module_header = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

      = llc$program_description =
        file_descriptor^.directory^ [i].kind := occ$program_description;

        IF obsolete_library_version THEN
          old_library_member_header := #PTR (module_dictionary^ [i].program_header, sequence^);
          IF (old_library_member_header^.generator_name_vers = 'CREATE_OBJECT_LIBRARY  V1.0') OR
                (old_library_member_header^.generator_name_vers = 'OBJECT LIBRARY GENERATOR  V1.0') THEN

            ALLOCATE new_library_member_header IN ocv$olg_working_heap^;
            IF new_library_member_header = NIL THEN
              osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
              RETURN;
            IFEND;
            new_library_member_header^ := old_library_member_header^;
            new_library_member_header^.generator_name_vers := occ$generator_name CAT
                  llc$object_library_version;
            new_library_member_header^.command_function_availability := clc$advertised_entry;
            new_library_member_header^.command_function_kind := llc$entry_point;
            new_library_member_header^.command_log_option := clc$automatically_log;
            file_descriptor^.directory^ [i].program_description_header := new_library_member_header;
          IFEND;
        ELSE
          file_descriptor^.directory^ [i].program_description_header :=
                #PTR (module_dictionary^ [i].program_header, sequence^);
          IF file_descriptor^.directory^ [i].program_description_header = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
            RETURN;
          IFEND;
        IFEND;

      = llc$command_procedure =
        file_descriptor^.directory^ [i].kind := occ$command_procedure;

        IF obsolete_library_version THEN
          old_library_member_header := #PTR (module_dictionary^ [i].command_header, sequence^);
          IF (old_library_member_header^.generator_name_vers = 'CREATE_OBJECT_LIBRARY  V1.0') OR
                (old_library_member_header^.generator_name_vers = 'OBJECT LIBRARY GENERATOR  V1.0') THEN

            ALLOCATE new_library_member_header IN ocv$olg_working_heap^;
            IF new_library_member_header = NIL THEN
              osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
              RETURN;
            IFEND;
            new_library_member_header^ := old_library_member_header^;
            new_library_member_header^.generator_name_vers := occ$generator_name CAT
                  llc$object_library_version;
            new_library_member_header^.command_function_availability := clc$advertised_entry;
            new_library_member_header^.command_function_kind := llc$entry_point;
            new_library_member_header^.command_log_option := clc$automatically_log;
            file_descriptor^.directory^ [i].command_procedure_header := new_library_member_header;
          IFEND;
        ELSE
          file_descriptor^.directory^ [i].command_procedure_header :=
                #PTR (module_dictionary^ [i].command_header, sequence^);
          IF file_descriptor^.directory^ [i].command_procedure_header = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
            RETURN;
          IFEND;
        IFEND;

      = llc$command_description =
        file_descriptor^.directory^ [i].kind := occ$command_description;
        file_descriptor^.directory^ [i].command_description_header :=
              #PTR (module_dictionary^ [i].command_header, sequence^);
        IF file_descriptor^.directory^ [i].command_description_header = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

      = llc$applic_program_description =
        file_descriptor^.directory^ [i].kind := occ$applic_program_description;

        IF obsolete_library_version THEN
          old_application_member_header := #PTR (module_dictionary^ [i].applic_program_header, sequence^);
          IF (old_application_member_header^.library_member_header.generator_name_vers =
                'CREATE_OBJECT_LIBRARY  V1.0') OR (old_application_member_header^.library_member_header.
                generator_name_vers = 'OBJECT LIBRARY GENERATOR  V1.0') THEN

            ALLOCATE new_application_member_header IN ocv$olg_working_heap^;
            IF new_application_member_header = NIL THEN
              osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
              RETURN;
            IFEND;
            new_application_member_header^ := old_application_member_header^;
            new_application_member_header^.library_member_header.generator_name_vers := occ$generator_name CAT
                  llc$object_library_version;
            new_application_member_header^.library_member_header.command_function_availability :=
                  clc$advertised_entry;
            new_application_member_header^.library_member_header.command_function_kind := llc$entry_point;
            new_application_member_header^.library_member_header.command_log_option := clc$automatically_log;
            file_descriptor^.directory^ [i].applic_program_description_hdr := new_application_member_header;
          IFEND;
        ELSE
          file_descriptor^.directory^ [i].applic_program_description_hdr :=
                #PTR (module_dictionary^ [i].applic_program_header, sequence^);
          IF file_descriptor^.directory^ [i].applic_program_description_hdr = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
            RETURN;
          IFEND;
        IFEND;

      = llc$applic_command_procedure =
        file_descriptor^.directory^ [i].kind := occ$applic_command_procedure;

        IF obsolete_library_version THEN
          old_application_member_header := #PTR (module_dictionary^ [i].applic_command_header, sequence^);
          IF (old_application_member_header^.library_member_header.generator_name_vers =
                'CREATE_OBJECT_LIBRARY  V1.0') OR (old_application_member_header^.library_member_header.
                generator_name_vers = 'OBJECT LIBRARY GENERATOR  V1.0') THEN

            ALLOCATE new_application_member_header IN ocv$olg_working_heap^;
            IF new_application_member_header = NIL THEN
              osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
              RETURN;
            IFEND;
            new_application_member_header^ := old_application_member_header^;
            new_application_member_header^.library_member_header.generator_name_vers := occ$generator_name CAT
                  llc$object_library_version;
            new_application_member_header^.library_member_header.command_function_availability :=
                  clc$advertised_entry;
            new_application_member_header^.library_member_header.command_function_kind := llc$entry_point;
            new_application_member_header^.library_member_header.command_log_option := clc$automatically_log;
            file_descriptor^.directory^ [i].applic_command_procedure_header := new_application_member_header;
          IFEND;
        ELSE
          file_descriptor^.directory^ [i].applic_command_procedure_header :=
                #PTR (module_dictionary^ [i].applic_command_header, sequence^);
          IF file_descriptor^.directory^ [i].applic_command_procedure_header = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
            RETURN;
          IFEND;
        IFEND;

      = llc$applic_command_description =
        file_descriptor^.directory^ [i].kind := occ$applic_command_description;
        file_descriptor^.directory^ [i].applic_command_description_hdr :=
              #PTR (module_dictionary^ [i].applic_command_header, sequence^);
        IF file_descriptor^.directory^ [i].applic_command_description_hdr = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

      = llc$function_procedure =
        file_descriptor^.directory^ [i].kind := occ$function_procedure;
        file_descriptor^.directory^ [i].function_procedure_header :=
              #PTR (module_dictionary^ [i].function_header, sequence^);
        IF file_descriptor^.directory^ [i].function_procedure_header = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

      = llc$function_description =
        file_descriptor^.directory^ [i].kind := occ$function_description;
        file_descriptor^.directory^ [i].function_description_header :=
              #PTR (module_dictionary^ [i].function_header, sequence^);
        IF file_descriptor^.directory^ [i].function_description_header = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

      = llc$message_module =
        file_descriptor^.directory^ [i].kind := occ$message_module;

        file_descriptor^.directory^ [i].message_module_header :=
              #PTR (module_dictionary^ [i].message_header, sequence^);
        IF file_descriptor^.directory^ [i].message_module_header = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

      = llc$panel_module =
        file_descriptor^.directory^ [i].kind := occ$panel_module;

        file_descriptor^.directory^ [i].panel_module_header :=
              #PTR (module_dictionary^ [i].panel_header, sequence^);
        IF file_descriptor^.directory^ [i].panel_module_header = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
          RETURN;
        IFEND;

      ELSE
        osp$set_status_abnormal (oc, oce$e_invalid_module_kind, module_dictionary^ [i].name, status);
        RETURN;
      CASEND;
    FOREND;

    IF number_of_entry_points = 0 THEN
      file_descriptor^.entry_point_dictionary := NIL;
    ELSE
      file_descriptor^.entry_point_dictionary := entry_point_dictionary;
    IFEND;


  PROCEND ocp$build_library_directory;
?? OLDTITLE ??
?? NEWTITLE := 'scan_thru_cpu_module' ??
?? EJECT ??

  PROCEDURE scan_thru_cpu_module
    (    module_name: pmt$program_name;
     VAR cpu_object_module_header: ^oct$cpu_object_module_header;
     VAR sequence: ^SEQ ( * );
     VAR status: ost$status);

?? NEWTITLE := 'condition_handler', EJECT ??

    VAR
      error_conditions: [STATIC, READ] pmt$condition := [pmc$user_defined_condition, cye$run_time_condition];



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


      condition_status.normal := TRUE;


      osp$set_status_abnormal (oc, oce$e_bad_otd_size, module_name, status);
      EXIT scan_thru_cpu_module;


    PROCEND condition_handler;
?? OLDTITLE ??
?? EJECT ??

    VAR
      actual_parameters: ^llt$actual_parameters,
      address_formulation: ^llt$address_formulation,
      application_identifier: ^llt$application_identifier,
      binding_template: ^llt$binding_template,
      bit_string_insertion: ^llt$bit_string_insertion,
      debug_table_fragment: ^llt$debug_table_fragment,
      deferred_common_blocks: ^llt$deferred_common_blocks,
      deferred_entry_points: ^llt$deferred_entry_points,
      entry_definition: ^llt$entry_definition,
      established_descriptor: pmt$established_handler,
      external_linkage: ^llt$external_linkage,
      formal_parameters: ^llt$formal_parameters,
      libraries: ^llt$libraries,
      line_address_table: ^llt$line_address_table,
      m68000_absolute: ^llt$68000_absolute,
      object_text_descriptor: ^llt$object_text_descriptor,
      obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
      obsolete_line_address_table: ^llt$obsolete_line_address_table,
      obsolete_segment_definition: ^llt$obsolete_segment_definition,
      record_number: integer,
      relocation: ^llt$relocation,
      replication: ^llt$replication,
      section_definition: ^llt$section_definition,
      segment_definition: ^llt$segment_definition,
      supplemental_debug_tables: ^llt$supplemental_debug_tables,
      symbol_table: ^llt$symbol_table,
      text: ^llt$text,
      transfer_symbol: ^llt$transfer_symbol;


    pmp$establish_condition_handler (error_conditions, ^condition_handler, ^established_descriptor, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    record_number := 1;

    REPEAT
      NEXT object_text_descriptor IN sequence;

      IF object_text_descriptor = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
        RETURN;
      IFEND;
      record_number := record_number + 1;

      CASE object_text_descriptor^.kind OF

      = llc$identification =
        osp$set_status_abnormal (oc, oce$e_multiple_ident_rec, module_name, status);
        RETURN;

      = llc$application_identifier =
        NEXT application_identifier IN sequence;
        IF application_identifier = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

        cpu_object_module_header^.application_identifier := application_identifier;

      = llc$libraries =
        NEXT libraries: [1 .. object_text_descriptor^.number_of_libraries] IN sequence;
        IF libraries = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$section_definition, llc$unallocated_common_block =
        NEXT section_definition IN sequence;
        IF section_definition = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$segment_definition =
        NEXT segment_definition IN sequence;
        IF segment_definition = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$obsolete_segment_definition =
        NEXT obsolete_segment_definition IN sequence;
        IF obsolete_segment_definition = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$text =
        NEXT text: [1 .. object_text_descriptor^.number_of_bytes] IN sequence;
        IF text = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$replication =
        NEXT replication: [1 .. object_text_descriptor^.number_of_bytes] IN sequence;
        IF replication = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$bit_string_insertion =
        NEXT bit_string_insertion IN sequence;
        IF bit_string_insertion = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$entry_definition =
        NEXT entry_definition IN sequence;
        IF entry_definition = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$deferred_entry_points =
        NEXT deferred_entry_points: [1 .. object_text_descriptor^.number_of_entry_points] IN sequence;
        IF deferred_entry_points = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$deferred_common_blocks =
        NEXT deferred_common_blocks: [1 .. object_text_descriptor^.number_of_common_blocks] IN sequence;
        IF deferred_common_blocks = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$relocation =
        NEXT relocation: [1 .. object_text_descriptor^.number_of_rel_items] IN sequence;
        IF relocation = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$address_formulation =
        NEXT address_formulation: [1 .. object_text_descriptor^.number_of_adr_items] IN sequence;
        IF address_formulation = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$external_linkage =
        NEXT external_linkage: [1 .. object_text_descriptor^.number_of_ext_items] IN sequence;
        IF external_linkage = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$obsolete_formal_parameters =
        NEXT obsolete_formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN sequence;
        IF obsolete_formal_parameters = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$formal_parameters =
        NEXT formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN sequence;
        IF formal_parameters = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$actual_parameters =
        NEXT actual_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN sequence;
        IF actual_parameters = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$cybil_symbol_table_fragment =
        NEXT debug_table_fragment: [[REP object_text_descriptor^.sequence_length OF cell]] IN sequence;
        IF debug_table_fragment = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$obsolete_line_table =
        NEXT obsolete_line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN sequence;
        IF obsolete_line_address_table = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$symbol_table =
        NEXT symbol_table: [[REP object_text_descriptor^.sequence_length OF cell]] IN sequence;
        IF symbol_table = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$line_table =
        NEXT line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN sequence;
        IF line_address_table = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$supplemental_debug_tables =
        NEXT supplemental_debug_tables: [[REP object_text_descriptor^.sequence_length OF cell]] IN sequence;
        IF supplemental_debug_tables = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$binding_template =
        NEXT binding_template IN sequence;
        IF binding_template = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$form_definition =
        osp$set_status_abnormal (oc, oce$e_form_def_found_in_module, module_name, status);
        RETURN;

      = llc$68000_absolute =
        NEXT m68000_absolute: [[REP object_text_descriptor^.number_of_68000_bytes OF cell]] IN sequence;
        IF m68000_absolute = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      = llc$transfer_symbol =
        NEXT transfer_symbol IN sequence;
        IF transfer_symbol = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
          RETURN;
        IFEND;

      ELSE
        osp$set_status_abnormal (oc, oce$e_invalid_object_rec_kind, module_name, status);
        osp$append_status_integer (osc$status_parameter_delimiter, record_number, 10, FALSE, status);
        RETURN;

      CASEND;
    UNTIL object_text_descriptor^.kind = llc$transfer_symbol;


  PROCEND scan_thru_cpu_module;
?? OLDTITLE ??
?? NEWTITLE := 'scan_thru_ppu_module' ??
?? EJECT ??

  PROCEDURE scan_thru_ppu_module
    (    module_name: pmt$program_name;
     VAR sequence: ^SEQ ( * );
     VAR status: ost$status);


    VAR
      object_text_descriptor: ^llt$object_text_descriptor,
      ppu_absolute: ^llt$ppu_absolute;


    NEXT object_text_descriptor IN sequence;
    IF object_text_descriptor = NIL THEN
      osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
      RETURN;
    IFEND;

    IF object_text_descriptor^.kind = llc$ppu_absolute THEN
      NEXT ppu_absolute: [0 .. object_text_descriptor^.number_of_words - 1] IN sequence;
      IF ppu_absolute = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
        RETURN;
      IFEND;
    ELSE
      osp$set_status_abnormal (oc, oce$e_invalid_object_rec_kind, module_name, status);
      RETURN;
    IFEND;


  PROCEND scan_thru_ppu_module;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$build_file_directory', EJECT ??

  PROCEDURE [XDCL] ocp$build_file_directory
    (VAR sequence: ^SEQ ( * );
     VAR file_descriptor: ^oct$open_file_list;
     VAR status: ost$status);


    VAR
      directory: ^array [1 .. * ] of oct$module_description,
      i: 1 .. llc$max_modules_in_library,
      identification: ^llt$identification,
      j: 1 .. llc$max_modules_in_library + 1,
      local_status: ost$status,
      module_description: ^oct$module_description,
      number_of_modules: 0 .. llc$max_modules_in_library,
      object_text_descriptor: ^llt$object_text_descriptor,
      reset_value: ^SEQ ( * );

    reset_value := ocv$olg_scratch_seq;

    number_of_modules := 0;

    RESET sequence;
    NEXT object_text_descriptor IN sequence;

    WHILE object_text_descriptor <> NIL DO
      IF object_text_descriptor^.kind <> llc$identification THEN
        osp$set_status_abnormal (oc, oce$e_no_ident_rec_on_obj_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      IF number_of_modules >= llc$max_modules_in_library THEN
        osp$set_status_abnormal (oc, oce$e_too_many_modules_on_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      number_of_modules := number_of_modules + 1;

      NEXT identification IN sequence;
      IF identification = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      IF (identification^.object_text_version <> 'V1.2') AND
            (identification^.object_text_version <> 'V1.3') AND
            (identification^.object_text_version <> 'V1.4') THEN
        osp$set_status_abnormal (oc, oce$e_invalid_obj_text_version, identification^.object_text_version,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, identification^.name, status);
        RETURN;
      IFEND;

      IF (identification^.name <> osc$null_name) THEN
        NEXT module_description IN ocv$olg_scratch_seq;
        IF module_description = NIL THEN
          osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
          RETURN;
        IFEND;

        module_description^.name := identification^.name;
        module_description^.source := occ$file;
        module_description^.file := sequence;

        CASE identification^.kind OF
        = llc$mi_virtual_state, llc$vector_virtual_state, llc$motorola_68000, llc$motorola_68000_absolute,
              llc$vector_extended_state =
          module_description^.kind := occ$cpu_object_module;

          ALLOCATE module_description^.cpu_object_module_header IN ocv$olg_working_heap^;
          module_description^.cpu_object_module_header^.identification := identification;
          module_description^.cpu_object_module_header^.application_identifier := NIL;

          scan_thru_cpu_module (module_description^.name, module_description^.cpu_object_module_header,
                sequence, status);

        = llc$iou =
          module_description^.kind := occ$ppu_object_module;
          module_description^.ppu_object_module_header := identification;

          scan_thru_ppu_module (module_description^.name, sequence, status);

        ELSE
          osp$set_status_abnormal (oc, oce$e_invalid_module_kind, identification^.name, status);
        CASEND;
      ELSE
        osp$set_status_abnormal (oc, oce$e_module_has_null_name, file_descriptor^.name, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      NEXT object_text_descriptor IN sequence;
    WHILEND;

    IF number_of_modules = 0 THEN
      osp$set_status_abnormal (oc, oce$e_empty_object_file, file_descriptor^.name, status);
      RETURN;
    ELSE
      ocv$olg_scratch_seq := reset_value;
      NEXT directory: [1 .. number_of_modules] IN ocv$olg_scratch_seq;

      FOR i := 1 TO (UPPERBOUND (directory^) - 1) DO
        IF (directory^ [i].name <> osc$null_name) THEN
          FOR j := (i + 1) TO UPPERBOUND (directory^) DO
            IF (directory^ [i].name = directory^ [j].name) THEN
              osp$set_status_abnormal (oc, oce$w_duplicate_module_on_file, directory^ [i].name, local_status);
              osp$append_status_parameter (osc$status_parameter_delimiter, file_descriptor^.name,
                    local_status);
              ocp$generate_message (local_status);

              directory^ [j].name := osc$null_name;
              number_of_modules := number_of_modules - 1;
            IFEND;
          FOREND;
        IFEND;
      FOREND;

      ALLOCATE file_descriptor^.directory: [1 .. number_of_modules] IN ocv$olg_working_heap^;
      IF file_descriptor^.directory = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      ELSE
        j := 1;
        FOR i := 1 TO number_of_modules DO
          WHILE (directory^ [j].name = osc$null_name) AND (j < UPPERBOUND (directory^)) DO
            j := j + 1;
          WHILEND;
          file_descriptor^.directory^ [i] := directory^ [j];
          j := j + 1;
        FOREND;
      IFEND;
    IFEND;

    file_descriptor^.entry_point_dictionary := NIL;

    ocv$olg_scratch_seq := reset_value;


  PROCEND ocp$build_file_directory;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$build_file_dir_from_temp', EJECT ??

{ PURPOSE:
{   The purpose of this request is to build a file directory from modules on
{   a scratch segment.
{ DESIGN:
{   Since EOI is not set at the end of the modules, "NEXT-ing" beyond this point
{   will not return NIL.  Upon entry to this procedure, the scratch segment is
{   positioned at the end of the last module.  This ending position is saved
{   and the sequence is reset and then read until the current sequence position
{   is beyond the ending position.
{ NOTES:
{   Since the file has already been generated successfully there is no need
{   to check for NIL pointers or bad status from procedure calls.

  PROCEDURE [XDCL] ocp$build_file_dir_from_temp
    (VAR sequence: ^SEQ ( * );
     VAR file_descriptor: ^oct$open_file_list);

    VAR
      directory: ^array [1 .. * ] of oct$module_description,
      end_of_file: integer,
      identification: ^llt$identification,
      ignore_status: ost$status,
      module_description: ^oct$module_description,
      number_of_modules: 0 .. llc$max_modules_in_library,
      object_text_descriptor: ^llt$object_text_descriptor,
      reset_value: ^SEQ ( * );


    end_of_file := i#current_sequence_position (sequence);
    reset_value := ocv$olg_scratch_seq;
    number_of_modules := 0;

    RESET sequence;
    NEXT object_text_descriptor IN sequence;

    WHILE i#current_sequence_position (sequence) <= end_of_file DO
      number_of_modules := number_of_modules + 1;
      NEXT identification IN sequence;

      NEXT module_description IN ocv$olg_scratch_seq;
      module_description^.name := identification^.name;
      module_description^.source := occ$file;
      module_description^.file := sequence;

      CASE identification^.kind OF
      = llc$mi_virtual_state, llc$vector_virtual_state, llc$motorola_68000, llc$motorola_68000_absolute,
            llc$vector_extended_state =
        module_description^.kind := occ$cpu_object_module;

        ALLOCATE module_description^.cpu_object_module_header IN ocv$olg_working_heap^;
        module_description^.cpu_object_module_header^.identification := identification;
        module_description^.cpu_object_module_header^.application_identifier := NIL;

        scan_thru_cpu_module (module_description^.name, module_description^.cpu_object_module_header,
              sequence, ignore_status);

      = llc$iou =
        module_description^.kind := occ$ppu_object_module;
        module_description^.ppu_object_module_header := identification;

        scan_thru_ppu_module (module_description^.name, sequence, ignore_status);

      ELSE
        ;
      CASEND;

      NEXT object_text_descriptor IN sequence;
    WHILEND;

    ocv$olg_scratch_seq := reset_value;
    NEXT directory: [1 .. number_of_modules] IN ocv$olg_scratch_seq;

    ALLOCATE file_descriptor^.directory: [1 .. number_of_modules] IN ocv$olg_working_heap^;
    file_descriptor^.directory^ := directory^;

    file_descriptor^.entry_point_dictionary := NIL;
    ocv$olg_scratch_seq := reset_value;
  PROCEND ocp$build_file_dir_from_temp;
?? NEWTITLE := '[XDCL] ocp$build_panel_directory' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$build_panel_directory
    (VAR sequence: ^SEQ ( * );
     VAR file_descriptor: ^oct$open_file_list;
     VAR status: ost$status);

    VAR
      directory: ^array [1 .. * ] of oct$module_description,
      file_form_module: ^SEQ ( * ),
      i: 1 .. llc$max_modules_in_library,
      identification: ^llt$identification,
      j: 1 .. llc$max_modules_in_library + 1,
      library_form_module: ^SEQ ( * ),
      library_member_header: ^llt$library_member_header,
      local_status: ost$status,
      member_sequence: ^SEQ ( * ),
      module_description: ^oct$module_description,
      number_of_modules: 0 .. llc$max_modules_in_library,
      object_text_descriptor: ^llt$object_text_descriptor,
      reset_value: ^SEQ ( * ),
      size: 0 .. 0ffffffff(16);

    reset_value := ocv$olg_scratch_seq;

    number_of_modules := 0;

    RESET sequence;
    NEXT object_text_descriptor IN sequence;

    WHILE object_text_descriptor <> NIL DO
      IF object_text_descriptor^.kind <> llc$identification THEN
        osp$set_status_abnormal (oc, oce$e_no_ident_rec_on_obj_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      IF number_of_modules >= llc$max_modules_in_library THEN
        osp$set_status_abnormal (oc, oce$e_too_many_modules_on_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      NEXT identification IN sequence;
      IF identification = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
        RETURN;
      IFEND;

      IF (identification^.object_text_version <> 'V1.2') AND
            (identification^.object_text_version <> 'V1.3') AND
            (identification^.object_text_version <> 'V1.4') THEN
        osp$set_status_abnormal (oc, oce$e_invalid_obj_text_version, identification^.object_text_version,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, identification^.name, status);
        RETURN;
      IFEND;

      NEXT object_text_descriptor IN sequence;
      IF object_text_descriptor^.kind <> llc$form_definition THEN
        osp$set_status_abnormal (oc, oce$e_invalid_object_rec_kind, identification^.name, status);
        RETURN;
      IFEND;

      size := #SIZE (llt$library_member_header) + object_text_descriptor^.sequence_length;
      ALLOCATE member_sequence: [[REP size OF cell]] IN ocv$olg_working_heap^;
      IF member_sequence = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;

      RESET member_sequence;
      NEXT library_member_header IN member_sequence;
      library_member_header^.name := identification^.name;
      library_member_header^.kind := llc$panel_module;
      library_member_header^.time_created := identification^.time_created;
      library_member_header^.date_created := identification^.date_created;
      library_member_header^.generator_id := identification^.generator_id;
      library_member_header^.generator_name_vers := identification^.generator_name_vers;
      library_member_header^.commentary := identification^.commentary;
      library_member_header^.member_size := object_text_descriptor^.sequence_length;

      NEXT file_form_module: [[REP object_text_descriptor^.sequence_length OF cell]] IN sequence;
      IF file_form_module = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, file_descriptor^.name, status);
        RETURN;
      IFEND;
      NEXT library_form_module: [[REP object_text_descriptor^.sequence_length OF cell]] IN member_sequence;
      library_member_header^.member := #REL (library_form_module, member_sequence^);
      library_form_module^ := file_form_module^;
      number_of_modules := number_of_modules + 1;
      NEXT module_description IN ocv$olg_scratch_seq;
      IF module_description = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;

      module_description^.name := identification^.name;
      module_description^.source := occ$file;
      module_description^.file := member_sequence;
      module_description^.kind := occ$panel_module;
      module_description^.panel_module_header := library_member_header;
      NEXT object_text_descriptor IN sequence;
    WHILEND;

    IF number_of_modules = 0 THEN
      osp$set_status_abnormal (oc, oce$e_empty_object_file, file_descriptor^.name, status);
      RETURN;
    ELSE
      ocv$olg_scratch_seq := reset_value;
      NEXT directory: [1 .. number_of_modules] IN ocv$olg_scratch_seq;

      FOR i := 1 TO (UPPERBOUND (directory^) - 1) DO
        IF (directory^ [i].name <> osc$null_name) THEN
          FOR j := (i + 1) TO UPPERBOUND (directory^) DO
            IF (directory^ [i].name = directory^ [j].name) THEN
              osp$set_status_abnormal (oc, oce$w_duplicate_module_on_file, directory^ [i].name, local_status);
              osp$append_status_parameter (osc$status_parameter_delimiter, file_descriptor^.name,
                    local_status);
              ocp$generate_message (local_status);

              directory^ [j].name := osc$null_name;
              number_of_modules := number_of_modules - 1;
            IFEND;
          FOREND;
        IFEND;
      FOREND;

      ALLOCATE file_descriptor^.directory: [1 .. number_of_modules] IN ocv$olg_working_heap^;
      IF file_descriptor^.directory = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      ELSE
        j := 1;
        FOR i := 1 TO number_of_modules DO
          WHILE (directory^ [j].name = osc$null_name) AND (j < UPPERBOUND (directory^)) DO
            j := j + 1;
          WHILEND;

          file_descriptor^.directory^ [i] := directory^ [j];
          j := j + 1;
        FOREND;
      IFEND;
    IFEND;

    file_descriptor^.entry_point_dictionary := NIL;

    ocv$olg_scratch_seq := reset_value;


  PROCEND ocp$build_panel_directory;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$obtain_header' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$obtain_header
    (VAR module_description: oct$module_description;
         changed_info: ^oct$changed_info;
     VAR header: oct$header;
     VAR status: ost$status);


    VAR
      object_text_descriptor: ^llt$object_text_descriptor,
      identification: ^llt$identification,
      application_identifier: ^llt$application_identifier;


    CASE module_description.kind OF
    = occ$cpu_object_module =
      header.identification := module_description.cpu_object_module_header^.identification^;
      IF module_description.cpu_object_module_header^.application_identifier <> NIL THEN
        header.application_identifier.name := module_description.cpu_object_module_header^.
              application_identifier^.name;
      ELSE
        header.application_identifier.name := osc$null_name;
      IFEND;

    = occ$ppu_object_module =
      header.identification := module_description.ppu_object_module_header^;
      header.application_identifier.name := osc$null_name;

    = occ$program_description =
      IF (changed_info <> NIL) AND (changed_info^.application_identifier <> NIL) AND
            (changed_info^.application_identifier^.name <> osc$null_name) THEN
        header.application_member_header.library_member_header :=
              module_description.program_description_header^;
        header.application_member_header.library_member_header.kind := llc$applic_program_description;
      ELSE
        header.library_member_header := module_description.program_description_header^;
      IFEND;

    = occ$applic_program_description =
      IF (changed_info <> NIL) AND (changed_info^.application_identifier <> NIL) AND
            (changed_info^.application_identifier^.name = osc$null_name) THEN
        header.library_member_header := module_description.applic_program_description_hdr^.
              library_member_header;
        header.library_member_header.kind := llc$program_description;
      ELSE
        header.application_member_header := module_description.applic_program_description_hdr^;
      IFEND;

    = occ$command_procedure =
      IF (changed_info <> NIL) AND (changed_info^.application_identifier <> NIL) AND
            (changed_info^.application_identifier^.name <> osc$null_name) THEN
        header.application_member_header.library_member_header :=
              module_description.command_procedure_header^;
        header.application_member_header.library_member_header.kind := llc$applic_command_procedure;
      ELSE
        header.library_member_header := module_description.command_procedure_header^;
      IFEND;

    = occ$applic_command_procedure =
      IF (changed_info <> NIL) AND (changed_info^.application_identifier <> NIL) AND
            (changed_info^.application_identifier^.name = osc$null_name) THEN
        header.library_member_header := module_description.applic_command_procedure_header^.
              library_member_header;
        header.library_member_header.kind := llc$command_procedure;
      ELSE
        header.application_member_header := module_description.applic_command_procedure_header^;
      IFEND;

    = occ$command_description =
      IF (changed_info <> NIL) AND (changed_info^.application_identifier <> NIL) AND
            (changed_info^.application_identifier^.name <> osc$null_name) THEN
        header.application_member_header.library_member_header :=
              module_description.command_description_header^;
        header.application_member_header.library_member_header.kind := llc$applic_command_description;
      ELSE
        header.library_member_header := module_description.command_description_header^;
      IFEND;

    = occ$applic_command_description =
      IF (changed_info <> NIL) AND (changed_info^.application_identifier <> NIL) AND
            (changed_info^.application_identifier^.name = osc$null_name) THEN
        header.library_member_header := module_description.applic_command_description_hdr^.
              library_member_header;
        header.library_member_header.kind := llc$command_description;
      ELSE
        header.application_member_header := module_description.applic_command_description_hdr^;
      IFEND;

    = occ$function_procedure =
      header.library_member_header := module_description.function_procedure_header^;

    = occ$function_description =
      header.library_member_header := module_description.function_description_header^;

    = occ$message_module =
      header.library_member_header := module_description.message_module_header^;

    = occ$panel_module =
      header.library_member_header := module_description.panel_module_header^;

    = occ$bound_module =
      header.identification := module_description.bound_module_header^.identification;
      header.application_identifier.name := osc$null_name;

    = occ$load_module =
      object_text_descriptor := #PTR (module_description.load_module_header^.interpretive_element,
            module_description.file^);
      IF object_text_descriptor = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
        RETURN;
      IFEND;

      RESET module_description.file TO object_text_descriptor;
      NEXT object_text_descriptor IN module_description.file;

      NEXT identification IN module_description.file;
      IF identification = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
        RETURN;
      IFEND;
      header.identification := identification^;

      NEXT object_text_descriptor IN module_description.file;
      IF object_text_descriptor = NIL THEN
        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
        RETURN;
      IFEND;

      IF object_text_descriptor^.kind = llc$application_identifier THEN
        NEXT application_identifier IN module_description.file;
        IF application_identifier = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        header.application_identifier.name := application_identifier^.name;
      ELSE
        header.application_identifier.name := osc$null_name;
      IFEND;

    CASEND;

    IF changed_info <> NIL THEN
      IF (changed_info^.application_identifier <> NIL) THEN
        CASE module_description.kind OF
        = occ$cpu_object_module, occ$ppu_object_module, occ$load_module, occ$bound_module =
          header.application_identifier.name := changed_info^.application_identifier^.name;

        = occ$program_description, occ$command_procedure, occ$command_description,
              occ$applic_program_description, occ$applic_command_procedure, occ$applic_command_description =
          IF (changed_info^.application_identifier^.name <> osc$null_name) THEN
            header.application_member_header.application_identifier.name :=
                  changed_info^.application_identifier^.name;
          IFEND;
        ELSE
          ;
        CASEND;
      IFEND;

      IF changed_info^.name <> NIL THEN
        CASE module_description.kind OF
        = occ$cpu_object_module, occ$ppu_object_module, occ$load_module, occ$bound_module =
          header.identification.name := changed_info^.name^;
        = occ$function_procedure, occ$function_description, occ$message_module, occ$panel_module =
          header.library_member_header.name := changed_info^.name^;
        = occ$program_description, occ$command_procedure, occ$command_description =
          IF (changed_info^.application_identifier <> NIL) AND
                (changed_info^.application_identifier^.name <> osc$null_name) THEN
            header.application_member_header.library_member_header.name := changed_info^.name^;
          ELSE
            header.library_member_header.name := changed_info^.name^;
          IFEND;
        = occ$applic_program_description, occ$applic_command_procedure, occ$applic_command_description =
          IF (changed_info^.application_identifier <> NIL) AND
                (changed_info^.application_identifier^.name = osc$null_name) THEN
            header.library_member_header.name := changed_info^.name^;
          ELSE
            header.application_member_header.library_member_header.name := changed_info^.name^;
          IFEND;
        CASEND;
      IFEND;

      IF changed_info^.commentary <> NIL THEN
        CASE module_description.kind OF
        = occ$cpu_object_module, occ$ppu_object_module, occ$load_module, occ$bound_module =
          header.identification.commentary := changed_info^.commentary^;
        = occ$function_procedure, occ$function_description, occ$message_module, occ$panel_module =
          header.library_member_header.commentary := changed_info^.commentary^;
        = occ$program_description, occ$command_procedure, occ$command_description =
          IF (changed_info^.application_identifier <> NIL) AND
                (changed_info^.application_identifier^.name <> osc$null_name) THEN
            header.application_member_header.library_member_header.commentary := changed_info^.commentary^;
          ELSE
            header.library_member_header.commentary := changed_info^.commentary^;
          IFEND;
        = occ$applic_program_description, occ$applic_command_procedure, occ$applic_command_description =
          IF (changed_info^.application_identifier <> NIL) AND
                (changed_info^.application_identifier^.name = osc$null_name) THEN
            header.library_member_header.commentary := changed_info^.commentary^;
          ELSE
            header.application_member_header.library_member_header.commentary := changed_info^.commentary^;
          IFEND;
        CASEND;
      IFEND;
    IFEND;


  PROCEND ocp$obtain_header;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$obtain_xdcl_list', EJECT ??

  PROCEDURE [XDCL] ocp$obtain_xdcl_list
    (    changed_info: ^oct$changed_info;
         retain: boolean;
         obtain_deferred_entry_points: boolean;
     VAR module_description: oct$module_description;
     VAR xdcl_list: oct$external_declaration_list;
     VAR starting_procedure: pmt$program_name;
     VAR deferred_entry_point_list: oct$external_declaration_list;
     VAR status: ost$status);

?? NEWTITLE := 'obtain_xdcls_from_object_module', EJECT ??

    PROCEDURE obtain_xdcls_from_object_module
      (    retain: boolean;
           obtain_deferred_entry_points: boolean;
       VAR module_description: oct$module_description;
       VAR xdcl_list: oct$external_declaration_list;
       VAR starting_procedure: pmt$program_name;
       VAR deferred_entry_point_list: oct$external_declaration_list;
       VAR status: ost$status);


      VAR
        last_deferred_entry_point: ^oct$external_declaration_list,
        last_xdcl: ^oct$external_declaration_list;

      VAR { object text record templates }
        object_text_descriptor: ^llt$object_text_descriptor,

        identification: ^llt$identification,
        application_identifier: ^llt$application_identifier,
        libraries: ^llt$libraries,
        section_definition: ^llt$section_definition,
        segment_definition: ^llt$segment_definition,
        obsolete_segment_definition: ^llt$obsolete_segment_definition,
        text: ^llt$text,
        replication: ^llt$replication,
        bit_string_insertion: ^llt$bit_string_insertion,
        relocation: ^llt$relocation,
        binding_template: ^llt$binding_template,
        entry_definition: ^llt$entry_definition,
        deferred_entry_index: 1 .. llc$max_deferred_entry_points,
        deferred_entry_points: ^llt$deferred_entry_points,
        deferred_common_blocks: ^llt$deferred_common_blocks,
        external_linkage: ^llt$external_linkage,
        address_formulation: ^llt$address_formulation,
        obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
        formal_parameters: ^llt$formal_parameters,
        actual_parameters: ^llt$actual_parameters,
        debug_table_fragment: ^llt$debug_table_fragment,
        obsolete_line_address_table: ^llt$obsolete_line_address_table,
        symbol_table: ^llt$symbol_table,
        line_address_table: ^llt$line_address_table,
        supplemental_debug_tables: ^llt$supplemental_debug_tables,
        m68000_absolute: ^llt$68000_absolute,
        transfer_symbol: ^llt$transfer_symbol,
        module_name: pmt$program_name;

      last_deferred_entry_point := ^deferred_entry_point_list;
      last_xdcl := ^xdcl_list;

      RESET module_description.file TO module_description.cpu_object_module_header^.identification;
      NEXT identification IN module_description.file;

      REPEAT
        NEXT object_text_descriptor IN module_description.file;

        CASE object_text_descriptor^.kind OF
        = llc$entry_definition =
          NEXT entry_definition IN module_description.file;

          IF retain THEN
            ALLOCATE last_xdcl^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_xdcl^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_xdcl^.link = NIL THEN
            osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
            RETURN;
          IFEND;

          last_xdcl := last_xdcl^.link;
          last_xdcl^.name := entry_definition^.name;
          last_xdcl^.old_name := entry_definition^.name;
          last_xdcl^.attributes := entry_definition^.attributes;
          last_xdcl^.deferred := FALSE;

        = llc$deferred_entry_points =
          NEXT deferred_entry_points: [1 .. object_text_descriptor^.number_of_entry_points] IN
                module_description.file;

          IF obtain_deferred_entry_points THEN
            FOR deferred_entry_index := 1 TO object_text_descriptor^.number_of_entry_points DO
              IF retain THEN
                ALLOCATE last_deferred_entry_point^.link IN ocv$olg_working_heap^;
              ELSE
                NEXT last_deferred_entry_point^.link IN ocv$olg_scratch_seq;
              IFEND;

              IF last_deferred_entry_point^.link = NIL THEN
                osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
                RETURN;
              IFEND;

              last_deferred_entry_point := last_deferred_entry_point^.link;
              last_deferred_entry_point^.name := deferred_entry_points^ [deferred_entry_index].name;
              last_deferred_entry_point^.old_name := deferred_entry_points^ [deferred_entry_index].name;
              last_deferred_entry_point^.attributes := deferred_entry_points^ [deferred_entry_index].
                    attributes;
              last_deferred_entry_point^.deferred := TRUE;
            FOREND;
          IFEND;

        = llc$deferred_common_blocks =
          NEXT deferred_common_blocks: [1 .. object_text_descriptor^.number_of_common_blocks] IN
                module_description.file;

        = llc$transfer_symbol =
          NEXT transfer_symbol IN module_description.file;
          starting_procedure := transfer_symbol^.name;

        = llc$application_identifier =
          NEXT application_identifier IN module_description.file;

        = llc$libraries =
          NEXT libraries: [1 .. object_text_descriptor^.number_of_libraries] IN module_description.file;

        = llc$section_definition, llc$unallocated_common_block =
          NEXT section_definition IN module_description.file;

        = llc$segment_definition =
          NEXT segment_definition IN module_description.file;

        = llc$obsolete_segment_definition =
          NEXT obsolete_segment_definition IN module_description.file;

        = llc$text =
          NEXT text: [1 .. object_text_descriptor^.number_of_bytes] IN module_description.file;

        = llc$replication =
          NEXT replication: [1 .. object_text_descriptor^.number_of_bytes] IN module_description.file;

        = llc$bit_string_insertion =
          NEXT bit_string_insertion IN module_description.file;

        = llc$address_formulation =
          NEXT address_formulation: [1 .. object_text_descriptor^.number_of_adr_items] IN
                module_description.file;

        = llc$external_linkage =
          NEXT external_linkage: [1 .. object_text_descriptor^.number_of_ext_items] IN
                module_description.file;

        = llc$relocation =
          NEXT relocation: [1 .. object_text_descriptor^.number_of_rel_items] IN module_description.file;

        = llc$actual_parameters =
          NEXT actual_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$cybil_symbol_table_fragment =
          NEXT debug_table_fragment: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$obsolete_line_table =
          NEXT obsolete_line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                module_description.file;

        = llc$symbol_table =
          NEXT symbol_table: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$line_table =
          NEXT line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                module_description.file;

        = llc$supplemental_debug_tables =
          NEXT supplemental_debug_tables: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$obsolete_formal_parameters =
          NEXT obsolete_formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$formal_parameters =
          NEXT formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$binding_template =
          NEXT binding_template IN module_description.file;

        = llc$form_definition =
          osp$set_status_abnormal (oc, oce$e_form_def_found_in_module, module_name, status);
          RETURN;

        = llc$68000_absolute =
          NEXT m68000_absolute: [[REP object_text_descriptor^.number_of_68000_bytes OF cell]] IN
                module_description.file;

        CASEND;
      UNTIL object_text_descriptor^.kind = llc$transfer_symbol;

      last_deferred_entry_point^.link := NIL;
      last_xdcl^.link := NIL;


    PROCEND obtain_xdcls_from_object_module;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_xdcls_from_load_module', EJECT ??

    PROCEDURE obtain_xdcls_from_load_module
      (    retain: boolean;
           obtain_deferred_entry_points: boolean;
       VAR module_descritpion: oct$module_description;
       VAR xdcl_list: oct$external_declaration_list;
       VAR starting_procedure: pmt$program_name;
       VAR deferred_entry_point_list: oct$external_declaration_list;
       VAR status: ost$status);


      VAR
        deferred_entry_index: 1 .. llc$max_deferred_entry_points,
        deferred_entry_points: ^llt$deferred_entry_points,
        entry_definition: ^llt$entry_definition,
        last_deferred_entry_point: ^oct$external_declaration_list,
        last_xdcl: ^oct$external_declaration_list,
        object_text_descriptor: ^llt$object_text_descriptor,
        transfer_symbol: ^llt$transfer_symbol;


      last_deferred_entry_point := ^deferred_entry_point_list;
      last_xdcl := ^xdcl_list;

      IF llc$entry_point_element IN module_description.load_module_header^.interpretive_header.
            elements_defined THEN
        object_text_descriptor := #PTR (module_description.load_module_header^.interpretive_header.
              entry_points, module_description.file^);
        IF object_text_descriptor = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        RESET module_description.file TO object_text_descriptor;
        NEXT object_text_descriptor IN module_description.file;

        WHILE object_text_descriptor^.kind = llc$entry_definition DO
          NEXT entry_definition IN module_description.file;
          IF entry_definition = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;

          IF retain THEN
            ALLOCATE last_xdcl^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_xdcl^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_xdcl^.link = NIL THEN
            osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
            RETURN;
          IFEND;

          last_xdcl := last_xdcl^.link;
          last_xdcl^.name := entry_definition^.name;
          last_xdcl^.old_name := entry_definition^.name;
          last_xdcl^.attributes := entry_definition^.attributes;
          last_xdcl^.deferred := FALSE;

          NEXT object_text_descriptor IN module_description.file;
          IF object_text_descriptor = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;
        WHILEND;

        IF obtain_deferred_entry_points AND (object_text_descriptor^.kind = llc$deferred_entry_points) THEN
          NEXT deferred_entry_points: [1 .. object_text_descriptor^.number_of_entry_points] IN
                module_description.file;
          IF deferred_entry_points = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;

          FOR deferred_entry_index := 1 TO object_text_descriptor^.number_of_entry_points DO
            IF retain THEN
              ALLOCATE last_deferred_entry_point^.link IN ocv$olg_working_heap^;
            ELSE
              NEXT last_deferred_entry_point^.link IN ocv$olg_scratch_seq;
            IFEND;

            IF last_deferred_entry_point^.link = NIL THEN
              osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
              RETURN;
            IFEND;

            last_deferred_entry_point := last_deferred_entry_point^.link;
            last_deferred_entry_point^.name := deferred_entry_points^ [deferred_entry_index].name;
            last_deferred_entry_point^.old_name := deferred_entry_points^ [deferred_entry_index].name;
            last_deferred_entry_point^.attributes := deferred_entry_points^ [deferred_entry_index].attributes;
            last_deferred_entry_point^.deferred := TRUE;
          FOREND;
        IFEND;
      IFEND;

      last_deferred_entry_point^.link := NIL;
      last_xdcl^.link := NIL;

      IF llc$transfer_symbol_element IN module_description.load_module_header^.interpretive_header.
            elements_defined THEN
        object_text_descriptor := #PTR (module_description.load_module_header^.interpretive_header.
              transfer_symbol, module_description.file^);
        IF object_text_descriptor = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        RESET module_description.file TO object_text_descriptor;
        NEXT object_text_descriptor IN module_description.file;

        NEXT transfer_symbol IN module_description.file;
        IF transfer_symbol = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        starting_procedure := transfer_symbol^.name;
      ELSE
        starting_procedure := osc$null_name;
      IFEND;

    PROCEND obtain_xdcls_from_load_module;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_aliases_from_scl_proc', EJECT ??

    PROCEDURE obtain_aliases_from_scl_proc
      (VAR module_description: oct$module_description;
       VAR alias_list: oct$external_declaration_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        command_procedure_header: ^llt$library_member_header,
        function_procedure_header: ^llt$library_member_header,
        last_alias: ^oct$external_declaration_list,
        aliases: ^array [1 .. * ] of pmt$program_name,
        number_of_aliases: llt$number_of_aliases,
        i: llt$number_of_aliases;

      CASE module_description.kind OF

      = occ$command_procedure =
        IF module_description.command_procedure_header^.number_of_aliases = 0 THEN
          alias_list.link := NIL;
          number_of_aliases := 0;
        ELSE
          aliases := #PTR (module_description.command_procedure_header^.aliases, module_description.file^);
          IF aliases = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;
          number_of_aliases := module_description.command_procedure_header^.number_of_aliases;
        IFEND;

      = occ$function_procedure =
        IF module_description.function_procedure_header^.number_of_aliases = 0 THEN
          alias_list.link := NIL;
          number_of_aliases := 0;
        ELSE
          aliases := #PTR (module_description.function_procedure_header^.aliases, module_description.file^);
          IF aliases = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;
          number_of_aliases := module_description.function_procedure_header^.number_of_aliases;
        IFEND;

      = occ$applic_command_procedure =
        IF module_description.applic_command_procedure_header^.library_member_header.number_of_aliases =
              0 THEN
          alias_list.link := NIL;
          number_of_aliases := 0;
        ELSE
          aliases := #PTR (module_description.applic_command_procedure_header^.library_member_header.aliases,
                module_description.file^);
          IF aliases = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;
          number_of_aliases := module_description.applic_command_procedure_header^.library_member_header.
                number_of_aliases;
        IFEND;

      CASEND;

      IF number_of_aliases <> 0 THEN
        last_alias := ^alias_list;
        FOR i := 1 TO number_of_aliases DO
          IF retain THEN
            ALLOCATE last_alias^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_alias^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_alias^.link = NIL THEN
            osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
            RETURN;
          IFEND;

          last_alias := last_alias^.link;
          last_alias^.name := aliases^ [i];
          last_alias^.attributes := $llt$entry_point_attributes [];
        FOREND;

        last_alias^.link := NIL;
      IFEND;

    PROCEND obtain_aliases_from_scl_proc;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_aliases_from_prog_desc', EJECT ??

    PROCEDURE obtain_aliases_from_prog_desc
      (VAR module_description: oct$module_description;
       VAR alias_list: oct$external_declaration_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        program_description_header: ^llt$library_member_header,
        last_alias: ^oct$external_declaration_list,
        aliases: ^array [1 .. * ] of pmt$program_name,
        i: llt$number_of_aliases;


      IF module_description.program_description_header^.number_of_aliases = 0 THEN
        alias_list.link := NIL;

      ELSE
        aliases := #PTR (module_description.program_description_header^.aliases, module_description.file^);
        IF aliases = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        last_alias := ^alias_list;
        FOR i := 1 TO module_description.program_description_header^.number_of_aliases DO
          IF retain THEN
            ALLOCATE last_alias^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_alias^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_alias^.link = NIL THEN
            osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
            RETURN;
          IFEND;

          last_alias := last_alias^.link;
          last_alias^.name := aliases^ [i];
          last_alias^.attributes := $llt$entry_point_attributes [];
        FOREND;

        last_alias^.link := NIL;
      IFEND;

    PROCEND obtain_aliases_from_prog_desc;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_aliases_from_applic_prog', EJECT ??

    PROCEDURE obtain_aliases_from_applic_prog
      (VAR module_description: oct$module_description;
       VAR alias_list: oct$external_declaration_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        aliases: ^array [1 .. * ] of pmt$program_name,
        i: llt$number_of_aliases,
        last_alias: ^oct$external_declaration_list,
        program_description_header: ^llt$library_member_header;


      IF module_description.applic_program_description_hdr^.library_member_header.number_of_aliases = 0 THEN
        alias_list.link := NIL;

      ELSE
        aliases := #PTR (module_description.applic_program_description_hdr^.library_member_header.aliases,
              module_description.file^);
        IF aliases = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        last_alias := ^alias_list;
        FOR i := 1 TO module_description.applic_program_description_hdr^.library_member_header.
              number_of_aliases DO
          IF retain THEN
            ALLOCATE last_alias^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_alias^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_alias^.link = NIL THEN
            osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
            RETURN;
          IFEND;

          last_alias := last_alias^.link;
          last_alias^.name := aliases^ [i];
          last_alias^.attributes := $llt$entry_point_attributes [];
        FOREND;

        last_alias^.link := NIL;
      IFEND;


    PROCEND obtain_aliases_from_applic_prog;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_aliases_from_cmnd_desc' ??
?? EJECT ??

    PROCEDURE obtain_aliases_from_cmnd_desc
      (VAR module_description: oct$module_description;
       VAR alias_list: oct$external_declaration_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        command_description_header: ^llt$library_member_header,
        last_alias: ^oct$external_declaration_list,
        aliases: ^array [1 .. * ] of pmt$program_name,
        i: llt$number_of_aliases;


      IF module_description.command_description_header^.number_of_aliases = 0 THEN
        alias_list.link := NIL;

      ELSE
        aliases := #PTR (module_description.command_description_header^.aliases, module_description.file^);
        IF aliases = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        last_alias := ^alias_list;
        FOR i := 1 TO module_description.command_description_header^.number_of_aliases DO
          IF retain THEN
            ALLOCATE last_alias^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_alias^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_alias^.link = NIL THEN
            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
            RETURN;
          IFEND;

          last_alias := last_alias^.link;
          last_alias^.name := aliases^ [i];
          last_alias^.attributes := $llt$entry_point_attributes [];
        FOREND;

        last_alias^.link := NIL;
      IFEND;


    PROCEND obtain_aliases_from_cmnd_desc;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_aliases_from_applic_cmnd' ??
?? EJECT ??

    PROCEDURE obtain_aliases_from_applic_cmnd
      (VAR module_description: oct$module_description;
       VAR alias_list: oct$external_declaration_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        aliases: ^array [1 .. * ] of pmt$program_name,
        i: llt$number_of_aliases,
        last_alias: ^oct$external_declaration_list,
        command_description_header: ^llt$library_member_header;


      IF module_description.applic_command_description_hdr^.library_member_header.number_of_aliases = 0 THEN
        alias_list.link := NIL;

      ELSE
        aliases := #PTR (module_description.applic_command_description_hdr^.library_member_header.aliases,
              module_description.file^);
        IF aliases = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        last_alias := ^alias_list;
        FOR i := 1 TO module_description.applic_command_description_hdr^.library_member_header.
              number_of_aliases DO
          IF retain THEN
            ALLOCATE last_alias^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_alias^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_alias^.link = NIL THEN
            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
            RETURN;
          IFEND;

          last_alias := last_alias^.link;
          last_alias^.name := aliases^ [i];
          last_alias^.attributes := $llt$entry_point_attributes [];
        FOREND;

        last_alias^.link := NIL;
      IFEND;


    PROCEND obtain_aliases_from_applic_cmnd;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_aliases_from_func_desc' ??
?? EJECT ??

    PROCEDURE obtain_aliases_from_func_desc
      (VAR module_description: oct$module_description;
       VAR alias_list: oct$external_declaration_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        function_description_header: ^llt$library_member_header,
        last_alias: ^oct$external_declaration_list,
        aliases: ^array [1 .. * ] of pmt$program_name,
        i: llt$number_of_aliases;


      IF module_description.function_description_header^.number_of_aliases = 0 THEN
        alias_list.link := NIL;

      ELSE
        aliases := #PTR (module_description.function_description_header^.aliases, module_description.file^);
        IF aliases = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        last_alias := ^alias_list;
        FOR i := 1 TO module_description.function_description_header^.number_of_aliases DO
          IF retain THEN
            ALLOCATE last_alias^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_alias^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_alias^.link = NIL THEN
            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
            RETURN;
          IFEND;

          last_alias := last_alias^.link;
          last_alias^.name := aliases^ [i];
          last_alias^.attributes := $llt$entry_point_attributes [];
        FOREND;

        last_alias^.link := NIL;
      IFEND;


    PROCEND obtain_aliases_from_func_desc;
?? OLDTITLE ??
?? EJECT ??

    VAR
      ignore_starting_procedure: pmt$program_name,
      ignore_xdcl_list: oct$external_declaration_list;


    IF (changed_info <> NIL) AND (changed_info^.entry_points <> NIL) THEN
      xdcl_list.link := changed_info^.entry_points;
      starting_procedure := changed_info^.starting_procedure;
      IF obtain_deferred_entry_points THEN
        CASE module_description.kind OF
        = occ$cpu_object_module =
          obtain_xdcls_from_object_module (retain, obtain_deferred_entry_points, module_description,
                ignore_xdcl_list, ignore_starting_procedure, deferred_entry_point_list, status);

        = occ$load_module =
          obtain_xdcls_from_load_module (retain, obtain_deferred_entry_points, module_description,
                ignore_xdcl_list, ignore_starting_procedure, deferred_entry_point_list, status);

        ELSE
          deferred_entry_point_list.link := NIL;
        CASEND
      ELSE
        deferred_entry_point_list.link := NIL;
      IFEND;
    ELSE
      CASE module_description.kind OF
      = occ$cpu_object_module =
        obtain_xdcls_from_object_module (retain, obtain_deferred_entry_points, module_description, xdcl_list,
              starting_procedure, deferred_entry_point_list, status);

      = occ$load_module =
        obtain_xdcls_from_load_module (retain, obtain_deferred_entry_points, module_description, xdcl_list,
              starting_procedure, deferred_entry_point_list, status);

      = occ$bound_module =
        xdcl_list.link := NIL;

      = occ$ppu_object_module =
        xdcl_list.link := NIL;
        starting_procedure := osc$null_name;

      = occ$command_procedure, occ$function_procedure, occ$applic_command_procedure =
        obtain_aliases_from_scl_proc (module_description, xdcl_list, retain, status);

      = occ$program_description =
        obtain_aliases_from_prog_desc (module_description, xdcl_list, retain, status);

      = occ$applic_program_description =
        obtain_aliases_from_applic_prog (module_description, xdcl_list, retain, status);

      = occ$command_description =
        obtain_aliases_from_cmnd_desc (module_description, xdcl_list, retain, status);

      = occ$applic_command_description =
        obtain_aliases_from_applic_cmnd (module_description, xdcl_list, retain, status);

      = occ$function_description =
        obtain_aliases_from_func_desc (module_description, xdcl_list, retain, status);

      = occ$message_module, occ$panel_module =
        xdcl_list.link := NIL;
        starting_procedure := osc$null_name;

      CASEND;
    IFEND;

    CASE module_description.kind OF
    = occ$command_procedure, occ$function_procedure, occ$program_description, occ$command_description,
          occ$function_description =
      starting_procedure := osc$null_name;
    ELSE
    CASEND;


  PROCEND ocp$obtain_xdcl_list;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$obtain_xref_list' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$obtain_xref_list
    (VAR module_description: oct$module_description;
     VAR xref_list: oct$external_reference_list;
         retain: boolean;
     VAR status: ost$status);

?? NEWTITLE := 'obtain_xrefs_from_object_module' ??
?? EJECT ??

    PROCEDURE obtain_xrefs_from_object_module
      (VAR module_descritpion: oct$module_description;
       VAR xref_list: oct$external_reference_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        last_xref: ^oct$external_reference_list;

      VAR { object text record templates }
        object_text_descriptor: ^llt$object_text_descriptor,

        identification: ^llt$identification,
        application_identifier: ^llt$application_identifier,
        libraries: ^llt$libraries,
        section_definition: ^llt$section_definition,
        segment_definition: ^llt$segment_definition,
        obsolete_segment_definition: ^llt$obsolete_segment_definition,
        text: ^llt$text,
        replication: ^llt$replication,
        bit_string_insertion: ^llt$bit_string_insertion,
        relocation: ^llt$relocation,
        binding_template: ^llt$binding_template,
        entry_definition: ^llt$entry_definition,
        deferred_entry_points: ^llt$deferred_entry_points,
        deferred_common_blocks: ^llt$deferred_common_blocks,
        external_linkage: ^llt$external_linkage,
        address_formulation: ^llt$address_formulation,
        obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
        formal_parameters: ^llt$formal_parameters,
        actual_parameters: ^llt$actual_parameters,
        debug_table_fragment: ^llt$debug_table_fragment,
        obsolete_line_address_table: ^llt$obsolete_line_address_table,
        symbol_table: ^llt$symbol_table,
        line_address_table: ^llt$line_address_table,
        supplemental_debug_tables: ^llt$supplemental_debug_tables,
        m68000_absolute: ^llt$68000_absolute,
        transfer_symbol: ^llt$transfer_symbol,
        module_name: pmt$program_name;

      status.normal := TRUE;
      last_xref := ^xref_list;

      RESET module_description.file TO module_description.cpu_object_module_header^.identification;
      NEXT identification IN module_description.file;

      REPEAT
        NEXT object_text_descriptor IN module_description.file;
        IF object_text_descriptor = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        CASE object_text_descriptor^.kind OF
        = llc$external_linkage =
          NEXT external_linkage: [1 .. object_text_descriptor^.number_of_ext_items] IN
                module_description.file;
          IF external_linkage = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;

          IF retain THEN
            ALLOCATE last_xref^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_xref^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_xref^.link = NIL THEN
            osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
            RETURN;
          IFEND;

          last_xref := last_xref^.link;
          last_xref^.name := external_linkage^.name;

        = llc$application_identifier =
          NEXT application_identifier IN module_description.file;

        = llc$libraries =
          NEXT libraries: [1 .. object_text_descriptor^.number_of_libraries] IN module_description.file;

        = llc$section_definition, llc$unallocated_common_block =
          NEXT section_definition IN module_description.file;

        = llc$segment_definition =
          NEXT segment_definition IN module_description.file;

        = llc$obsolete_segment_definition =
          NEXT obsolete_segment_definition IN module_description.file;

        = llc$text =
          NEXT text: [1 .. object_text_descriptor^.number_of_bytes] IN module_description.file;

        = llc$replication =
          NEXT replication: [1 .. object_text_descriptor^.number_of_bytes] IN module_description.file;

        = llc$bit_string_insertion =
          NEXT bit_string_insertion IN module_description.file;

        = llc$address_formulation =
          NEXT address_formulation: [1 .. object_text_descriptor^.number_of_adr_items] IN
                module_description.file;

        = llc$entry_definition =
          NEXT entry_definition IN module_description.file;

        = llc$deferred_entry_points =
          NEXT deferred_entry_points: [1 .. object_text_descriptor^.number_of_entry_points] IN
                module_description.file;

        = llc$deferred_common_blocks =
          NEXT deferred_common_blocks: [1 .. object_text_descriptor^.number_of_common_blocks] IN
                module_description.file;

        = llc$relocation =
          NEXT relocation: [1 .. object_text_descriptor^.number_of_rel_items] IN module_description.file;

        = llc$actual_parameters =
          NEXT actual_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$cybil_symbol_table_fragment =
          NEXT debug_table_fragment: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$obsolete_line_table =
          NEXT obsolete_line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                module_description.file;

        = llc$symbol_table =
          NEXT symbol_table: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$line_table =
          NEXT line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                module_description.file;

        = llc$supplemental_debug_tables =
          NEXT supplemental_debug_tables: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$obsolete_formal_parameters =
          NEXT obsolete_formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$formal_parameters =
          NEXT formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$binding_template =
          NEXT binding_template IN module_description.file;

        = llc$form_definition =
          osp$set_status_abnormal (oc, oce$e_form_def_found_in_module, module_name, status);
          RETURN;

        = llc$68000_absolute =
          NEXT m68000_absolute: [[REP object_text_descriptor^.number_of_68000_bytes OF cell]] IN
                module_description.file;

        = llc$transfer_symbol =
          NEXT transfer_symbol IN module_description.file;

        CASEND;
      UNTIL object_text_descriptor^.kind = llc$transfer_symbol;

      last_xref^.link := NIL;


    PROCEND obtain_xrefs_from_object_module;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_xrefs_from_load_module' ??
?? EJECT ??

    PROCEDURE obtain_xrefs_from_load_module
      (VAR module_descritpion: oct$module_description;
       VAR xref_list: oct$external_reference_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        last_xref: ^oct$external_reference_list;

      VAR { object text record templates }
        object_text_descriptor: ^llt$object_text_descriptor,
        external_linkage: ^llt$external_linkage;


      last_xref := ^xref_list;

      IF llc$external_element IN module_description.load_module_header^.interpretive_header.
            elements_defined THEN
        object_text_descriptor := #PTR (module_description.load_module_header^.interpretive_header.
              external_linkages, module_description.file^);
        IF object_text_descriptor = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        RESET module_description.file TO object_text_descriptor;
        NEXT object_text_descriptor IN module_description.file;

        WHILE object_text_descriptor^.kind = llc$external_linkage DO
          NEXT external_linkage: [1 .. object_text_descriptor^.number_of_ext_items] IN
                module_description.file;
          IF external_linkage = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;

          IF retain THEN
            ALLOCATE last_xref^.link IN ocv$olg_working_heap^;
          ELSE
            NEXT last_xref^.link IN ocv$olg_scratch_seq;
          IFEND;

          IF last_xref^.link = NIL THEN
            osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
            RETURN;
          IFEND;

          last_xref := last_xref^.link;
          last_xref^.name := external_linkage^.name;

          NEXT object_text_descriptor IN module_description.file;
          IF object_text_descriptor = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;
        WHILEND;
      IFEND;

      last_xref^.link := NIL;



    PROCEND obtain_xrefs_from_load_module;
?? OLDTITLE ??
?? EJECT ??


    CASE module_description.kind OF
    = occ$cpu_object_module =
      obtain_xrefs_from_object_module (module_description, xref_list, retain, status);

    = occ$load_module =
      obtain_xrefs_from_load_module (module_description, xref_list, retain, status);

    = occ$bound_module =
      xref_list.link := module_description.bound_module_header^.xref_list.link;

    = occ$command_procedure, occ$function_procedure, occ$program_description, occ$ppu_object_module,
          occ$command_description, occ$function_description, occ$message_module, occ$panel_module =
      xref_list.link := NIL;
    CASEND;

  PROCEND ocp$obtain_xref_list;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$obtain_library_list' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$obtain_library_list
    (VAR module_description: oct$module_description;
         changed_info: ^oct$changed_info;
     VAR library_list: oct$name_list;
         retain: boolean;
     VAR status: ost$status);

?? NEWTITLE := 'obtain_libs_from_object_module' ??
?? EJECT ??

    PROCEDURE obtain_libs_from_object_module
      (VAR module_descritpion: oct$module_description;
       VAR library_list: oct$name_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        l: integer,
        last_library: ^oct$name_list;

      VAR { object text record templates }
        object_text_descriptor: ^llt$object_text_descriptor,

        identification: ^llt$identification,
        application_identifier: ^llt$application_identifier,
        libraries: ^llt$libraries,
        section_definition: ^llt$section_definition,
        segment_definition: ^llt$segment_definition,
        obsolete_segment_definition: ^llt$obsolete_segment_definition,
        text: ^llt$text,
        replication: ^llt$replication,
        bit_string_insertion: ^llt$bit_string_insertion,
        relocation: ^llt$relocation,
        binding_template: ^llt$binding_template,
        entry_definition: ^llt$entry_definition,
        deferred_entry_points: ^llt$deferred_entry_points,
        deferred_common_blocks: ^llt$deferred_common_blocks,
        external_linkage: ^llt$external_linkage,
        address_formulation: ^llt$address_formulation,
        obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
        formal_parameters: ^llt$formal_parameters,
        actual_parameters: ^llt$actual_parameters,
        debug_table_fragment: ^llt$debug_table_fragment,
        obsolete_line_address_table: ^llt$obsolete_line_address_table,
        symbol_table: ^llt$symbol_table,
        line_address_table: ^llt$line_address_table,
        supplemental_debug_tables: ^llt$supplemental_debug_tables,
        m68000_absolute: ^llt$68000_absolute,
        transfer_symbol: ^llt$transfer_symbol,
        module_name: pmt$program_name;

      library_list.link := NIL;

      RESET module_description.file TO module_description.cpu_object_module_header^.identification;
      NEXT identification IN module_description.file;

      REPEAT
        NEXT object_text_descriptor IN module_description.file;

        CASE object_text_descriptor^.kind OF
        = llc$libraries =
          NEXT libraries: [1 .. object_text_descriptor^.number_of_libraries] IN module_description.file;

          FOR l := 1 TO object_text_descriptor^.number_of_libraries DO
            last_library := ^library_list;
            WHILE (last_library^.link <> NIL) AND (last_library^.link^.name <> libraries^ [l]) DO
              last_library := last_library^.link;
            WHILEND;

            IF last_library^.link = NIL THEN
              IF retain THEN
                ALLOCATE last_library^.link IN ocv$olg_working_heap^;
              ELSE
                NEXT last_library^.link IN ocv$olg_scratch_seq;
              IFEND;

              last_library := last_library^.link;
              IF last_library = NIL THEN
                osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
                RETURN;
              IFEND;

              last_library^.name := libraries^ [l];
              last_library^.link := NIL;
            IFEND;
          FOREND;

        = llc$application_identifier =
          NEXT application_identifier IN module_description.file;

        = llc$section_definition, llc$unallocated_common_block =
          NEXT section_definition IN module_description.file;

        = llc$deferred_common_blocks =
          NEXT deferred_common_blocks: [1 .. object_text_descriptor^.number_of_common_blocks] IN
                module_description.file;

        = llc$segment_definition =
          NEXT segment_definition IN module_description.file;

        = llc$obsolete_segment_definition =
          NEXT obsolete_segment_definition IN module_description.file;

        = llc$text =
          NEXT text: [1 .. object_text_descriptor^.number_of_bytes] IN module_description.file;

        = llc$replication =
          NEXT replication: [1 .. object_text_descriptor^.number_of_bytes] IN module_description.file;

        = llc$bit_string_insertion =
          NEXT bit_string_insertion IN module_description.file;

        = llc$address_formulation =
          NEXT address_formulation: [1 .. object_text_descriptor^.number_of_adr_items] IN
                module_description.file;

        = llc$external_linkage =
          NEXT external_linkage: [1 .. object_text_descriptor^.number_of_ext_items] IN
                module_description.file;

        = llc$entry_definition =
          NEXT entry_definition IN module_description.file;

        = llc$deferred_entry_points =
          NEXT deferred_entry_points: [1 .. object_text_descriptor^.number_of_entry_points] IN
                module_description.file;

        = llc$relocation =
          NEXT relocation: [1 .. object_text_descriptor^.number_of_rel_items] IN module_description.file;

        = llc$actual_parameters =
          NEXT actual_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$cybil_symbol_table_fragment =
          NEXT debug_table_fragment: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$obsolete_line_table =
          NEXT obsolete_line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                module_description.file;

        = llc$symbol_table =
          NEXT symbol_table: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$line_table =
          NEXT line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                module_description.file;

        = llc$supplemental_debug_tables =
          NEXT supplemental_debug_tables: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$obsolete_formal_parameters =
          NEXT obsolete_formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$formal_parameters =
          NEXT formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$binding_template =
          NEXT binding_template IN module_description.file;

        = llc$form_definition =
          osp$set_status_abnormal (oc, oce$e_form_def_found_in_module, module_name, status);
          RETURN;

        = llc$68000_absolute =
          NEXT m68000_absolute: [[REP object_text_descriptor^.number_of_68000_bytes OF cell]] IN
                module_description.file;

        = llc$transfer_symbol =
          NEXT transfer_symbol IN module_description.file;

        CASEND;
      UNTIL object_text_descriptor^.kind = llc$transfer_symbol;


    PROCEND obtain_libs_from_object_module;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_libs_from_load_module' ??
?? EJECT ??

    PROCEDURE obtain_libs_from_load_module
      (VAR module_descritpion: oct$module_description;
       VAR library_list: oct$name_list;
           retain: boolean;
       VAR status: ost$status);


      VAR
        l: integer,
        last_library: ^oct$name_list;

      VAR { object text record templates }
        object_text_descriptor: ^llt$object_text_descriptor,
        libraries: ^llt$libraries;


      library_list.link := NIL;

      IF llc$library_element IN module_description.load_module_header^.interpretive_header.
            elements_defined THEN
        object_text_descriptor := #PTR (module_description.load_module_header^.interpretive_header.
              library_list, module_description.file^);
        IF object_text_descriptor = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        RESET module_description.file TO object_text_descriptor;
        NEXT object_text_descriptor IN module_description.file;

        IF object_text_descriptor^.kind = llc$libraries THEN
          NEXT libraries: [1 .. object_text_descriptor^.number_of_libraries] IN module_description.file;
          IF libraries = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;

          FOR l := 1 TO object_text_descriptor^.number_of_libraries DO
            last_library := ^library_list;
            WHILE (last_library^.link <> NIL) AND (last_library^.link^.name <> libraries^ [l]) DO
              last_library := last_library^.link;
            WHILEND;

            IF last_library^.link = NIL THEN
              IF retain THEN
                ALLOCATE last_library^.link IN ocv$olg_working_heap^;
              ELSE
                NEXT last_library^.link IN ocv$olg_scratch_seq;
              IFEND;

              last_library := last_library^.link;
              IF last_library = NIL THEN
                osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
                RETURN;
              IFEND;

              last_library^.name := libraries^ [l];
              last_library^.link := NIL;
            IFEND;
          FOREND;
        IFEND;
      IFEND;



    PROCEND obtain_libs_from_load_module;
?? OLDTITLE ??
?? EJECT ??


    IF (changed_info <> NIL) AND (changed_info^.new_libraries) THEN
      library_list.link := changed_info^.library_list;

    ELSE
      CASE module_description.kind OF
      = occ$cpu_object_module =
        obtain_libs_from_object_module (module_description, library_list, retain, status);

      = occ$load_module =
        obtain_libs_from_load_module (module_description, library_list, retain, status);

      = occ$command_procedure, occ$function_procedure, occ$program_description, occ$ppu_object_module,
            occ$command_description, occ$function_description, occ$message_module, occ$panel_module =
        library_list.link := NIL;
      CASEND;
    IFEND;

  PROCEND ocp$obtain_library_list;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$obtain_code_section_ids' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$obtain_code_section_ids
    (VAR module_description: oct$module_description;
     VAR code_section_ids: oct$code_section_ids;
     VAR status: ost$status);

?? NEWTITLE := 'get_ordinals_from_object_module' ??
?? EJECT ??

    PROCEDURE get_ordinals_from_object_module
      (VAR module_descritpion: oct$module_description;
       VAR code_section_ids: oct$code_section_ids;
       VAR status: ost$status);


      VAR
        last_code_section_id: ^oct$code_section_ids;

      VAR { object text record templates }
        object_text_descriptor: ^llt$object_text_descriptor,

        identification: ^llt$identification,
        application_identifier: ^llt$application_identifier,
        libraries: ^llt$libraries,
        section_definition: ^llt$section_definition,
        segment_definition: ^llt$segment_definition,
        obsolete_segment_definition: ^llt$obsolete_segment_definition,
        text: ^llt$text,
        replication: ^llt$replication,
        bit_string_insertion: ^llt$bit_string_insertion,
        relocation: ^llt$relocation,
        binding_template: ^llt$binding_template,
        entry_definition: ^llt$entry_definition,
        deferred_entry_points: ^llt$deferred_entry_points,
        deferred_common_blocks: ^llt$deferred_common_blocks,
        external_linkage: ^llt$external_linkage,
        address_formulation: ^llt$address_formulation,
        obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
        formal_parameters: ^llt$formal_parameters,
        actual_parameters: ^llt$actual_parameters,
        debug_table_fragment: ^llt$debug_table_fragment,
        obsolete_line_address_table: ^llt$obsolete_line_address_table,
        symbol_table: ^llt$symbol_table,
        line_address_table: ^llt$line_address_table,
        supplemental_debug_tables: ^llt$supplemental_debug_tables,
        m68000_absolute: ^llt$68000_absolute,
        transfer_symbol: ^llt$transfer_symbol,
        module_name: pmt$program_name;

      last_code_section_id := ^code_section_ids;

      RESET module_description.file TO module_description.cpu_object_module_header^.identification;
      NEXT identification IN module_description.file;

      REPEAT
        NEXT object_text_descriptor IN module_description.file;

        CASE object_text_descriptor^.kind OF
        = llc$section_definition, llc$unallocated_common_block =
          NEXT section_definition IN module_description.file;

          IF section_definition^.kind = llc$code_section THEN
            ALLOCATE last_code_section_id^.link IN ocv$olg_working_heap^;
            IF last_code_section_id^.link = NIL THEN
              osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
              RETURN;
            IFEND;

            last_code_section_id := last_code_section_id^.link;
            last_code_section_id^.name := module_description.name;
            last_code_section_id^.section_ordinal := section_definition^.section_ordinal;
          IFEND;

        = llc$deferred_common_blocks =
          NEXT deferred_common_blocks: [1 .. object_text_descriptor^.number_of_common_blocks] IN
                module_description.file;

        = llc$segment_definition =
          NEXT segment_definition IN module_description.file; { Should never get here !!!! }

        = llc$obsolete_segment_definition =
          NEXT obsolete_segment_definition IN module_description.file; { Should never get here !!!! }

        = llc$application_identifier =
          NEXT application_identifier IN module_description.file;

        = llc$libraries =
          NEXT libraries: [1 .. object_text_descriptor^.number_of_libraries] IN module_description.file;

        = llc$text =
          NEXT text: [1 .. object_text_descriptor^.number_of_bytes] IN module_description.file;

        = llc$replication =
          NEXT replication: [1 .. object_text_descriptor^.number_of_bytes] IN module_description.file;

        = llc$bit_string_insertion =
          NEXT bit_string_insertion IN module_description.file;

        = llc$address_formulation =
          NEXT address_formulation: [1 .. object_text_descriptor^.number_of_adr_items] IN
                module_description.file;

        = llc$entry_definition =
          NEXT entry_definition IN module_description.file;

        = llc$deferred_entry_points =
          NEXT deferred_entry_points: [1 .. object_text_descriptor^.number_of_entry_points] IN
                module_description.file;

        = llc$external_linkage =
          NEXT external_linkage: [1 .. object_text_descriptor^.number_of_ext_items] IN
                module_description.file;

        = llc$relocation =
          NEXT relocation: [1 .. object_text_descriptor^.number_of_rel_items] IN module_description.file;

        = llc$actual_parameters =
          NEXT actual_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$cybil_symbol_table_fragment =
          NEXT debug_table_fragment: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$obsolete_line_table =
          NEXT obsolete_line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                module_description.file;

        = llc$symbol_table =
          NEXT symbol_table: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$line_table =
          NEXT line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                module_description.file;

        = llc$supplemental_debug_tables =
          NEXT supplemental_debug_tables: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$obsolete_formal_parameters =
          NEXT obsolete_formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$formal_parameters =
          NEXT formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                module_description.file;

        = llc$binding_template =
          NEXT binding_template IN module_description.file;

        = llc$form_definition =
          osp$set_status_abnormal (oc, oce$e_form_def_found_in_module, module_name, status);
          RETURN;

        = llc$68000_absolute =
          NEXT m68000_absolute: [[REP object_text_descriptor^.number_of_68000_bytes OF cell]] IN
                module_description.file;

        = llc$transfer_symbol =
          NEXT transfer_symbol IN module_description.file;

        CASEND;
      UNTIL object_text_descriptor^.kind = llc$transfer_symbol;

      last_code_section_id^.link := NIL;


    PROCEND get_ordinals_from_object_module;
?? OLDTITLE ??
?? NEWTITLE := 'get_ordinals_from_load_module' ??
?? EJECT ??

    PROCEDURE get_ordinals_from_load_module
      (VAR module_descritpion: oct$module_description;
       VAR code_section_ids: oct$code_section_ids;
       VAR status: ost$status);


      VAR
        last_code_section_id: ^oct$code_section_ids;

      VAR { object text record templates }
        object_text_descriptor: ^llt$object_text_descriptor,
        section_definition: ^llt$section_definition;


      last_code_section_id := ^code_section_ids;

      IF llc$section_element IN module_description.load_module_header^.interpretive_header.
            elements_defined THEN
        object_text_descriptor := #PTR (module_description.load_module_header^.interpretive_header.
              section_definitions, module_description.file^);
        IF object_text_descriptor = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        RESET module_description.file TO object_text_descriptor;
        NEXT object_text_descriptor IN module_description.file;

        WHILE (object_text_descriptor^.kind = llc$section_definition) OR
              (object_text_descriptor^.kind = llc$allotted_section_definition) OR
              (object_text_descriptor^.kind = llc$unallocated_common_block) DO
          NEXT section_definition IN module_description.file;
          IF section_definition = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;

          IF section_definition^.kind = llc$code_section THEN
            ALLOCATE last_code_section_id^.link IN ocv$olg_working_heap^;
            IF last_code_section_id^.link = NIL THEN
              osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
              RETURN;
            IFEND;

            last_code_section_id := last_code_section_id^.link;
            last_code_section_id^.name := module_description.name;
            last_code_section_id^.section_ordinal := section_definition^.section_ordinal;
          IFEND;

          NEXT object_text_descriptor IN module_description.file;
          IF object_text_descriptor = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;

        WHILEND;
      IFEND;

      last_code_section_id^.link := NIL;



    PROCEND get_ordinals_from_load_module;
?? OLDTITLE ??
?? EJECT ??


    CASE module_description.kind OF
    = occ$cpu_object_module =
      get_ordinals_from_object_module (module_description, code_section_ids, status);

    = occ$load_module =
      get_ordinals_from_load_module (module_description, code_section_ids, status);

    = occ$command_procedure, occ$function_procedure, occ$program_description, occ$ppu_object_module,
          occ$command_description, occ$function_description, occ$message_module, occ$panel_module,
          occ$bound_module =
      code_section_ids.link := NIL;
    CASEND;

  PROCEND ocp$obtain_code_section_ids;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$obtain_component_info' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$obtain_component_info
    (VAR module_description: oct$module_description;
     VAR component_info: ^llt$component_information;
     VAR status: ost$status);


    VAR

      i: integer,
      info_element_header: ^llt$info_element_header,
      new_header: llt$info_element_header,
      header: oct$header;


    CASE module_description.kind OF
    = occ$cpu_object_module, occ$ppu_object_module, occ$program_description, occ$command_procedure,
          occ$function_procedure, occ$command_description, occ$function_description, occ$message_module,
          occ$panel_module =
      component_info := NIL;

    = occ$load_module =
      IF llc$information_element IN module_description.load_module_header^.elements_defined THEN
        info_element_header := #PTR (module_description.load_module_header^.information_element,
              module_description.file^);
        IF info_element_header = NIL THEN
          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
          RETURN;
        IFEND;

        IF info_element_header^.version <> llc$info_element_version THEN
          ocp$convert_information_element (info_element_header, new_header);
          info_element_header := ^new_header;
        IFEND;

        IF info_element_header^.number_of_components > 1 THEN
          component_info := #PTR (info_element_header^.component_ptr, module_description.file^);
          IF component_info = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description.name, status);
            RETURN;
          IFEND;
        ELSE
          component_info := NIL;
        IFEND;
      ELSE
        component_info := NIL;
      IFEND;

    = occ$bound_module =
      IF UPPERBOUND (module_description.bound_module_header^.components^) > 1 THEN
        NEXT component_info: [1 .. UPPERBOUND (module_description.bound_module_header^.components^)] IN
              ocv$olg_scratch_seq;
        IF component_info = NIL THEN
          osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
          RETURN;
        IFEND;

        FOR i := 1 TO UPPERBOUND (module_description.bound_module_header^.components^) DO
          ocp$obtain_header (module_description.bound_module_header^.components^ [i]^, NIL, header, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          component_info^ [i].name := header.identification.name;
          component_info^ [i].time_created := header.identification.time_created;
          component_info^ [i].date_created := header.identification.date_created;
          component_info^ [i].generator_id := header.identification.generator_id;
          component_info^ [i].generator_name_vers := header.identification.generator_name_vers;
          component_info^ [i].commentary := header.identification.commentary;
        FOREND;
      ELSE
        component_info := NIL;
      IFEND;
    CASEND;


  PROCEND ocp$obtain_component_info;
?? OLDTITLE ??



MODEND ocm$object_module_scanners;
