?? RIGHT := 110 ??
*copyc OSD$DEFAULT_PRAGMATS
?? TITLE := 'NOS/VE : Loader : Linkage generation' ??
?? NEWTITLE := '  Global declarations', EJECT ??
MODULE lom$linkage_generation;

{  PURPOSE:
{    This module is responsible for generation of all linkages (pointers) to program addresses.  Since
{    linkages are the only data that may be stored in the binding segment, this is the only module
{    which needs write access to the binding segment.  It executes in a more privileged
{    environment (ring) than the remainder of the loader -- thereby allowing the binding segment to
{    have more stringent access protection.  Since different types of linkages exist, this module
{    also isolates the knowledge of the formats of the various types of linkages.
?? PUSH (LISTEXT := ON) ??
*copyc LOT$LOADER_TYPE_DEFINITIONS
*copyc LOE$ABORT_LOAD
*copyc LLE$LOADER_STATUS_CONDITIONS
?? POP ??
*copyc i#build_adaptable_array_ptr
*copyc MMP$STORE_SEGMENT_ATTRIBUTES
*copyc OSP$SET_STATUS_ABNORMAL
*copyc PMP$CAUSE_CONDITION
*copyc PMP$EXIT
?? TITLE := '  [XDCL, #GATE] lop$copy_binding_section_text', EJECT ??

  PROCEDURE [XDCL, #GATE] lop$copy_binding_section_text (target_address: lot$address;
        text: ^array [1 .. *] of 0 .. 0ff(16);
    VAR any_code_base_ptrs__initialized: boolean);


    TYPE
      binding_section_word = record
        first_two_bytes: 0 .. 0ffff(16),
        remaining_bytes: 0 .. 0ffffffffffff(16),
      recend;

    VAR
      of_execution: ^cell,
      target_byte: ^array [1 .. *] of 0 .. 255,
      target_word: ^array [1 .. *] of binding_section_word,
      starting_word_address: ost$segment_length,
      number_of_words: ost$segment_length,
      i: integer,
      j: integer,
      abort_status: ^ost$status;


    i#build_adaptable_array_ptr (#RING (^of_execution), target_address.segment, target_address.
          offset, UPPERBOUND (text^), LOWERBOUND (text^), 1, #LOC (target_byte));

    target_byte^ := text^;

    starting_word_address := (target_address.offset DIV 8) * 8;  { Round of to a word boundry. }
    number_of_words := (#SIZE (text^) + 7) DIV 8;

    i#build_adaptable_array_ptr (#RING (^of_execution), target_address.segment, starting_word_address,
          (number_of_words * 8), 1, 8, #LOC (target_word));

    FOR i := 1 TO number_of_words DO
      IF (target_word^ [i].first_two_bytes <> 0) THEN
        any_code_base_ptrs__initialized := TRUE;

        FOR j := 1 TO number_of_words DO
          target_word^ [j].first_two_bytes := 0;
          target_word^ [j].remaining_bytes := 0;
        FOREND;

        RETURN;  {----->
      IFEND;
    FOREND;

    any_code_base_ptrs__initialized := FALSE;


  PROCEND lop$copy_binding_section_text;
?? TITLE := '  [XDCL, #GATE] lop$fix_binding_segment_attr', EJECT ??

  PROCEDURE [XDCL, #GATE] lop$fix_binding_segment_attr (binding_segment: ost$segment;
        current_length: ost$segment_length;
    VAR status: ost$status);

{  PURPOSE:
{    This procedure is responsible for fixing the binding segment's attributes to those required
{    for the loaded program's usage (as opposed to the loader's usage).
*copyc LOV$BINDING_SEGMENT_ATTRIBUTES

    VAR
      attribute_fixer: array [1 .. 2] of mmt$attribute_descriptor,
{!   temporary variable until CYBIL is fixed for intrinsics in procedure call
      temporary_ptr: ^cell;

    attribute_fixer [1].keyword := mmc$kw_segment_access_control;
    attribute_fixer [1].access_control := binding_segment_attributes.access_control;
    attribute_fixer [2].keyword := mmc$kw_max_segment_length;
{ Add eight bytes to current length to prevent a THETA page fault if a one word CBP occurs in the last word
{  of a page.
    attribute_fixer [2].max_length := current_length + 8;
{!  mmp$store_segment_attributes (#address (osc$min_ring, binding_segment, 0), osc$min_ring, attribute_fixer,
{!   temporary code until CYBIL is fixed - intrinsics in procedure call
    temporary_ptr := #address (osc$min_ring, binding_segment, 0);
    mmp$store_segment_attributes (temporary_ptr, osc$min_ring, attribute_fixer,
{!   End of temporary code.
    status);
  PROCEND lop$fix_binding_segment_attr;
?? TITLE := '  [XDCL, #GATE] lop$defix_binding_segment_attr', EJECT ??

  PROCEDURE [XDCL, #GATE] lop$defix_binding_segment_attr (binding_segment: ost$segment;
        maximum_length: ost$segment_length;
    VAR status {control} : ost$status);

{  PURPOSE:
{    This procedure is responsible for restoring the binding segment's attributes to those required
{    for the loader's usage (as opposed to the loaded program's usage).

    VAR
      attribute_defixer: array [1 .. 2] of mmt$attribute_descriptor,
{!   temporary variable until CYBIL is fixed for intrinsics in a procedure call
      temporary_ptr: ^cell;

    attribute_defixer [1].keyword := mmc$kw_segment_access_control;
    attribute_defixer [1].access_control.cache_bypass := FALSE;
    attribute_defixer [1].access_control.execute_privilege := osc$non_executable;
    attribute_defixer [1].access_control.read_privilege := osc$binding_segment;
    attribute_defixer [1].access_control.write_privilege := osc$write_uncontrolled;
    attribute_defixer [2].keyword := mmc$kw_max_segment_length;
    attribute_defixer [2].max_length := maximum_length;
{!  mmp$store_segment_attributes (#address (osc$min_ring, binding_segment, 0), osc$min_ring,
{!   temporary code until CYBIL is fixed - intrinsics in a procedure call
    temporary_ptr := #address (osc$min_ring, binding_segment, 0);
    mmp$store_segment_attributes (temporary_ptr, osc$min_ring,
{!   End of temporary code.
    attribute_defixer, status);
  PROCEND lop$defix_binding_segment_attr;
MODEND lom$linkage_generation;
