COMPILATION LISTING OF SEGMENT tedglobal_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/23/82 1044.7 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 7 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ 8 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ 9 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ 10 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ 11 12 proc_expr: /* process the expression for global execution */ 13 proc (ted_support_p, msg, code); /* of an external function */ 14 15 dcl msg char (168) var, 16 code fixed bin (35); 17 18 code = 0; 19 if db_glob 20 then call ioa_ (">proc rchr(^i)=`^1a' de=^i", req.cc, rchr (req.cc), 21 req.de); 22 loop1: 23 delim = rchr (req.cc); /* pick up str delimiter */ 24 if (delim = " ") 25 then do; 26 req.cc = req.cc + 1; 27 goto loop1; 28 end; 29 if (delim = NL) 30 then do; 31 code = tederror_table_$No_Delim1; 32 return; 33 end; 34 35 expr_b = req.cc + 1; 36 concealsw = "0"b; 37 do req.cc = req.cc + 1 to req.de; /* try to find end of str1 */ 38 if ^concealsw 39 then do; 40 ch = rchr (req.cc); 41 if (ch = delim) 42 then goto sub1; 43 if (ch = "\") 44 then do; 45 if (rchr (req.cc + 1) = "c") 46 | (rchr (req.cc + 1) = "C") 47 then do; 48 req.cc = req.cc + 1; 49 concealsw = "1"b; 50 end; 51 end; 52 end; 53 else concealsw = "0"b; 54 end; 55 56 code = tederror_table_$No_Delim2; /* no end of string */ 57 return; 58 59 sub1: 60 expr_l = req.cc - expr_b; 61 if (expr_l > 0) 62 then call tedsrch_$compile (addr (rchr (expr_b)), expr_l, 63 ted_support.reg_exp_p, (ted_support.string_mode), ""b, msg, code); 64 65 /* req.nc now points to 2nd delim */ 66 67 if db_glob 68 then call ioa_ ("do sb=^i se=^i ln=^i", inp.sb, inp.se, inp.lno); 83 gb_loop: 84 inp.sb = gb_sb; 85 i = index ( /* then find end of it */ 86 substr (istr, gb_sb, gb_se - gb_sb + 1), NL); 87 if (i = 0) /* worry about no NL at EOB */ 88 then inp.se = gb_se; 89 else inp.se = gb_sb + i - 1; 90 if db_glob 91 then call ioa_ ("-do sb=^i se=^i ln=^i", inp.sb, inp.se, inp.lno); 92 gb_sb = inp.se + 1; /* keep beginning of next line.. */ 93 /* search line for REGEXP */ 94 call tedsrch_$search (ted_support.reg_exp_p, ted_support.bcb_p, 95 inp.sb, inp.se, 0, 0, 0, /* don't care what match was */ 96 msg, code); 97 if (code = 2) 98 then do; 99 code = tederror_table_$Error_Msg; 100 return; 101 end; 102 if xsw = (code ^= 0) /* ^match w/ exclude request */ 103 then do; /* OR match w/ global request */ 104 /* this line is to be processed */ 105 code = 0; 106 call worker; 107 if (code ^= 0) 108 then return; 109 end; 110 else do; 111 i = inp.se - inp.sb + 1; 112 substr (ostr, out.de + 1, i) = substr (istr, inp.sb, i); 113 out.de = out.de + i; 114 end; 115 ted_support.inp.lno = ted_support.inp.lno + 1; 116 if (gb_sb <= gb_se) 117 then goto gb_loop; 118 code = 0; 119 if db_glob 120 then call ioa_ (" ted_support structure [IN] */ 1 51 char (168) var, /* message text [OUT] */ 1 52 fixed bin (35)), /* completion code [OUT] */ 1 53 2 do_global entry /* globally execute some action */ 1 54 (entry (), /* worker procedure [IN] */ 1 55 char (1), /* which action, "g" or "v" [IN] */ 1 56 ptr, /* -> ted_support structure [IN] */ 1 57 char (168) var, /* message text [OUT] */ 1 58 fixed bin (35)), /* completion code [OUT] */ 1 59 2 reg_exp_p ptr, /* -> the remembered regular expression area */ 1 60 2 bcb_p ptr; /* -> buffer control block */ 1 61 /* _________________________________________________________________________ */ 1 62 /* ENTRY CONDITIONS */ 1 63 /* _________________________________________________________________________ */ 1 64 /* Upon entering, three substructures describe the environment in which the */ 1 65 /* request is to operate. (Refer to the INPUT diagram) Note that the */ 1 66 /* "normal" operational steps are: */ 1 67 /* 1) ted copies the string from 1:inp.sb-1 to the output string */ 1 68 /* 2) ted_xyz_ takes care of the data from inp.sb:inp.se */ 1 69 /* 3) ted copies the string from inp.se+1:inp.de to the output string */ 1 70 /* The following 3 diagrams represent conditions upon entering ted_xyz_: */ 1 71 /* _________________________________________________________________________ */ 1 72 /* inp.pt (\ represents NL) */ 1 73 /* | */ 1 74 /* [INPUT] now is\the time\for all\good men\to come.\..... */ 1 75 /* | | | */ 1 76 /* inp.sb inp.se inp.de */ 1 77 /* _________________________________________________________________________ */ 1 78 /* out.pt (\ represents NL) */ 1 79 /* | */ 1 80 /* [OUTPUT] ? now is\........................................ */ 1 81 /* | | | */ 1 82 /* current out.de out.ml */ 1 83 /* _________________________________________________________________________ */ 1 84 /* req.pt (\ represents NL) */ 1 85 /* | */ 1 86 /* [REQUEST] x 2,3|req /farfle/ 1,$P\....................... */ 1 87 /* | | | */ 1 88 /* req.cc req.de req.ml */ 1 89 /* req.nc */ 1 90 1 91 /* _________________________________________________________________________ */ 1 92 /* EXIT CONDITIONS */ 1 93 /* _________________________________________________________________________ */ 1 94 /* Assume a request replaces the addressed lines with the string following */ 1 95 /* it, (in this case "farfle") and leaves "." at the beginning of the range. */ 1 96 /* out.pt (\ represents NL) */ 1 97 /* | */ 1 98 /* [OUTPUT] now is\farfle\farfle\.......................... */ 1 99 /* | | | */ 1 100 /* current out.de out.ml */ 1 101 /* _________________________________________________________________________ */ 1 102 /* 1) If the data after the string are to be treated as more ted requests, */ 1 103 /* the request data would be left like this. */ 1 104 /* req.pt (\ represents NL) */ 1 105 /* | */ 1 106 /* [REQUEST] x 2,3|req /farfle/ 1,$P\....................... */ 1 107 /* | | | */ 1 108 /* req.nc req.de req.ml */ 1 109 /* _________________________________________________________________________ */ 1 110 /* 2) If the request is going to return a string to be executed, the request */ 1 111 /* data (and buffer) would be left like this: */ 1 112 /* req.pt (\ represents NL) */ 1 113 /* | */ 1 114 /* [REQUEST] -1,.1p w\ /farfle/ 1,$P\....................... */ 1 115 /* | | | */ 1 116 /* req.nc req.de req.ml */ 1 117 1 118 /* These return codes are expected */ 1 119 dcl (tederror_table_$Copy_Set,/* copy rest of input to output, */ 1 120 /* and set "." from current */ 1 121 /* "rest of input" is the string which begins */ 1 122 /* at char inp.se+1 and extends to inp.de. */ 1 123 /* If the input has all been processed, then */ 1 124 /* inp.se should be set to inp.de+1. */ 1 125 tederror_table_$NoChange,/* dont copy, dont set current */ 1 126 tederror_table_$Set, /* dont copy, just set current */ 1 127 /* (in input buffer) */ 1 128 tederror_table_$Error_Msg,/* msg is being returned. */ 1 129 /* no copy or set is done */ 1 130 tederror_table_$No_Delim1,/* missing 1st delimiter */ 1 131 tederror_table_$No_Delim2,/* missing 2nd delimiter */ 1 132 tederror_table_$No_Delim3)/* missing 3nd delimiter */ 1 133 fixed bin(35)ext static; 1 134 dcl error_table_$unimplemented_version fixed bin(35) ext static; 1 135 1 136 dcl istr char(inp.de) based(inp.pt); /* the input string */ 1 137 dcl ichr(inp.de) char(1) based(inp.pt); 1 138 dcl ostr char(out.ml) based(out.pt); /* the output string */ 1 139 dcl ochr(out.ml) char(1) based(out.pt); 1 140 dcl rstr char(req.ml) based(req.pt); /* the request string */ 1 141 dcl rchr(req.ml) char(1) based(req.pt); 1 142 1 143 /* These declarations are used if the expression search is needed by the */ 1 144 /* request. There are 2 parts to getting an expression search done: */ 1 145 /* 1) compiling 2) searching */ 1 146 /* If a function uses the remembered expression, it does this: */ 1 147 /* call tedsrch_$search (ted_support.reg_exp_p, */ 1 148 /* ted_support.bcbp, string_begin, string_end, match_begin, */ 1 149 /* match_end, search_end, msg, code); */ 1 150 1 151 /* If a function utilizes an expression the user supplies, it must first be */ 1 152 /* compiled: 1 153*/* if (expression_length > 0) */ 1 154 /* then call tedsrch_$compile (addr (ichr (expression_begin)), */ 1 155 /* expression_length, ted_support.reg_exp_p, */ 1 156 /* ted_support.string_mode, ""b, msg, code); */ 1 157 /* This results in the remembered expression being changed to the one just */ 1 158 /* compiled. */ 1 159 1 160 /* If a function wishes to utilize a function without it being remembered */ 1 161 /* by ted, it may declare an area of its own and compile into it. It first */ 1 162 /* must be initialized: */ 1 163 /* dcl expr_area (200) bit (36); */ 1 164 /* call tedsrch_$init_exp (addr (expr_area), size (expr_area)); */ 2 1 /* BEGIN INCLUDE FILE ..... tedsrch_.incl.pl1 ..... 10/21/82 J Falksen */ 2 2 2 3 dcl tedsrch_$init_exp entry ( /* initialize an expression area */ 2 4 ptr, /* -> compiled expression area [IN] */ 2 5 fixed bin (21)); /* length of area in words */ 2 6 2 7 dcl tedsrch_$compile entry ( /* compile a regular expression */ 2 8 ptr, /* -> regular expression to search */ 2 9 fixed bin (21), /* length thereof */ 2 10 ptr, /* -> compiled expression area [IN] */ 2 11 bit (1)aligned, /* 0- line mode 1- string mode */ 2 12 bit (1)aligned, /* 0- reg expr 1- literal expr */ 2 13 char (168) var, /* error message [OUT] */ 2 14 fixed bin (35) /* error status code [OUT] */ 2 15 ); 2 16 2 17 dcl tedsrch_$search entry ( /* search for expression */ 2 18 ptr, /* -> compiled expression */ 2 19 ptr, /* -> buffer ctl block for file */ 2 20 fixed bin (21), /* beginning of string to search */ 2 21 fixed bin (21), /* end of string to search */ 2 22 fixed bin (21), /* beginning of match */ 2 23 fixed bin (21), /* end of match */ 2 24 fixed bin (21), /* end of string used for match */ 2 25 char (168)var, /* error message return [OUT] */ 2 26 fixed bin (35) /* error status code [OUT] */ 2 27 ); 2 28 2 29 2 30 /* END INCLUDE FILE ..... tedsrch_.incl.pl1 ..... */ 1 165 1 166 1 167 /* END INCLUDE FILE ..... ted_support.incl.pl1 ..... */ 136 137 138 dcl 1 tedcommon_$etc ext static, 139 2 unused fixed bin (24), 140 2 com_blank bit (1) aligned, 141 2 com1_blank bit (1) aligned, 142 2 caps bit (1) aligned, 143 2 sws, 144 3 db_ted bit (1) aligned, 145 3 db_addr bit (1) aligned, 146 3 db_eval bit (1) aligned, 147 3 db_sort bit (1) aligned, 148 3 db_zproc bit (1) aligned, 149 3 db_gv bit (1) aligned, 150 3 db_util bit (1) aligned, 151 3 db_srch bit (1) aligned, 152 3 db_glob bit (1) aligned, 153 3 db_sp1 bit (1) aligned, 154 2 not_used fixed bin, 155 2 not_used2 bit (1) aligned, 156 2 reset_read bit (1) aligned; 157 158 end proc_expr; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/22/82 1525.4 tedglobal_.pl1 >spec>on>11/22/82>tedglobal_.pl1 136 1 11/22/82 1523.2 ted_support.incl.pl1 >spec>on>11/22/82>ted_support.incl.pl1 1-165 2 11/22/82 1523.2 tedsrch_.incl.pl1 >spec>on>11/22/82>tedsrch_.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. NL constant char(1) initial unaligned dcl 132 ref 29 85 bcb_p 46 based pointer level 2 dcl 1-7 set ref 94* cc 22 based fixed bin(21,0) level 3 dcl 1-7 set ref 19* 19 22 26* 26 35 37* 37* 40 45 45 48* 48* 59 67* 67 ch 000101 automatic char(1) unaligned dcl 124 set ref 40* 41 43 code parameter fixed bin(35,0) dcl 15 set ref 12 18* 31* 56* 61* 71 77* 94* 97 99* 102 105* 107 118* concealsw 000100 automatic bit(1) unaligned dcl 123 set ref 36* 38 49* 53* db_glob 14 000024 external static bit(1) level 3 dcl 138 ref 19 67 81 90 119 de 24 based fixed bin(21,0) level 3 in structure "ted_support" dcl 1-7 in procedure "proc_expr" set ref 19* 37 67* de 16 based fixed bin(21,0) level 3 in structure "ted_support" dcl 1-7 in procedure "proc_expr" set ref 112 113* 113 de 13 based fixed bin(21,0) level 3 in structure "ted_support" dcl 1-7 in procedure "proc_expr" ref 85 112 delim 000102 automatic char(1) unaligned dcl 125 set ref 22* 24 29 41 expr_b 000103 automatic fixed bin(21,0) dcl 126 set ref 35* 59 61 61 expr_l 000104 automatic fixed bin(21,0) dcl 127 set ref 59* 61 61* gb_sb 000105 automatic fixed bin(21,0) dcl 128 set ref 79* 83 85 85 89 92* 116 gb_se 000106 automatic fixed bin(21,0) dcl 129 set ref 80* 85 87 116 i 000107 automatic fixed bin(21,0) dcl 130 set ref 85* 87 89 111* 112 112 113 inp 6 based structure level 2 unaligned dcl 1-7 ioa_ 000010 constant entry external dcl 134 ref 19 67 81 90 119 istr based char unaligned dcl 1-136 ref 85 112 lno 11 based fixed bin(21,0) level 3 dcl 1-7 set ref 81* 90* 115* 115 119* ml 17 based fixed bin(21,0) level 3 dcl 1-7 ref 112 mode parameter char(1) unaligned dcl 74 ref 71 78 msg parameter varying char(168) dcl 15 set ref 12 61* 71 94* ostr based char unaligned dcl 1-138 set ref 112* out 14 based structure level 2 unaligned dcl 1-7 pt 14 based pointer level 3 in structure "ted_support" dcl 1-7 in procedure "proc_expr" ref 112 pt 6 based pointer level 3 in structure "ted_support" dcl 1-7 in procedure "proc_expr" ref 85 112 pt 20 based pointer level 3 in structure "ted_support" dcl 1-7 in procedure "proc_expr" ref 19 22 40 45 45 61 61 67 rchr based char(1) array unaligned dcl 1-141 set ref 19* 22 40 45 45 61 61 67* reg_exp_p 44 based pointer level 2 dcl 1-7 set ref 61* 94* req 20 based structure level 2 unaligned dcl 1-7 sb 10 based fixed bin(21,0) level 3 dcl 1-7 set ref 79 81* 83* 90* 94* 111 112 119* se 12 based fixed bin(21,0) level 3 dcl 1-7 set ref 80 81* 87* 89* 90* 92 94* 111 119* string_mode 26 based bit(1) level 2 packed unaligned dcl 1-7 ref 61 sws 4 000024 external static structure level 2 unaligned dcl 138 ted_support based structure level 1 unaligned dcl 1-7 ted_support_p parameter pointer dcl 1-5 ref 12 19 19 19 19 22 22 26 26 35 37 37 37 40 40 45 45 45 45 48 48 59 61 61 61 61 67 67 67 67 71 79 80 81 81 81 83 85 85 87 89 90 90 90 92 94 94 94 94 111 111 112 112 112 112 112 112 113 113 115 115 119 119 119 tedcommon_$etc 000024 external static structure level 1 unaligned dcl 138 tederror_table_$Error_Msg 000012 external static fixed bin(35,0) dcl 1-119 ref 99 tederror_table_$No_Delim1 000014 external static fixed bin(35,0) dcl 1-119 ref 31 tederror_table_$No_Delim2 000016 external static fixed bin(35,0) dcl 1-119 ref 56 tedsrch_$compile 000020 constant entry external dcl 2-7 ref 61 tedsrch_$search 000022 constant entry external dcl 2-17 ref 94 worker parameter entry variable dcl 74 ref 71 106 xsw 000110 automatic bit(1) unaligned dcl 131 set ref 78* 102 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_table_$unimplemented_version external static fixed bin(35,0) dcl 1-134 ichr based char(1) array unaligned dcl 1-137 ochr based char(1) array unaligned dcl 1-139 rstr based char unaligned dcl 1-140 ted_support_version_2 internal static fixed bin(17,0) initial dcl 1-6 tederror_table_$Copy_Set external static fixed bin(35,0) dcl 1-119 tederror_table_$NoChange external static fixed bin(35,0) dcl 1-119 tederror_table_$No_Delim3 external static fixed bin(35,0) dcl 1-119 tederror_table_$Set external static fixed bin(35,0) dcl 1-119 tedsrch_$init_exp 000000 constant entry external dcl 2-3 NAMES DECLARED BY EXPLICIT CONTEXT. do_global 000345 constant entry external dcl 71 gb_loop 000433 constant label dcl 83 set ref 116 loop1 000132 constant label dcl 22 ref 27 proc_expr 000054 constant entry external dcl 12 sub1 000236 constant label dcl 59 ref 41 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 61 61 index builtin function ref 85 substr builtin function set ref 85 112* 112 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1006 1034 672 1016 Length 1246 672 26 176 114 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME proc_expr 134 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME proc_expr 000100 concealsw proc_expr 000101 ch proc_expr 000102 delim proc_expr 000103 expr_b proc_expr 000104 expr_l proc_expr 000105 gb_sb proc_expr 000106 gb_se proc_expr 000107 i proc_expr 000110 xsw proc_expr THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as call_var call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_ tedsrch_$compile tedsrch_$search THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. tedcommon_$etc tederror_table_$Error_Msg tederror_table_$No_Delim1 tederror_table_$No_Delim2 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 12 000050 18 000070 19 000071 22 000132 24 000142 26 000145 27 000146 29 000147 31 000151 32 000154 35 000155 36 000160 37 000161 38 000174 40 000176 41 000206 43 000211 45 000213 48 000223 49 000224 52 000226 53 000227 54 000230 56 000232 57 000235 59 000236 61 000240 67 000275 70 000337 71 000340 77 000361 78 000362 79 000371 80 000375 81 000377 83 000433 85 000437 87 000455 89 000461 90 000464 92 000520 94 000525 97 000557 99 000562 100 000565 102 000566 105 000572 106 000573 107 000600 109 000602 111 000603 112 000611 113 000623 115 000625 116 000630 118 000633 119 000634 121 000670 ----------------------------------------------------------- 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