COMPILATION LISTING OF SEGMENT cobol_ms_handler Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1008.3 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_ms_handler.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 08/02/77 by Bob Chang to fix the bug for declaration of digit identifier. */ 23 /* Modified on 11/15/76 by Bob Chang to make the declaration for entry explicitly. */ 24 /* Modified since Version 2.0 */ 25 26 /*{*/ 27 28 /* Write on 1-29-76 by Bob Chang */ 29 30 /* format: style3 */ 31 cobol_ms_handler: 32 proc (fp, vp, st, rp, rl); 33 34 /* This procedure is to handle multi_segment working file. */ 35 36 dcl code fixed bin (35), 37 fp ptr, 38 rp ptr, /* points to the current token */ 39 rl fixed bin, /* length of the current token */ 40 vstr char (rl) var based (vp), 41 st bit (32), /* status code for io */ 42 vp ptr; 43 44 /* 45* code for return status code. 46* fp points to the current working file. (input and output) 47* vp points to the current token. (input and output) 48* */ 49 50 dcl new_ptr ptr, /* temporary pointer */ 51 temp_ptr ptr, /* temporary pointer */ 52 temp_fc char (4), /* temporary file_code */ 53 temp_no fixed bin, /* temporary file number. */ 54 (length, pointer, index, divide, substr, addrel) 55 builtin; 56 dcl hcs_$fs_get_path_name 57 entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 58 dcl hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)); 59 dcl hcs_$delentry_file entry (char (*), char (*), fixed bin (35)); 60 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 61 dcl com_err_ entry options (variable) ext; 62 63 dcl digit (6) char (1) static init ("1", "2", "3", "4", "5", "6"); 64 /* array for conversion*/ 65 dcl dir_name char (168), /* directory _name of the file */ 66 len fixed bin, /* length of the directory name */ 67 len1 fixed bin, /* length of the entry_name */ 68 entry_name char (32); /* entry name of the file */ 69 70 dcl 1 shdr based (fp) aligned, /* header of working file */ 71 2 x1 char (12), 72 2 next fixed bin, /* offset of next token */ 73 2 code fixed bin, /* 10 for sequential file */ 74 2 x3 char (4), /* unused */ 75 2 next_file ptr, /* points to next working file */ 76 2 prev_file ptr, /* points to previous file */ 77 2 fc char (4), /* file code for each different kind of file */ 78 2 file_no fixed bin, /* file count for each working file */ 79 2 x2 char (12), /* unused */ 80 2 first fixed bin; /* first token */ 81 82 /*}*/ 83 84 85 /**************************************************/ 86 /* START OF EXECUTION */ 87 /* ENTRY POINT: get */ 88 /**************************************************/ 89 90 91 get: 92 entry (fp, vp, st, rp, rl); 93 94 if next_file ^= null () 95 then do; 96 fp = next_file; 97 shdr.next = 15; 98 vp = pointer (fp, shdr.next); 99 rp = addrel (vp, 1); 100 rl = first; 101 shdr.next = shdr.next + divide (rl + 7, 4, 17, 0); 102 st = ""b; 103 end; 104 else do; 105 st = "00000000000000000000000000100111"b; 106 /* end of file */ 107 end; 108 return; 109 110 111 112 /**************************************************/ 113 /* START OF EXECUTION */ 114 /* ENTRY POINT: put */ 115 /**************************************************/ 116 117 118 put: 119 entry (fp, vp, st); 120 121 vp = pointer (fp, shdr.next); 122 vstr = ""; 123 call hcs_$fs_get_path_name (fp, dir_name, len, entry_name, code); 124 if code ^= 0 125 then call com_err_ (code, "cobol_ms_handler", "fail to get path name"); 126 if file_no > 5 127 then call com_err_ (0, "cobol_ms_handler", "too many work files for ^a", entry_name); 128 len1 = index (entry_name, " ") - 1; 129 if file_no > 0 130 then len1 = len1 - 1; 131 temp_no = file_no + 1; 132 entry_name = substr (entry_name, 1, len1) || digit (temp_no); 133 call hcs_$delentry_file (dir_name, entry_name, code); 134 call hcs_$make_seg (dir_name, entry_name, "", 01011b, new_ptr, code); 135 if code ^= 0 | new_ptr = null () 136 then call com_err_ (0, "cobol_ms_handler", "fail to create new working file for ^a", entry_name); 137 call hcs_$truncate_seg (new_ptr, 0, code); 138 if code ^= 0 139 then call com_err_ (code, "cobol_ms_handler", "fail to truncate ^a", entry_name); 140 next_file = new_ptr; 141 temp_ptr = fp; 142 temp_fc = fc; 143 fp = new_ptr; 144 prev_file = temp_ptr; 145 next_file = null (); 146 shdr.code = 10; 147 shdr.next = 15; 148 fc = temp_fc; 149 file_no = temp_no; 150 return; 151 152 end cobol_ms_handler; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0834.5 cobol_ms_handler.pl1 >spec>install>MR12.3-1048>cobol_ms_handler.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. addrel builtin function dcl 50 ref 99 code 000100 automatic fixed bin(35,0) dcl 36 in procedure "cobol_ms_handler" set ref 123* 124 124* 133* 134* 135 137* 138 138* code 4 based fixed bin(17,0) level 2 in structure "shdr" dcl 70 in procedure "cobol_ms_handler" set ref 146* com_err_ 000020 constant entry external dcl 61 ref 124 126 135 138 digit 000000 constant char(1) initial array packed unaligned dcl 63 ref 132 dir_name 000110 automatic char(168) packed unaligned dcl 65 set ref 123* 133* 134* divide builtin function dcl 50 ref 101 entry_name 000164 automatic char(32) packed unaligned dcl 65 set ref 123* 126* 128 132* 132 133* 134* 135* 138* fc 12 based char(4) level 2 dcl 70 set ref 142 148* file_no 13 based fixed bin(17,0) level 2 dcl 70 set ref 126 129 131 149* first 17 based fixed bin(17,0) level 2 dcl 70 ref 100 fp parameter pointer dcl 36 set ref 31 91 94 96* 96 97 98 98 100 101 101 118 121 121 123* 126 129 131 140 141 142 143* 144 145 146 147 148 149 hcs_$delentry_file 000014 constant entry external dcl 59 ref 133 hcs_$fs_get_path_name 000010 constant entry external dcl 56 ref 123 hcs_$make_seg 000016 constant entry external dcl 60 ref 134 hcs_$truncate_seg 000012 constant entry external dcl 58 ref 137 index builtin function dcl 50 ref 128 len 000162 automatic fixed bin(17,0) dcl 65 set ref 123* len1 000163 automatic fixed bin(17,0) dcl 65 set ref 128* 129* 129 132 new_ptr 000102 automatic pointer dcl 50 set ref 134* 135 137* 140 143 next 3 based fixed bin(17,0) level 2 dcl 70 set ref 97* 98 101* 101 121 147* next_file 6 based pointer level 2 dcl 70 set ref 94 96 140* 145* pointer builtin function dcl 50 ref 98 121 prev_file 10 based pointer level 2 dcl 70 set ref 144* rl parameter fixed bin(17,0) dcl 36 set ref 31 91 100* 101 122 rp parameter pointer dcl 36 set ref 31 91 99* shdr based structure level 1 dcl 70 st parameter bit(32) packed unaligned dcl 36 set ref 31 91 102* 105* 118 substr builtin function dcl 50 ref 132 temp_fc 000106 automatic char(4) packed unaligned dcl 50 set ref 142* 148 temp_no 000107 automatic fixed bin(17,0) dcl 50 set ref 131* 132 149 temp_ptr 000104 automatic pointer dcl 50 set ref 141* 144 vp parameter pointer dcl 36 set ref 31 91 98* 99 118 121* 122 vstr based varying char dcl 36 set ref 122* NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. length builtin function dcl 50 NAMES DECLARED BY EXPLICIT CONTEXT. cobol_ms_handler 000067 constant entry external dcl 31 get 000077 constant entry external dcl 91 put 000150 constant entry external dcl 118 NAME DECLARED BY CONTEXT OR IMPLICATION. null builtin function ref 94 135 145 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 714 736 612 724 Length 1120 612 22 146 102 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_ms_handler 194 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_ms_handler 000100 code cobol_ms_handler 000102 new_ptr cobol_ms_handler 000104 temp_ptr cobol_ms_handler 000106 temp_fc cobol_ms_handler 000107 temp_no cobol_ms_handler 000110 dir_name cobol_ms_handler 000162 len cobol_ms_handler 000163 len1 cobol_ms_handler 000164 entry_name cobol_ms_handler THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ hcs_$delentry_file hcs_$fs_get_path_name hcs_$make_seg hcs_$truncate_seg NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 31 000062 91 000074 94 000104 96 000113 97 000115 98 000117 99 000121 100 000123 101 000127 102 000132 103 000136 105 000137 108 000143 118 000144 121 000155 122 000163 123 000164 124 000215 126 000247 128 000312 129 000322 131 000331 132 000334 133 000352 134 000374 135 000433 137 000476 138 000512 140 000553 141 000560 142 000563 143 000565 144 000566 145 000572 146 000576 147 000602 148 000604 149 000606 150 000610 ----------------------------------------------------------- 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