COMPILATION LISTING OF SEGMENT setonsource Compiled by: Multics PL/I Compiler, Release 28d, of September 14, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 10/03/83 1441.9 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 setonsource: proc(str) options(support); 7 8 /* recoded by M. Weaver 1/14/74 for new pl1 signalling discipline */ 9 10 dcl str char(256) var; 11 12 dcl type fixed bin; 13 14 dcl (addr, null, substr) builtin; 15 dcl pl1_signal_$help_plio2_signal_ entry(char(*), ptr, fixed bin(35), char(256) var, fixed bin); 16 1 1 /* declarations for users of 1 2* ondata_$ 1 3*installed in >ldd>include>on_data_.incl.pl1 1 4*fixed up in PAB>others>on_data_.incl.pl1 1 5**/ 1 6 1 7 1 8 1 9 dcl ( 1 10 ondata_$ondatalength fixed bin(15), 1 11 ondata_$callersegname char(32) varying, 1 12 ondata_$callerpathname char(168) varying, 1 13 ondata_$calleroffset fixed bin(17), 1 14 ondata_$infoptr ptr, 1 15 ondata_$onreturnp ptr, 1 16 ondata_$this_file ptr, 1 17 ondata_$who char(4) aligned, 1 18 ondata_$handled fixed bin(15), 1 19 ondata_$file_related fixed bin(15), 1 20 ondata_$fileptr ptr, 1 21 ondata_$pliopsp ptr, 1 22 ondata_$datafield char(256) var, 1 23 ondata_$oncalled char(256) var, 1 24 ondata_$onfile char(32) var, 1 25 ondata_$onloc char(292) var, 1 26 ondata_$onsource char(256) var, 1 27 ondata_$onkey char(256) var, 1 28 ondata_$oncharindex fixed bin(15), 1 29 ondata_$onchar char(1000) aligned, 1 30 ondata_$oncode fixed bin(15), 1 31 ondata_$oncount fixed bin(15), 1 32 ondata_$plio_code fixed bin(15), 1 33 ondata_$condition_name char(32) var ) external; 17 18 2 1 /* BEGIN INCLUDE FILE ... condition_info.incl.pl1 */ 2 2 2 3 /* Structure for find_condition_info_. 2 4* 2 5* Written 1-Mar-79 by M. N. Davidoff. 2 6**/ 2 7 2 8 /* automatic */ 2 9 2 10 declare condition_info_ptr pointer; 2 11 2 12 /* based */ 2 13 2 14 declare 1 condition_info aligned based (condition_info_ptr), 2 15 2 mc_ptr pointer, /* pointer to machine conditions at fault time */ 2 16 2 version fixed binary, /* Must be 1 */ 2 17 2 condition_name char (32) varying, /* name of condition */ 2 18 2 info_ptr pointer, /* pointer to the condition data structure */ 2 19 2 wc_ptr pointer, /* pointer to wall crossing machine conditions */ 2 20 2 loc_ptr pointer, /* pointer to location where condition occured */ 2 21 2 flags unaligned, 2 22 3 crawlout bit (1), /* on if condition occured in lower ring */ 2 23 3 pad1 bit (35), 2 24 2 pad2 bit (36), 2 25 2 user_loc_ptr pointer, /* ptr to most recent nonsupport loc before condition occurred */ 2 26 2 pad3 (4) bit (36); 2 27 2 28 /* internal static */ 2 29 2 30 declare condition_info_version_1 2 31 fixed binary internal static options (constant) initial (1); 2 32 2 33 /* END INCLUDE FILE ... condition_info.incl.pl1 */ 19 20 declare 1 CI aligned like condition_info; 21 3 1 /* BEGIN INCLUDE FILE ... pl1_info.incl.pl1 */ 3 2 /* This is intended to be used by all procedures raising pl1 conditions and by the default handler */ 3 3 /* Created June 1981 by Benson I. Margulies from pl1_info_struc.incl.pl1 */ 3 4 /* This include file must be used with condition_info_header.incl.pl1. Both must be %included */ 3 5 3 6 declare pl1_info_ptr pointer; 3 7 declare 1 pl1_info aligned based (pl1_info_ptr), 3 8 2 header aligned like condition_info_header, 3 9 2 id char(8) aligned, /* init "pliocond"; indicates pl1 structure */ 3 10 2 content_flags aligned, 3 11 (3 v1_sw, /* on if raised by version 1 */ 3 12 3 oncode_sw, /* "1"b->valid oncode */ 3 13 3 onfile_sw, /* "1"b->file name is in structure */ 3 14 3 file_ptr_sw, /* "1"b->file is associated with this condition */ 3 15 3 onsource_sw, /* "1"b->valid onsource string for this condition */ 3 16 3 onchar_sw, /* "1"b->valid onchar index in this structure */ 3 17 3 onkey_sw, /* "1"b->valid onkey string in this structure */ 3 18 3 onfield_sw) bit(1) unaligned, /* "1"b->valid onfield string in this structure */ 3 19 2 oncode fixed bin(35), /* oncode for condition */ 3 20 2 onfile char(32) aligned, /* onfile string */ 3 21 2 file_ptr ptr, /* pointer to file value */ 3 22 2 onsource char(256) var, /* onsource string */ 3 23 2 oncharindex fixed bin, /* char offset in onsource of offending char */ 3 24 2 onkey_onfield char(256) var; /* either onkey string or onfield string */ 3 25 3 26 /* END INCLUDE FILE ... pl1_info.incl.pl1 */ 22 4 1 /* BEGIN INCLUDE FILE condition_info_header.incl.pl1 BIM 1981 */ 4 2 /* format: style2 */ 4 3 4 4 declare condition_info_header_ptr 4 5 pointer; 4 6 declare 1 condition_info_header 4 7 aligned based (condition_info_header_ptr), 4 8 2 length fixed bin, /* length in words of this structure */ 4 9 2 version fixed bin, /* version number of this structure */ 4 10 2 action_flags aligned, /* tell handler how to proceed */ 4 11 3 cant_restart bit (1) unaligned, /* caller doesn't ever want to be returned to */ 4 12 3 default_restart bit (1) unaligned, /* caller can be returned to with no further action */ 4 13 3 quiet_restart bit (1) unaligned, /* return, and print no message */ 4 14 3 support_signal bit (1) unaligned, /* treat this signal as if the signalling procedure had the support bit set */ 4 15 /* if the signalling procedure had the support bit set, do the same for its caller */ 4 16 3 pad bit (32) unaligned, 4 17 2 info_string char (256) varying, /* may contain printable message */ 4 18 2 status_code fixed bin (35); /* if^=0, code interpretable by com_err_ */ 4 19 4 20 /* END INCLUDE FILE condition_info_header.incl.pl1 */ 23 24 25 /* */ 26 /* This procedure must change the onsource string in both the old ondata_ 27* segment and in the relevant structure. 28* If there is no relevant structure to change, the calling procedure is in error */ 29 30 type = 1; /* indicate onsource */ 31 if find_struc() then do; /* true if relevant struc()ture found */ 32 ondata_$onsource = str; /* set in old way */ 33 pl1_info.onsource = str; /* set in new way */ 34 return; 35 end; 36 37 sig_err: /* no relevant structure found */ 38 call pl1_signal_$help_plio2_signal_("error", null, 170, "", 0); 39 return; 40 41 42 set_onchar: entry(ch); 43 44 dcl ch char(1); 45 46 type = 2; /* indicate onchar */ 47 if find_struc() then do; 48 substr(ondata_$onsource, ondata_$oncharindex-3, 1) = ch; 49 substr(pl1_info.onsource, pl1_info.oncharindex, 1) = ch; 50 return; 51 end; 52 53 go to sig_err; 54 55 /* */ 56 find_struc: proc() returns(bit(1) aligned); 57 58 /* internal procedure to find the info structure associated with the 59* most recent condition to set onsource/onchar */ 60 61 dcl code fixed bin(35); 62 dcl (nsp, sp) ptr; 63 dcl find_condition_frame_ entry(ptr) returns(ptr); 64 dcl find_condition_info_ entry(ptr, ptr, fixed bin(35)); 65 66 nsp, sp = null; 67 next_frame: 68 nsp = find_condition_frame_(sp); /* look for the next condition frame */ 69 if nsp = null then return("0"b); /* can't even find frame */ 70 call find_condition_info_(nsp, addr(CI), code); 71 if code ^= 0 then return("0"b); /* something must be wrong; stop here */ 72 73 pl1_info_ptr = CI.info_ptr; 74 if pl1_info_ptr ^= null 75 then if pl1_info.id = "pliocond" then do; /* have a pl1 structure */ 76 if type = 1 then if pl1_info.onsource_sw then return("1"b); 77 if type = 2 then if pl1_info.onchar_sw then return("1"b); 78 end; 79 80 sp = nsp; 81 go to next_frame; /* look for next */ 82 83 end; 84 85 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/03/83 1247.9 setonsource.pl1 >spec>on>pl128d>setonsource.pl1 17 1 05/06/74 1742.5 on_data_.incl.pl1 >ldd>include>on_data_.incl.pl1 19 2 06/28/79 1204.8 condition_info.incl.pl1 >ldd>include>condition_info.incl.pl1 22 3 07/18/81 1100.0 pl1_info.incl.pl1 >ldd>include>pl1_info.incl.pl1 23 4 03/24/82 1347.2 condition_info_header.incl.pl1 >ldd>include>condition_info_header.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. CI 000102 automatic structure level 1 dcl 20 set ref 70 70 addr builtin function dcl 14 ref 70 70 ch parameter char(1) unaligned dcl 44 ref 42 48 49 code 000144 automatic fixed bin(35,0) dcl 61 set ref 70* 71 condition_info based structure level 1 dcl 2-14 condition_info_header based structure level 1 dcl 4-6 content_flags 107 based structure level 2 dcl 3-7 find_condition_frame_ 000016 constant entry external dcl 63 ref 67 find_condition_info_ 000020 constant entry external dcl 64 ref 70 id 105 based char(8) level 2 dcl 3-7 ref 74 info_ptr 14 000102 automatic pointer level 2 dcl 20 set ref 73 nsp 000146 automatic pointer dcl 62 set ref 66* 67* 69 70* 80 null builtin function dcl 14 ref 37 37 66 69 74 onchar_sw 107(05) based bit(1) level 3 packed unaligned dcl 3-7 ref 77 oncharindex 225 based fixed bin(17,0) level 2 dcl 3-7 ref 49 ondata_$oncharindex 000014 external static fixed bin(15,0) dcl 1-9 ref 48 ondata_$onsource 000012 external static varying char(256) dcl 1-9 set ref 32* 48* onsource 124 based varying char(256) level 2 dcl 3-7 set ref 33* 49* onsource_sw 107(04) based bit(1) level 3 packed unaligned dcl 3-7 ref 76 pl1_info based structure level 1 dcl 3-7 pl1_info_ptr 000134 automatic pointer dcl 3-6 set ref 33 49 49 73* 74 74 76 77 pl1_signal_$help_plio2_signal_ 000010 constant entry external dcl 15 ref 37 sp 000150 automatic pointer dcl 62 set ref 66* 67* 80* str parameter varying char(256) dcl 10 ref 6 32 33 substr builtin function dcl 14 set ref 48* 49* type 000100 automatic fixed bin(17,0) dcl 12 set ref 30* 46* 76 77 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. condition_info_header_ptr automatic pointer dcl 4-4 condition_info_ptr automatic pointer dcl 2-10 condition_info_version_1 internal static fixed bin(17,0) initial dcl 2-30 ondata_$calleroffset external static fixed bin(17,0) dcl 1-9 ondata_$callerpathname external static varying char(168) dcl 1-9 ondata_$callersegname external static varying char(32) dcl 1-9 ondata_$condition_name external static varying char(32) dcl 1-9 ondata_$datafield external static varying char(256) dcl 1-9 ondata_$file_related external static fixed bin(15,0) dcl 1-9 ondata_$fileptr external static pointer dcl 1-9 ondata_$handled external static fixed bin(15,0) dcl 1-9 ondata_$infoptr external static pointer dcl 1-9 ondata_$oncalled external static varying char(256) dcl 1-9 ondata_$onchar external static char(1000) dcl 1-9 ondata_$oncode external static fixed bin(15,0) dcl 1-9 ondata_$oncount external static fixed bin(15,0) dcl 1-9 ondata_$ondatalength external static fixed bin(15,0) dcl 1-9 ondata_$onfile external static varying char(32) dcl 1-9 ondata_$onkey external static varying char(256) dcl 1-9 ondata_$onloc external static varying char(292) dcl 1-9 ondata_$onreturnp external static pointer dcl 1-9 ondata_$plio_code external static fixed bin(15,0) dcl 1-9 ondata_$pliopsp external static pointer dcl 1-9 ondata_$this_file external static pointer dcl 1-9 ondata_$who external static char(4) dcl 1-9 NAMES DECLARED BY EXPLICIT CONTEXT. find_struc 000157 constant entry internal dcl 56 ref 31 47 next_frame 000164 constant label dcl 67 ref 81 set_onchar 000123 constant entry external dcl 42 setonsource 000021 constant entry external dcl 6 sig_err 000056 constant label dcl 37 ref 53 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 402 424 274 412 Length 662 274 22 222 105 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME setonsource 216 external procedure is an external procedure. find_struc internal procedure shares stack frame of external procedure setonsource. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME setonsource 000100 type setonsource 000102 CI setonsource 000134 pl1_info_ptr setonsource 000144 code find_struc 000146 nsp find_struc 000150 sp find_struc THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry set_support THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. find_condition_frame_ find_condition_info_ pl1_signal_$help_plio2_signal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. ondata_$oncharindex ondata_$onsource LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000016 30 000027 31 000031 32 000036 33 000047 34 000055 37 000056 39 000117 42 000120 46 000131 47 000133 48 000140 49 000150 50 000155 53 000156 56 000157 66 000161 67 000164 69 000175 70 000204 71 000221 73 000226 74 000230 76 000241 77 000253 80 000264 81 000266 ----------------------------------------------------------- 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