COMPILATION LISTING OF SEGMENT delete_symbols Compiled by: Multics PL/I Compiler, Release 26a, of September 3, 1980 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 01/06/81 1246.9 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems * 5* * Inc., 1980. * 6* * * 7* * * 8* ****************************************************** */ 9 10 delete_symbols: dsb: procedure; 11 12 /* This procedure implements the delete_symbols command. 13* * Created on 10/15/75 by Bill Silver as delete_notescript. 14* * Changed on 06/07/77 by Bill Silver to delete_symbols. 15* * Changed on 10/28/80 by Paul Benjamin for special suffixing. 16* * 17* * The delete_symbols command will delete one or more symbols from 18* * the current Speedtype symbol dictinary. Its calling sequence is: 19* * 20* * delete_symbols, dsb symbols 21**/ 22 23 dcl arg_len fixed bin; /* Length of symbol argument. */ 24 dcl arg_ptr ptr; /* Pointer to symbol argument. */ 25 dcl argx fixed bin; /* Index of current argument. */ 26 dcl del_exp_ptr ptr; /* Pointer to expansion being deleted. */ 27 dcl del_sb_ptr ptr; /* Pointer to symbol being deleted. */ 28 dcl del_spc_ptr ptr; /* Pointer to special entry being deleted. */ 29 dcl dir_name char (168); /* Directory containing symbol dict. */ 30 dcl ecode fixed bin (35); /* Error table code. */ 31 dcl ent_name char (32); /* Symbol dictionary. */ 32 dcl i fixed bin; 33 dcl sbx fixed bin; /* Symbol entry index. */ 34 dcl temp_code fixed bin (35); /* Used when already hav non-zero ecode. */ 35 dcl num_args fixed bin; /* Number of command arguments. */ 36 37 dcl argument char (arg_len) based (arg_ptr); /* Command argument. */ 38 39 dcl (addr, hbound, unspec) builtin; 40 41 dcl error_table_$no_w_permission fixed bin(35) ext static; 42 dcl error_table_$wrong_no_of_args fixed bin (35) external; 43 44 dcl com_err_ entry options (variable); 45 dcl cu_$arg_count entry (fixed bin); 46 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 47 dcl speedtype_index_ entry (char (*), ptr, fixed bin, fixed bin (35)); 48 dcl speedtype_info_$name entry (char(168), char(32), fixed bin(35)); 49 dcl speedtype_info_$pointer entry (ptr, fixed bin (35)); 50 dcl speedtype_info_$set_bc entry (ptr, fixed bin (35)); 51 dcl speedtype_info_$shrink_table entry (ptr, fixed bin(35)); 52 /* */ 1 1 /* Begin include file ... speedtype_symbols.incl.pl1 1 2** Created on 09/06/76 by Bill Silver. 1 3** Modified 06/03/80 by Paul Benjamin to allow special suffixing. 1 4** 1 5** This include file defines the format of a Speedtype Symbol Dictionary. 1 6** The default Speedtype options are: 1 7** 1 8** ESCAPES: 1 9** temp "~" pad (Octal 177) perm "`" trans ":" space ";" 1 10** PREFIXES: 1 11** under "_" upper "+" 1 12** SUFFIXES: 1 13** plural "+" ed "-" ing "*" er "=" ly "|" 1 14** DELIMITERS: 1 15** ,"()?!<>[]{} 1 16**/ 1 17 dcl ssd_ptr ptr; /* Pointer to the base of a Speedtype Symbol Dictionary. */ 1 18 dcl exp_ptr ptr; /* Pointer to an expansion entry. */ 1 19 dcl sb_ptr ptr; /* Pointer to a symbol entry. */ 1 20 dcl spc_ptr ptr; /* Pointer to a special entry. */ 1 21 dcl delim_ptr ptr; /* Pointer to delimiter characters. */ 1 22 1 23 dcl ssd_version_2 fixed bin /* Version of this include file. */ 1 24 internal static init (2); 1 25 1 26 dcl 1 ssd based(ssd_ptr) aligned, /* Format of a Speedtype Symbol Dictionary. */ 1 27 2 version fixed bin, /* Version number. Currently = 2. */ 1 28 2 identifier char(12), /* "Seedtype_SD" => this is a Speedtype Symbol Dictionary. */ 1 29 2 flags bit(36), /* Not used, all zero. */ 1 30 2 delimiters char(24), /* Blank, New Line, Tab, Escapes, Others. */ 1 31 2 escapes char(5), /* Pad, Perm, Temp, Trans, Space */ 1 32 2 prefixes char(2), /* Under, Upper. */ 1 33 2 suffixes char(5), /* Plural, ed, ing, er, ly. */ 1 34 2 num_symbols fixed bin, /* Number of defined symbols. */ 1 35 2 table_size fixed bin, /* Size of the 3 tables to follow. */ 1 36 2 pad(14) bit(36), /* Round out header to 32 words. */ 1 37 2 spec_tab(table_size) like spc, /* Special entries. */ 1 38 2 exp_tab(table_size) like exp, /* Expansion entries. */ 1 39 2 sb_tab(table_size) like sb; /* Symbol entries. */ 1 40 1 41 dcl 1 delim_chars based(delim_ptr) aligned, /* Overlay of ssd.delimiters. */ 1 42 ( 2 blank char(1), 1 43 2 new_line char(1), 1 44 2 tab char(1), 1 45 2 escapes char(5), 1 46 2 others char(16)) unaligned; 1 47 1 48 dcl 1 sb based(sb_ptr) aligned, /* Symbol entry. */ 1 49 ( 2 new_line char(1), /* Needed to make index functions work. */ 1 50 2 symbol char(7)) unal; /* Actual symbol string. */ 1 51 1 52 dcl 1 exp based(exp_ptr) aligned, /* Expansion entry. */ 1 53 ( 2 actionx(5) fixed bin(8), /* Action index for each suffix. */ 1 54 2 pad fixed bin(17), /* Reserved for additional suffixes, flags, etc.. */ 1 55 2 len fixed bin(8), /* Actual length of expansion. */ 1 56 2 expansion char(56)) unal; /* Expansion of string (56 => size(exp) = 16 words). */ 1 57 dcl 1 spc based(spc_ptr) aligned, /* Special entry. */ 1 58 2 special (5) char(56) unal; /* One for each possible suffix. */ 1 59 1 60 /* End include file ... speedtype_symbols.incl.pl1 */ 53 54 /* */ 55 /* Begin delete_symbols command. 56**/ 57 call speedtype_info_$pointer (ssd_ptr, ecode); 58 if ecode ^= 0 /* Did we get a pointer to symbol dictionary? */ 59 then do; /* No. */ 60 if ecode = error_table_$no_w_permission 61 then do; 62 call speedtype_info_$name (dir_name, ent_name, temp_code); 63 call com_err_ (ecode, "Speedtype", "Attempting to convert ^a>^a to new version.", dir_name, ent_name); 64 end; 65 return; 66 end; 67 68 call cu_$arg_count (num_args); /* Check calling sequence. */ 69 if num_args = 0 70 then do; 71 call com_err_ (error_table_$wrong_no_of_args, "Speedtype", 72 "Usage is: dsb symbols"); 73 return; 74 end; 75 76 do argx = 1 to num_args; /* Process each argument. */ 77 call DELETE_SYMBOL; /* It is a symbol to be deleted. */ 78 if ecode ^= 0 then return; /* Stop if any error. */ 79 end; 80 81 call speedtype_info_$set_bc (ssd_ptr, ecode); 82 83 return; 84 /* */ 85 DELETE_SYMBOL: procedure; 86 87 /* This procedure is called to get and delete one symbols. 88* * We will call speedtype_index_ to get the symbol entry index 89* * that corresponds to this symbol. 90**/ 91 call cu_$arg_ptr (argx, arg_ptr, arg_len, ecode); 92 if ecode ^= 0 93 then do; 94 call com_err_ (ecode, "Speedtype", "Error getting symbol argument"); 95 return; 96 end; 97 98 call speedtype_index_ (argument, ssd_ptr, sbx, ecode); 99 if ecode ^= 0 /* Was it a valid symbol? */ 100 then return; /* No. */ 101 102 if sbx = 0 /* Is it defined? */ 103 then do; /* No. */ 104 call com_err_ (0, "Speedtype", """^a"" not defined", argument); 105 return; 106 end; 107 108 del_sb_ptr = addr (ssd.sb_tab (sbx)); /* Get pointer to symbol being deleted. */ 109 del_exp_ptr = addr (ssd.exp_tab (sbx)); /* And corresponding expansion entry. */ 110 del_spc_ptr = addr (ssd.spec_tab (sbx)); /* AND corresponding special entry. */ 111 sb_ptr = addr (ssd.sb_tab (ssd.num_symbols)); /* Get pointer to last symbol entry. */ 112 exp_ptr = addr (ssd.exp_tab (ssd.num_symbols)); /* And corresponding expansion entry. */ 113 spc_ptr = addr (ssd.spec_tab (ssd.num_symbols)); /* AND corresponding special entry. */ 114 115 del_sb_ptr -> sb.symbol = " "; /* Blank deleted symbol. */ 116 117 del_exp_ptr -> exp = exp; /* Replace expansion with last expansion. */ 118 del_spc_ptr -> spc = spc; /* Replace special with last special. */ 119 del_sb_ptr -> sb = sb; /* Now replace symbol. */ 120 121 ssd.num_symbols = ssd.num_symbols - 1; /* Last entry no longer defined. */ 122 123 unspec (exp) = "0"b; /* Zero last entries. */ 124 unspec (spc) = "0"b; 125 unspec (sb) = "0"b; /* This may gain back a page of quota. */ 126 127 if mod (ssd.num_symbols, 100) < mod (ssd.num_symbols - 1, 100) 128 then call speedtype_info_$shrink_table (ssd_ptr, ecode); 129 130 end DELETE_SYMBOL; 131 132 end delete_symbols; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/06/81 1246.9 delete_symbols.pl1 >spec>on>speed>delete_symbols.pl1 53 1 11/14/80 1152.8 speedtype_symbols.incl.pl1 >ldd>include_1>speedtype_symbols.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 39 ref 108 109 110 111 112 113 arg_len 000100 automatic fixed bin(17,0) dcl 23 set ref 91* 98 98 104 104 arg_ptr 000102 automatic pointer dcl 24 set ref 91* 98 104 argument based char unaligned dcl 37 set ref 98* 104* argx 000104 automatic fixed bin(17,0) dcl 25 set ref 76* 91* com_err_ 000014 constant entry external dcl 44 ref 63 71 94 104 cu_$arg_count 000016 constant entry external dcl 45 ref 68 cu_$arg_ptr 000020 constant entry external dcl 46 ref 91 del_exp_ptr 000106 automatic pointer dcl 26 set ref 109* 117 del_sb_ptr 000110 automatic pointer dcl 27 set ref 108* 115 119 del_spc_ptr 000112 automatic pointer dcl 28 set ref 110* 118 dir_name 000114 automatic char(168) unaligned dcl 29 set ref 62* 63* ecode 000166 automatic fixed bin(35,0) dcl 30 set ref 57* 58 60 63* 78 81* 91* 92 94* 98* 99 127* ent_name 000167 automatic char(32) unaligned dcl 31 set ref 62* 63* error_table_$no_w_permission 000010 external static fixed bin(35,0) dcl 41 ref 60 error_table_$wrong_no_of_args 000012 external static fixed bin(35,0) dcl 42 set ref 71* exp based structure level 1 dcl 1-52 set ref 117* 117 123* exp_ptr 000204 automatic pointer dcl 1-18 set ref 112* 117 123 exp_tab based structure array level 2 dcl 1-26 set ref 109 112 num_args 000201 automatic fixed bin(17,0) dcl 35 set ref 68* 69 76 num_symbols 20 based fixed bin(17,0) level 2 dcl 1-26 set ref 111 112 113 121* 121 127 127 sb based structure level 1 dcl 1-48 set ref 119* 119 125* sb_ptr 000206 automatic pointer dcl 1-19 set ref 111* 119 125 sb_tab based structure array level 2 dcl 1-26 set ref 108 111 sbx 000177 automatic fixed bin(17,0) dcl 33 set ref 98* 102 108 109 110 spc based structure level 1 dcl 1-57 set ref 118* 118 124* spc_ptr 000210 automatic pointer dcl 1-20 set ref 113* 118 124 spec_tab 40 based structure array level 2 dcl 1-26 set ref 110 113 speedtype_index_ 000022 constant entry external dcl 47 ref 98 speedtype_info_$name 000024 constant entry external dcl 48 ref 62 speedtype_info_$pointer 000026 constant entry external dcl 49 ref 57 speedtype_info_$set_bc 000030 constant entry external dcl 50 ref 81 speedtype_info_$shrink_table 000032 constant entry external dcl 51 ref 127 ssd based structure level 1 dcl 1-26 ssd_ptr 000202 automatic pointer dcl 1-17 set ref 57* 81* 98* 108 108 108 109 109 110 111 111 111 111 112 112 112 113 113 121 121 127 127 127* symbol 0(09) based char(7) level 2 packed unaligned dcl 1-48 set ref 115* table_size 21 based fixed bin(17,0) level 2 dcl 1-26 ref 108 108 109 111 111 112 temp_code 000200 automatic fixed bin(35,0) dcl 34 set ref 62* unspec builtin function dcl 39 set ref 123* 124* 125* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. delim_chars based structure level 1 dcl 1-41 delim_ptr automatic pointer dcl 1-21 hbound builtin function dcl 39 i automatic fixed bin(17,0) dcl 32 ssd_version_2 internal static fixed bin(17,0) initial dcl 1-23 NAMES DECLARED BY EXPLICIT CONTEXT. DELETE_SYMBOL 000254 constant entry internal dcl 85 ref 77 delete_symbols 000070 constant entry external dcl 10 dsb 000061 constant entry external dcl 10 NAME DECLARED BY CONTEXT OR IMPLICATION. mod builtin function ref 127 127 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 724 760 563 734 Length 1162 563 34 165 140 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dsb 247 external procedure is an external procedure. DELETE_SYMBOL internal procedure shares stack frame of external procedure dsb. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dsb 000100 arg_len dsb 000102 arg_ptr dsb 000104 argx dsb 000106 del_exp_ptr dsb 000110 del_sb_ptr dsb 000112 del_spc_ptr dsb 000114 dir_name dsb 000166 ecode dsb 000167 ent_name dsb 000177 sbx dsb 000200 temp_code dsb 000201 num_args dsb 000202 ssd_ptr dsb 000204 exp_ptr dsb 000206 sb_ptr dsb 000210 spc_ptr dsb THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return mod_fx1 ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr speedtype_index_ speedtype_info_$name speedtype_info_$pointer speedtype_info_$set_bc speedtype_info_$shrink_table THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$no_w_permission error_table_$wrong_no_of_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000060 57 000075 58 000105 60 000107 62 000112 63 000124 65 000164 68 000165 69 000174 71 000176 73 000226 76 000227 77 000235 78 000236 79 000240 81 000242 83 000253 85 000254 91 000255 92 000272 94 000274 95 000324 98 000325 99 000355 102 000360 104 000362 105 000425 108 000426 109 000445 110 000452 111 000456 112 000463 113 000470 115 000474 117 000500 118 000505 119 000511 121 000517 123 000522 124 000526 125 000531 127 000534 130 000556 ----------------------------------------------------------- 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