COMPILATION LISTING OF SEGMENT gcos_create_file
	Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982
	Compiled at: Honeywell LISD Phoenix, System M
	Compiled on: 11/19/82  1005.4 mst Fri
	    Options: optimize map

        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 gcos_create_file: gcf: proc ();
       12 
       13 
       14 /* ***************************************************************
       15*   ***************************************************************
       16*   *
       17*   *
       18*   *		G C O S   C R E A T E   F I L E
       19*   *
       20*   *   This command is used to create a Multics segment or
       21*   *   multisegment file to be used as a GCOS file with the GCOS
       22*   *   Environment Simulator. The GCOS attributes of the file are
       23*   *   recognized by this command and are passed to the support
       24*   *   subroutine which actually creates the file.
       25*   *   The command syntax is:
       26*   *
       27*   *	gcos_create_file <filename> {<-control_arg>}
       28*   *
       29*   *   where -control_arg is one of the following:
       30*   *
       31*   *	-llinks <n>		file size in llinks
       32*   *	-links <n>		file size in links
       33*   *
       34*   *
       35*   *	Written by M. R. Jordan, 12/10/77
       36*   *
       37*   *
       38*   ***************************************************************
       39*   *************************************************************** */
       40 
       41 dcl  ME char (16) static internal options (constant) init ("gcos_create_file"); /*  my name  */
       42 dcl  addr builtin;
       43 dcl  arg char (arg_len) based (arg_ptr);		/*  string to access current arg  */
       44 dcl  arg_len fixed bin;				/*  len of current arg  */
       45 dcl  arg_ptr ptr;					/*  loc of current arg  */
       46 dcl  code fixed bin (35);				/*  status code used in calls  */
       47 dcl  com_err_ entry options (variable);
       48 dcl  cu_$arg_count entry (fixed bin);
       49 dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
       50 dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
       51 dcl  dname char (168);				/*  directory name of target  */
       52 dcl  ename char (32);				/*  entry name of target  */
       53 dcl  error_table_$bad_conversion fixed bin (35) ext;
       54 dcl  error_table_$badopt fixed bin (35) ext;
       55 dcl  error_table_$noarg fixed bin (35) ext;
       56 dcl  error_table_$wrong_no_of_args fixed bin (35) ext;
       57 dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
       58 dcl  gcos_create_file_ entry (char (*), char (*), ptr, fixed bin (35));
       59 dcl  multiplier fixed bin (18);			/*  multiplier to get file size in words  */
       60 dcl  nargs fixed bin;				/*  number of args supplied by user  */
       61 
  1     1 
  1     2 /* Begin include file ...... gcos_file_info.incl.pl1 */
  1     3 
  1     4 dcl  gcos_file_info_ptr ptr;				/*  ptr to the info structure  */
  1     5 
  1     6 dcl 1 gcos_file_info aligned based (gcos_file_info_ptr),	/*  a structure describing a GCOS file  */
  1     7     2 version fixed bin,				/* must be 1 */
  1     8     2 size_in_llinks fixed bin (35),			/*  number of 320 word units in file  */
  1     9     2 max_size_in_llinks fixed bin (35),		/*  max number of these units  */
  1    10     2 flags unal,
  1    11       3 random bit (1),				/*  =1 if file is random  */
  1    12       3 pad bit (35),
  1    13       3 original_file_has_been_written bit (1),		/*  set =1 on first file write  */
  1    14       3 user_specified_attributes bit (35),		/*  user attributes info  */
  1    15     2 ids_attributes unal,				/*  IDS attributes  */
  1    16       3 first_page_in_subfile fixed bin (17),
  1    17       3 last_page_in_subfile fixed bin (17),
  1    18       3 multiuser bit (1),
  1    19       3 reserveed_1 bit (17),
  1    20       3 words_per_page fixed bin (17),
  1    21       3 reserved_2 bit (18),
  1    22       3 lines_per_page fixed bin (17),
  1    23       3 reserved_3 bit (18),
  1    24       3 page_fill_percent bit (18),
  1    25       3 reserved_4 bit (6),
  1    26       3 area_number fixed bin (5),
  1    27       3 reserved_5 bit (6),
  1    28       3 num_pages_in_area fixed bin (17),
  1    29       3 minus_one fixed bin (35),
  1    30       3 reserved_6 (51) bit (36);
  1    31 
  1    32 /* End include file ...... gcos_file_info.incl.pl1 */
  1    33 
       62 
       63 
       64 
       65 dcl 1 my_gcos_file_info like gcos_file_info;
       66 
       67 /*
       68*
       69*   Get the number of arguments passed to the command.
       70*
       71**/
       72 
       73 
       74 	call cu_$arg_count (nargs);
       75 	if nargs < 1 then do;
       76 	     call com_err_ (error_table_$noarg, ME, "^/Usage is:  gcos_create_file filename {-links N|-llinks N}");
       77 	     return;
       78 	end;
       79 
       80 
       81 /*
       82*
       83*   Now get the file name argument.
       84*
       85**/
       86 
       87 
       88 	call cu_$arg_ptr (1, arg_ptr, arg_len, code);
       89 	if code ^= 0 then do;
       90 	     call com_err_ (code, ME, "Error referencing argument 1.");
       91 	     return;
       92 	end;
       93 
       94 	call expand_pathname_ (arg, dname, ename, code);
       95 	if code ^= 0 then do;
       96 	     call com_err_ (code, ME, "^a", arg);
       97 	     return;
       98 	end;
       99 
      100 
      101 /*
      102*
      103*   Initialize the file info structure with default values.
      104*
      105**/
      106 
      107 
      108 	my_gcos_file_info.version = 1;
      109 	my_gcos_file_info.size_in_llinks = 1;
      110 	my_gcos_file_info.max_size_in_llinks = 0;
      111 	my_gcos_file_info.flags.random = "0"b;
      112 	my_gcos_file_info.flags.pad = (35)"0"b;
      113 	my_gcos_file_info.flags.original_file_has_been_written = "0"b;
      114 	my_gcos_file_info.flags.user_specified_attributes = (35)"0"b;
      115 	my_gcos_file_info.ids_attributes.first_page_in_subfile = 0;
      116 	my_gcos_file_info.ids_attributes.last_page_in_subfile = 0;
      117 	my_gcos_file_info.ids_attributes.multiuser = "0"b;
      118 	my_gcos_file_info.ids_attributes.reserveed_1 = (17)"0"b;
      119 	my_gcos_file_info.ids_attributes.words_per_page = 0;
      120 	my_gcos_file_info.ids_attributes.reserved_2 = (18)"0"b;
      121 	my_gcos_file_info.ids_attributes.lines_per_page = 0;
      122 	my_gcos_file_info.ids_attributes.reserved_3 = (18)"0"b;
      123 	my_gcos_file_info.ids_attributes.page_fill_percent = "202020"b3;
      124 	my_gcos_file_info.ids_attributes.reserved_4 = (6)"0"b;
      125 	my_gcos_file_info.ids_attributes.area_number = 0;
      126 	my_gcos_file_info.ids_attributes.reserved_5 = (6)"0"b;
      127 	my_gcos_file_info.ids_attributes.num_pages_in_area = 0;
      128 	my_gcos_file_info.ids_attributes.minus_one = -1;
      129 	my_gcos_file_info.ids_attributes.reserved_6 (*) = (36)"0"b;
      130 
      131 
      132 /*
      133*
      134*   Now process all control arguments.
      135*
      136**/
      137 
      138 
      139 	if nargs> 1 then do;
      140 
      141 	     call cu_$arg_ptr (2, arg_ptr, arg_len, code);
      142 	     if code ^= 0 then do;
      143 		call com_err_ (code, ME, "Error referencing argument 2.");
      144 		return;
      145 	     end;
      146 
      147 	     if arg = "-links" then multiplier = 12;
      148 	     else if arg = "-llinks" then multiplier = 1;
      149 	     else do;
      150 		call com_err_ (error_table_$badopt, ME, "^a", arg);
      151 		return;
      152 	     end;
      153 
      154 	     if nargs > 2 then do;
      155 
      156 		call cu_$arg_ptr (3, arg_ptr, arg_len, code);
      157 		if code ^= 0 then do;
      158 		     call com_err_ (code, ME, "Error referencing argument 3.");
      159 		     return;
      160 		end;
      161 
      162 		my_gcos_file_info.size_in_llinks = cv_dec_check_ (arg, code)*multiplier;
      163 		if code ^= 0 then do;
      164 		     call com_err_ (error_table_$bad_conversion, ME, "Error converting ""^a"" to decimal integer.", arg);
      165 		     return;
      166 		end;
      167 
      168 		if nargs > 3 then do;
      169 		     call com_err_ (error_table_$wrong_no_of_args, ME, "Too many arguments supplied.");
      170 		     return;
      171 		end;
      172 
      173 	     end;
      174 	     else do;
      175 		call com_err_ (error_table_$noarg, ME, "Decimal file size missing.");
      176 		return;
      177 	     end;
      178 
      179 	end;
      180 
      181 /*
      182*
      183*   Now that we have all of the pertinent information, create the file.
      184*
      185**/
      186 
      187 
      188 	call gcos_create_file_ (dname, ename, addr (my_gcos_file_info), code);
      189 	if code ^= 0 then do;
      190 	     call com_err_ (code, ME, "^a^[>^]^a", dname, (dname ^= ">"), ename);
      191 	end;
      192 
      193 
      194 	return;
      195 
      196 
      197      end gcos_create_file;
	SOURCE FILES USED IN THIS COMPILATION.

LINE      NUMBER  DATE MODIFIED     NAME			PATHNAME
             0    11/19/82  0930.8  gcos_create_file.pl1              >spec>on>11/19/82>gcos_create_file.pl1
62           1    03/27/82  0439.3  gcos_file_info.incl.pl1           >ldd>include>gcos_file_info.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.
ME                              000000 constant        char(16)                 initial unaligned dcl 41 set ref 76* 90* 96* 143*
                                                                                  150* 158* 164* 169* 175* 190*
addr                                                   builtin function         dcl 42 ref 188 188
area_number              11(06) 000171 automatic       fixed bin(5,0)           level 3 packed unaligned dcl 65 set ref 125*
arg                                    based           char                     unaligned dcl 43 set ref 94* 96* 147 148 150* 162*
                                                                                  164*
arg_len                         000100 automatic       fixed bin(17,0)          dcl 44 set ref 88* 94 94 96 96 141* 147 148 150 150
                                                                                  156* 162 162 164 164
arg_ptr                         000102 automatic       pointer                  dcl 45 set ref 88* 94 96 141* 147 148 150 156* 162
                                                                                  164
code                            000104 automatic       fixed bin(35,0)          dcl 46 set ref 88* 89 90* 94* 95 96* 141* 142 143*
                                                                                  156* 157 158* 162* 163 188* 189 190*
com_err_                        000010 constant        entry                    external dcl 47 ref 76 90 96 143 150 158 164 169 175
                                                                                  190
cu_$arg_count                   000012 constant        entry                    external dcl 48 ref 74
cu_$arg_ptr                     000014 constant        entry                    external dcl 49 ref 88 141 156
cv_dec_check_                   000016 constant        entry                    external dcl 50 ref 162
dname                           000105 automatic       char(168)                unaligned dcl 51 set ref 94* 188* 190* 190
ename                           000157 automatic       char(32)                 unaligned dcl 52 set ref 94* 188* 190*
error_table_$bad_conversion     000020 external static fixed bin(35,0)          dcl 53 set ref 164*
error_table_$badopt             000022 external static fixed bin(35,0)          dcl 54 set ref 150*
error_table_$noarg              000024 external static fixed bin(35,0)          dcl 55 set ref 76* 175*
error_table_$wrong_no_of_args   000026 external static fixed bin(35,0)          dcl 56 set ref 169*
expand_pathname_                000030 constant        entry                    external dcl 57 ref 94
first_page_in_subfile
                          5     000171 automatic       fixed bin(17,0)          level 3 packed unaligned dcl 65 set ref 115*
flags                     3     000171 automatic       structure                level 2 packed unaligned dcl 65
gcos_create_file_               000032 constant        entry                    external dcl 58 ref 188
gcos_file_info                         based           structure                level 1 dcl 1-6
ids_attributes            5     000171 automatic       structure                level 2 packed unaligned dcl 65
last_page_in_subfile      5(18) 000171 automatic       fixed bin(17,0)          level 3 packed unaligned dcl 65 set ref 116*
lines_per_page            7(18) 000171 automatic       fixed bin(17,0)          level 3 packed unaligned dcl 65 set ref 121*
max_size_in_llinks        2     000171 automatic       fixed bin(35,0)          level 2 dcl 65 set ref 110*
minus_one                12     000171 automatic       fixed bin(35,0)          level 3 packed unaligned dcl 65 set ref 128*
multiplier                      000167 automatic       fixed bin(18,0)          dcl 59 set ref 147* 148* 162
multiuser                 6     000171 automatic       bit(1)                   level 3 packed unaligned dcl 65 set ref 117*
my_gcos_file_info               000171 automatic       structure                level 1 unaligned dcl 65 set ref 188 188
nargs                           000170 automatic       fixed bin(17,0)          dcl 60 set ref 74* 75 139 154 168
num_pages_in_area        11(18) 000171 automatic       fixed bin(17,0)          level 3 packed unaligned dcl 65 set ref 127*
original_file_has_been_written
                          4     000171 automatic       bit(1)                   level 3 packed unaligned dcl 65 set ref 113*
pad                       3(01) 000171 automatic       bit(35)                  level 3 packed unaligned dcl 65 set ref 112*
page_fill_percent        10(18) 000171 automatic       bit(18)                  level 3 packed unaligned dcl 65 set ref 123*
random                    3     000171 automatic       bit(1)                   level 3 packed unaligned dcl 65 set ref 111*
reserved_2                7     000171 automatic       bit(18)                  level 3 packed unaligned dcl 65 set ref 120*
reserved_3               10     000171 automatic       bit(18)                  level 3 packed unaligned dcl 65 set ref 122*
reserved_4               11     000171 automatic       bit(6)                   level 3 packed unaligned dcl 65 set ref 124*
reserved_5               11(12) 000171 automatic       bit(6)                   level 3 packed unaligned dcl 65 set ref 126*
reserved_6               13     000171 automatic       bit(36)                  array level 3 packed unaligned dcl 65 set ref 129*
reserveed_1               6(01) 000171 automatic       bit(17)                  level 3 packed unaligned dcl 65 set ref 118*
size_in_llinks            1     000171 automatic       fixed bin(35,0)          level 2 dcl 65 set ref 109* 162*
user_specified_attributes
                          4(01) 000171 automatic       bit(35)                  level 3 packed unaligned dcl 65 set ref 114*
version                         000171 automatic       fixed bin(17,0)          level 2 dcl 65 set ref 108*
words_per_page            6(18) 000171 automatic       fixed bin(17,0)          level 3 packed unaligned dcl 65 set ref 119*

NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED.
gcos_file_info_ptr                     automatic       pointer                  dcl 1-4

NAMES DECLARED BY EXPLICIT CONTEXT.
gcf                             000132 constant        entry                    external dcl 11
gcos_create_file                000141 constant        entry                    external dcl 11

THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION.

STORAGE REQUIREMENTS FOR THIS PROGRAM.

	Object	Text	Link	Symbol	Defs	Static
Start          0       0      1224        1260    1064        1234
Length      1466    1064        34         171     140           0

BLOCK NAME	         STACK SIZE     TYPE		WHY NONQUICK/WHO SHARES STACK FRAME
gcf                                 266 external procedure  is an external procedure.  

STORAGE FOR AUTOMATIC VARIABLES.

STACK FRAME                 LOC IDENTIFIER                  BLOCK NAME
gcf                      000100 arg_len                     gcf
                         000102 arg_ptr                     gcf
                         000104 code                        gcf
                         000105 dname                       gcf
                         000157 ename                       gcf
                         000167 multiplier                  gcf
                         000170 nargs                       gcf
                         000171 my_gcos_file_info           gcf

THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.
r_ne_as             call_ext_out_desc   call_ext_out        return              ext_entry

THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.
com_err_                      cu_$arg_count                 cu_$arg_ptr                   cv_dec_check_
expand_pathname_              gcos_create_file_

THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.
error_table_$bad_conversion   error_table_$badopt           error_table_$noarg            error_table_$wrong_no_of_args




   LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC   
     11 000131        74 000146        75 000154        76 000157        77 000203        88 000204        89 000223
     90 000225        91 000251        94 000252        95 000302        96 000304        97 000336       108 000337
    109 000341       110 000343       111 000344       112 000346       113 000350       114 000352       115 000354
    116 000356       117 000360       118 000362       119 000364       120 000366       121 000370       122 000372
    123 000374       124 000376       125 000400       126 000402       127 000404       128 000406       129 000410
    139 000420       141 000423       142 000442       143 000444       144 000470       147 000471       148 000502
    150 000511       151 000543       154 000544       156 000547       157 000566       158 000570       159 000614
    162 000615       163 000643       164 000645       165 000700       168 000701       169 000704       170 000730
    173 000731       175 000732       176 000756       188 000757       189 001006       190 001010       194 001056


                                          -----------------------------------------------------------


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