COMPILATION LISTING OF SEGMENT pl1_frame_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/20/86 1205.2 mst Thu Options: optimize list 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 pl1_frame_: proc (spt, ans); 12 13 /* sets ans = "1"b if stack frame pointed at by pt is a pl1 frame */ 14 15 /* Modified: 2 Januaray, 1973 by S. Webber for 6180. */ 16 17 dcl spt ptr, 18 (bc, code) fixed bin, 19 ans bit (1) aligned; 20 21 dcl pl1_operators$call_out ptr ext; 22 23 dcl p ptr int static, 24 (defp, pt) ptr, 25 v2 bit (1) int static, 26 legal_f_ entry (ptr) returns (fixed bin), 27 bit_word aligned bit (36) based (p), 28 fix_word fixed bin based (p), 29 (addr, addrel, baseptr, divide, fixed, null, ptr, rel, substr) builtin, 30 pl1_frame_ entry (ptr) returns (aligned bit (1)); 31 32 dcl lang fixed bin; 33 34 dcl based_ptr ptr based; 35 36 dcl 1 half aligned based, 37 2 (left, right) unaligned bit (18); 38 39 dcl 1 acc aligned based, 40 2 length unal bit (9), 41 2 string unal char (1); 42 /* */ 1 1 /* BEGIN INCLUDE FILE definition.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(86-05-02,Elhard), approve(86-05-02,MCR7391), 1 7* audit(86-07-18,DGHowe), install(86-11-20,MR12.0-1222): 1 8* Modified to add indirect bit to definition flags. 1 9* END HISTORY COMMENTS */ 1 10 1 11 1 12 dcl 1 definition aligned based, 1 13 2 forward unal bit(18), /* offset of next def */ 1 14 2 backward unal bit(18), /* offset of previous def */ 1 15 2 value unal bit(18), 1 16 2 flags unal, 1 17 3 new bit(1), 1 18 3 ignore bit(1), 1 19 3 entry bit(1), 1 20 3 retain bit(1), 1 21 3 argcount bit(1), 1 22 3 descriptors bit(1), 1 23 3 indirect bit(1), 1 24 3 unused bit(8), 1 25 2 class unal bit(3), 1 26 2 symbol unal bit(18), /* offset of ACC for symbol */ 1 27 2 segname unal bit(18); /* offset of segname def */ 1 28 1 29 /* END INCLUDE FILE definition.incl.pl1 */ 43 44 /* */ 2 1 /* BEGIN INCLUDE FILE ... stack_frame.incl.pl1 ... */ 2 2 2 3 /* format: off */ 2 4 2 5 /* Modified: 16 Dec 1977, D. Levin - to add fio_ps_ptr and pl1_ps_ptr */ 2 6 /* Modified: 3 Feb 1978, P. Krupp - to add run_unit_manager bit & main_proc bit */ 2 7 /* Modified: 21 March 1978, D. Levin - change fio_ps_ptr to support_ptr */ 2 8 /* Modified: 03/01/84, S. Herbst - Added RETURN_PTR_MASK */ 2 9 2 10 2 11 /****^ HISTORY COMMENTS: 2 12* 1) change(86-09-15,Kissel), approve(86-09-15,MCR7473), 2 13* audit(86-10-01,Fawcett), install(86-11-03,MR12.0-1206): 2 14* Modified to add constants for the translator_id field in the stack_frame 2 15* structure. 2 16* END HISTORY COMMENTS */ 2 17 2 18 2 19 dcl RETURN_PTR_MASK bit (72) int static options (constant) /* mask to be AND'd with stack_frame.return_ptr */ 2 20 init ("777777777777777777000000"b3); /* when copying, to ignore bits that a call fills */ 2 21 /* with indicators (nonzero for Fortran hexfp caller) */ 2 22 /* say: unspec(ptr) = unspec(stack_frame.return_ptr) & RETURN_PTR_MASK; */ 2 23 2 24 dcl TRANSLATOR_ID_PL1V2 bit (18) internal static options (constant) init ("000000"b3); 2 25 dcl TRANSLATOR_ID_ALM bit (18) internal static options (constant) init ("000001"b3); 2 26 dcl TRANSLATOR_ID_PL1V1 bit (18) internal static options (constant) init ("000002"b3); 2 27 dcl TRANSLATOR_ID_SIGNAL_CALLER bit (18) internal static options (constant) init ("000003"b3); 2 28 dcl TRANSLATOR_ID_SIGNALLER bit (18) internal static options (constant) init ("000004"b3); 2 29 2 30 2 31 dcl sp pointer; /* pointer to beginning of stack frame */ 2 32 2 33 dcl stack_frame_min_length fixed bin static init(48); 2 34 2 35 2 36 dcl 1 stack_frame based(sp) aligned, 2 37 2 pointer_registers(0 : 7) ptr, 2 38 2 prev_sp pointer, 2 39 2 next_sp pointer, 2 40 2 return_ptr pointer, 2 41 2 entry_ptr pointer, 2 42 2 operator_and_lp_ptr ptr, /* serves as both */ 2 43 2 arg_ptr pointer, 2 44 2 static_ptr ptr unaligned, 2 45 2 support_ptr ptr unal, /* only used by fortran I/O */ 2 46 2 on_unit_relp1 bit(18) unaligned, 2 47 2 on_unit_relp2 bit(18) unaligned, 2 48 2 translator_id bit(18) unaligned, /* Translator ID (see constants above) 2 49* 0 => PL/I version II 2 50* 1 => ALM 2 51* 2 => PL/I version I 2 52* 3 => signal caller frame 2 53* 4 => signaller frame */ 2 54 2 operator_return_offset bit(18) unaligned, 2 55 2 x(0: 7) bit(18) unaligned, /* index registers */ 2 56 2 a bit(36), /* accumulator */ 2 57 2 q bit(36), /* q-register */ 2 58 2 e bit(36), /* exponent */ 2 59 2 timer bit(27) unaligned, /* timer */ 2 60 2 pad bit(6) unaligned, 2 61 2 ring_alarm_reg bit(3) unaligned; 2 62 2 63 2 64 dcl 1 stack_frame_flags based(sp) aligned, 2 65 2 pad(0 : 7) bit(72), /* skip over prs */ 2 66 2 xx0 bit(22) unal, 2 67 2 main_proc bit(1) unal, /* on if frame belongs to a main procedure */ 2 68 2 run_unit_manager bit(1) unal, /* on if frame belongs to run unit manager */ 2 69 2 signal bit(1) unal, /* on if frame belongs to logical signal_ */ 2 70 2 crawl_out bit(1) unal, /* on if this is a signal caller frame */ 2 71 2 signaller bit(1) unal, /* on if next frame is signaller's */ 2 72 2 link_trap bit(1) unal, /* on if this frame was made by the linker */ 2 73 2 support bit(1) unal, /* on if frame belongs to a support proc */ 2 74 2 condition bit(1) unal, /* on if condition established in this frame */ 2 75 2 xx0a bit(6) unal, 2 76 2 xx1 fixed bin, 2 77 2 xx2 fixed bin, 2 78 2 xx3 bit(25) unal, 2 79 2 old_crawl_out bit (1) unal, /* on if this is a signal caller frame */ 2 80 2 old_signaller bit(1) unal, /* on if next frame is signaller's */ 2 81 2 xx3a bit(9) unaligned, 2 82 2 xx4(9) bit(72) aligned, 2 83 2 v2_pl1_op_ret_base ptr, /* When a V2 PL/I program calls an operator the 2 84* * operator puts a pointer to the base of 2 85* * the calling procedure here. (text base ptr) */ 2 86 2 xx5 bit(72) aligned, 2 87 2 pl1_ps_ptr ptr; /* ptr to ps for this frame; also used by fio. */ 2 88 2 89 /* format: on */ 2 90 2 91 /* END INCLUDE FILE ... stack_frame.incl.pl1 */ 45 46 /* */ 3 1 /* BEGIN INCLUDE FILE its.incl.pl1 3 2* modified 27 July 79 by JRDavis to add its_unsigned 3 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 3 4 3 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 3 6 2 pad1 bit (3) unaligned, 3 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 3 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 3 9 2 pad2 bit (9) unaligned, 3 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 3 11 3 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 3 13 2 pad3 bit (3) unaligned, 3 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 3 15 2 pad4 bit (3) unaligned, 3 16 2 mod bit (6) unaligned; /* further modification */ 3 17 3 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 3 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 3 20 2 pad1 bit (27) unaligned, 3 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 3 22 3 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 3 24 2 pad2 bit (3) unaligned, 3 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 3 26 2 pad3 bit (3) unaligned, 3 27 2 mod bit (6) unaligned; /* further modification */ 3 28 3 29 3 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 3 31 2 pad1 bit (3) unaligned, 3 32 2 segno fixed bin (15) unsigned unaligned, 3 33 2 ringno fixed bin (3) unsigned unaligned, 3 34 2 pad2 bit (9) unaligned, 3 35 2 its_mod bit (6) unaligned, 3 36 3 37 2 offset fixed bin (18) unsigned unaligned, 3 38 2 pad3 bit (3) unaligned, 3 39 2 bit_offset fixed bin (6) unsigned unaligned, 3 40 2 pad4 bit (3) unaligned, 3 41 2 mod bit (6) unaligned; 3 42 3 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 3 44 2 pr_no fixed bin (3) unsigned unaligned, 3 45 2 pad1 bit (27) unaligned, 3 46 2 itp_mod bit (6) unaligned, 3 47 3 48 2 offset fixed bin (18) unsigned unaligned, 3 49 2 pad2 bit (3) unaligned, 3 50 2 bit_offset fixed bin (6) unsigned unaligned, 3 51 2 pad3 bit (3) unaligned, 3 52 2 mod bit (6) unaligned; 3 53 3 54 3 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 3 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 3 57 3 58 /* END INCLUDE FILE its.incl.pl1 */ 47 48 49 4 1 /* BEGIN INCLUDE FILE...pl1_stack_frame.incl.pl1 */ 4 2 /* This is an overlay for a stack frame giving pointers 4 3** set and used by pl/I programs only. 4 4**/ 4 5 4 6 dcl 1 pl1_stack_frame based aligned, 4 7 2 pad(32) fixed bin, 4 8 2 display_ptr ptr, /* pointer to stack frame of parent block */ 4 9 2 descriptor_ptr ptr, /* pointer to argument descriptor list */ 4 10 2 linkage_ptr ptr, /* pointer to base of linkage section */ 4 11 2 text_base_ptr ptr; /* pointer to base of text */ 4 12 4 13 /* END INCLUDE FILE ... pl1_stack_frame.incl.pl1 */ 50 51 /* */ 52 pt = spt; 53 54 /* Clear out any flags (such as condition list present) which may have 55* been set in stack frame pointer. This is necessary because the 56* pointer we are passed may actually be the back point in a stack frame */ 57 58 addr (pt) -> its.pad1 = "0"b; 59 addr (pt) -> its.pad2 = "0"b; 60 61 if pt = null /* pt can't possibly point to a stack frame */ 62 then do; 63 no: ans = "0"b; 64 return; 65 end; 66 67 if legal_f_ (pt) ^= 0 then goto no; /* check to see if frame is at least threaded */ 68 69 lang = fixed(pt -> stack_frame.translator_id, 18); 70 /* find out which translator produced 71* the segment */ 72 73 if lang = 2 then v2 = "0"b; /*PL/I, version 1 */ 74 else if lang = 0 then v2 = "1"b; /* pl/I version 2 */ 75 76 else go to no; /* not PL/I at all */ 77 78 /* get entry pointer for use by "name" entry */ 79 80 p = pt -> stack_frame.entry_ptr; 81 82 ans = "1"b; 83 return; 84 /* */ 85 pl1_frame_$name: entry (spt, name_pt, name_size); 86 87 /* sets name_pt & name_size to determine name of pl1 program 88* corresponding to stack frame pointed at by pt. name_pt will be 89* set to null if frame is not a pl1 frame */ 90 91 dcl name_pt ptr, 92 name_size fixed bin; 93 94 if ^ pl1_frame_ (spt) /* first see if we have a good pl1 frame */ 95 then do; /* if not, there's no name to return */ 96 l2: name_pt = null; 97 name_size = 0; 98 return; 99 end; /* p now contains the entry pointer */ 100 101 if addrel(p, 1) -> bit_word = "000000000110001100010111010001000000"b then 102 /* a tsbbp ap|614 marks the entry as a begin block */ 103 go to l2; /* in which case we can't get the name */ 104 105 if v2 /* for Version II */ 106 then do; 107 p = addrel (p, -1); /* length of name is 1 word before entry */ 108 if p -> half.left then goto std_obj; /* left half ^= 0 means std object segment */ 109 goto l1; 110 end; 111 /* for Version I */ 112 /* name-size is 3 words before entry point */ 113 114 p = addrel(p, -3); 115 116 l1: name_size = p -> fix_word; /* get length of name in characters */ 117 name_pt = addrel (p, -divide (name_size+3, 4, 18, 0)); /* name immediately precedes length; get length in */ 118 /* words (rounding up) and subtract from pointer */ 119 return; 120 121 /* For a standard object segment we use the fact that the 122* linkage ptr in the stack frame points to the linkage header 123* in CLS and the first two words in linkage header point 124* to definition section */ 125 126 std_obj: defp = spt -> pl1_stack_frame.linkage_ptr -> based_ptr; 127 128 p = addrel (defp, p -> half.left); 129 p = addrel (defp, p -> definition.symbol); 130 131 name_size = fixed (p -> acc.length, 9); 132 name_pt = addr (p -> acc.string); 133 134 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/20/86 1145.0 pl1_frame_.pl1 >special_ldd>install>MR12.0-1222>pl1_frame_.pl1 43 1 11/20/86 1035.2 definition.incl.pl1 >special_ldd>install>MR12.0-1222>definition.incl.pl1 45 2 11/07/86 1550.3 stack_frame.incl.pl1 >ldd>include>stack_frame.incl.pl1 47 3 11/26/79 1320.6 its.incl.pl1 >ldd>include>its.incl.pl1 50 4 05/06/74 1742.6 pl1_stack_frame.incl.pl1 >ldd>include>pl1_stack_frame.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. acc based structure level 1 dcl 39 addr builtin function dcl 23 ref 58 59 132 addrel builtin function dcl 23 ref 101 107 114 117 128 129 ans parameter bit(1) dcl 17 set ref 11 63* 82* based_ptr based pointer dcl 34 ref 126 bit_word based bit(36) dcl 23 ref 101 definition based structure level 1 dcl 1-12 defp 000100 automatic pointer dcl 23 set ref 126* 128 129 divide builtin function dcl 23 ref 117 entry_ptr 26 based pointer level 2 dcl 2-36 ref 80 fix_word based fixed bin(17,0) dcl 23 ref 116 fixed builtin function dcl 23 ref 69 131 half based structure level 1 dcl 36 its based structure level 1 dcl 3-5 lang 000104 automatic fixed bin(17,0) dcl 32 set ref 69* 73 74 left based bit(18) level 2 packed unaligned dcl 36 ref 108 128 legal_f_ 000014 constant entry external dcl 23 ref 67 length based bit(9) level 2 packed unaligned dcl 39 ref 131 linkage_ptr 44 based pointer level 2 dcl 4-6 ref 126 name_pt parameter pointer dcl 91 set ref 85 96* 117* 132* name_size parameter fixed bin(17,0) dcl 91 set ref 85 97* 116* 117 131* null builtin function dcl 23 ref 61 96 p 000010 internal static pointer dcl 23 set ref 80* 101 107* 107 108 114* 114 116 117 128* 128 129* 129 131 132 pad1 based bit(3) level 2 packed unaligned dcl 3-5 set ref 58* pad2 0(21) based bit(9) level 2 packed unaligned dcl 3-5 set ref 59* pl1_frame_ 000016 constant entry external dcl 23 ref 94 pl1_stack_frame based structure level 1 dcl 4-6 pt 000102 automatic pointer dcl 23 set ref 52* 58 59 61 67* 69 80 spt parameter pointer dcl 17 set ref 11 52 85 94* 126 stack_frame based structure level 1 dcl 2-36 string 0(09) based char(1) level 2 packed unaligned dcl 39 set ref 132 symbol 2 based bit(18) level 2 packed unaligned dcl 1-12 ref 129 translator_id 37 based bit(18) level 2 packed unaligned dcl 2-36 ref 69 v2 000012 internal static bit(1) unaligned dcl 23 set ref 73* 74* 105 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ITP_MODIFIER internal static bit(6) initial unaligned dcl 3-56 ITS_MODIFIER internal static bit(6) initial unaligned dcl 3-55 RETURN_PTR_MASK internal static bit(72) initial unaligned dcl 2-19 TRANSLATOR_ID_ALM internal static bit(18) initial unaligned dcl 2-25 TRANSLATOR_ID_PL1V1 internal static bit(18) initial unaligned dcl 2-26 TRANSLATOR_ID_PL1V2 internal static bit(18) initial unaligned dcl 2-24 TRANSLATOR_ID_SIGNALLER internal static bit(18) initial unaligned dcl 2-28 TRANSLATOR_ID_SIGNAL_CALLER internal static bit(18) initial unaligned dcl 2-27 baseptr builtin function dcl 23 bc automatic fixed bin(17,0) dcl 17 code automatic fixed bin(17,0) dcl 17 itp based structure level 1 dcl 3-18 itp_unsigned based structure level 1 dcl 3-43 its_unsigned based structure level 1 dcl 3-30 pl1_operators$call_out external static pointer dcl 21 ptr builtin function dcl 23 rel builtin function dcl 23 sp automatic pointer dcl 2-31 stack_frame_flags based structure level 1 dcl 2-64 stack_frame_min_length internal static fixed bin(17,0) initial dcl 2-33 substr builtin function dcl 23 NAMES DECLARED BY EXPLICIT CONTEXT. l1 000152 constant label dcl 116 ref 109 l2 000122 constant label dcl 96 ref 101 no 000033 constant label dcl 63 ref 67 74 pl1_frame_ 000012 constant entry external dcl 11 pl1_frame_$name 000100 constant entry external dcl 85 std_obj 000165 constant label dcl 126 ref 108 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 266 306 214 276 Length 552 214 20 227 51 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME pl1_frame_ 76 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 p pl1_frame_ 000012 v2 pl1_frame_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME pl1_frame_ 000100 defp pl1_frame_ 000102 pt pl1_frame_ 000104 lang pl1_frame_ 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. legal_f_ pl1_frame_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. CONSTANTS 000212 aa 777777700077 000213 aa 077777777777 000000 aa 000614272100 000001 aa 404000000021 000002 aa 514000000001 000003 aa 464000000000 000004 aa 077777000043 000005 aa 000001000000 BEGIN PROCEDURE pl1_frame_ ENTRY TO pl1_frame_ STATEMENT 1 ON LINE 11 pl1_frame_: proc (spt, ans); 000006 at 000002000003 000007 ta 000002000000 000010 ta 000006000000 000011 da 000031300000 000012 aa 000120 6270 00 eax7 80 000013 aa 7 00034 3521 20 epp2 pr7|28,* 000014 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000015 aa 000004000000 000016 aa 000000000000 STATEMENT 1 ON LINE 52 pt = spt; 000017 aa 6 00032 3735 20 epp7 pr6|26,* 000020 aa 7 00002 3715 20 epp5 pr7|2,* spt 000021 aa 5 00000 3715 20 epp5 pr5|0,* spt 000022 aa 6 00102 6515 00 spri5 pr6|66 pt STATEMENT 1 ON LINE 58 addr (pt) -> its.pad1 = "0"b; 000023 aa 000170 2350 04 lda 120,ic 000213 = 077777777777 000024 aa 6 00102 3551 00 ansa pr6|66 its.pad1 STATEMENT 1 ON LINE 59 addr (pt) -> its.pad2 = "0"b; 000025 aa 000165 2350 04 lda 117,ic 000212 = 777777700077 000026 aa 6 00102 3551 00 ansa pr6|66 its.pad2 STATEMENT 1 ON LINE 61 if pt = null /* pt can't possibly point to a stack frame */ then do; 000027 aa 6 00102 2371 00 ldaq pr6|66 pt 000030 aa 777754 6770 04 eraq -20,ic 000004 = 077777000043 000001000000 000031 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000032 aa 000004 6010 04 tnz 4,ic 000036 STATEMENT 1 ON LINE 63 no: ans = "0"b; 000033 aa 6 00032 3735 20 epp7 pr6|26,* 000034 aa 7 00004 4501 20 stz pr7|4,* ans STATEMENT 1 ON LINE 64 return; 000035 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 65 end; STATEMENT 1 ON LINE 67 if legal_f_ (pt) ^= 0 then goto no; 000036 aa 6 00102 3521 00 epp2 pr6|66 pt 000037 aa 6 00110 2521 00 spri2 pr6|72 000040 aa 6 00105 3521 00 epp2 pr6|69 000041 aa 6 00112 2521 00 spri2 pr6|74 000042 aa 6 00106 6211 00 eax1 pr6|70 000043 aa 010000 4310 07 fld 4096,dl 000044 la 4 00014 3521 20 epp2 pr4|12,* legal_f_ 000045 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out 000046 aa 6 00105 2361 00 ldq pr6|69 000047 aa 777764 6010 04 tnz -12,ic 000033 STATEMENT 1 ON LINE 69 lang = fixed(pt -> stack_frame.translator_id, 18); 000050 aa 6 00102 3735 20 epp7 pr6|66,* pt 000051 aa 7 00037 2351 00 lda pr7|31 stack_frame.translator_id 000052 aa 000066 7730 00 lrl 54 000053 aa 6 00104 7561 00 stq pr6|68 lang STATEMENT 1 ON LINE 73 if lang = 2 then v2 = "0"b; 000054 aa 000002 1160 07 cmpq 2,dl 000055 aa 000004 6010 04 tnz 4,ic 000061 000056 aa 6 00044 3701 20 epp4 pr6|36,* 000057 ia 4 00012 4501 00 stz pr4|10 v2 000060 aa 000006 7100 04 tra 6,ic 000066 STATEMENT 1 ON LINE 74 else if lang = 0 then v2 = "1"b; 000061 aa 6 00104 2361 00 ldq pr6|68 lang 000062 aa 777751 6010 04 tnz -23,ic 000033 000063 aa 400000 2350 03 lda 131072,du 000064 aa 6 00044 3701 20 epp4 pr6|36,* 000065 ia 4 00012 7551 00 sta pr4|10 v2 STATEMENT 1 ON LINE 80 p = pt -> stack_frame.entry_ptr; 000066 aa 7 00026 3715 20 epp5 pr7|22,* stack_frame.entry_ptr 000067 ia 4 00010 6515 00 spri5 pr4|8 p STATEMENT 1 ON LINE 82 ans = "1"b; 000070 aa 400000 2350 03 lda 131072,du 000071 aa 6 00032 3535 20 epp3 pr6|26,* 000072 aa 3 00004 7551 20 sta pr3|4,* ans STATEMENT 1 ON LINE 83 return; 000073 aa 0 00631 7101 00 tra pr0|409 return_mac ENTRY TO pl1_frame_$name STATEMENT 1 ON LINE 85 pl1_frame_$name: entry (spt, name_pt, name_size); 000074 at 000003000003 000075 tt 000003000001 000076 ta 000074000000 000077 da 000045300000 000100 aa 000120 6270 00 eax7 80 000101 aa 7 00034 3521 20 epp2 pr7|28,* 000102 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000103 aa 000006000000 000104 aa 000000000000 STATEMENT 1 ON LINE 94 if ^ pl1_frame_ (spt) /* first see if we have a good pl1 frame */ then do; 000105 aa 6 00032 3735 20 epp7 pr6|26,* 000106 aa 7 00002 3521 20 epp2 pr7|2,* spt 000107 aa 6 00110 2521 00 spri2 pr6|72 000110 aa 6 00105 3521 00 epp2 pr6|69 000111 aa 6 00112 2521 00 spri2 pr6|74 000112 aa 6 00106 6211 00 eax1 pr6|70 000113 aa 010000 4310 07 fld 4096,dl 000114 aa 6 00044 3701 20 epp4 pr6|36,* 000115 la 4 00016 3521 20 epp2 pr4|14,* pl1_frame_ 000116 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out 000117 aa 6 00105 2351 00 lda pr6|69 000120 aa 400000 3150 03 cana 131072,du 000121 aa 000006 6010 04 tnz 6,ic 000127 STATEMENT 1 ON LINE 96 l2: name_pt = null; 000122 aa 777662 2370 04 ldaq -78,ic 000004 = 077777000043 000001000000 000123 aa 6 00032 3735 20 epp7 pr6|26,* 000124 aa 7 00004 7571 20 staq pr7|4,* name_pt STATEMENT 1 ON LINE 97 name_size = 0; 000125 aa 7 00006 4501 20 stz pr7|6,* name_size STATEMENT 1 ON LINE 98 return; 000126 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 99 end; STATEMENT 1 ON LINE 101 if addrel(p, 1) -> bit_word = "000000000110001100010111010001000000"b then /* a tsbbp ap|614 marks the entry as a begin block */ go to l2; 000127 aa 6 00044 3701 20 epp4 pr6|36,* 000130 ia 4 00010 3521 20 epp2 pr4|8,* p 000131 aa 000001 0520 03 adwp2 1,du 000132 aa 2 00000 2351 00 lda pr2|0 bit_word 000133 aa 777645 1150 04 cmpa -91,ic 000000 = 000614272100 000134 aa 777766 6000 04 tze -10,ic 000122 STATEMENT 1 ON LINE 105 if v2 /* for Version II */ then do; 000135 ia 4 00012 2351 00 lda pr4|10 v2 000136 aa 000011 6000 04 tze 9,ic 000147 STATEMENT 1 ON LINE 107 p = addrel (p, -1); 000137 ia 4 00010 3521 20 epp2 pr4|8,* p 000140 aa 777777 0520 03 adwp2 262143,du 000141 ia 4 00010 2521 00 spri2 pr4|8 p STATEMENT 1 ON LINE 108 if p -> half.left then goto std_obj; 000142 aa 2 00000 2351 00 lda pr2|0 half.left 000143 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 000144 aa 6 00105 7551 00 sta pr6|69 half.left 000145 aa 000020 6010 04 tnz 16,ic 000165 STATEMENT 1 ON LINE 109 goto l1; 000146 aa 000004 7100 04 tra 4,ic 000152 STATEMENT 1 ON LINE 110 end; STATEMENT 1 ON LINE 114 p = addrel(p, -3); 000147 ia 4 00010 3521 20 epp2 pr4|8,* p 000150 aa 777775 0520 03 adwp2 262141,du 000151 ia 4 00010 2521 00 spri2 pr4|8 p STATEMENT 1 ON LINE 116 l1: name_size = p -> fix_word; 000152 aa 2 00000 2361 00 ldq pr2|0 fix_word 000153 aa 6 00032 3735 20 epp7 pr6|26,* 000154 aa 7 00006 7561 20 stq pr7|6,* name_size STATEMENT 1 ON LINE 117 name_pt = addrel (p, -divide (name_size+3, 4, 18, 0)); 000155 aa 000003 0760 07 adq 3,dl 000156 aa 000004 5060 07 div 4,dl 000157 aa 0 00110 6761 00 erq pr0|72 = 777777777777 000160 aa 000001 0760 07 adq 1,dl 000161 aa 2 00000 3515 06 epp1 pr2|0,ql 000162 aa 000000 0510 03 adwp1 0,du 000163 aa 7 00004 2515 20 spri1 pr7|4,* name_pt STATEMENT 1 ON LINE 119 return; 000164 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 126 std_obj: defp = spt -> pl1_stack_frame.linkage_ptr -> based_ptr; 000165 aa 6 00032 3735 20 epp7 pr6|26,* 000166 aa 7 00002 3715 20 epp5 pr7|2,* spt 000167 aa 5 00000 3715 20 epp5 pr5|0,* spt 000170 aa 5 00044 3535 20 epp3 pr5|36,* based_ptr 000171 aa 3 00000 3535 20 epp3 pr3|0,* based_ptr 000172 aa 6 00100 2535 00 spri3 pr6|64 defp STATEMENT 1 ON LINE 128 p = addrel (defp, p -> half.left); 000173 aa 3 00000 3515 01 epp1 pr3|0,au 000174 aa 000000 0510 03 adwp1 0,du 000175 ia 4 00010 2515 00 spri1 pr4|8 p STATEMENT 1 ON LINE 129 p = addrel (defp, p -> definition.symbol); 000176 aa 1 00002 2351 00 lda pr1|2 definition.symbol 000177 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 000200 aa 3 00000 3521 01 epp2 pr3|0,au 000201 aa 000000 0520 03 adwp2 0,du 000202 ia 4 00010 2521 00 spri2 pr4|8 p STATEMENT 1 ON LINE 131 name_size = fixed (p -> acc.length, 9); 000203 aa 2 00000 2351 00 lda pr2|0 acc.length 000204 aa 000077 7730 00 lrl 63 000205 aa 7 00006 7561 20 stq pr7|6,* name_size STATEMENT 1 ON LINE 132 name_pt = addr (p -> acc.string); 000206 aa 000001 7270 07 lxl7 1,dl 000207 aa 2 00000 5005 17 a9bd pr2|0,7 acc.string 000210 aa 7 00004 2521 20 spri2 pr7|4,* name_pt STATEMENT 1 ON LINE 134 end; 000211 aa 0 00631 7101 00 tra pr0|409 return_mac END PROCEDURE pl1_frame_ ----------------------------------------------------------- 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