


		    enter_lss.pl1                   02/07/84  1208.0r   02/07/84  1207.5       34227


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


enter_lss: procedure options (variable);

/* This command forces the command processor to transform commands using
   a LSS command table.

   Usage: enter_lss {table path}

   Written by C. Hornig, October 1979
   Modified by C Spitzer. Jan 1984. attempt to verify the goodness of the
	  command list.
*/

dcl 1 lss_header based (lssp) aligned,
      2 ratio fixed bin (17),
      2 interval fixed bin (17),
      2 number_of_names fixed bin (71),
      2 names (lss_header.number_of_names) char (32) aligned,
      2 pointers (lss_header.number_of_names) aligned,
        3 where fixed bin (17),
        3 length fixed bin (17);

dcl 1 lss based (lssp) aligned,
      2 ratio fixed bin (17),
      2 interval fixed bin (17),
      2 number_of_names fixed bin (71),
      2 names (lss.number_of_names) char (32) aligned,
      2 pointers (lss.number_of_names) aligned,
        3 where fixed bin (17),
        3 length fixed bin (17),
      2 paths char (path_length) aligned;

dcl  ME char (9) init ("enter_lss") static options (constant);

dcl  com_err_ entry options (variable);
dcl  command_processor_$setup_lss entry (pointer);
dcl  cu_$arg_count entry returns (fixed bin);
dcl  cu_$arg_ptr entry (fixed bin, pointer, fixed bin (24), fixed bin (35));
dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
dcl  initiate_file_ entry (char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35));
dcl  start_governor_ entry (fixed bin, fixed bin);
dcl  pathname_ entry (char(*), char(*)) returns(char(168));

dcl  fixedoverflow condition;

dcl (currentsize, divide, null) builtin;

dcl  bit_count fixed bin (24);
dcl  path_length fixed bin (21);
dcl  dirname char (168);
dcl  ename char (32);
dcl  ap ptr;
dcl  al fixed bin (24);
dcl  argument character (al) based (ap);
dcl  code fixed bin (35);
dcl  lssp ptr;
dcl  i fixed bin;

/* * * * * * * * * * ENTER_LSS * * * * * * * * * */

	if cu_$arg_count () ^= 1 then do;		/* program misused */
	     call com_err_ (0, ME, "Usage: enter_lss {table pathname}");
	     return;
	end;

	call cu_$arg_ptr (1, ap, al, code);		/* get the taBle path */
	if code ^= 0 then do;
	     call com_err_ (code, ME);
	     return;
	end;

	call expand_pathname_ (argument, dirname, ename, code);
	if code ^= 0 then do;			/* bad pathname */
	     call com_err_ (code, ME, "^a.", argument);
	     return;
	end;
	call initiate_file_ (dirname, ename,"100"b, lssp, bit_count, code); /* initiate the LSS */
	if lssp = null () then do;
	     call com_err_ (code, ME, "Initiating ^a.", pathname_ (dirname, ename));
	     return;
	end;

	on fixedoverflow goto bad_input_segment;
	if lss.number_of_names * 9 > divide (bit_count, 36, 21, 0)
	then goto bad_input_segment;			/* 9 is the size in words of 1 entry in lss */

          path_length = divide (bit_count, 9, 21, 0) - (currentsize (lss_header)*4);
	do i = 1 to lss.number_of_names;
	     if lss.where (i) + lss.length (i) > path_length + 1 then do;
bad_input_segment:	call com_err_ (0, ME, "The input command list is not a validly compiled LSS table. ^a", pathname_ (dirname, ename));
		return;
	     end;
	end;

	revert fixedoverflow;

	call command_processor_$setup_lss (lssp);	/* tell the CP */
	call start_governor_ (lss.ratio, lss.interval);	/* enforce the governor */
     end enter_lss;
 



		    make_commands.pl1               11/04/82  1907.4rew 11/04/82  1613.4       90621


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


make_commands: procedure ();

/*

   Coded for the Limited Service System May 1970 by R. Frankston
   Modified by Dan Bricklin Nov 1970
   Updated 7/22/76 to current version PL/I by S. Herbst
   Modified March 1977 by M. R. Jordan to correct errors and update to use expand_pathname_  (MCR #2576)

*/


/*

   make_commands, mc

   Usage:

   make_commands <input_path>

   Where:

   <input_path> is the pathname of the input segment. The .ct suffix may
   be included but is not necessary (it will be assumed). The
   make_commands command will build a command table from the ASCII input
   segment to be used by transform_command_ whenever the
   command_processor_ recieves a command from the listen_ procedure. The
   table built is named <input_seg> where <input_seg> is the entry name
   of <input_path> with the .ct suffix removed and is located in the
   working direcory. The output segment must be named lss_command_list_
   to be used by the limited_service_subsystem_ or
   limited_command_system_ process overseers. If the
   limited_command_system_ process overseer is used, the output segment
   must be located in the project directory.

*/

dcl  NL char (1) aligned internal static options (constant) init ("
");
dcl  aclinfo_ptr ptr;
dcl  arg_ptr ptr;
dcl  arglen fixed bin;
dcl  before builtin;
dcl  bit_count fixed bin (24);
dcl  ch char (arglen) based (arg_ptr) unaligned;
dcl  chr char (1) aligned;
dcl  chs char (100) aligned based (input_pointer);
dcl  cleanup condition;
dcl  code fixed bin (35);
dcl  com_err_ ext entry options (variable);
dcl  command_pointer ptr;
dcl  cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  cv_dec_ ext entry (char (*) aligned) returns (fixed bin (35));
dcl  dirname char (168);
dcl  divide builtin;
dcl  ename char (32);
dcl  error_occurred bit (1) aligned;
dcl  error_table_$segknown external fixed bin (35);
dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
dcl  expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
dcl  first fixed bin;
dcl  fixed builtin;
dcl  hcs_$initiate_count ext entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35));
dcl  i fixed bin;
dcl  in_comment bit (1) aligned;
dcl  index builtin;
dcl  input_pointer pointer;
dcl  ioa_ ext entry options (variable);
dcl  j fixed bin;
dcl  length builtin;
dcl  line char (256) aligned varying;
dcl  lineno fixed bin;
dcl  min builtin;
dcl  n fixed bin;
dcl  name_len fixed bin;
dcl  next_free fixed bin;
dcl  null builtin;
dcl  output_name char (32);
dcl  paren bit (1) aligned;
dcl  path_len fixed bin;
dcl  rtrim builtin;
dcl  s fixed bin;
dcl  skip bit (1) aligned;
dcl  start_line fixed bin;
dcl  start_name fixed bin;
dcl  substr builtin;
dcl  temp1 fixed bin;
dcl  tssi_$get_segment entry (char (*), char (*), ptr, ptr, fixed bin (35));
dcl  tssi_$finish_segment entry (ptr, fixed bin (24), bit (36) aligned, ptr, fixed bin (35));
dcl  tssi_$clean_up_segment entry (ptr);

/*

   The following structure is used as temporary storage for the command
   transformation information until we can determine just exactly how many
   commands there are.

*/


dcl 1 commands aligned,
    2 com_info (200),
      3 name char (32),
      3 path char (168),
      3 len fixed bin (71);


/*

   The following table is the template for the final output segment created
   by this command.  The table contains information for mapping commands
   typed to actual command segment names.  Also information for the governor
   is save in this structure.

   */


dcl 1 table based (command_pointer) aligned,
    2 ratio fixed bin (17),
    2 interval_len fixed bin (17),
    2 number_of_names fixed bin (71),
    2 names (code refer (number_of_names)) char (32) aligned,
    2 pointers (code refer (number_of_names)) aligned,
      3 where fixed bin (17),
      3 length fixed bin (17),
    2 paths char (100) aligned;

	goto common;


mc:	entry ();


common:


	call cu_$arg_ptr (1, arg_ptr, arglen, code);
	if code ^= 0 then do;
	     call com_err_ (code, "make_commands", "Usage is: ""make_commands <input_path>""");
	     return;
	end;

	call expand_pathname_$add_suffix (ch, "ct", dirname, ename, code);
	if code ^= 0 then do;
in_err:	     call com_err_ (code, "make_commands", "^a", ch);
	     return;
	end;
	call hcs_$initiate_count (dirname, ename, "", bit_count, 01b, input_pointer, code);
	if code ^= 0 then if code ^= error_table_$segknown then do;
		if dirname = ">" then call com_err_ (code, "make_commands", ">^a", ename);
		else call com_err_ (code, "make_commands", "^a>^a", dirname, ename);
		return;
	     end;

	output_name = substr (ename, 1, length (rtrim (ename))-3);
	call expand_pathname_ (output_name, dirname, ename, code);
	if code ^= 0 then do;
out_err:	     call com_err_ (code, "make_commands", "^a", output_name);
	     return;
	end;
	aclinfo_ptr = null ();
	on cleanup
	     begin;
	     if aclinfo_ptr ^= null () then call tssi_$clean_up_segment (aclinfo_ptr);
	end;
	call tssi_$get_segment (dirname, ename, command_pointer, aclinfo_ptr, code);
	if command_pointer = null then go to out_err;

/*

   Now parse the input segment and build a temporary table of the results of
   that parse.

*/


	temp1 = divide (bit_count, 9, 17, 0);
	n = 0;
	s, lineno, start_line = 1;
	paren, in_comment, skip, error_occurred = "0"b;
	do i = 1 to temp1;
	     if in_comment then
		if substr (chs, i-1, 2) = "*/" then do;
		     in_comment = "0"b;
		     chr = " ";
		     go to blank;
		end;
		else go to next;
	     chr = substr (chs, i, 1);
	     if chr = NL then do;
		lineno = lineno + 1;
		go to next;
	     end;
	     if skip then do;
		if chr = ";" then skip = "0"b;
		s = 1;
		start_line = i+1;
		go to next;
	     end;
	     if chr = "/" then
		if i < temp1 then
		     if substr (chs, i+1, 1) = "*" then do;
			in_comment = "1"b;
			go to next;
		     end;
	     if chr = " " then do;
blank:		if s = 2 then if paren then do;
			s = 1;
			name_len = 0;
		     end;
		     else s = 3;
		if s = 5 then s = 6;
		go to next;
	     end;

	     if chr = "	" then do;			/* tab */
		if s = 1|s = 4 then go to next;
		go to error;
	     end;

	     if chr = "(" then do;
		if ^paren & s = 1 then do;
		     paren = "1"b;
		     first = n+1;
		     go to next;
		end;
		go to error;
	     end;

	     if chr = ")" then do;
		if paren then do;
		     if s = 2 then s = 3;
		     if s ^= 3 then go to error;
		     paren = "0"b;
		     go to next;
		end;
		go to error;
	     end;

	     if chr = ":" then do;
		if paren then go to error;
		if s = 2|s = 3 then do;
		     s = 4;
		     go to next;
		end;
		go to error;
	     end;

	     if chr = ";" then do;
		if s = 4 then do;
		     do j = first to n;
			commands.path (j) = commands.name (n);
			commands.len (j) = name_len;
		     end;
		     s = 1;
		     start_line = i+1;
		     go to next;
		end;
		if s = 5|s = 6 then do;
		     do j = first to n-1;
			commands.len (j) = path_len;
			commands.path (j) = commands.path (n);
		     end;
		     commands.len (n) = path_len;
		     s = 1;
		     start_line = i+1;
		     go to next;
		end;
		go to error;
	     end;

/* other characters */

	     if s = 1 then do;
		s = 2;
		n = n+1;
		if ^paren then first = n;
		if n>200 then do;
		     call com_err_ (0, "make_commands", "Max number of names (200) exceeded, terminating run.");
		     return;
		end;
		commands.name (n) = " ";
		name_len = 0;
		start_name = i;
	     end;
	     if s = 2 then do;
		name_len = name_len + 1;
		substr (commands.name (n), name_len, 1) = chr;
		go to next;
	     end;
	     if s = 4 then do;
		s = 5;
		path_len = 0;
		commands.path (n) = " ";
	     end;
	     if s = 5 then do;
		path_len = path_len+1;
		substr (commands.path (n), path_len, 1) = chr;
		go to next;
	     end;
error:	     line = substr (chs, start_line, min (index (substr (chs, i, temp1-i+1), ";")+i-1, temp1)-start_line+1);
	     call com_err_ (0, "make_commands", "Syntax error on line ^d, around char #^d of statement: ^a",
		lineno, i-start_line, line);
	     error_occurred, skip = "1"b;

next:	end;

	if s ^= 1 then do;
	     call com_err_ (0, "make_commands", "Last statement doesn't end with a semi-colon.");
give_up:	     call com_err_ (0, "make_commands", "At least one syntax error, compilation is aborted.");
	     return;
	end;

	if error_occurred then go to give_up;

/*

   Now we must build the commands table from the data gathered thus far.

*/


	next_free = 1;
	j = 1;
	ratio, interval_len = 0;
	if commands.name (1) = "ratio" then if commands.name (2) = "interval" then do;
		ratio = cv_dec_ (commands.path (1));
		interval_len = cv_dec_ (commands.path (2));
		call ioa_ ("ratio = ^d, interval = ^d", ratio, interval_len);
		j = 3;
	     end;
	number_of_names = n - j + 1;
	do i = j to n;
	     table.names (i-j+1) = commands.name (i);
	     pointers.where (i-j+1) = next_free;
	     next_free = next_free + commands.len (i);
	     if i>j then if commands.path (i) = commands.path (i-1) then do;
		     next_free = pointers.where (i-j+1);
		     pointers.where (i-j+1) = pointers.where (i-j);
		end;
	     pointers.length (i-j+1) = commands.len (i);
	     substr (paths, pointers.where (i-j+1), pointers.length (i-j+1)) = substr (commands.path (i), 1, pointers.length (i-j+1));
	end;
	i = 4 + 10*number_of_names + divide (next_free+2, 4, 17, 0);
	call tssi_$finish_segment (command_pointer, fixed (i*36, 24), "110"b, aclinfo_ptr, code);
	revert cleanup;
	if code ^= 0 then go to out_err;
	return;

     end make_commands;
   



		    start_governor_.pl1             11/04/82  1907.4rew 11/04/82  1613.5       44073


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


start_governor_: proc (ratiop, interval_lengthp);

/* This is the governor section of the LSS.  It is seperate
   so you can use it just to do the function of governing and
   have other functions done by other routines (such as
   accounting.

   Coded Nov 1970 by Dan Bricklin */
/* Updated 7/22/76 to current version PL/I by S. Herbst */

dcl
    (addr, divide, float) builtin,
	ioa_ ext entry options (variable),
	     clock_ ext entry returns (fixed bin (71)),
	     hcs_$usage_values ext entry (fixed bin (35), fixed bin (52)),
	     create_ips_mask_ ext entry (ptr, fixed bin (17), bit (36) aligned),
	     hcs_$set_ips_mask ext entry (bit (36) aligned, bit (36) aligned),
	     start_governor_$cput_int ext entry,
	     timer_manager_$sleep_lss ext entry (fixed bin (71), bit (2) aligned), /* timer_manager_ takes care */
	     timer_manager_$cpu_call_inhibit ext entry (fixed bin (71), bit (2) aligned, entry), /* of handling timer interrupts */
	     timer_manager_$reset_cpu_call ext entry (entry),
	     ((ratio, interval_length) int static, ratiop, interval_lengthp) fixed bin (17),
	     ((last_real, until) int static, now) fixed bin (71),
	     (cpu_last int static, cpu_now) fixed bin (52),
	     page_waits fixed bin (35),
	     cpu_allowed int static fixed bin (71),
	     ((quit_mask, all_mask) int static, mask) bit (36) aligned,
	     quited_in_cput bit (1) aligned int static,
	     time fixed bin (17),
	     quit condition,
	     all (1) char (32) aligned static int init ("-all"),
	     ips_names (1) char (32) aligned static int init ("quit");


	ratio = ratiop;				/* save these values */
	interval_length = interval_lengthp;
						/* prepare for ratio checking interrupts */

	if ratio > 0 & interval_length > 0 then do;	/* only do ratio checking if ratio is greater than zero */
	     call create_ips_mask_ (addr (ips_names), 1, quit_mask); /* get a mask for quits to be used later */
	     quit_mask = ^quit_mask;			/* make a mask for everything but quit and save */
	     call create_ips_mask_ (addr (all), 1, all_mask); /* get a mask for nothing */
	     all_mask = ^all_mask;
	     last_real = clock_ ();			/* get time and save it */
	     call hcs_$usage_values (page_waits, cpu_now);
	     cpu_last = cpu_now + 3000000;		/* save current cput plus extra for burst */
	     cpu_allowed = divide (interval_length*1000000, ratio, 71, 0);
						/* cpu time allowed in real interval */
	     call timer_manager_$cpu_call_inhibit (cpu_allowed+cpu_last, "00"b, start_governor_$cput_int); /* set timer */
	end;

	return;


/* This section of code is executed every "cpu_allowed" cpu seconds and checks to see */
/* if the amount of cpu time used per real time is in keeping with the ratio.  If it is, */
/* control is returned, after setting up the next interrupt to occur.  If it is too high a */
/* usage rate, the process is put to sleep long enough to bring the ratio to the acceptable level. */

cput_int:	entry;					/* entry on cpu time interrupt */

	quited_in_cput = "0"b;
	now = clock_ ();
	call hcs_$usage_values (page_waits, cpu_now);
	if divide (now - last_real, cpu_now - cpu_last, 17, 0) >= ratio then do;
						/* if not over using, then do */
	     last_real = now;
GOOD:	     cpu_last = cpu_now;
	     call timer_manager_$cpu_call_inhibit (cpu_allowed+cpu_now, "00"b, start_governor_$cput_int); /* set timer */
	     if quited_in_cput then do;
		call hcs_$set_ips_mask (all_mask, mask); /* restore mask to allow everything */
		revert condition (quit);
		signal condition (quit);		/* do a quit that the user wanted */
	     end;
	     return;
	end;
						/* if used too much cpu time */
	until = last_real + (cpu_now - cpu_last)*ratio;	/* 'till when to sleep */

	on condition (quit) begin;			/* set up quit handler */
	     now = clock_ ();
	     time = divide (until-now, 1000000, 35, 0);
	     if time>60 then call ioa_ ("Will quit in ^.1f minutes", float (time, 27)/60.e0);
	     else call ioa_ ("Will quit in ^d seconds", time);
	     quited_in_cput = "1"b;
	end;

	call hcs_$set_ips_mask (quit_mask, mask);	/* mask everything but quits */
	call timer_manager_$sleep_lss (until, "00"b);	/* go to sleep */
	last_real = clock_ ();
	go to GOOD;				/* set timer */


/* This entry stops the governing of cpu time */

stop_governor_: entry;

	call timer_manager_$reset_cpu_call (start_governor_$cput_int);
	return;


     end start_governor_;
   



		    transform_command_.pl1          11/08/82  1608.3rew 11/08/82  1607.5       20574


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


transform_command_: proc (name_ptr, name_len, table_ptr, code);

/* coded May 1970 by R. Frankston */

/* name_ptr and name_len are the pointer and the length for the command name.
   They are replaced by the pointer and length for the new command.
   The tranformation is made according to the table addressed by table_ptr.
   The code is 0 if the tranform is ok. Otherwise it is 1 and a message
   is typed.

   Modified Nov 1970 by Dan Bricklin
/* Updated 7/22/76 to current version PL/I by S. Herbst */

dcl (name_ptr, table_ptr) ptr;
dcl (name_len, temp) fixed bin;

dcl (code, error_table_$noentry ext) fixed bin (35);

dcl  ch char (100) based (name_ptr) unaligned;

dcl  command char (32) based (cptr) aligned,
     cptr pointer internal;

dcl 1 c,
    2 (c1, c2, c3, c4) fixed binary (71);

dcl 1 commands based (table_ptr) aligned,
    2 info fixed bin (71),
    2 nonames fixed bin (71),
    2 com_info (temp refer (commands.nonames)) char (32) aligned,
    2 more_info (temp refer (commands.nonames)),
      3 where fixed bin (17),
      3 len fixed bin (17),
    2 paths (100) char (1) unaligned;

dcl 1 comnames based (table_ptr) aligned,
    2 info fixed bin (71),
    2 nonames fixed bin (71),
    2 com_info (temp refer (comnames.nonames)),
      3 (n1, n2, n3, n4) fixed bin (71);

dcl  ioa_ entry options (variable);

dcl (addr, substr) builtin;

/*  */
          cptr = addr (c);
	command = substr (ch, 1, name_len);

	do temp = 1 to commands.nonames;

	     if n1 (temp) = c1 & n2 (temp) = c2 & n3 (temp) = c3 & n4 (temp) = c4 then do;
		name_ptr = addr (paths (where (temp)));
		name_len = len (temp);
		code = 0;
		return;
	     end;
	end;
	call ioa_ ("^a is not a legal command", command);
	code = error_table_$noentry;

     end transform_command_;


		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


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