1 /* 2 3 function: This procedure causes a Type-1, Type-4, or Type-5 link 4 to be located or created in the linkage section, depending 5 on the entry at which it is called. 6 7 cobol_make_link$type_1 8 cobol_make_link$type_4 9 cobol_make_link$type_5 10 11 The offset of the link that has been found or created 12 in the linkage section of the object segment (cobol_link_seg) 13 is returned to the caller. 14 15 For checkout purposes, an additional entry is provided to 16 display these links and their corresponding definitions. 17 18 cobol_display_links 19 20 NOTE: The main entry (cobol_make_link) is NOT invoked. 21 22 23 24 type_5: entry (linkoff, name, init_info_ptr, init_info_loc); 25 26 dcl name char (*); 27 dcl init_info_ptr ptr; 28 dcl (linkoff, init_info_loc) fixed bin; 29 30 function: This procedure locates or creates a Type-6 link to "name". 31 This external reference ("name") may be in the form of "A" 32 or "A$B". If it is in the form of "A", then the reference 33 (ie segment) name portion of this external reference and 34 the offset (ie entry) name are assumed to be equivalent, 35 and BOTH equal to "name". 36 If "name" is in the form "A$B", then the reference name is 37 taken as "A" and the offset name as "B". 38 NOTE: 39 The acc_strings for these "names" are entered into the 40 definition section ONLY on the first reference to this 41 "name". All subsequent references will utilize the 42 acc_string previously entered. 43 44 where: name (input): 45 explained under function (above). 46 47 init_info_ptr (input): 48 is a pointer to the initialization information to be used. 49 This structure is defined as follows: 50 51 dcl 1 init_info_struct aligned based (init_info_ptr), 52 2 n_words fixed bin, 53 2 code fixed bin, 54 2 info (0 refer(n_words)) bit (36) aligned; 55 56 where: 57 n_words is the number of words in the array "info" 58 59 code indicates what type of initialization is to be 60 performed. Code can have one of the following 61 values: 62 63 0 - no initialization is to be performed. 64 65 3 - copy the info array into the newly grown variable. 66 67 4 - initialize the variable as an area. 68 69 info is the array of 36 bit words to be copied into the 70 new variable. 71 (it exists ONLY if code = 3) 72 73 init_info_loc (input/output): 74 represents a pointer (relative to the base of the defintion 75 section) to the area in which the "init_info" structure will 76 be stored. (If init_info_loc = 0, then the "init_info" struct- 77 ure will be stored beginning at the next available location 78 and this offset will be returned in init_info_loc). 79 80 linkoff (output): 81 the offset of this type-5 link (either found or created) 82 is returned in linkoff. 83 NOTE: 84 In the event an error condition is detected during the 85 creation of this link, a value of 0 is returned. 86 87 88 type-5 link specifics: 89 - set type = 5 90 - set module_name to "cobol_make_link$type_5" 91 - set reset_loc for error recovery 92 - set subject to "init info" 93 - ck if space for initialization info already established 94 - if yes, re-use this space 95 - if not, establish space for init info 96 record this loc in est_init_info_loc 97 - calculate size of init_info in words 98 - check if init_info will fit in def_section 99 - calculate size of init_info in characters 100 - copy init_info into def_section (via init_ptr) 101 - increment def_wd_off by # of words copied (n_words+2) 102 - set def_sect reloc bits for (2*(n_words+2)) copied 103 - set type_pair relocation for type-5 104 - go to create_acc_string to continue processing 105 106 107 type_4: entry (linkoff, name); 108 109 dcl name char (*); 110 dcl linkoff fixed bin; 111 112 function: This procedure locates or creates a Type-4 link to "name". 113 This external reference ("name") may be in the form of "A" 114 or "A$B". If it is in the form of "A", then the reference 115 (ie segment) name portion of this external reference and 116 the offset (ie entry) name are assumed to be equivalent, 117 and BOTH equal to "name". 118 If "name" is in the form "A$B", then the reference name is 119 taken as "A" and the offset name as "B". 120 NOTE: 121 The acc_strings for these "names" are entered into the 122 definition section ONLY on the first reference to this 123 "name". All subsequent references will utilize the 124 acc_string previously entered. 125 126 where: name (input): 127 explained under function (above). 128 129 linkoff (input/output): 130 the offset of this Type-4 link (either found or created) 131 is returned in "linkoff". 132 NOTE: 133 In the event an error condition is detected during the 134 creation of this link, a value of 0 is returned. 135 136 137 type-4 link specifics: 138 - set type = 4 139 - set module_name to "cobol_make_link$type_4" 140 - set reset_loc for error recovery 141 - set init_info_loc = 0 142 - set type pair relocation for type-4 143 144 acc_strings are common to BOTH type-4 and type-6 links: 145 - record loc of seg_name (in seg_name_loc) 146 - calculate parameters of seg_name and ent_name (if any) 147 - check seg_name and ent_name (if any) for format errors 148 - check seg_name and ent_name (if any) = "blanks" 149 - check seg_name and ent_name (if any) for length errors 150 - set err_msg subject to "segment name " 151 - then, with seg_name parameters: 152 :-> - create ds_wrk_ptr from (def_base_ptr + def_wd_off) 153 - calculate size of seg_name string in words 154 - check if seg_name string will fit in def_section 155 - create acc_string of seg_name in def_section 156 - increment def_wd_off by # of words in seg_name string 157 - if ent_name exists; then: 158 - record loc of ent_name (in ent_name_loc) 159 - set err_msg subject to "entry name " 160 - with ent_name parameters; repeat from :-> (above) 161 - after repeat (or if ent_name does not exist) 162 - go to create_type_pair to continue processing 163 164 165 type_1: entry (linkoff, segcode); 166 167 dcl (linkoff, segcode) fixed bin; 168 169 function: This procedure locates or creates a Type-1 link in 170 accordance with the value of "segcode". 171 172 where: segcode (input): 173 = 0 :- specifies a self-reference to the program's text 174 section; such a reference is symbolically represented 175 as "*text". 176 177 = 1 :- specifies a self-reference to the program's linkage 178 section; such a reference is symbolically represented 179 as "*link". 180 181 = 2 :- specifies a self-reference to the program's symbol 182 section; such a reference is symbolically represented 183 as "*symbol". 184 185 linkoff (input/output): 186 the offset of this type-1 link (either found or created) 187 is returned in "linkoff". 188 NOTE: 189 In the event an error condition is detected during the 190 creation of this link, a value of 0 is returned. 191 192 193 type-1 link specifics: 194 (Note: type-1 links are self-referencing. therefore, 195 there are no seg_ or ent_names and the seg_name_relp 196 field is used to store the segment_code) 197 - set type = 1 198 - set module_name = "cobol_make_link$type_1" 199 - set reset_loc for error recovery 200 - set seg_name_loc = seg_code 201 - check seg_code within limits (0<=seg_code<=2) 202 - set ent_name_loc = 0 203 - set init_info_loc = 0 204 - set type pair relocation for type-1 205 206 A) create type_pair in def_section: 207 208 - create ds_wrk_ptr from (def_base_ptr + def_wd_off) 209 - record loc of type_pair (in type_pair_loc) 210 - set subject to "typ_pr & expr_word" 211 - check if typ_pr/expr_wrd will fit in definition section 212 - set link_type = type 213 - set trap_relp = init_info_loc (or 0) 214 - set seg_name_relp = seg_name_loc (or seg_code) 215 - set ent_name_relp = ent_name_loc (or 0) 216 - increment def_wd_off by 2 words in type pair 217 - set def_section reloc bits for appropriate type_pair 218 ^L 219 B) create expression: word in def_section: 220 221 - create ds_wrk_ptr from (def_base_ptr + def_wd_off) 222 - record loc of expr_word (in expr_word_loc) 223 - set type_pair_relp = type_pair_loc 224 - set expression = 0 225 - increment def_wd_off by 1 word in expr_word 226 - set def_sect reloc bits for expression word 227 228 (NOTE: these 2-word links MUST begin at an even location) 229 - set err_msg subject to "the link" 230 - ensure that link_wd_off is an even number 231 - ensure that link section length is set 232 - create ls_wrk_ptr from (link_base_ptr + link_wd_off) 233 - record loc of this link (in linkoff) 234 - check if link will fit in linkage section 235 - set NEGATIVE header_relp = link_base - loc this link 236 - set ignore_1, ignore_2 = 0 237 - set tag = 46)8 238 - set modifier = 0 239 - set expr_word_relp = loc of expr_word 240 - increment link_wd_off by 2 words in link 241 - increment link_sect length by 2 words in link 242 - set link_sect reloc bits for link 243 - return with loc (offset) of this link in linkoff 244 245 cobol_display_links: entry (linkoff_char, num_links_char); 246 247 248 cobol_display_links: entry (linkoff_char, num_links_char); 249 250 dcl (linkoff_char, num_links_char) char (6); 251 252 function: This procedure displays the links which currently exist 253 in the linkage section. 254 255 Starting from the link at "linkoff", it displays as many 256 links as called for by "num_links"; unless "linkoff = 0, 257 in which case, ALL links are displayed. 258 259 NOTE: The 1st argument is the OCTAL value of the starting link offset. 260 261 The corresponding definitions (in cobol_def_seg) are used 262 to describe the displayed links in symbolic form. 263 264 NOTE: This procedure is callable from MULTICS command level. 265 266 267 get # of arguments passed 268 call cu_$arg_count (n_args); 269 get arg1 (starting link offset or 0) 270 call cu_$arg_ptr (1, lo_ptr, lo_lnth, code); 271 if (code ^= 0) then do; 272 call ioa_$nnl ("^/^-Routine requires 1 argument (starting link offset or 0);"); 273 err_exit: call ioa_ ("^-please re-enter^/"); 274 return; 275 end; 276 lnk_offset = cv_oct_check_ (lo_char, code); 277 if (code ^= 0) then do; 278 conv_err: call ioa_$nnl ("^/^-CONVERSION ERROR"); 279 goto err_exit; 280 end; 281 if it exists, get arg2 (number of links to display) 282 if (n_args ^= 1) then do; 283 call cu_$arg_ptr (2, nl_ptr, nl_lnth, code); 284 n_lnks = cv_dec_check_ (nl_char, code); 285 if (code ^= 0) then do; 286 goto conv_err; 287 end; 288 end; 289 else n_lnks = 1; 290 291 get beginning and ending locations of linkage section 292 ls_wrk_ptr = link_base_ptr; 293 beg_link_loc = fixed(substr(links_relp,1,18),36); 294 end_link_loc = fixed(substr(link_sect_lgth,1,18),36); 295 ck if any links were made 296 if (end_link_loc = beg_link_loc) then do; 297 call ioa_ ("^/^2-No links exist at this time^/"); 298 return; 299 end; 300 if (lnk_offset ^= 0) then do; 301 if (lnk_offset >= end_link_loc) then do; 302 call ioa_$nnl ("^/^-Link offset out of range (too large);"); 303 goto err_exit; 304 end; 305 else if (lnk_offset < beg_link_loc) then do; 306 call ioa_$nnl ("^/^-Link offset out of range (too small);"); 307 goto err_exit; 308 end; 309 else do; 310 x = fixed(substr(unspec(lnk_offset),36,1),36); 311 if (x ^= 0) then do; 312 call ioa_$nnl ("^/^-Link offset MUST BE an even number;"); 313 goto err_exit; 314 end; 315 cur_link_loc = lnk_offset; 316 call ioa_ (" "); 317 goto prnt_lp; 318 end; 319 end; 320 else do; 321 # of links made = (end - beg)/2 322 x = end_link_loc - beg_link_loc; 323 x = fixed(substr(unspec(x),1,35),36); 324 call ioa_ ("^/^-^d links:^/",x); 325 cur_link_loc = beg_link_loc; 326 end; 327 prnt_lp: ls_wrk_ptr = addrel (link_base_ptr, cur_link_loc); 328 exp_wd_loc = fixed(substr(ls_wrk_ptr->expr_word_relp,1,18),36); 329 ds_wrk_ptr = addrel (def_base_ptr, exp_wd_loc); 330 typ_pr_loc = fixed(substr(ds_wrk_ptr->type_pair_relp,1,18),36); 331 express_loc = fixed(substr(ds_wrk_ptr->expression,1,18),36); 332 ds_wrk_ptr = addrel (def_base_ptr, typ_pr_loc); 333 seg_name_loc = fixed(substr(ds_wrk_ptr->seg_name_relp,1,18),36); 334 ent_name_loc = fixed(substr(ds_wrk_ptr->ent_name_relp,1,18),36); 335 lnk_typ = fixed(substr(ds_wrk_ptr->link_type,1,18),36); 336 init_info_loc = fixed(substr(ds_wrk_ptr->trap_relp,1,18),36); 337 ds_wrk_ptr = addrel (def_base_ptr, seg_name_loc); 338 ln_lnth, segl = fixed(nam_lnth,9); 339 substr(link_name,1,segl) = substr(char_string,1,segl); 340 if (ent_name_loc ^= seg_name_loc) then do; 341 ds_wrk_ptr = addrel (def_base_ptr, ent_name_loc); 342 entl = fixed(nam_lnth,9); 343 substr(link_name,segl+1,1) = substr("$",1,1); 344 substr(link_name,segl+2,entl) = substr(char_string,1,entl); 345 ln_lnth = segl + entl + 1; 346 end; 347 if (lnk_typ = 4) then call ioa_ 348 ("^-link|^o ^- ^va",cur_link_loc,ln_lnth,link_name); 349 else if (lnk_typ = 5) then call ioa_ 350 ("^-link|^o ^- ^va^-Init info at def|^o",cur_link_loc,ln_lnth,link_name,init_info_loc); 351 else if (lnk_typ = 1) then do; 352 if (seg_name_loc = 0) then call ioa_ ("^-link|^o ^- *text",cur_link_loc); 353 else if (seg_name_loc = 1) then call ioa_ ("^-link|^o ^- *link",cur_link_loc); 354 else if (seg_name_loc = 2) then call ioa_ ("^-link|^o ^- *symbol",cur_link_loc); 355 else call ioa_ ("^-link|^o^-(code = ^o)",cur_link_loc,seg_name_loc); 356 end; 357 else call ioa_ ("^-link|^o^-(type = ^o^3xseg = def|^o^3xent = def|^o)",cur_link_loc,lnk_typ,seg_name_loc,ent_name_loc); 358 359 if (lnk_offset ^= 0) then do; 360 n_lnks = n_lnks - 1; 361 if (n_lnks = 0) then goto dspl_xit; 362 end; 363 cur_link_loc = cur_link_loc + 2; 364 if (cur_link_loc < end_link_loc) then goto prnt_lp; 365 366 all links printed 367 dspl_xit: call ioa_ (" "); 368 return; 369 370 371 372 ERROR CONDITIONS :- 373 374 The following error situations can arise in attempting 375 to locate or create a link to an external reference name. 376 Should any of the following errors be detected, the link 377 offset (linkoff) is set set to 0, an error condition is set 378 (via signal_), and processing is discontinued. 379 380 a) errors pertaining to the external reference (ie link name): 381 382 - the external reference name (ie link name) has 0 length 383 - either the reference (segment) or offset (entry) name 384 portion of the link name exceeds 32 characters in length 385 - either the reference (segment) or offset (entry) name 386 portion of the link name contains imbedded blanks 387 - the link name contains a "$", but no offset (entry) name 388 is given 389 - the link name contains more than one "$" 390 391 b) errors pertaining to the "segcode": 392 393 - the given segcode has a value other than 0, 1, or 2 394 395 c) errors pertaining to the "init_info" structure: 396 397 - the number of words in the "init_info" structure will 398 not fit into the area requested (ie init_info_loc ^= 0) 399 400 d) errors pertaining to all link types: 401 402 - the space remaining in the definition section is NOT 403 sufficient to store the definitions for this link 404 - the space remaining in the linkage section is NOT 405 sufficient to store this link 406 - cobol_make_link$type_ has been improperly entered (at cobol_make_link$type_) 407 as opposed to the precribed entry points (cobol_make_link$type_1, 408 cobol_make_link$type_4 or cobol_make_link$type_5) 409 410 e) error conditions detected in "cobol_display_links" 411 412 are sent to the caller at his or her terminal and the 413 corrected input can be immediately re-entered. 414 415 416 on error: 417 - set link offset = 0 418 - set err_switch = 0 419 - reset def_wd_off (ie cancel ALL def_section entries 420 */ 421 422