COMPILATION LISTING OF SEGMENT get_link_ptr_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/20/86 1221.7 mst Thu Options: optimize list 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 /* format: style4,delnl,insnl,ifthenstmt,ifthen,indnoniterend,indend,^indproc */ 11 12 get_link_ptr_: 13 proc (loc_ptr, link_ptr, entry_ptr); 14 15 /* This procedure is given a pointer to a text location and tries to find an external reference 16* just before the location. If a link reference is found, a pointer to the original link and the snapped 17* link itself are returned. If a text-to-text transfer appears to be found, a pointer to the target 18* is returned. In the latter case, the caller is responsible for determining that 19* the returned pointer in fact points to an entry sequence (this can be done by 20* calling get_entry_name_). */ 21 /* coded by M. Weaver 7/5/73 */ 22 /* last modified by M. Weaver 10/17/73 */ 23 /* last modified by M. Weaver 1/10/74 to change opcodes to 10 bits */ 24 /* last modified by J.M. Broughton on 2 July 1975 to prevent fault when 25* rel (loc_ptr) is small, i.e. -~ 0 */ 26 /* Modified 2/82 BIM to make sure temp_ptr is initialized when used. */ 27 28 29 declare (loc_ptr, link_ptr, temp_ptr, segptr, entry_ptr, ls_ptr) ptr; 30 declare based_ptr ptr based; 31 32 declare i fixed bin; 33 declare type fixed bin (2); 34 declare link_offset fixed bin (18); 35 declare bitcnt fixed bin (24); 36 declare code fixed bin (35); 37 38 declare lang char (8) aligned; 39 40 declare ( 41 epp2 init ("0111010100"b), 42 tra init ("1110010000"b), 43 tsp3 init ("0101110110"b) 44 ) bit (10) aligned int static options (constant); 45 46 declare object_info_$display entry (ptr, fixed bin (24), ptr, fixed bin (35)); 47 declare hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)); 48 declare component_info_$offset entry (ptr, fixed bin (18), ptr, fixed bin (35)); 49 50 declare (addr, addrel, baseno, bin, null, rel, ptr) builtin; 51 52 1 1 /* BEGIN INCLUDE FILE ... object_info.incl.pl1 1 2*coded February 8, 1972 by Michael J. Spier */ 1 3 /* modified May 26, 1972 by M. Weaver */ 1 4 /* modified 15 April, 1975 by M. Weaver */ 1 5 1 6 declare 1 object_info aligned based, /* structure containing object info based, returned by object_info_ */ 1 7 2 version_number fixed bin, /* version number of current structure format (=2) */ 1 8 2 textp pointer, /* pointer to beginning of text section */ 1 9 2 defp pointer, /* pointer to beginning of definition section */ 1 10 2 linkp pointer, /* pointer to beginning of linkage section */ 1 11 2 statp pointer, /* pointer to beginning of static section */ 1 12 2 symbp pointer, /* pointer to beginning of symbol section */ 1 13 2 bmapp pointer, /* pointer to beginning of break map (may be null) */ 1 14 2 tlng fixed bin, /* length in words of text section */ 1 15 2 dlng fixed bin, /* length in words of definition section */ 1 16 2 llng fixed bin, /* length in words of linkage section */ 1 17 2 ilng fixed bin, /* length in words of static section */ 1 18 2 slng fixed bin, /* length in words of symbol section */ 1 19 2 blng fixed bin, /* length in words of break map */ 1 20 2 format, /* word containing bit flags about object type */ 1 21 3 old_format bit(1) unaligned, /* on if segment isn't in new format, i.e. has old style object map */ 1 22 3 bound bit(1) unaligned, /* on if segment is bound */ 1 23 3 relocatable bit(1) unaligned, /* on if seg has relocation info in its first symbol block */ 1 24 3 procedure bit(1) unaligned, /* on if segment is an executable object program */ 1 25 3 standard bit(1) unaligned, /* on if seg is in standard format (more than just standard map) */ 1 26 3 gate bit(1) unaligned, /* on if segment is a gate */ 1 27 3 separate_static bit(1) unaligned, /* on if static not in linkage */ 1 28 3 links_in_text bit(1) unaligned, /* on if there are threaded links in text */ 1 29 3 perprocess_static bit (1) unaligned, /* on if static is not to be per run unit */ 1 30 3 pad bit(27) unaligned, 1 31 2 entry_bound fixed bin, /* entry bound if segment is a gate */ 1 32 2 textlinkp pointer, /* ptr to first link in text */ 1 33 1 34 /* LIMIT OF BRIEF STRUCTURE */ 1 35 1 36 2 compiler char(8) aligned, /* name of processor which generated segment */ 1 37 2 compile_time fixed bin(71), /* clock reading of date/time object was generated */ 1 38 2 userid char(32) aligned, /* standard Multics id of creator of object segment */ 1 39 2 cvers aligned, /* generator version name in printable char string form */ 1 40 3 offset bit(18) unaligned, /* offset of name in words relative to base of symbol section */ 1 41 3 length bit(18) unaligned, /* length of name in characters */ 1 42 2 comment aligned, /* printable comment concerning generator or generation of segment */ 1 43 3 offset bit(18) unaligned, /* offset of comment in words relative to base of symbol section */ 1 44 3 length bit(18) unaligned, /* length of comment in characters */ 1 45 2 source_map fixed bin, /* offset, relative to base of symbol section, of source map structure */ 1 46 1 47 /* LIMIT OF DISPLAY STRUCTURE */ 1 48 1 49 2 rel_text pointer, /* pointer to text section relocation info */ 1 50 2 rel_def pointer, /* pointer to definition section relocation info */ 1 51 2 rel_link pointer, /* pointer to linkage section relocation info */ 1 52 2 rel_static pointer, /* pointer to static section relocation info */ 1 53 2 rel_symbol pointer, /* pointer to symbol section relocation info */ 1 54 2 text_boundary fixed bin, /* specifies mod of text section base boundary */ 1 55 2 static_boundary fixed bin, /* specifies mod of internal static base boundary */ 1 56 /* currently not used by system */ 1 57 2 default_truncate fixed bin, /* offset rel to symbp for binder to automatically trunc. symb sect. */ 1 58 2 optional_truncate fixed bin; /* offset rel to symbp for binder to optionally trunc. symb sect. */ 1 59 1 60 declare object_info_version_2 fixed bin int static init(2); 1 61 1 62 /* END INCLUDE FILE ... object_info.incl.pl1 */ 53 54 declare 1 oi aligned like object_info; 55 2 1 /* BEGIN INCLUDE SEGMENT ... component_info.incl.pl1 M. Weaver 4/26/72 */ 2 2 2 3 declare 1 ci aligned, 2 4 2 dcl_version fixed bin, /* version number of this structure */ 2 5 2 name char(32) aligned, /* objectname of component segment */ 2 6 2 text_start pointer, /* ptr to component's section of text */ 2 7 2 stat_start pointer, /* pointer to component's section of internal static */ 2 8 2 symb_start pointer, /* pointer to component's first symbol block */ 2 9 2 defblock_ptr pointer, /* ptr to component's definition block */ 2 10 2 text_lng fixed bin, /* length of text section */ 2 11 2 stat_lng fixed bin, /* length of internal static */ 2 12 2 symb_lng fixed bin, /* length of symbol section */ 2 13 2 n_blocks fixed bin, /* number of symbol blocks in component's symbol section */ 2 14 2 standard bit(1) aligned, /* indicates whether component is in standard (new) format */ 2 15 2 compiler char(8) aligned, /* name of component's compiler */ 2 16 2 compile_time fixed bin(71), /* time component was compiled */ 2 17 2 userid char(32) aligned, /* id of creator of component */ 2 18 2 cvers aligned, /* version of component's compiler in printable form */ 2 19 3 offset bit(18) unaligned, /* offset in words relative to symb_start */ 2 20 3 length bit(18) unaligned, /* length of name in characters */ 2 21 2 comment aligned, /* component's comment */ 2 22 3 offset bit(18) unaligned, /* offset in words relative to symb_start */ 2 23 3 length bit(18) unaligned, /* length of comment in characters */ 2 24 2 source_map fixed bin; /* offset, rel to beg of symbol block, of component's source map */ 2 25 2 26 /* END INCLUDE SEGMENT ... component_info.incl.pl1 */ 56 57 3 1 /* BEGIN INCLUDE FILE ... stack_header.incl.pl1 .. 3/72 Bill Silver */ 3 2 /* modified 7/76 by M. Weaver for *system links and more system use of areas */ 3 3 /* modified 3/77 by M. Weaver to add rnt_ptr */ 3 4 /* Modified April 1983 by C. Hornig for tasking */ 3 5 3 6 /****^ HISTORY COMMENTS: 3 7* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 3 8* audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206): 3 9* added the heap_header_ptr definition. 3 10* 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 3 11* audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206): 3 12* Modified to support control point management. These changes were actually 3 13* made in February 1985 by G. Palter. 3 14* 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473), 3 15* audit(86-10-22,Farley), install(86-11-03,MR12.0-1206): 3 16* Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18 3 17* bit pad after cur_lot_size for the cpm_enabled. This was done to save some 3 18* space int the stack header and change the cpd_ptr unal to cpm_data_ptr 3 19* (ITS pair). 3 20* END HISTORY COMMENTS */ 3 21 3 22 /* format: style2 */ 3 23 3 24 dcl sb ptr; /* the main pointer to the stack header */ 3 25 3 26 dcl 1 stack_header based (sb) aligned, 3 27 2 pad1 (4) fixed bin, /* (0) also used as arg list by outward_call_handler */ 3 28 2 cpm_data_ptr ptr, /* (4) pointer to control point which owns this stack */ 3 29 2 combined_stat_ptr ptr, /* (6) pointer to area containing separate static */ 3 30 2 clr_ptr ptr, /* (8) pointer to area containing linkage sections */ 3 31 2 max_lot_size fixed bin (17) unal, /* (10) DU number of words allowed in lot */ 3 32 2 main_proc_invoked fixed bin (11) unal, /* (10) DL nonzero if main procedure invoked in run unit */ 3 33 2 have_static_vlas bit (1) unal, /* (10) DL "1"b if (very) large arrays are being used in static */ 3 34 2 pad4 bit (2) unal, 3 35 2 run_unit_depth fixed bin (2) unal, /* (10) DL number of active run units stacked */ 3 36 2 cur_lot_size fixed bin (17) unal, /* (11) DU number of words (entries) in lot */ 3 37 2 cpm_enabled bit (18) unal, /* (11) DL non-zero if control point management is enabled */ 3 38 2 system_free_ptr ptr, /* (12) pointer to system storage area */ 3 39 2 user_free_ptr ptr, /* (14) pointer to user storage area */ 3 40 2 null_ptr ptr, /* (16) */ 3 41 2 stack_begin_ptr ptr, /* (18) pointer to first stack frame on the stack */ 3 42 2 stack_end_ptr ptr, /* (20) pointer to next useable stack frame */ 3 43 2 lot_ptr ptr, /* (22) pointer to the lot for the current ring */ 3 44 2 signal_ptr ptr, /* (24) pointer to signal procedure for current ring */ 3 45 2 bar_mode_sp ptr, /* (26) value of sp before entering bar mode */ 3 46 2 pl1_operators_ptr ptr, /* (28) pointer to pl1_operators_$operator_table */ 3 47 2 call_op_ptr ptr, /* (30) pointer to standard call operator */ 3 48 2 push_op_ptr ptr, /* (32) pointer to standard push operator */ 3 49 2 return_op_ptr ptr, /* (34) pointer to standard return operator */ 3 50 2 return_no_pop_op_ptr 3 51 ptr, /* (36) pointer to standard return / no pop operator */ 3 52 2 entry_op_ptr ptr, /* (38) pointer to standard entry operator */ 3 53 2 trans_op_tv_ptr ptr, /* (40) pointer to translator operator ptrs */ 3 54 2 isot_ptr ptr, /* (42) pointer to ISOT */ 3 55 2 sct_ptr ptr, /* (44) pointer to System Condition Table */ 3 56 2 unwinder_ptr ptr, /* (46) pointer to unwinder for current ring */ 3 57 2 sys_link_info_ptr ptr, /* (48) pointer to *system link name table */ 3 58 2 rnt_ptr ptr, /* (50) pointer to Reference Name Table */ 3 59 2 ect_ptr ptr, /* (52) pointer to event channel table */ 3 60 2 assign_linkage_ptr ptr, /* (54) pointer to storage for (obsolete) hcs_$assign_linkage */ 3 61 2 heap_header_ptr ptr, /* (56) pointer to the heap header for this ring */ 3 62 2 trace, 3 63 3 frames, 3 64 4 count fixed bin, /* (58) number of trace frames */ 3 65 4 top_ptr ptr unal, /* (59) pointer to last trace frame */ 3 66 3 in_trace bit (36) aligned, /* (60) trace antirecursion flag */ 3 67 2 pad2 bit (36), /* (61) */ 3 68 2 pad5 pointer; /* (62) pointer to future stuff */ 3 69 3 70 /* The following offset refers to a table within the pl1 operator table. */ 3 71 3 72 dcl tv_offset fixed bin init (361) internal static; 3 73 /* (551) octal */ 3 74 3 75 3 76 /* The following constants are offsets within this transfer vector table. */ 3 77 3 78 dcl ( 3 79 call_offset fixed bin init (271), 3 80 push_offset fixed bin init (272), 3 81 return_offset fixed bin init (273), 3 82 return_no_pop_offset fixed bin init (274), 3 83 entry_offset fixed bin init (275) 3 84 ) internal static; 3 85 3 86 3 87 3 88 3 89 3 90 /* The following declaration is an overlay of the whole stack header. Procedures which 3 91* move the whole stack header should use this overlay. 3 92**/ 3 93 3 94 dcl stack_header_overlay (size (stack_header)) fixed bin based (sb); 3 95 3 96 3 97 3 98 /* END INCLUDE FILE ... stack_header.incl.pl1 */ 58 59 4 1 /* BEGIN INCLUDE FILE -- lot.incl.pl1 S.Webber 9/74, Modified by R. Bratt 04/76, modified by M. Weaver 7/76 */ 4 2 /* modified by M. Weaver 3/77 */ 4 3 4 4 dcl lotp ptr; 4 5 4 6 dcl 1 lot based (lotp) aligned, 4 7 2 lp (0:9999) ptr unaligned; /* array of packed pointers to linkage sections */ 4 8 4 9 dcl lot_fault bit (36) aligned static options (constant) init ("111000000000000000000000000000000000"b); 4 10 /* lot fault has fault code = 0 and offset = 0 */ 4 11 4 12 dcl isotp ptr; 4 13 dcl 1 isot based (isotp) aligned, 4 14 2 isp (0:9999) ptr unaligned; 4 15 4 16 dcl 1 isot1 (0 :9999) aligned based, 4 17 2 flags unaligned, 4 18 3 fault bit (2) unaligned, 4 19 3 system bit (1) unaligned, 4 20 3 mbz bit (6) unaligned, 4 21 2 fault_code fixed bin (8) unaligned, 4 22 2 static_offset bit (18) unaligned; 4 23 4 24 4 25 /* END INCLUDE FILE lot.incl.pl1 */ 60 61 5 1 /* Begin include file instruction.incl.pl1 2/82 BIM -- from db_inst */ 5 2 /* format: style3 */ 5 3 5 4 declare 1 instruction_right_half 5 5 based unaligned, /* The second halfword */ 5 6 2 opcode bit (10) unaligned, /* what */ 5 7 2 inhibit bit (1) unaligned, /* interrupts */ 5 8 2 pr bit (1) unaligned, /* if ON, use instruction_pr */ 5 9 /* else instruction_offset */ 5 10 2 tag bit (6) unaligned; /* type of indirection */ 5 11 5 12 declare instruction_ptr pointer; 5 13 5 14 declare 1 instruction_common 5 15 aligned based (instruction_ptr), 5 16 2 pad_address bit (18) unaligned, 5 17 2 right unaligned like instruction_right_half; 5 18 5 19 declare 1 instruction_off aligned based (instruction_ptr), 5 20 2 offset fixed bin (18) unsigned unaligned, 5 21 2 right unaligned like instruction_right_half; 5 22 5 23 declare 1 instruction_pr aligned based (instruction_ptr), 5 24 2 address unaligned, 5 25 3 pr fixed bin (3) unsigned unaligned, 5 26 3 offset fixed bin (14) unaligned, /* this is signed */ 5 27 2 right unaligned like instruction_right_half; 5 28 5 29 /* End include file instruction.incl.pl1 */ 62 63 6 1 /* BEGIN INCLUDE FILE object_link_dcls.incl.pl1 BIM 1981 from linkdcl */ 6 2 6 3 6 4 /****^ HISTORY COMMENTS: 6 5* 1) change(86-05-02,Elhard), approve(86-05-02,MCR7391), 6 6* audit(86-11-18,Schroth), install(86-11-20,MR12.0-1222): 6 7* Modified to add partial_link structure for an object MSF partially snapped 6 8* link. 6 9* 2) change(86-11-13,DGHowe), approve(86-11-13,MCR7391), audit(86-11-13,Zwick), 6 10* install(86-11-20,MR12.0-1222): 6 11* Added a declaration of FAULT_TAG_1, FAULT_TAG_2 and FAULT_TAG_3. 6 12* END HISTORY COMMENTS */ 6 13 6 14 6 15 /* format: style3 */ 6 16 /* everything you ever wanted in a linkage section */ 6 17 6 18 /* 6 19* Last Modified (Date and Reason): 6 20* 15 Nov 1971 by C Garman 6 21* 6/75 by M.Weaver to add virgin_linkage_header declaration 6 22* 6/75 by S.Webber to comment existing structures better 6 23* 9/77 by M. Weaver to add run_depth to link 6 24* 7/81 by B. Margulies for firstref structure, unsigned fixed bins. 6 25* 3/83 by M. Weaver to add flags overlaying def_ptr 6 26**/ 6 27 6 28 declare 1 object_link based aligned, /* link pair in linkage section */ 6 29 2 header_relp fixed bin (17) unal, /* rel pointer to beginning of linkage, always negative */ 6 30 2 ringno fixed bin (3) unsigned unal, /* MBZ */ 6 31 2 mbz bit (6) unal, 6 32 2 run_depth fixed bin (2) unal, /* run unit depth, filled when link is snapped */ 6 33 2 tag bit (6) unal, /* fault tag. 46(8) if not snapped, 43(8) if snapped */ 6 34 2 expression_relp fixed bin (18) unsigned unal, /* pointer (rel to defs) of expression word */ 6 35 2 mbz2 bit (12) unal, 6 36 2 modifier bit (6) unal; /* modifier to be left in snapped link */ 6 37 6 38 declare 1 partial_link based aligned, /* partially snapped link */ 6 39 2 type fixed bin (3) unsigned unal, /* target section of link */ 6 40 2 component fixed bin (15) unsigned unal, /* target component index */ 6 41 2 mbz1 bit (12) unal, 6 42 2 tag bit (6) unal, /* fault tag 3 47(8), ITS 43(8) if snapped */ 6 43 6 44 2 offset fixed bin (18) unsigned unal, /* word offset of link */ 6 45 2 mbz2 bit (3) unal, 6 46 2 bit_offset fixed bin (6) unsigned unal, /* bit offset (in practice, always 0) */ 6 47 2 mbz3 bit (3) unal, 6 48 2 modifier bit (6) unal; /* modifier to be left in snapped link */ 6 49 6 50 declare 1 linkage_header based aligned, /* linkage block header */ 6 51 2 def_ptr ptr, /* pointer to definition section */ 6 52 2 symbol_ptr ptr unal, /* pointer to symbol section in object segment */ 6 53 2 original_linkage_ptr 6 54 ptr unal, /* pointer to linkage section in object segment */ 6 55 2 unused bit (72), 6 56 2 stats, 6 57 3 begin_links fixed bin (18) unsigned unal, /* offset (rel to this section) of first link */ 6 58 3 block_length fixed bin (18) unsigned unal, /* number of words in this linkage section */ 6 59 3 segment_number 6 60 fixed bin (18) unsigned unal, /* text segment number associated with this section */ 6 61 3 static_length fixed bin (18) unsigned unal; /* number of words of static for this segment */ 6 62 6 63 declare 1 linkage_header_flags 6 64 aligned based, /* overlay of def_ptr for flags */ 6 65 2 pad1 bit (28) unaligned, /* flags are in first word */ 6 66 2 static_vlas bit (1) unaligned, /* static section "owns" some LA/VLA segments */ 6 67 2 perprocess_static 6 68 bit (1) unaligned, /* 1 copy of static section is shared among all tasks/run units */ 6 69 2 pad2 bit (6) unaligned; 6 70 6 71 declare 1 virgin_linkage_header 6 72 aligned based, /* template for linkage header in object segment */ 6 73 2 pad bit (30) unaligned, /* is filled in by linker */ 6 74 2 defs_in_link bit (6) unaligned, /* =o20 if defs in linkage (nonstandard) */ 6 75 2 def_offset fixed bin (18) unsigned unaligned, 6 76 /* offset of definition section */ 6 77 2 first_ref_relp fixed bin (18) unsigned unaligned, 6 78 /* offset of trap-at-first-reference offset array */ 6 79 2 filled_in_later bit (144), 6 80 2 link_begin fixed bin (18) unsigned unaligned, 6 81 /* offset of first link */ 6 82 2 linkage_section_lng 6 83 fixed bin (18) unsigned unaligned, 6 84 /* length of linkage section */ 6 85 2 segno_pad fixed bin (18) unsigned unaligned, 6 86 /* will be segment number of copied linkage */ 6 87 2 static_length fixed bin (18) unsigned unaligned; 6 88 /* length of static section */ 6 89 6 90 declare 1 fr_traps based aligned, /* First Reference Trap Procedures */ 6 91 2 decl_vers fixed bin, /* version of this struc, value=1, ABS reloc */ 6 92 2 n_traps fixed bin, /* number of traps on this segment, ABS */ 6 93 2 trap_array (n_fr_traps refer (fr_traps.n_traps)) aligned, 6 94 3 call_relp fixed bin (18) unsigned unaligned, 6 95 /* LINK18, offset of link defining procedure to call */ 6 96 3 info_relp fixed bin (18) unsigned unaligned; 6 97 /* LINK18, offser of link defining argument list for trap proc */ 6 98 6 99 declare FR_TRAPS_VERSION_1 init (1) fixed bin internal static options (constant); 6 100 declare FAULT_TAG_1 bit(6) unaligned init ("40"b3) static options (constant); 6 101 declare FAULT_TAG_2 bit(6) unaligned init ("46"b3) static options (constant); 6 102 declare FAULT_TAG_3 bit(6) unaligned init ("47"b3) static options (constant); 6 103 6 104 /* END INCLUDE FILE object_link_dcls.incl.pl1 */ 64 65 66 67 68 link_ptr, entry_ptr, temp_ptr = null; /* initialize output args */ 69 70 segptr = ptr (loc_ptr, 0); /* get ptr to beg of seg */ 71 72 /* get ptrs to sections of object seg and determine language */ 73 74 call hcs_$status_mins (segptr, type, bitcnt, code); 75 if code ^= 0 then return; 76 77 oi.version_number = object_info_version_2; 78 call object_info_$display (segptr, bitcnt, addr (oi), code); 79 if code ^= 0 then return; 80 81 if oi.compiler = "binder" then do; /* find language of component */ 82 call component_info_$offset (loc_ptr, bin (rel (loc_ptr), 18), addr (ci), code); 83 if code = 0 then 84 lang = ci.compiler; 85 else lang = "binder"; 86 end; 87 else lang = oi.compiler; 88 89 /* now look for external reference; if proc is pl1 type, we know what code should look like */ 90 91 instruction_ptr = loc_ptr; 92 93 if (lang = "pl1") | (lang = "v2pl1") | (lang = "fortran") | (lang = "PL/I") then do; 94 /* look for epp2 pr4|k,* */ 95 96 if instruction_common.opcode = epp2 /* at link ref; probably linkage error */ 97 | instruction_common.opcode = tsp3 /* transfer to math operator is by link */ 98 then temp_ptr = loc_ptr; 99 100 else do; /* should be at transfer to pl1 call operator */ 101 102 if lang = "pl1" then do; /* version 1 */ 103 if rel (temp_ptr) < bit (bin (2, 18)) then return; 104 temp_ptr = addrel (loc_ptr, -2); 105 end; 106 else do; /* version 2 */ 107 if rel (temp_ptr) = (18)"0"b then return; 108 temp_ptr = addrel (loc_ptr, -1); 109 end; 110 111 if temp_ptr = null then return; 112 if temp_ptr -> instruction_common.opcode ^= epp2 then return; 113 114 end; 115 116 if temp_ptr = null then return; 117 if temp_ptr -> instruction_common.pr /* has a PR */ 118 then if temp_ptr -> instruction_pr.address.pr = 4 119 /* PR4 */ 120 & temp_ptr -> instruction_pr.tag = "010100"b /* ,* */ then 121 go to get_link; 122 else return; 123 else if temp_ptr -> instruction_common.tag = ""b then go to get_ttr; 124 /* assume text-text transfer */ 125 else return; 126 127 end; 128 129 else do; /* not pl1 */ 130 131 temp_ptr = loc_ptr; 132 do i = 1 to 3; /* look back in text */ 133 134 if temp_ptr -> instruction_common.pr /* PR */ 135 & temp_ptr -> instruction_pr.address.pr = 4 & temp_ptr -> instruction_pr.tag = "010100"b then 136 go to get_link; /* something pr4|k,* */ 137 138 if rel (temp_ptr) = (18)"0"b then go to check_for_tra; 139 temp_ptr = addrel (temp_ptr, -1); /* move ptr back */ 140 141 end; 142 143 check_for_tra: 144 temp_ptr = loc_ptr; /* reset */ 145 146 if temp_ptr -> instruction_common.opcode = tra & temp_ptr -> instruction_common.tag = "0"b then 147 go to get_ttr; /* have tra n */ 148 149 return; /* couldn't find anything */ 150 151 end; 152 153 get_link: /* instruction address should be the offset of the link in the linkage section */ 154 /* use original object linkage section for link_ptr and active 155* linkage section fo entry_ptr */ 156 link_offset = temp_ptr -> instruction_pr.address.offset; 157 158 link_ptr = addrel (oi.linkp, link_offset); 159 160 if link_ptr -> object_link.tag ^= "100110"b then 161 link_ptr = null; /* not ft2 */ 162 163 else do; /* find link being used; will probably be snapped */ 164 165 sb = ptr (addr (temp_ptr), 0); /* get ptr to stack header */ 166 167 ls_ptr = lot_ptr -> lot.lp (bin (baseno (segptr), 18)); 168 169 entry_ptr = addrel (ls_ptr, link_offset) -> based_ptr; 170 /* pick up link itself */ 171 172 if addr (entry_ptr) -> object_link.tag = "100110"b then entry_ptr = null; 173 /* not snapped yet */ 174 end; 175 176 return; 177 178 179 get_ttr: /* instruction address should be offset in text of entry sequence */ 180 entry_ptr = ptr (loc_ptr, temp_ptr -> instruction_off.offset); 181 182 return; 183 184 end get_link_ptr_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/20/86 1145.0 get_link_ptr_.pl1 >special_ldd>install>MR12.0-1222>get_link_ptr_.pl1 53 1 08/05/77 1022.5 object_info.incl.pl1 >ldd>include>object_info.incl.pl1 56 2 05/06/74 1741.0 component_info.incl.pl1 >ldd>include>component_info.incl.pl1 58 3 11/07/86 1550.3 stack_header.incl.pl1 >ldd>include>stack_header.incl.pl1 60 4 08/05/77 1022.4 lot.incl.pl1 >ldd>include>lot.incl.pl1 62 5 04/13/82 1621.3 instruction.incl.pl1 >ldd>include>instruction.incl.pl1 64 6 11/20/86 1035.4 object_link_dcls.incl.pl1 >special_ldd>install>MR12.0-1222>object_link_dcls.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. addr builtin function dcl 50 ref 78 78 82 82 165 172 addrel builtin function dcl 50 ref 104 108 139 158 169 address based structure level 2 packed unaligned dcl 5-23 based_ptr based pointer dcl 30 ref 169 baseno builtin function dcl 50 ref 167 bin builtin function dcl 50 ref 82 82 103 167 bitcnt 000111 automatic fixed bin(24,0) dcl 35 set ref 74* 78* ci 000204 automatic structure level 1 dcl 2-3 set ref 82 82 code 000112 automatic fixed bin(35,0) dcl 36 set ref 74* 75 78* 79 82* 83 compiler 30 000116 automatic char(8) level 2 in structure "oi" dcl 54 in procedure "get_link_ptr_" set ref 81 87 compiler 27 000204 automatic char(8) level 2 in structure "ci" dcl 2-3 in procedure "get_link_ptr_" set ref 83 component_info_$offset 000014 constant entry external dcl 48 ref 82 entry_ptr parameter pointer dcl 29 set ref 12 68* 169* 172 172* 179* epp2 constant bit(10) initial dcl 40 ref 96 112 hcs_$status_mins 000012 constant entry external dcl 47 ref 74 i 000106 automatic fixed bin(17,0) dcl 32 set ref 132* instruction_common based structure level 1 dcl 5-14 instruction_off based structure level 1 dcl 5-19 instruction_pr based structure level 1 dcl 5-23 instruction_ptr 000256 automatic pointer dcl 5-12 set ref 91* 96 96 instruction_right_half based structure level 1 packed unaligned dcl 5-4 lang 000114 automatic char(8) dcl 38 set ref 83* 85* 87* 93 93 93 93 102 link_offset 000110 automatic fixed bin(18,0) dcl 34 set ref 153* 158 169 link_ptr parameter pointer dcl 29 set ref 12 68* 158* 160 160* linkp 6 000116 automatic pointer level 2 dcl 54 set ref 158 loc_ptr parameter pointer dcl 29 set ref 12 70 82* 82 82 91 96 104 108 131 143 179 lot based structure level 1 dcl 4-6 lot_ptr 26 based pointer level 2 dcl 3-26 ref 167 lp based pointer array level 2 packed unaligned dcl 4-6 ref 167 ls_ptr 000104 automatic pointer dcl 29 set ref 167* 169 null builtin function dcl 50 ref 68 111 116 160 172 object_info based structure level 1 dcl 1-6 object_info_$display 000010 constant entry external dcl 46 ref 78 object_info_version_2 constant fixed bin(17,0) initial dcl 1-60 ref 77 object_link based structure level 1 dcl 6-28 offset based fixed bin(18,0) level 2 in structure "instruction_off" packed unsigned unaligned dcl 5-19 in procedure "get_link_ptr_" ref 179 offset 0(03) based fixed bin(14,0) level 3 in structure "instruction_pr" packed unaligned dcl 5-23 in procedure "get_link_ptr_" ref 153 oi 000116 automatic structure level 1 dcl 54 set ref 78 78 opcode 0(18) based bit(10) level 3 packed unaligned dcl 5-14 ref 96 96 112 146 pr 0(29) based bit(1) level 3 in structure "instruction_common" packed unaligned dcl 5-14 in procedure "get_link_ptr_" ref 117 134 pr based fixed bin(3,0) level 3 in structure "instruction_pr" packed unsigned unaligned dcl 5-23 in procedure "get_link_ptr_" ref 117 134 ptr builtin function dcl 50 ref 70 165 179 rel builtin function dcl 50 ref 82 82 103 107 138 right 0(18) based structure level 2 in structure "instruction_pr" packed unaligned dcl 5-23 in procedure "get_link_ptr_" right 0(18) based structure level 2 in structure "instruction_common" packed unaligned dcl 5-14 in procedure "get_link_ptr_" sb 000254 automatic pointer dcl 3-24 set ref 165* 167 segptr 000102 automatic pointer dcl 29 set ref 70* 74* 78* 167 stack_header based structure level 1 dcl 3-26 tag 0(30) based bit(6) level 3 in structure "instruction_pr" packed unaligned dcl 5-23 in procedure "get_link_ptr_" ref 117 134 tag 0(30) based bit(6) level 3 in structure "instruction_common" packed unaligned dcl 5-14 in procedure "get_link_ptr_" ref 123 146 tag 0(30) based bit(6) level 2 in structure "object_link" packed unaligned dcl 6-28 in procedure "get_link_ptr_" ref 160 172 temp_ptr 000100 automatic pointer dcl 29 set ref 68* 96* 103 104* 107 108* 111 112 116 117 117 117 123 131* 134 134 134 138 139* 139 143* 146 146 153 165 179 tra constant bit(10) initial dcl 40 ref 146 tsp3 constant bit(10) initial dcl 40 ref 96 type 000107 automatic fixed bin(2,0) dcl 33 set ref 74* version_number 000116 automatic fixed bin(17,0) level 2 dcl 54 set ref 77* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. FAULT_TAG_1 internal static bit(6) initial unaligned dcl 6-100 FAULT_TAG_2 internal static bit(6) initial unaligned dcl 6-101 FAULT_TAG_3 internal static bit(6) initial unaligned dcl 6-102 FR_TRAPS_VERSION_1 internal static fixed bin(17,0) initial dcl 6-99 call_offset internal static fixed bin(17,0) initial dcl 3-78 entry_offset internal static fixed bin(17,0) initial dcl 3-78 fr_traps based structure level 1 dcl 6-90 isot based structure level 1 dcl 4-13 isot1 based structure array level 1 dcl 4-16 isotp automatic pointer dcl 4-12 linkage_header based structure level 1 dcl 6-50 linkage_header_flags based structure level 1 dcl 6-63 lot_fault internal static bit(36) initial dcl 4-9 lotp automatic pointer dcl 4-4 partial_link based structure level 1 dcl 6-38 push_offset internal static fixed bin(17,0) initial dcl 3-78 return_no_pop_offset internal static fixed bin(17,0) initial dcl 3-78 return_offset internal static fixed bin(17,0) initial dcl 3-78 stack_header_overlay based fixed bin(17,0) array dcl 3-94 tv_offset internal static fixed bin(17,0) initial dcl 3-72 virgin_linkage_header based structure level 1 dcl 6-71 NAMES DECLARED BY EXPLICIT CONTEXT. check_for_tra 000321 constant label dcl 143 ref 138 get_link 000336 constant label dcl 153 ref 117 134 get_link_ptr_ 000022 constant entry external dcl 12 get_ttr 000402 constant label dcl 179 ref 123 146 NAME DECLARED BY CONTEXT OR IMPLICATION. bit builtin function ref 103 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 470 506 411 500 Length 1002 411 16 260 57 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME get_link_ptr_ 189 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME get_link_ptr_ 000100 temp_ptr get_link_ptr_ 000102 segptr get_link_ptr_ 000104 ls_ptr get_link_ptr_ 000106 i get_link_ptr_ 000107 type get_link_ptr_ 000110 link_offset get_link_ptr_ 000111 bitcnt get_link_ptr_ 000112 code get_link_ptr_ 000114 lang get_link_ptr_ 000116 oi get_link_ptr_ 000204 ci get_link_ptr_ 000254 sb get_link_ptr_ 000256 instruction_ptr get_link_ptr_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. component_info_$offset hcs_$status_mins object_info_$display NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. CONSTANTS 000000 aa 120 114 057 111 PL/I 000001 aa 160 154 061 000 pl1 000002 aa 464000000000 000004 aa 146 157 162 164 fort 000005 aa 162 141 156 000 ran 000006 aa 166 062 160 154 v2pl 000007 aa 061 000 000 000 1 000010 aa 142 151 156 144 bind 000011 aa 145 162 040 040 er 000012 aa 142 151 156 144 bind 000013 aa 145 162 000 000 er 000014 aa 077777000043 000015 aa 000001000000 BEGIN PROCEDURE get_link_ptr_ ENTRY TO get_link_ptr_ STATEMENT 1 ON LINE 12 get_link_ptr_: proc (loc_ptr, link_ptr, entry_ptr); 000016 at 000003000002 000017 tt 000002000002 000020 ta 000016000000 000021 da 000053300000 000022 aa 000300 6270 00 eax7 192 000023 aa 7 00034 3521 20 epp2 pr7|28,* 000024 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000025 aa 000006000000 000026 aa 000000000000 STATEMENT 1 ON LINE 68 link_ptr, entry_ptr, temp_ptr = null; 000027 aa 777765 3734 24 epp7 -11,ic* 000030 aa 6 00032 3715 20 epp5 pr6|26,* 000031 aa 5 00004 6535 20 spri7 pr5|4,* link_ptr 000032 aa 5 00006 6535 20 spri7 pr5|6,* entry_ptr 000033 aa 6 00100 6535 00 spri7 pr6|64 temp_ptr STATEMENT 1 ON LINE 70 segptr = ptr (loc_ptr, 0); 000034 aa 5 00002 3521 20 epp2 pr5|2,* loc_ptr 000035 aa 2 00000 3525 20 epbp2 pr2|0,* loc_ptr 000036 aa 6 00102 2521 00 spri2 pr6|66 segptr STATEMENT 1 ON LINE 74 call hcs_$status_mins (segptr, type, bitcnt, code); 000037 aa 6 00102 3521 00 epp2 pr6|66 segptr 000040 aa 6 00264 2521 00 spri2 pr6|180 000041 aa 6 00107 3521 00 epp2 pr6|71 type 000042 aa 6 00266 2521 00 spri2 pr6|182 000043 aa 6 00111 3521 00 epp2 pr6|73 bitcnt 000044 aa 6 00270 2521 00 spri2 pr6|184 000045 aa 6 00112 3521 00 epp2 pr6|74 code 000046 aa 6 00272 2521 00 spri2 pr6|186 000047 aa 6 00262 6211 00 eax1 pr6|178 000050 aa 020000 4310 07 fld 8192,dl 000051 la 4 00012 3521 20 epp2 pr4|10,* hcs_$status_mins 000052 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 75 if code ^= 0 then return; 000053 aa 6 00112 2361 00 ldq pr6|74 code 000054 aa 0 00631 6011 00 tnz pr0|409 return_mac STATEMENT 1 ON LINE 77 oi.version_number = object_info_version_2; 000055 aa 000002 2360 07 ldq 2,dl 000056 aa 6 00116 7561 00 stq pr6|78 oi.version_number STATEMENT 1 ON LINE 78 call object_info_$display (segptr, bitcnt, addr (oi), code); 000057 aa 6 00116 3735 00 epp7 pr6|78 oi 000060 aa 6 00260 6535 00 spri7 pr6|176 000061 aa 6 00102 3521 00 epp2 pr6|66 segptr 000062 aa 6 00264 2521 00 spri2 pr6|180 000063 aa 6 00111 3521 00 epp2 pr6|73 bitcnt 000064 aa 6 00266 2521 00 spri2 pr6|182 000065 aa 6 00260 3521 00 epp2 pr6|176 000066 aa 6 00270 2521 00 spri2 pr6|184 000067 aa 6 00112 3521 00 epp2 pr6|74 code 000070 aa 6 00272 2521 00 spri2 pr6|186 000071 aa 6 00262 6211 00 eax1 pr6|178 000072 aa 020000 4310 07 fld 8192,dl 000073 aa 6 00044 3701 20 epp4 pr6|36,* 000074 la 4 00010 3521 20 epp2 pr4|8,* object_info_$display 000075 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 79 if code ^= 0 then return; 000076 aa 6 00112 2361 00 ldq pr6|74 code 000077 aa 0 00631 6011 00 tnz pr0|409 return_mac STATEMENT 1 ON LINE 81 if oi.compiler = "binder" then do; 000100 aa 777712 2370 04 ldaq -54,ic 000012 = 142151156144 145162000000 000101 aa 0 00454 2771 00 oraq pr0|300 = 000000000000 000000040040 000102 aa 6 00146 1171 00 cmpaq pr6|102 oi.compiler 000103 aa 000037 6010 04 tnz 31,ic 000142 STATEMENT 1 ON LINE 82 call component_info_$offset (loc_ptr, bin (rel (loc_ptr), 18), addr (ci), code); 000104 aa 6 00032 3735 20 epp7 pr6|26,* 000105 aa 7 00002 3715 20 epp5 pr7|2,* loc_ptr 000106 aa 5 00000 3715 20 epp5 pr5|0,* loc_ptr 000107 aa 5 00000 6351 00 eaa pr5|0 loc_ptr 000110 aa 000066 7730 00 lrl 54 000111 aa 6 00274 7561 00 stq pr6|188 000112 aa 6 00204 3535 00 epp3 pr6|132 ci 000113 aa 6 00260 2535 00 spri3 pr6|176 000114 aa 7 00002 3521 20 epp2 pr7|2,* loc_ptr 000115 aa 6 00264 2521 00 spri2 pr6|180 000116 aa 6 00274 3521 00 epp2 pr6|188 000117 aa 6 00266 2521 00 spri2 pr6|182 000120 aa 6 00260 3521 00 epp2 pr6|176 000121 aa 6 00270 2521 00 spri2 pr6|184 000122 aa 6 00112 3521 00 epp2 pr6|74 code 000123 aa 6 00272 2521 00 spri2 pr6|186 000124 aa 6 00262 6211 00 eax1 pr6|178 000125 aa 020000 4310 07 fld 8192,dl 000126 aa 6 00044 3701 20 epp4 pr6|36,* 000127 la 4 00014 3521 20 epp2 pr4|12,* component_info_$offset 000130 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 83 if code = 0 then lang = ci.compiler; 000131 aa 6 00112 2361 00 ldq pr6|74 code 000132 aa 000005 6010 04 tnz 5,ic 000137 000133 aa 6 00233 2351 00 lda pr6|155 ci.compiler 000134 aa 6 00234 2361 00 ldq pr6|156 ci.compiler 000135 aa 6 00114 7571 00 staq pr6|76 lang 000136 aa 000006 7100 04 tra 6,ic 000144 STATEMENT 1 ON LINE 85 else lang = "binder"; 000137 aa 777651 2370 04 ldaq -87,ic 000010 = 142151156144 145162040040 000140 aa 6 00114 7571 00 staq pr6|76 lang STATEMENT 1 ON LINE 86 end; 000141 aa 000003 7100 04 tra 3,ic 000144 STATEMENT 1 ON LINE 87 else lang = oi.compiler; 000142 aa 6 00146 2371 00 ldaq pr6|102 oi.compiler 000143 aa 6 00114 7571 00 staq pr6|76 lang STATEMENT 1 ON LINE 91 instruction_ptr = loc_ptr; 000144 aa 6 00032 3735 20 epp7 pr6|26,* 000145 aa 7 00002 3715 20 epp5 pr7|2,* loc_ptr 000146 aa 5 00000 3715 20 epp5 pr5|0,* loc_ptr 000147 aa 6 00256 6515 00 spri5 pr6|174 instruction_ptr STATEMENT 1 ON LINE 93 if (lang = "pl1") | (lang = "v2pl1") | (lang = "fortran") | (lang = "PL/I") then do; 000150 aa 777631 2350 04 lda -103,ic 000001 = 160154061000 000151 aa 0 00066 3771 00 anaq pr0|54 = 777777777000 000000000000 000152 aa 0 00446 2771 00 oraq pr0|294 = 000000000040 040040040040 000153 aa 6 00114 1171 00 cmpaq pr6|76 lang 000154 aa 000016 6000 04 tze 14,ic 000172 000155 aa 777631 2370 04 ldaq -103,ic 000006 = 166062160154 061000000000 000156 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000157 aa 6 00114 1171 00 cmpaq pr6|76 lang 000160 aa 000012 6000 04 tze 10,ic 000172 000161 aa 777623 2370 04 ldaq -109,ic 000004 = 146157162164 162141156000 000162 aa 0 00456 2771 00 oraq pr0|302 = 000000000000 000000000040 000163 aa 6 00114 1171 00 cmpaq pr6|76 lang 000164 aa 000006 6000 04 tze 6,ic 000172 000165 aa 777613 2350 04 lda -117,ic 000000 = 120114057111 000166 aa 0 00110 3771 00 anaq pr0|72 = 777777777777 000000000000 000167 aa 0 00450 2771 00 oraq pr0|296 = 000000000000 040040040040 000170 aa 6 00114 1171 00 cmpaq pr6|76 lang 000171 aa 000077 6010 04 tnz 63,ic 000270 STATEMENT 1 ON LINE 96 if instruction_common.opcode = epp2 /* at link ref; probably linkage error */ | instruction_common.opcode = tsp3 /* transfer to math operator is by link */ then temp_ptr = loc_ptr; 000172 aa 6 00256 2351 20 lda pr6|174,* instruction_common.opcode 000173 aa 000022 7350 00 als 18 000174 aa 0 00024 3771 00 anaq pr0|20 = 777400000000 000000000000 000175 aa 6 00274 7551 00 sta pr6|188 instruction_common.opcode 000176 aa 352000 1150 03 cmpa 119808,du 000177 aa 000003 6000 04 tze 3,ic 000202 000200 aa 273000 1150 03 cmpa 95744,du 000201 aa 000003 6010 04 tnz 3,ic 000204 000202 aa 6 00100 6515 00 spri5 pr6|64 temp_ptr 000203 aa 000041 7100 04 tra 33,ic 000244 STATEMENT 1 ON LINE 100 else do; STATEMENT 1 ON LINE 102 if lang = "pl1" then do; 000204 aa 777575 2350 04 lda -131,ic 000001 = 160154061000 000205 aa 0 00066 3771 00 anaq pr0|54 = 777777777000 000000000000 000206 aa 0 00446 2771 00 oraq pr0|294 = 000000000040 040040040040 000207 aa 6 00114 1171 00 cmpaq pr6|76 lang 000210 aa 000016 6010 04 tnz 14,ic 000226 STATEMENT 1 ON LINE 103 if rel (temp_ptr) < bit (bin (2, 18)) then return; 000211 aa 000002 2350 07 lda 2,dl 000212 aa 000002 6050 04 tpl 2,ic 000214 000213 aa 000000 5310 00 neg 0 000214 aa 000022 7350 00 als 18 000215 aa 6 00274 7551 00 sta pr6|188 000216 aa 6 00100 6351 20 eaa pr6|64,* temp_ptr 000217 aa 6 00274 1151 00 cmpa pr6|188 000220 aa 000002 6030 04 trc 2,ic 000222 000221 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 104 temp_ptr = addrel (loc_ptr, -2); 000222 aa 5 00000 3521 00 epp2 pr5|0 000223 aa 777776 0520 03 adwp2 262142,du 000224 aa 6 00100 2521 00 spri2 pr6|64 temp_ptr STATEMENT 1 ON LINE 105 end; 000225 aa 000006 7100 04 tra 6,ic 000233 STATEMENT 1 ON LINE 106 else do; STATEMENT 1 ON LINE 107 if rel (temp_ptr) = (18)"0"b then return; 000226 aa 6 00100 6351 20 eaa pr6|64,* temp_ptr 000227 aa 0 00631 6001 00 tze pr0|409 return_mac STATEMENT 1 ON LINE 108 temp_ptr = addrel (loc_ptr, -1); 000230 aa 5 00000 3521 00 epp2 pr5|0 000231 aa 777777 0520 03 adwp2 262143,du 000232 aa 6 00100 2521 00 spri2 pr6|64 temp_ptr STATEMENT 1 ON LINE 109 end; STATEMENT 1 ON LINE 111 if temp_ptr = null then return; 000233 aa 6 00100 2371 00 ldaq pr6|64 temp_ptr 000234 aa 777560 6770 04 eraq -144,ic 000014 = 077777000043 000001000000 000235 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000236 aa 0 00631 6001 00 tze pr0|409 return_mac STATEMENT 1 ON LINE 112 if temp_ptr -> instruction_common.opcode ^= epp2 then return; 000237 aa 2 00000 2351 00 lda pr2|0 instruction_common.opcode 000240 aa 000022 7350 00 als 18 000241 aa 0 00024 3771 00 anaq pr0|20 = 777400000000 000000000000 000242 aa 352000 1150 03 cmpa 119808,du 000243 aa 0 00631 6011 00 tnz pr0|409 return_mac STATEMENT 1 ON LINE 114 end; STATEMENT 1 ON LINE 116 if temp_ptr = null then return; 000244 aa 6 00100 2371 00 ldaq pr6|64 temp_ptr 000245 aa 777547 6770 04 eraq -153,ic 000014 = 077777000043 000001000000 000246 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000247 aa 0 00631 6001 00 tze pr0|409 return_mac STATEMENT 1 ON LINE 117 if temp_ptr -> instruction_common.pr /* has a PR */ then if temp_ptr -> instruction_pr.address.pr = 4 /* PR4 */ & temp_ptr -> instruction_pr.tag = "010100"b /* ,* */ then go to get_link; 000250 aa 6 00100 2351 20 lda pr6|64,* instruction_common.pr 000251 aa 000100 3150 07 cana 64,dl 000252 aa 000012 6000 04 tze 10,ic 000264 000253 aa 6 00100 2351 20 lda pr6|64,* instruction_pr.pr 000254 aa 000105 7730 00 lrl 69 000255 aa 000004 1160 07 cmpq 4,dl 000256 aa 000005 6010 04 tnz 5,ic 000263 000257 aa 6 00100 2351 20 lda pr6|64,* instruction_pr.tag 000260 aa 000036 7350 00 als 30 000261 aa 240000 1150 03 cmpa 81920,du 000262 aa 000054 6000 04 tze 44,ic 000336 STATEMENT 1 ON LINE 122 else return; 000263 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 123 else if temp_ptr -> instruction_common.tag = ""b then go to get_ttr; 000264 aa 6 00100 2351 20 lda pr6|64,* instruction_common.tag 000265 aa 000077 3150 07 cana 63,dl 000266 aa 000114 6000 04 tze 76,ic 000402 STATEMENT 1 ON LINE 125 else return; 000267 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 127 end; STATEMENT 1 ON LINE 129 else do; STATEMENT 1 ON LINE 131 temp_ptr = loc_ptr; 000270 aa 6 00100 6515 00 spri5 pr6|64 temp_ptr STATEMENT 1 ON LINE 132 do i = 1 to 3; 000271 aa 000001 2360 07 ldq 1,dl 000272 aa 6 00106 7561 00 stq pr6|70 i 000273 aa 000000 0110 03 nop 0,du 000274 aa 6 00106 2361 00 ldq pr6|70 i 000275 aa 000003 1160 07 cmpq 3,dl 000276 aa 000023 6054 04 tpnz 19,ic 000321 STATEMENT 1 ON LINE 134 if temp_ptr -> instruction_common.pr /* PR */ & temp_ptr -> instruction_pr.address.pr = 4 & temp_ptr -> instruction_pr.tag = "010100"b then go to get_link; 000277 aa 6 00100 2351 20 lda pr6|64,* instruction_common.pr 000300 aa 000100 3150 07 cana 64,dl 000301 aa 000011 6000 04 tze 9,ic 000312 000302 aa 6 00100 2351 20 lda pr6|64,* instruction_pr.pr 000303 aa 000105 7730 00 lrl 69 000304 aa 000004 1160 07 cmpq 4,dl 000305 aa 000005 6010 04 tnz 5,ic 000312 000306 aa 6 00100 2351 20 lda pr6|64,* instruction_pr.tag 000307 aa 000036 7350 00 als 30 000310 aa 240000 1150 03 cmpa 81920,du 000311 aa 000025 6000 04 tze 21,ic 000336 STATEMENT 1 ON LINE 138 if rel (temp_ptr) = (18)"0"b then go to check_for_tra; 000312 aa 6 00100 6351 20 eaa pr6|64,* temp_ptr 000313 aa 000006 6000 04 tze 6,ic 000321 STATEMENT 1 ON LINE 139 temp_ptr = addrel (temp_ptr, -1); 000314 aa 6 00100 3521 20 epp2 pr6|64,* temp_ptr 000315 aa 777777 0520 03 adwp2 262143,du 000316 aa 6 00100 2521 00 spri2 pr6|64 temp_ptr STATEMENT 1 ON LINE 141 end; 000317 aa 6 00106 0541 00 aos pr6|70 i 000320 aa 777754 7100 04 tra -20,ic 000274 STATEMENT 1 ON LINE 143 check_for_tra: temp_ptr = loc_ptr; 000321 aa 6 00032 3735 20 epp7 pr6|26,* 000322 aa 7 00002 3715 20 epp5 pr7|2,* loc_ptr 000323 aa 5 00000 3715 20 epp5 pr5|0,* loc_ptr 000324 aa 6 00100 6515 00 spri5 pr6|64 temp_ptr STATEMENT 1 ON LINE 146 if temp_ptr -> instruction_common.opcode = tra & temp_ptr -> instruction_common.tag = "0"b then go to get_ttr; 000325 aa 5 00000 2351 00 lda pr5|0 instruction_common.opcode 000326 aa 000022 7350 00 als 18 000327 aa 0 00024 3771 00 anaq pr0|20 = 777400000000 000000000000 000330 aa 710000 1150 03 cmpa 233472,du 000331 aa 000004 6010 04 tnz 4,ic 000335 000332 aa 5 00000 2351 00 lda pr5|0 instruction_common.tag 000333 aa 000077 3150 07 cana 63,dl 000334 aa 000046 6000 04 tze 38,ic 000402 STATEMENT 1 ON LINE 149 return; 000335 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 151 end; STATEMENT 1 ON LINE 153 get_link: /* instruction address should be the offset of the link in the linkage section */ /* use original object linkage section for link_ptr and active linkage section fo entry_ptr */ link_offset = temp_ptr -> instruction_pr.address.offset; 000336 aa 6 00100 2351 20 lda pr6|64,* instruction_pr.offset 000337 aa 000003 7350 00 als 3 000340 aa 000071 7330 00 lrs 57 000341 aa 6 00110 7561 00 stq pr6|72 link_offset STATEMENT 1 ON LINE 158 link_ptr = addrel (oi.linkp, link_offset); 000342 aa 6 00124 3521 66 epp2 pr6|84,*ql oi.linkp 000343 aa 000000 0520 03 adwp2 0,du 000344 aa 6 00032 3735 20 epp7 pr6|26,* 000345 aa 7 00004 2521 20 spri2 pr7|4,* link_ptr STATEMENT 1 ON LINE 160 if link_ptr -> object_link.tag ^= "100110"b then link_ptr = null; 000346 aa 2 00000 2351 00 lda pr2|0 object_link.tag 000347 aa 000036 7350 00 als 30 000350 aa 460000 1150 03 cmpa 155648,du 000351 aa 000004 6000 04 tze 4,ic 000355 000352 aa 777442 2370 04 ldaq -222,ic 000014 = 077777000043 000001000000 000353 aa 7 00004 7571 20 staq pr7|4,* link_ptr 000354 aa 000024 7100 04 tra 20,ic 000400 STATEMENT 1 ON LINE 163 else do; STATEMENT 1 ON LINE 165 sb = ptr (addr (temp_ptr), 0); 000355 aa 6 00100 3715 00 epp5 pr6|64 temp_ptr 000356 aa 5 00000 3525 00 epbp2 pr5|0 000357 aa 6 00254 2521 00 spri2 pr6|172 sb STATEMENT 1 ON LINE 167 ls_ptr = lot_ptr -> lot.lp (bin (baseno (segptr), 18)); 000360 aa 6 00102 2131 20 epaq pr6|66,* segptr 000361 aa 077777 3750 03 ana 32767,du 000362 aa 000066 7730 00 lrl 54 000363 aa 2 00026 7631 66 lprp3 pr2|22,*ql lot.lp 000364 aa 6 00104 2535 00 spri3 pr6|68 ls_ptr STATEMENT 1 ON LINE 169 entry_ptr = addrel (ls_ptr, link_offset) -> based_ptr; 000365 aa 6 00110 2361 00 ldq pr6|72 link_offset 000366 aa 3 00000 3515 06 epp1 pr3|0,ql 000367 aa 000000 0510 03 adwp1 0,du 000370 aa 1 00000 3535 20 epp3 pr1|0,* based_ptr 000371 aa 7 00006 2535 20 spri3 pr7|6,* entry_ptr STATEMENT 1 ON LINE 172 if addr (entry_ptr) -> object_link.tag = "100110"b then entry_ptr = null; 000372 aa 7 00006 2351 20 lda pr7|6,* object_link.tag 000373 aa 000036 7350 00 als 30 000374 aa 460000 1150 03 cmpa 155648,du 000375 aa 000003 6010 04 tnz 3,ic 000400 000376 aa 777416 2370 04 ldaq -242,ic 000014 = 077777000043 000001000000 000377 aa 7 00006 7571 20 staq pr7|6,* entry_ptr STATEMENT 1 ON LINE 174 end; 000400 aa 6 00260 6515 00 spri5 pr6|176 STATEMENT 1 ON LINE 176 return; 000401 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 179 get_ttr: /* instruction address should be offset in text of entry sequence */ entry_ptr = ptr (loc_ptr, temp_ptr -> instruction_off.offset); 000402 aa 6 00100 2351 20 lda pr6|64,* instruction_off.offset 000403 aa 000066 7730 00 lrl 54 000404 aa 7 00002 3521 20 epp2 pr7|2,* loc_ptr 000405 aa 2 00000 3521 20 epp2 pr2|0,* loc_ptr 000406 aa 000000 3120 06 eawp2 0,ql 000407 aa 7 00006 2521 20 spri2 pr7|6,* entry_ptr STATEMENT 1 ON LINE 182 return; 000410 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 184 end get_link_ptr_; END PROCEDURE get_link_ptr_ ----------------------------------------------------------- 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