This Multics source file was rescued from the messed-up source archive at MIT.
This piece of the linker is called in response to a linkage fault. It finds the link target and "snaps" the link.
Back to Multics Source index.
link_snap.pl1 11/17/83 0847.5r 11/17/83 0846.4 238383
/* ***********************************************************
* *
* Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *
* Copyright (c) 1972 by Massachusetts Institute of *
* Technology and Honeywell Information Systems, Inc. *
* *
*********************************************************** */
/* Modified October 1976 by M. Weaver to handle *system links, to add make_entry entry, and to create targets like *system links */
/* Modified March 1977 by M. Weaver to handle *system links with no init info */
/* Modified May 1977 by M. Weaver to allocate external variable symbol nodes in the user area */
/* Modified September 1977 by M. Weaver to add run unit depth to snapped links */
/* Modified 770815 by PG to use vclock builtin instead of calling vclock subr directly */
/* Modified October 1977 by M. Weaver to not reallocate external variables */
/* Modified January 1981 by J. Bongiovanni for link_meters.incl.pl1 + cleanup */
/* Modified March 1982 by S. Krupp to return error code for connection failure */
/* Modified January 1983 by M. Weaver to call $for_linker entrypoint in set_ext_variable_ */
link_snap$link_fault: proc (mc_ptr);
/* Parameters */
dcl mc_ptr ptr; /* pointer to machine conditions */
dcl linkp ptr; /* pointer to link pair to snap */
dcl rcode fixed bin (35); /* error code */
dcl dummy fixed bin;
dcl a_caller_ptr ptr;
dcl a_seg_name char (*);
dcl a_entrypoint_name char (*);
dcl a_sptr ptr;
dcl a_entry entry variable;
dcl errcode fixed bin (35);
/* Based */
dcl based_ptr ptr based;
dcl 1 instr (0:1) based aligned,
2 address bit (18) unal,
2 op_code bit (12) unal,
2 mod bit (6) unal;
dcl 1 acc_name aligned based,
2 nchars fixed bin (8) unaligned,
2 string char (0 refer (acc_name.nchars)) unaligned;
dcl 1 based_ev aligned based,
2 ent_ptr ptr,
2 env_ptr ptr;
/* Automatic */
dcl make_ptr_call bit (1) aligned init ("0"b);
dcl make_entry_call bit (1) aligned init ("0"b);
dcl mapped bit (1) aligned;
dcl i fixed bin;
dcl ecode_ptr ptr;
dcl save_ring fixed bin (3);
dcl link_pair_ptr ptr;
dcl inst_ptr ptr;
dcl code fixed bin (35);
dcl pf (8) fixed bin (30) init ((8)0);
dcl time (8) fixed bin (71) init ((8)0);
dcl header_ptr ptr;
dcl text_ptr ptr;
dcl ls_ptr ptr;
dcl static_ptr ptr;
dcl symb_ptr ptr;
dcl def_ptr ptr;
dcl modifier bit (6) aligned;
dcl exp_ptr ptr;
dcl type_ptr ptr;
dcl type fixed bin;
dcl sptr ptr;
dcl init_info_ptr ptr;
dcl ext_name char (65);
dcl seg_name char (32);
dcl nchars fixed bin;
dcl ext_ptr ptr;
dcl callerptr ptr;
dcl entrypoint_name char (32) aligned;
dcl 1 automatic_def aligned,
2 size fixed bin (8) unal,
2 string char (32) unaligned;
dcl 1 automatic_seg aligned,
2 size fixed bin (8) unal,
2 string char (32) unaligned;
dcl class fixed bin;
dcl sgnp ptr;
dcl other_header_ptr ptr init (null);
dcl other_static_ptr ptr;
dcl other_symb_ptr ptr;
dcl new_ext_ptr ptr;
dcl value fixed bin;
dcl dtime fixed bin (35);
dcl bino fixed bin;
dcl zero_word bit (36) aligned init ("0"b) int static options (constant);
/* Entries */
dcl condition_ entry (char(*), entry);
dcl level$get entry returns (fixed bin (3));
dcl level$set entry (fixed bin (3));
dcl page$enter_data entry (ptr unal, fixed bin);
dcl usage_values entry (fixed bin (30), fixed bin (71));
dcl rest_of_datmk_ entry (ptr, ptr, fixed bin (35));
dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl fs_search entry (ptr, char (*), ptr, fixed bin (35));
dcl get_defptr_ entry (ptr, ptr, ptr, ptr, fixed bin (35));
dcl link_man$own_linkage entry (ptr, ptr, ptr, ptr, fixed bin (35));
dcl link_man$other_linkage entry (ptr, ptr, ptr, ptr, fixed bin (35));
dcl trap_caller_caller_ entry (ptr, ptr, ptr, ptr, ptr, ptr, fixed bin (35));
dcl link_snap$link_force entry (ptr, fixed bin, fixed bin (35));
dcl set_ext_variable_$for_linker entry (char (*), ptr, ptr, bit (1) aligned, ptr, fixed bin (35), ptr, ptr, ptr, ptr);
/* External */
dcl error_table_$no_call_ptr fixed bin (35) ext;
dcl error_table_$bad_link_type fixed bin (35) ext;
dcl error_table_$no_ext_sym fixed bin (35) ext;
dcl error_table_$no_defs fixed bin (35) ext;
dcl error_table_$seg_not_found fixed bin (35) ext;
dcl error_table_$bad_self_ref fixed bin (35) ext;
dcl error_table_$no_linkage fixed bin (35) ext;
dcl error_table_$no_sym_seg fixed bin (35) ext;
dcl error_table_$force_bases fixed bin (35) ext;
dcl error_table_$defs_loop fixed bin (35) ext;
dcl error_table_$bad_entry_point_name fixed bin (35) ext;
dcl error_table_$first_reference_trap fixed bin (35) ext;
dcl error_table_$illegal_ft2 fixed bin (35) ext;
dcl error_table_$unexpected_ft2 fixed bin (35) ext;
dcl error_table_$bad_class_def fixed bin (35) ext;
dcl error_table_$noalloc fixed bin (35) ext;
dcl error_table_$notalloc fixed bin (35) ext;
dcl error_table_$bad_link_target_init_info fixed bin (35) ext;
dcl pds$link_meters_bins (4) fixed bin (30) ext;
dcl pds$link_meters_times (4) fixed bin (35) ext;
dcl pds$link_meters_pgwaits (4) fixed bin (30) ext;
dcl pds$stacks (0:7) ptr ext;
dcl sys_info$max_seg_size fixed bin (19) ext;
dcl 1 ahd$link_meters (4) aligned ext like link_meters;
/* Builtins */
dcl (addr, addrel, baseptr, bin, bit, divide, hbound, index, lbound, length, max, min, multiply,
null, ptr, rel, reverse, substr, unspec, vclock, verify) builtin;
/* Static */
dcl its_value bit (6) aligned static init ("100011"b) options (constant);
dcl ft2 bit (6) aligned static init ("100110"b) options (constant);
dcl indirect bit (6) aligned static init ("010000"b) options (constant);
/* */
/* Code for link_fault starts here....... */
mcp = mc_ptr; /* get copy of input pointer */
ecode_ptr = null;
save_ring = level$get (); /* get current validation level */
scup = addr (mcp -> mc.scu (0)); /* get pointer to SCU data */
call level$set (bin (scu.ppr.prr, 3)); /* set validation level appropriately */
link_pair_ptr = ptr (baseptr (bin (scu.tpr.tsr, 15)), scu.ca); /* get pointer to faulting link pair */
call page$enter_data (ptr (baseptr (bin (scu.ppr.psr, 15)), scu.ilc), linkage_fault_start); /* trace the fault */
/* Make a check to see if FT2 is in instruction */
inst_ptr = ptr (baseptr (bin (scu.ppr.psr, 15)), scu.ilc); /* get pointer to faulting instruction */
if inst_ptr -> its.its_mod = ft2 then do;
code = error_table_$unexpected_ft2;
goto ERROR;
end;
join: call usage_values (pf (1), time (1)); /* meter linkage fault time */
if link_pair_ptr -> link.ft2 ^= ft2 then do;
if mcp = null then code = 0;
else code = error_table_$illegal_ft2;
goto ERROR;
end;
header_ptr = addrel (link_pair_ptr, link_pair_ptr -> link.head_ptr); /* get pointer to linkage section */
text_ptr = baseptr (header_ptr -> header.stats.segment_number); /* get pointer to base of text */
if addr (header_ptr -> header.def_ptr) -> its.its_mod ^= its_value then do; /* check validity of def pointer */
code = error_table_$no_defs;
goto ERROR;
end;
if header_ptr -> virgin_linkage_header.first_ref_relp ^= "0"b then do; /* check for first reference trap */
code = error_table_$first_reference_trap;
goto ERROR;
end;
/* */
/* Come here after validity checks have all passed. Start decoding the linkage information. */
code = 0;
def_ptr = header_ptr -> header.def_ptr; /* get def pointer */
modifier = link_pair_ptr -> its.mod; /* save modifier from link pair */
exp_ptr = addrel (def_ptr, link_pair_ptr -> link.exp_ptr); /* get pointer to expression word */
type_ptr = addrel (def_ptr, exp_ptr -> exp_word.type_ptr); /* get pointer to type pair */
type = bin (type_ptr -> type_pair.type, 18); /* extract link type from type pair */
if type ^= 6 then do; /* trap_ptr means something different for type 6 links */
if mcp ^= null then do; /* only look for trap-before-link at link_fault entry */
if type = 5 then do; /* must check further */
if bin (type_ptr -> type_pair.seg_ptr, 18) = 5 then do; /* *system */
ext_name = addrel (def_ptr, type_ptr -> type_pair.ext_ptr) -> acc_name.string;
process_star_system1: init_info_ptr = addrel (def_ptr, type_ptr -> type_pair.trap_ptr);
if mcp ^= null then sb = ptr (mcp -> prs (6), 0); /* fault entry */
else sb = pds$stacks (level$get ()); /* force entry */
if init_info_ptr = def_ptr then init_info_ptr = null; /* no init info */
process_star_system2: call set_ext_variable_$for_linker (ext_name, init_info_ptr, sb, ("0"b),
sptr, code, mcp, def_ptr, type_ptr, link_pair_ptr);
if code ^= 0 then goto ERROR;
sptr = sptr -> variable_node.vbl_ptr; /* link gets snapped to variable itself */
call snap;
call finish_and_meter;
return;
end;
end;
else if type_ptr -> type_pair.trap_ptr ^= "0"b then do; /* check trap-before-link if not type 6 */
call map_datmk_link;
if mapped then goto process_star_system2; /* converted to *system */
call adjust_mc; /* diddle the machine conditions */
call trap_caller_caller_ (mcp, header_ptr, def_ptr, type_ptr, link_pair_ptr, (null), code);
goto ERROR; /* usually don't return, but if we do.... */
end;
end;
end;
/* Dispatch on type */
if type = 1 then do; /* *|exp,m */
call self_reference;
call snap;
call finish_and_meter;
return;
end;
else if type = 2 then do; /* PR|[ext]+exp,m */
code = error_table_$bad_link_type;
goto ERROR;
end;
else if type = 3 then do; /* <seg>|exp,m */
call search_for_segment;
if sptr = null then goto ERROR;
call snap;
call finish_and_meter;
return;
end;
else if type = 4 then do; /* <seg>|[ext]+exp,m */
call search_for_segment;
if sptr = null then goto ERROR;
call condition_("seg_fault_error", connect_fail_handler_);
call get_ext_ptr;
call get_definition ("0"b);
call snap;
call finish_and_meter;
return;
end;
else if type = 5 then do; /* *|[ext]+exp,m */
call self_reference;
sgnp = addr (zero_word); /* set to name that get_defptr_ won't find */
call get_ext_ptr;
call get_definition ("0"b);
call snap;
call finish_and_meter;
return;
end;
else if type = 6 then do; /* <seg>|[ext]+exp,m (create if not found) */
/* see if this appears to be a link to pl1 ext static or
fortran common; if so, treat as *system link */
sgnp = addrel (def_ptr, type_ptr -> type_pair.seg_ptr);
ext_ptr = addrel (def_ptr, type_ptr -> type_pair.ext_ptr);
if sgnp -> acc_name.string = "stat_" then ext_name = ext_ptr -> acc_name.string;
/* PL/I external static */
else if ext_ptr -> acc_name.nchars = 0 then do;
i = index (sgnp -> acc_name.string, ".com");
if (i = 0) | (i < (sgnp -> acc_name.nchars - 3)) then goto process_type_6;
ext_name = substr (sgnp -> acc_name.string, 1, i - 1); /* fortran common */
if ext_name = "b_" then ext_name = "blnk*com"; /* unlabelled common */
end;
else if sgnp -> acc_name.string = "cobol_fsb_" then ext_name = "cobol_fsb_" || ext_ptr -> acc_name.string;
else goto process_type_6;
goto process_star_system1;
process_type_6:
call search_for_segment;
if sptr = null then do; /* segment not found, try to create as *system */
code = 0; /* so it won't come back to haunt us ... */
ext_name = sgnp -> acc_name.string || "$" || ext_ptr -> acc_name.string;
go to process_star_system1;
end;
else do;
call condition_("seg_fault_error", connect_fail_handler_);
call get_ext_ptr;
if ext_ptr ^= null then call get_definition ("0"b);
end;
call snap;
call finish_and_meter;
return;
end;
else do;
code = error_table_$bad_link_type;
goto ERROR;
end;
/* */
ERROR:
if make_ptr_call | make_entry_call then do;
errcode = code;
return;
end;
if mcp ^= null then do; /* normal fault entry */
mc.errcode = code;
call adjust_mc;
call level$set (save_ring);
end;
else rcode = code;
call page$enter_data (baseptr (0), linkage_fault_end);
return;
link_force: entry (linkp, dummy, rcode); /* entry to snap a link not faulted on */
mcp = null; /* indicates link_force entry */
link_pair_ptr = linkp;
ecode_ptr = addr (rcode);
goto join;
make_ptr: entry (a_caller_ptr, a_seg_name, a_entrypoint_name, a_sptr, errcode);
a_sptr = null;
make_ptr_call = "1"b;
make_join:
mcp = null;
call usage_values (pf (1), time (1));
call page$enter_data (baseptr (0), linkage_fault_start);
ecode_ptr = addr (errcode);
errcode = 0;
callerptr = a_caller_ptr;
seg_name = a_seg_name;
entrypoint_name = a_entrypoint_name;
call fs_search (callerptr, seg_name, sptr, code); /* search for given segment */
if code ^= 0 then goto ERROR;
call condition_("seg_fault_error", connect_fail_handler_);
nchars = 33 - verify (reverse (entrypoint_name), " ");
if nchars = 33 then do; /* null entrypoint name */
if make_ptr_call then a_sptr = sptr;
else do;
call combine_other_linkage; /* linkage must be combined before procedure is called */
addr (a_entry) -> based_ev.ent_ptr = sptr;
end;
return;
end;
ext_ptr = addr (automatic_def); /* fabricate an external entrypoint (segdef) name */
substr (unspec (automatic_def), 1, 36) = (36)"0"b; /* must pad first word with 0 for get_defptr_ */
automatic_def.size = nchars;
substr (automatic_def.string, 1, nchars) = substr (entrypoint_name, 1, nchars);
sgnp = addr (automatic_seg); /* fabricate reference name definition */
nchars = 33 - verify (reverse (seg_name), " ");
substr (unspec (automatic_seg), 1, 36) = (36)"0"b; /* must pad first word with 0 for get_defptr_ */
automatic_seg.size = nchars;
substr (automatic_seg.string, 1, nchars) = substr (seg_name, 1, nchars);
type = 4;
if seg_name = entrypoint_name then call get_definition ("1"b);
else call get_definition ("0"b);
if code ^= 0 then do; /* look for segname$main_ */
automatic_def.size = 5;
automatic_def.string = "main_";
call get_definition ("0"b);
end;
call finish_and_meter;
if make_ptr_call then a_sptr = sptr;
else addr (a_entry) -> based_ev.ent_ptr = sptr;
return;
make_entry: entry (a_caller_ptr, a_seg_name, a_entrypoint_name, a_entry, errcode);
make_entry_call = "1"b;
addr (a_entry) -> based_ev.env_ptr = null;
goto make_join;
/* */
self_reference: proc;
/* This internal procedure resolves type 1 and 5 links which are self relative links.
This procedure assumes the following variables have been set before calling:
type_ptr
text_ptr
header_ptr
symp_ptr
static_ptr
It sets the variable "sptr" to point to the base of the appropriate region.
*/
call link_man$own_linkage (text_ptr, ls_ptr, static_ptr, symb_ptr, code);
if code ^= 0 then goto ERROR;
class = bin (type_ptr -> type_pair.seg_ptr, 18); /* extract class from type pair */
if class = 0 then sptr = text_ptr;
else if class = 1 then sptr = header_ptr;
else if class = 2 then sptr = symb_ptr;
else if class = 4 then sptr = static_ptr;
else do;
code = error_table_$bad_self_ref;
goto ERROR;
end;
return;
end self_reference;
/* */
get_ext_ptr: proc;
/* This procedure is used to calculate the value for the variable "ext_ptr". It assumes the following
variables have been set before calling:
type_ptr
def_ptr
type
It sets the variable "ext_ptr" to point to the ACC string specifying the external name being searched for.
If no external name is specified in the type pair, "ext_ptr" is returned as null.
It sets ext_ptr to null if we are resolving a type 6 link for which no external name was given.
*/
ext_ptr = null;
if type_ptr -> type_pair.ext_ptr = "0"b then return;
ext_ptr = addrel (def_ptr, type_ptr -> type_pair.ext_ptr);
if type = 6 then if ext_ptr -> acc_name.nchars = 0 then ext_ptr = null;
return;
end get_ext_ptr;
/* */
search_for_segment: proc;
/* This procedure uses the search rules to search for a segment specified in the "seg_ptr"
field of a type pair. It copies the name into the variable "seg_name"; it saves the length of the name
in the variable "nchars"; it saves a pointer to the ACC string in "sgnp".
It assumes the following variables have been set before calling:
def_ptr
type_ptr
text_ptr
Upon return, the variable "sptr" is left pointing to the appropriate segment.
If "sptr" is returned as null, the segment could not be found and "code" is returned nonzero.
*/
call usage_values (pf (2), time (2));
sgnp = addrel (def_ptr, type_ptr -> type_pair.seg_ptr);
nchars = bin (sgnp -> name.nchars, 9);
seg_name = substr (sgnp -> name.char_string, 1, nchars);
call fs_search (text_ptr, seg_name, sptr, code);
call usage_values (pf (3), time (3));
return;
end search_for_segment;
/* */
get_definition: proc (will_retry);
/* this procedure searches the definitions of the appropriate segment in order to find the
segdef'd location specified by the link pair. It assumes the following variables have been set before calling:
sgnp
ext_ptr
sptr
It returns after setting "sptr" to point to the appropriate target of the link.
*/
dcl will_retry bit (1) aligned;
if ext_ptr = null then do;
code = 0;
return;
end;
call combine_other_linkage;
call usage_values (pf (6), time (6));
call get_defptr_ (other_header_ptr -> header.def_ptr, sgnp, ext_ptr, new_ext_ptr, code);
call usage_values (pf (7), time (7));
if code ^= 0 then do; /* couldn't find segdef */
if will_retry then if code = error_table_$no_ext_sym then return;
/* will then look for main_ */
goto ERROR;
end;
value = bin (new_ext_ptr -> definition.value, 18);
class = bin (new_ext_ptr -> definition.class, 18);
if class = 0 then sptr = ptr (sptr, value); /* text relative */
else if class = 1 then sptr = addrel (other_header_ptr, value); /* link relative */
else if class = 2 then sptr = addrel (other_symb_ptr, value);
else if class = 4 then sptr = addrel (other_static_ptr, value);
else do;
code = error_table_$bad_class_def;
goto ERROR;
end;
return;
end get_definition;
/* */
combine_other_linkage: proc;
/* this procedure calls link_man to get a pointer to the target segment's active linkage
section, combining it if necessary. It assumes the following variables have been set before calling:
sptr
It returns after obtaining other_header_ptr, other_static_ptr, and other_symb_ptr.
*/
call usage_values (pf (4), time (4));
call link_man$other_linkage (sptr, other_header_ptr, other_static_ptr, other_symb_ptr, code);
call usage_values (pf (5), time (5));
if code ^= 0 then goto ERROR; /* couldn't find linkage for segment pointed to by sptr */
if other_header_ptr = null then do;
code = error_table_$no_linkage;
goto ERROR;
end;
return;
end combine_other_linkage;
/* */
snap: proc;
/* This procedure fills in the link pair with the appropriate pointer value.
It also modifies the machine conditions so that the linkage fault may be restarted. It
will only do this if mcp is nonnull, i.e. we were cllled via the link_fault entry. It assumes the
following variables have been set before calling:
mcp
link_pair_ptr
sptr
exp_ptr
modifier
scup
code
save_ring
*/
if exp_ptr ^= null then sptr = addrel (sptr, exp_ptr -> exp_word.exp); /* update sptr */
link_pair_ptr -> based_ptr = sptr;
link_pair_ptr -> its.mod = modifier;
sb = pds$stacks (level$get ()); /* get ptr to stack header */
link_pair_ptr -> link.run_depth = sb -> stack_header.run_unit_depth;
if mcp ^= null then do;
call level$set (save_ring); /* restore validation level */
call adjust_mc;
mcp -> mc.errcode = code;
end;
end snap;
/* */
adjust_mc: proc;
/* This procedure modifies the hardware machine conditions so that they may be restarted without
retaking the linkage fault. The procedure assumes that scup is pointing at the SCU data */
addr (scu.even_inst) -> instr (0).address = scu.ca;
addr (scu.even_inst) -> instr (0).mod = indirect;
return;
end adjust_mc;
/* */
map_datmk_link: proc;
/* This procedure checks to see if a link is a type 4 link to stat_
with a trap before link to datmk_. If it is, the variables
ext_name and init_info_ptr are set so the link can be treated as a
*system link and the variable mapped is set to "1"b.
This procedure assumes the following variables have been set
before calling:
def_ptr
type_ptr
It sets the variables mapped, ext_name, init_info_ptr before returning.
*/
mapped = "0"b;
if type = 4
then if addrel (def_ptr, type_ptr -> type_pair.seg_ptr) -> acc_name.string = "stat_"
then if addrel (def_ptr, addrel (def_ptr, addrel (def_ptr, addrel (header_ptr, addrel (def_ptr,
type_ptr -> type_pair.trap_ptr)
-> trap_word.call_ptr)
-> link.exp_ptr)
-> exp_word.type_ptr)
-> type_pair.seg_ptr)
-> acc_name.string = "datmk_" then do;
inst_ptr = addrel (header_ptr, addrel (def_ptr,
type_ptr -> type_pair.trap_ptr) -> trap_word.arg_ptr);
call link_snap$link_force (inst_ptr, 0, code); /* snap link to init info */
if code ^= 0 then goto ERROR;
init_info_ptr = inst_ptr -> based_ptr;
ext_name = addrel (def_ptr, type_ptr -> type_pair.ext_ptr) -> acc_name.string;
mapped = "1"b;
end;
return;
end;
/* */
finish_and_meter: proc;
/* This procedure performs the last steps after handling the linkage fault.
*/
if code = 0 then do; /* only meter if no error */
call usage_values (pf (8), time (8));
dtime = bin (time (8)-time (1), 35); /* get VCPU time to handle fault */
bino = max (1, min (4, divide (dtime, 25000, 17, 0)+1)); /* get bin number (25msec wide) */
pds$link_meters_bins (bino) = pds$link_meters_bins (bino) + 1;
pds$link_meters_pgwaits (bino) = pds$link_meters_pgwaits (bino)+pf (8)-pf (1);
pds$link_meters_times (bino) = pds$link_meters_times (bino)+dtime;
ahd$link_meters (bino).total = ahd$link_meters (bino).total + 1;
ahd$link_meters (bino).pf = ahd$link_meters (bino).pf+pf (8)-pf (1);
ahd$link_meters (bino).time = ahd$link_meters (bino).time+dtime;
if ^(make_ptr_call | make_entry_call) & (type = 3 | type = 4) then do;
ahd$link_meters (bino).search_pf = ahd$link_meters (bino).search_pf+pf (3)-pf (2);
ahd$link_meters (bino).search_time = ahd$link_meters (bino).search_time+time (3)-time (2);
ahd$link_meters (bino).get_linkage_pf = ahd$link_meters (bino).get_linkage_pf+pf (5)-pf (4);
ahd$link_meters (bino).get_linkage_time = ahd$link_meters (bino).get_linkage_time+time (5)-time (4);
ahd$link_meters (bino).defsearch_pf = ahd$link_meters (bino).defsearch_pf+pf (7)-pf (6);
ahd$link_meters (bino).defsearch_time = ahd$link_meters (bino).defsearch_time+time (7)-time (6);
end;
else if type = 6 then do;
ahd$link_meters (bino).total_type_6 = ahd$link_meters (bino).total_type_6 + 1;
ahd$link_meters (bino).type_6_pf = ahd$link_meters (bino).type_6_pf+pf (8)-pf (1);
ahd$link_meters (bino).type_6_time = ahd$link_meters (bino).type_6_time+dtime;
end;
else do; /* types 1, 2, and 5 */
if (make_ptr_call | make_entry_call)
then ahd$link_meters (bino).tot_make_ptr = ahd$link_meters (bino).tot_make_ptr + 1;
ahd$link_meters (bino).total_others = ahd$link_meters (bino).total_others + 1;
ahd$link_meters (bino).others_pf = ahd$link_meters (bino).others_pf+pf (8)-pf (1);
ahd$link_meters (bino).others_time = ahd$link_meters (bino).others_time+dtime;
end;
/* Check for first-ref-trap */
if other_header_ptr ^= null then do;
if other_header_ptr -> virgin_linkage_header.first_ref_relp ^= "0"b then do; /* trap ON */
if mcp ^= null then call adjust_mc; /* diddle MC if necessary */
if make_ptr_call then a_sptr = sptr;
else if make_entry_call then addr (a_entry) -> based_ev.ent_ptr = sptr;
call trap_caller_caller_ (mcp, other_header_ptr, null, null, null, ecode_ptr, code);
if mcp ^= null then mcp -> mc.errcode = code; /* in case trap_caller_caller_ returned */
end;
end;
end;
call page$enter_data ((sptr), linkage_fault_end);
if (make_ptr_call | make_entry_call) then errcode = code;
else if mcp = null then rcode = code;
else mc.errcode = code;
return;
end finish_and_meter;
/* */
connect_fail_handler_: proc(a_mc_ptr, a_condition_name, a_wc_ptr, a_info_ptr, a_continue_flag);
/* This procedure expects sptr to be set and is only called
on a seg_fault_error. It continues signalling seg_fault_error if
the fault occured on some unexpected segment (a segment other
than that specified by sptr) otherwise it returns an error code. */
/* Parameter */
dcl a_condition_name char(*);
dcl a_continue_flag bit(1) aligned;
dcl a_info_ptr ptr;
dcl a_mc_ptr ptr;
dcl a_wc_ptr ptr;
/* Automatic */
dcl faulted_segno fixed bin(18);
dcl segno fixed bin(18);
dcl scu_ptr ptr;
/* Builtin */
dcl (addr, baseno, bin) builtin;
a_continue_flag = "0"b;
scu_ptr = addr(a_mc_ptr->mc.scu);
faulted_segno = bin(scu_ptr->scu.tpr.tsr, 18);
segno = bin(baseno(sptr), 18);
if faulted_segno ^= segno
then do;
a_continue_flag = "1"b;
return;
end;
code = a_mc_ptr->mc.errcode;
go to ERROR;
end connect_fail_handler_;
/* */
dcl 1 datmk_info aligned,
%include datmk_info;
%include trace_types;
%include mc;
%include its;
%include linkdcl;
%include definition;
%include system_link_names;
%include stack_header;
%include link_meters;
; /* for ind */
end link_snap$link_fault;
"This material is presented to ensure dissemination of scholarly and technical work. Copyright and all rights therein are retained by authors or by other copyright holders. All persons copying this information are expected to adhere to the terms and constraints invoked by each author's copyright. In most cases, these works may not be reposted without the explicit permission of the copyright holder."