%page;

/* *  	STRUCTURE_LIBRARY_CODE.INCL.PL1
   *
   *	This procedure generates the default library segment for the
   *      structure display system.  The way it operates is hardly what one
   *      would call normal, however. It has to do a number of rather unclean
   *      things, and modifications must be made carefully following these
   *      conventions:
   * 
   *      Because the compiler insists on actually having a structure appear
   *      in some reference context for it to appear in the symbol table,
   *      regardless of options, every structure defined herein must be
   *      referenced somehow. This is accomplished with the calls to the
   *      "add" procedure. The first argument to the "add" procedure is the
   *      name of the structure, put there so it can be added to the table
   *      of contents for the segment.
   *
   *      The second argument to the add procedure is a pointer, which must
   *      always be of the form "addr (p -> structure)".  This is done to 
   *      that the structure will be referenced, while at the same time 
   *      avoiding any reference to its implicit base, or to other values
   *      which must be initialized to avoid warnings.  
   *
   *      Finally, this program compiles and runs itself using 
   *      create_data_segment; this is done both to ensure that it gets
   *      compiled with a symbol table, and to make it possible copy the 
   *      object segment and write into the internal static options (constant)
   *      array that is the table of structures. All in all, it's pretty 
   *      complicated.
   *
   *      The code for this program is in an include file in order to ease
   *	the construction of user-defined structure libraries. In order to
   *      use this code, one must create a program looking like this:
   *
   *	structure_library_7_:
   *	     procedure ();
   *
   *		< %include statements, calls to add >
   *
   *       dcl  WHOAMI char (32) internal static options (constant) init ("structure_library_7_");
   *	%include structure_library_code;
   *	          end structure_library_7_;
   *
   *	The standard structure libraries (structure_library_1_.cds,
   *	for example, provide a good example of this.
   *	
   *      30 May 1983, W. Olin Sibert
   */

/*  */

/* Now come the more ordinary parts of code that usually appear in a program */

dcl  code	fixed binary (35);
dcl  severity_ptr pointer;
dcl  severity_value fixed bin (35) based (severity_ptr);
dcl  answer bit (1) aligned;
dcl  new_segp pointer;
dcl  old_segp pointer;
dcl  bitcount fixed bin (24);
dcl  n_words fixed bin (18);
dcl  based_words (n_words) bit (36) aligned based;

dcl  p pointer init (null ());			/* our general-purpose base */

dcl  com_err_ entry options (variable);
dcl  command_query_$yes_no entry options (variable);
dcl  get_external_variable_ entry (char (*), pointer, fixed bin (19), pointer, fixed bin (35));
dcl  get_wdir_ entry () returns (char (168));
dcl  hcs_$make_seg entry (char (*), char (*), char (*), 
     fixed bin (5), pointer, fixed bin (35));
dcl  hcs_$set_bc_seg entry (pointer, fixed bin (24), fixed bin (35));
dcl  hcs_$status_mins entry 
    (pointer, fixed bin (2), fixed bin (24), fixed bin (35));
dcl  hcs_$terminate_noname entry (pointer, fixed bin (35));
dcl  nothing entry options (variable);

dcl  INITIALIZED bit (1) aligned internal static options (constant) init ("0"b);
dcl  initialized_bit bit (1) aligned based;

/* The following array is important: it defines the "table of contents"
   for the structure library segment.  It is declared and initialized to
   empty, but when the object segment is copied into the library segment, 
   it is filled in with the actual names of all the structures, which were
   collected by all the calls to "add", above. */

dcl  STRUCTURES (200) char (32) unaligned internal static options (constant) 
     init ((200)(32)"");

/* This is the automatic array where the data is collected, and the based
   overlay used later on to copy it into the new segment */

dcl  based_structures (n_structures) char (32) unaligned based;
dcl  structures (hbound (STRUCTURES, 1)) char (32) unaligned automatic;
dcl  n_structures fixed bin init (0);

dcl (addr, codeptr, null, rel, size, unspec) builtin;

/**/

/* Finally, the real code, which copies one segment onto the other and
   updates the structures arrays. */

	if INITIALIZED then do;
	     call com_err_ (0, WHOAMI, "This program is a data segment, and may not be executed.");
	     return;
	     end;

	call get_external_variable_ ("pl1_severity_", severity_ptr, (0), (null ()), code);
	if (code ^= 0) then do;
	     call com_err_ (code,  WHOAMI, "Cannot determine severity for compilation of ^a.", WHOAMI);
	     return;
	     end;

	if (severity_value = 2) then do;
	     call command_query_$yes_no (answer, 0, WHOAMI, 

"ERROR 366 means that the program is too large to construct a symbol table;
this quite commonly happens to structure libraries because of their enormous
symbol tables. You may be able to fix the error by rearranging some of the
include files.",

"Warning: A severity two PL/I error has occurred. 
If it is ERROR 366, the result of this compilation will be partially invalid.
Do you wish to continue and generate the library segment anyway?");

	     if ^answer then return;
	     end;

	old_segp = pointer (addr (STRUCTURES), 0);

	call hcs_$status_mins (old_segp, (0), bitcount, code);
	if (code ^= 0) then do;
	     call com_err_ (code, WHOAMI, 
		"Cannot get bitcount of original segment.");
	     return;
	     end;

	call hcs_$make_seg ((get_wdir_ ()), WHOAMI, "", 01010b, new_segp, code);
	if (new_segp = null ()) then do;
	     call com_err_ (code, WHOAMI, "Cannot create [wd]>^a", WHOAMI);
	     return;
	     end;

	n_words = divide (bitcount, 36, 18, 0);
	new_segp -> based_words = old_segp -> based_words;

	call hcs_$set_bc_seg (new_segp, bitcount, code);
	if (code ^= 0) then do;
	     call com_err_ (code, WHOAMI,
		"Cannot set bitcount on [wd]>^a", WHOAMI);
	     return;
	     end;

/* Finally, copy in the structure list */

	pointer (new_segp, rel (addr (STRUCTURES))) -> based_structures
	     = addr (structures) -> based_structures;
	pointer (new_segp, rel (addr (INITIALIZED))) -> initialized_bit = "1"b;

	call hcs_$terminate_noname (new_segp, (0));

ERROR_RETURN:
	return;

/*  */

/* This is called once for each structure which goes in the table of contents.
   It adds the structure to the automatic array, and increments the count. */

add:
addx:
     procedure (name, useless_pointer);

dcl  name char (32);
dcl  useless_pointer pointer;

/* The bounds check is against hbound - 1, since it is necessary to always
   leave at least one blank entry in the table of contents to show where
   the last valid entry is. */


	if (n_structures >= (hbound (STRUCTURES, 1) - 1)) then do;
	     call com_err_ (0, WHOAMI, 
		"Too many structures defined. Max is ^d.^/^3xChange the dimension of the STRUCTURES array and recompile.",
		hbound (STRUCTURES, 1));
	     goto ERROR_RETURN;
	     end;

	n_structures = n_structures + 1;
	structures (n_structures) = name;
	structures (n_structures + 1) = "";
	return;
	end add;


*/
                                          -----------------------------------------------------------


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

*/