/*

function:	This procedure causes a Type-1, Type-4, or Type-5 link
	to be located or created in the linkage section, depending
	on the entry at which it is called.

	   cobol_make_link$type_1
	   cobol_make_link$type_4
	   cobol_make_link$type_5

	The offset of the link that has been found or created
	in the linkage section of the object segment (cobol_link_seg)
	is returned to the caller.

	For checkout purposes, an additional entry is provided to
	display these links and their corresponding definitions.

	   cobol_display_links

	NOTE: The main entry (cobol_make_link) is NOT invoked.



type_5: entry (linkoff, name, init_info_ptr, init_info_loc);

dcl	name char (*);
dcl	init_info_ptr ptr;
dcl	(linkoff, init_info_loc) fixed bin;

function:	This procedure locates or creates a Type-6 link to "name".
	This external reference ("name") may be in the form of "A"
	or "A$B". If it is in the form of "A", then the reference
	(ie segment) name portion of this external reference and
	the offset (ie entry) name are assumed to be equivalent,
	and BOTH equal to "name".
	If "name" is in the form "A$B", then the reference name is
	taken as "A" and the offset name as "B".
	NOTE:
	  The acc_strings for these "names" are entered into the
	  definition section ONLY on the first reference to this
	  "name". All subsequent references will utilize the
	  acc_string previously entered.

where:  name (input):
	explained under function (above).

        init_info_ptr (input):
	is a pointer to the initialization information to be used.
	This structure is defined as follows:

	dcl 1   init_info_struct aligned based (init_info_ptr),
	     2  n_words fixed bin,
	     2  code fixed bin,
	     2  info (0 refer(n_words)) bit (36) aligned;

	where:
	 n_words	is the number of words in the array "info"

	 code	indicates what type of initialization is to be
		performed. Code can have one of the following
		values:

	      0 - no initialization is to be performed.

 	      3 - copy the info array into the newly grown variable.

	      4 -	initialize the variable as an area.

	 info	is the array of 36 bit words to be copied into the
		new variable.
		(it exists ONLY if code = 3)

        init_info_loc (input/output):
	represents a pointer (relative to the base of the defintion
	section) to the area in which the "init_info" structure will
	be stored. (If init_info_loc = 0, then the "init_info" struct-
	ure will be stored beginning at the next available location
	and this offset will be returned in init_info_loc).

        linkoff (output):
	the offset of this type-5 link (either found or created)
	is returned in linkoff.
	NOTE:
	  In the event an error condition is detected during the
	  creation of this link, a value of 0 is returned.


        type-5 link specifics:
	 - set type = 5
	 - set module_name to "cobol_make_link$type_5"
	 - set reset_loc for error recovery
	 - set subject to "init info"
	 - ck if space for initialization info already established
	    - if yes, re-use this space
	    - if not, establish space for init info
	      record this loc in est_init_info_loc
	 - calculate size of init_info in words
	 - check if init_info will fit in def_section
	 - calculate size of init_info in characters
	 - copy init_info into def_section (via init_ptr)
	 - increment def_wd_off by # of words copied (n_words+2)
	 - set def_sect reloc bits for (2*(n_words+2)) copied
	 - set type_pair relocation for type-5
	 - go to create_acc_string to continue processing      


type_4: entry (linkoff, name);

dcl	name char (*);
dcl	linkoff fixed bin;

function:	This procedure locates or creates a Type-4 link to "name".
	This external reference ("name") may be in the form of "A"
	or "A$B". If it is in the form of "A", then the reference
	(ie segment) name portion of this external reference and
	the offset (ie entry) name are assumed to be equivalent,
	and BOTH equal to "name".
	If "name" is in the form "A$B", then the reference name is
	taken as "A" and the offset name as "B".
	NOTE:
	  The acc_strings for these "names" are entered into the
	  definition section ONLY on the first reference to this
	  "name". All subsequent references will utilize the
	  acc_string previously entered.

where:  name (input):
	explained under function (above).

        linkoff (input/output):
	the offset of this Type-4 link (either found or created)
	is returned in "linkoff".
	NOTE:
	  In the event an error condition is detected during the
	  creation of this link, a value of 0 is returned.


        type-4 link specifics:
	 - set type = 4
	 - set module_name to "cobol_make_link$type_4"
	 - set reset_loc for error recovery
           - set init_info_loc = 0   
	 - set type pair relocation for type-4   

   	acc_strings are common to BOTH type-4 and type-6 links:
	 - record loc of seg_name (in seg_name_loc)
	 - calculate parameters of seg_name and ent_name (if any)
	 - check seg_name and ent_name (if any) for format errors
	 - check seg_name and ent_name (if any) = "blanks"
	 - check seg_name and ent_name (if any) for length errors
	 - set err_msg subject to "segment name "
 	 - then, with seg_name parameters:
	:-> - create ds_wrk_ptr from (def_base_ptr + def_wd_off)
	    - calculate size of seg_name string in words
	    - check if seg_name string will fit in def_section
	    - create acc_string of seg_name in def_section
	    - increment def_wd_off by # of words in seg_name string
	    - if ent_name exists; then:
	      - record loc of ent_name (in ent_name_loc)
	      - set err_msg subject to "entry name "
	      - with ent_name parameters; repeat from :-> (above)
	 - after repeat (or if ent_name does not exist)
	 - go to create_type_pair to continue processing      


type_1: entry (linkoff, segcode);

dcl	(linkoff, segcode) fixed bin;

function:	This procedure locates or creates a Type-1 link in
	accordance with the value of "segcode".

where:  segcode (input):
	= 0 :- specifies a self-reference to the program's text
	       section; such a reference is symbolically represented
	       as "*text".

	= 1 :- specifies a self-reference to the program's linkage
	       section; such a reference is symbolically represented
	       as "*link".

	= 2 :- specifies a self-reference to the program's symbol
	       section; such a reference is symbolically represented
	       as "*symbol".

        linkoff (input/output):
	the offset of this type-1 link (either found or created)
	is returned in "linkoff".
	NOTE:
	  In the event an error condition is detected during the
	  creation of this link, a value of 0 is returned.


        type-1 link specifics:
	     (Note: type-1 links are self-referencing. therefore,
                there are no seg_ or ent_names and the seg_name_relp
                field is used to store the segment_code)
	 - set type = 1
	 - set module_name = "cobol_make_link$type_1"
	 - set reset_loc for error recovery
	 - set seg_name_loc = seg_code
	 - check seg_code within limits (0<=seg_code<=2)
	 - set ent_name_loc = 0
	 - set init_info_loc = 0   
	 - set type pair relocation for type-1   

        A) create type_pair in def_section:
	 
	 - create ds_wrk_ptr from (def_base_ptr + def_wd_off)
	 - record loc of type_pair (in type_pair_loc)
	 - set subject to "typ_pr & expr_word"
	 - check if typ_pr/expr_wrd will fit in definition section
	 - set link_type = type
	 - set trap_relp = init_info_loc (or 0)
	 - set seg_name_relp = seg_name_loc (or seg_code)
	 - set ent_name_relp = ent_name_loc (or 0)
	 - increment def_wd_off by 2 words in type pair      
	 - set def_section reloc bits for appropriate type_pair   

        B) create expression: word in def_section:      

     	 - create ds_wrk_ptr from (def_base_ptr + def_wd_off)
	 - record loc of expr_word (in expr_word_loc)
	 - set type_pair_relp = type_pair_loc
	 - set expression = 0
	 - increment def_wd_off by 1 word in expr_word
	 - set def_sect reloc bits for expression word      

        (NOTE: these 2-word links MUST begin at an even location)
	 - set err_msg subject to "the link"
	 - ensure that link_wd_off is an even number
	 - ensure that link section length is set
	 - create ls_wrk_ptr from (link_base_ptr + link_wd_off)
	 - record loc of this link (in linkoff)
	 - check if link will fit in linkage section
	 - set NEGATIVE header_relp = link_base - loc this link
	 - set ignore_1, ignore_2 = 0
	 - set tag = 46)8
	 - set modifier = 0
	 - set expr_word_relp = loc of expr_word
	 - increment link_wd_off by 2 words in link
	 - increment link_sect length by 2 words in link
	 - set link_sect reloc bits for link
	 - return with loc (offset) of this link in linkoff    

 cobol_display_links: entry (linkoff_char, num_links_char);


cobol_display_links: entry (linkoff_char, num_links_char);

dcl	(linkoff_char, num_links_char) char (6);

function:	This procedure displays the links which currently exist
	in the linkage section.

	Starting from the link at "linkoff", it displays as many 
	links as called for by "num_links"; unless "linkoff = 0,
	in which case, ALL links are displayed.

    NOTE:	The 1st argument is the OCTAL value of the starting link offset.

	The corresponding definitions (in cobol_def_seg) are used
	to describe the displayed links in symbolic form.
    
    NOTE:	This procedure is callable from MULTICS command level.


	 get # of arguments passed 
	call cu_$arg_count (n_args);
	 get arg1 (starting link offset or 0) 
	call cu_$arg_ptr (1, lo_ptr, lo_lnth, code);
	if (code ^= 0) then do;
	  call ioa_$nnl ("^/^-Routine requires 1 argument (starting link offset or 0);");
err_exit:	  call ioa_ ("^-please re-enter^/");
	  return;
	  end;
	lnk_offset = cv_oct_check_ (lo_char, code);
	if (code ^= 0) then do;
conv_err:	  call ioa_$nnl ("^/^-CONVERSION ERROR");
	  goto err_exit;
	  end;
	 if it exists, get arg2 (number of links to display) 
	if (n_args ^= 1) then do;
	  call cu_$arg_ptr (2, nl_ptr, nl_lnth, code);
	  n_lnks = cv_dec_check_ (nl_char, code);
	  if (code ^= 0) then do;
	    goto conv_err;
	    end;
	  end;
	 else n_lnks = 1;

	 get beginning and ending locations of linkage section 
	ls_wrk_ptr = link_base_ptr;
	beg_link_loc = fixed(substr(links_relp,1,18),36);
	end_link_loc = fixed(substr(link_sect_lgth,1,18),36);
	 ck if any links were made 
	if (end_link_loc = beg_link_loc) then do;
	  call ioa_ ("^/^2-No links exist at this time^/");
	  return;
	  end;
	if (lnk_offset ^= 0) then do;
	  if (lnk_offset >= end_link_loc) then do;
	    call ioa_$nnl ("^/^-Link offset out of range (too large);");
	    goto err_exit;
	    end;
	   else if (lnk_offset < beg_link_loc) then do;
	    call ioa_$nnl ("^/^-Link offset out of range (too small);");
	    goto err_exit;
	    end;
	   else do;
	    x = fixed(substr(unspec(lnk_offset),36,1),36);
	    if (x ^= 0) then do;
	      call ioa_$nnl ("^/^-Link offset MUST BE an even number;");
	      goto err_exit;
	      end;
	    cur_link_loc = lnk_offset;
	    call ioa_ (" ");
	    goto prnt_lp;
	    end;
	  end;
	 else do;
	   # of links made = (end - beg)/2 
	  x = end_link_loc - beg_link_loc;
	  x = fixed(substr(unspec(x),1,35),36);
	  call ioa_ ("^/^-^d links:^/",x);
	  cur_link_loc = beg_link_loc;
	  end;
prnt_lp:	ls_wrk_ptr = addrel (link_base_ptr, cur_link_loc);
	exp_wd_loc = fixed(substr(ls_wrk_ptr->expr_word_relp,1,18),36);
	ds_wrk_ptr = addrel (def_base_ptr, exp_wd_loc);
	typ_pr_loc = fixed(substr(ds_wrk_ptr->type_pair_relp,1,18),36);
	express_loc = fixed(substr(ds_wrk_ptr->expression,1,18),36);
	ds_wrk_ptr = addrel (def_base_ptr, typ_pr_loc);
	seg_name_loc = fixed(substr(ds_wrk_ptr->seg_name_relp,1,18),36);
	ent_name_loc = fixed(substr(ds_wrk_ptr->ent_name_relp,1,18),36);
	lnk_typ = fixed(substr(ds_wrk_ptr->link_type,1,18),36);
	init_info_loc = fixed(substr(ds_wrk_ptr->trap_relp,1,18),36);
	ds_wrk_ptr = addrel (def_base_ptr, seg_name_loc);
	ln_lnth, segl = fixed(nam_lnth,9);
	substr(link_name,1,segl) = substr(char_string,1,segl);
	if (ent_name_loc ^= seg_name_loc) then do;
	  ds_wrk_ptr = addrel (def_base_ptr, ent_name_loc);
	  entl = fixed(nam_lnth,9);
	  substr(link_name,segl+1,1) = substr("$",1,1);
	  substr(link_name,segl+2,entl) = substr(char_string,1,entl);
	  ln_lnth = segl + entl + 1;
	  end;
	if (lnk_typ = 4) then call ioa_
	  ("^-link|^o ^- ^va",cur_link_loc,ln_lnth,link_name);
	else if (lnk_typ = 5) then call ioa_
	  ("^-link|^o ^- ^va^-Init info at def|^o",cur_link_loc,ln_lnth,link_name,init_info_loc);
	else if (lnk_typ = 1) then do;
	 if (seg_name_loc = 0) then call ioa_ ("^-link|^o ^- *text",cur_link_loc);
	 else if (seg_name_loc = 1) then call ioa_ ("^-link|^o ^- *link",cur_link_loc);
	 else if (seg_name_loc = 2) then call ioa_ ("^-link|^o ^- *symbol",cur_link_loc);
	 else call ioa_ ("^-link|^o^-(code = ^o)",cur_link_loc,seg_name_loc);
	 end;
	else call ioa_ ("^-link|^o^-(type = ^o^3xseg = def|^o^3xent = def|^o)",cur_link_loc,lnk_typ,seg_name_loc,ent_name_loc);

	if (lnk_offset ^= 0) then do;
	  n_lnks = n_lnks - 1;
	  if (n_lnks = 0) then goto dspl_xit;
	  end;
	cur_link_loc = cur_link_loc + 2;
	if (cur_link_loc < end_link_loc) then goto prnt_lp;

	 all links printed 
dspl_xit:	call ioa_ (" ");
	return;



	ERROR CONDITIONS :-

	The following error situations can arise in attempting
	to locate or create a link to an external reference name.
	Should any of the following errors be detected, the link
	offset (linkoff) is set set to 0, an error condition is set 
	(via signal_), and processing is discontinued.

	a) errors pertaining to the external reference (ie link name):

	 - the external reference name (ie link name) has 0 length
	 - either the reference (segment) or offset (entry) name
	   portion of the link name exceeds 32 characters in length
	 - either the reference (segment) or offset (entry) name
	   portion of the link name contains imbedded blanks
	 - the link name contains a "$", but no offset (entry) name
	   is given
 	 - the link name contains more than one "$"

	b) errors pertaining to the "segcode":

	 - the given segcode has a value other than 0, 1, or 2

	c) errors pertaining to the "init_info" structure:

	 - the number of words in the "init_info" structure will
	   not fit into the area requested (ie init_info_loc ^= 0)

	d) errors pertaining to all link types:

	 - the space remaining in the definition section is NOT
	   sufficient to store the definitions for this link
	 - the space remaining in the linkage section is NOT
	   sufficient to store this link
	 - cobol_make_link$type_ has been improperly entered (at cobol_make_link$type_)
	   as opposed to the precribed entry points (cobol_make_link$type_1,
	   cobol_make_link$type_4 or cobol_make_link$type_5)

	e) error conditions detected in "cobol_display_links" 

	   are sent to the caller at his or her terminal and the 
	   corrected input can be immediately re-entered.


   	on error:
	   - set link offset = 0
	   - set err_switch = 0   
	   - reset def_wd_off (ie cancel ALL def_section entries   
*/




*/
                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems 
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved

*/