



		    examine_object_.pl1             11/15/82  1829.3rew 11/15/82  1506.3       43047



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



examine_object_: proc(seg_ptr, bit_count, segment_name, archive_name, prog_list, total);

/* examine_object_ - examine the segment identified by seg_ptr and determine if it is a PL/I object segment that uses unaligned decimal data */

/* Written by Peter C. Krupp on January 14, 1978 */


dcl  seg_ptr pointer;
dcl  (segment_name, archive_name) character(*);
dcl  prog_list(3) file variable;
dcl  total(3) fixed bin;

dcl  (addr, bin, hbound, string, substr, ltrim) builtin;


%include object_info;

dcl  object_info_$long entry (ptr, fixed bin(24), ptr, fixed bin(35));

dcl  decimal_use_code fixed bin;
dcl  decimal_use_record char(256) varying;

dcl  1 info like object_info;

dcl  bit_count fixed bin(24);
dcl  code fixed bin(35);

	info.version_number=2;
	call object_info_$long (seg_ptr, bit_count, addr(info), code);
	if code^=0
	     then return;

	if info.compiler^="PL/I" & info.compiler^="v2pl1"
	     then return;

	decimal_use_code=type_object_segment();
	total(decimal_use_code)=total(decimal_use_code)+1;
	decimal_use_record=ltrim(archive_name || " " || segment_name);
	if decimal_use_code^=1
	     then write file(prog_list(decimal_use_code)) from(decimal_use_record);

	return;


/* type_object_segment - classify a PL/I segment according to its use of arithmetic decimal instructions */

type_object_segment:
	procedure returns(fixed bin);

dcl  1  pl1$op_mnemonic(0:1023) ext static aligned,
	2 (opcode char(6),
	   dtype fixed bin(2),	/* 0-desc9a, 1-descb, 2-decimal */
	   num_desc fixed bin(5),
	   num_words fixed bin(8)) unaligned;

dcl  1  instruction based(text_ptr) aligned,
	2 (base bit(3),
	   offset bit(15),
	   op_code bit(10),
	   unused bit(1),
	   ext_base bit(1),
	   tag bit(6)) unaligned;

dcl  1  mod_factor aligned,
	2 (ext_base bit(1),
	   length_in_reg bit(1),
	   indirect_descriptor bit(1),
	   tag bit(4)) unaligned;

dcl  mf(3) fixed bin(6) int static init(30,12,3);

dcl  eis_modifier(0:15) char(3) aligned int static
	init("n","au","qu","du","ic","al","ql","dl","x0","x1","x2","x3","x4","x5","x6","x7");

dcl  1  descriptor based aligned,
	2 (address bit(18),
	   char bit(3),
	   nsd_type bit(3),
	   scale_factor bit(6),
	   length bit(6)) unaligned;

dcl  (text_offset,max_text_offset) fixed bin;
dcl  dec_data bit(1);
dcl  text_ptr pointer;
dcl  mop fixed bin;


	text_offset=0;
	max_text_offset=info.tlng-1;
	dec_data="0"b;

	do while(text_offset<=max_text_offset);
	     text_ptr=addrel(info.textp,text_offset);
	     mop=bin(instruction.op_code);
	     if opcode(mop)^=" "
		then do;
		     if num_words(mop)^=1 & dtype(mop)=2 & dec_arith(opcode(mop))
			then do;
			     dec_data="1"b;
			     if unaligned_data(text_ptr)
				then return(3); /* unaligned decimal data found */
			     end;
		     text_offset=text_offset+num_words(mop);
		     end;
		else text_offset=text_offset+1;
	end;

	if dec_data
	     then return(2); /* only word aligned decimal data */

	return(1); /* no decimal data found */


/* dec_arith - is opcode an arithmetic decimal opcode */

dec_arith:
	procedure(opcode) returns(bit(1) aligned);

dcl opcode char(6);

dcl dec_arith_ops(8) char(6) aligned int static
	init("ad2d","ad3d","sb2d","sb3d","mp2d","mp3d","dv2d","dv3d");

dcl i fixed bin;


	do i=1 to hbound(dec_arith_ops,1);
	     if opcode=dec_arith_ops(i)
		then do;
			do i=1 to num_desc(mop);
			     if addrel(text_ptr,i)->nsd_type ^= "001"b & addrel(text_ptr,i)->nsd_type ^= "000"b
				then return("0"b);
			end;
			return("1"b);
		     end;
	end;

	return("0"b);

	end dec_arith;

/* unaligned_data - determines whether or not the EIS instruction identified by inst_ptr accesses unaligned data */

unaligned_data:
	procedure(inst_ptr) returns(bit(1) aligned);

dcl inst_ptr ptr;
dcl i fixed bin;


	do i=1 to num_desc(mop);
	     if addrel(inst_ptr,i)->descriptor.char^="000"b
		then return("1"b); /* unaligned - nonzero digit offset */
	     string(mod_factor)=substr(string(inst_ptr->instruction),mf(i),7);
	     if eis_modifier(bin(mod_factor.tag))^="n" & eis_modifier(bin(mod_factor.tag))^="ic"
		then return("1"b); /* unaligned - address modification */
	end;

	return("0"b); /* all data aligned - zero digit offsets and no address modification */

	end unaligned_data;

	end type_object_segment;

	end examine_object_;




		    hunt_dec.pl1                    11/16/82  1436.3rew 11/16/82  1435.6       87381



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


hunt_dec: proc;

/* HUNT - find a segment in a given subtree. */
/* Modified by Peter C. Krupp on 1/14/78 to find and classify PL/I object segments that use decimal data */
/* Modified 780809 by PG to terminate archive segments when finished with them. */


/* automatic */

dcl  path char (168),				/* Root of tree to be scanned. */
     i fixed bin,
     ap ptr,
     segp ptr,
     al fixed bin,
     bchr char (al) unaligned based (ap),
     ec fixed bin(35),
     an fixed bin init (2),
     code fixed bin (35);

/* entries */

dcl  absolute_pathname_ entry (char (*), char (*), fixed bin (35)),
     cu_$arg_count entry returns (fixed bin),
     hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)),
     hcs_$initiate_count entry (char(*), char(*), char(*), fixed bin(24), fixed bin(2), ptr, fixed bin(35)),
     hcs_$terminate_noname entry (ptr, fixed bin (35)),
     com_err_ entry options (variable),
     ioa_$rsnnl entry options (variable),
     cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin(35)),
     sweep_disk_dec_ ext entry (char (168), entry),
     get_wdir_ entry returns (char (168)),
     ioa_ entry options (variable);

/* builtins */

dcl (addr, bin, hbound, index, length, null, rtrim, substr) builtin;

/* files */

dcl  (no_decimal,aligned_decimal,unaligned_decimal) file record output environment(stringvalue);

dcl  prog_list(3) file variable init(no_decimal,aligned_decimal,unaligned_decimal);

dcl  attach_description(3) char(256) varying
	init("discard_","record_stream_ -target vfile_ aligned_decimal.hd","record_stream_ -target vfile_ unaligned_decimal.hd");
dcl  header(3) char(132) var
	init("/* PL/I object segments that do not reference decimal data */",
	     "/* PL/I object segments that reference aligned decimal data */",
	     "/* PL/I object segments that reference unaligned decimal data */");

dcl  total(3) fixed bin init((3)0);
dcl  message char(256) var init("");


dcl  cleanup condition;

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

	path = get_wdir_ ();
	call cu_$arg_ptr (1, ap, al, ec);
	if ec ^= 0 then do;
	     call com_err_ (0, "hunt_dec", "Usage: hunt_dec {root_of_tree} {-control_args}^/	Control arguments: -aligned_decimal <path> -unaligned_decimal <path>");
	     return;
	end;

	call absolute_pathname_ (bchr, path, code);
	if code ^= 0 then go to er;

	call process_ctl_args(code,message);
	if code^=0 | message^=""
	     then go to er;

	do i=2 to 3;
	     open file(prog_list(i)) title(attach_description(i));
	end;

	on cleanup
	     begin;
		do i=2 to 3;
		     close file(prog_list(i));
		end;
	     end;

	do i=2 to 3;
	     write file(prog_list(i)) from(header(i));
	end;

/* Now, go to work. Call disk sweeper program */

	call sweep_disk_dec_ (path, counter);
	call ioa_ ("^/Total no decimal ^d^/Total aligned decimal ^d^/Total unaligned decimal ^d^/",total(1),total(2),total(3));

	do i=2 to 3;
	     close file(prog_list(i));
	end;
	return;

er:
	call com_err_ (code, "hunt_dec", message);
	return;

counter:	proc (sdn, sen, lvl, een, bptr, nptr);

dcl  archive_util_$first_disected entry(ptr, ptr, char(32) aligned, fixed bin(24), fixed bin(35));
dcl  archive_util_$disected_element entry(ptr, ptr, char(32) aligned, fixed bin(24), fixed bin(35));

dcl  examine_object_ entry (ptr,fixed bin(24),char(*),char(*),(3) file,(3) fixed bin);	/* examine segment to see if it is a PL/I object segment with unaligned decimal code */

dcl  message char(256);
dcl  ml fixed bin;

dcl  header_ptr ptr;		/* ptr to current archive header...input/output to archive util_ */
dcl  comp_ptr ptr;			/* pointer to component in archive segment */
dcl  comp_name char(32) aligned;	/* name of component in archive segment */
dcl  bit_count fixed bin(24);		/* bit count of component */

dcl  sdn char (168),				/* superior dir name */
     sen char (32),				/* dirname */
     lvl fixed bin,					/* distance from root */
     een char (32),				/* entry name */
     namec fixed bin,
    (j, k) fixed bin,
     names (100) char (32) aligned based (nptr),
     ename char (32),
     bptr ptr,					/* ptr to info structure */
     nptr ptr;					/* ptr to names structure */

dcl  xp char (168),
     xi fixed bin;

dcl 1 branch based (bptr) aligned,			/* thing returned by star_long */
    2 type bit (2) unal,
    2 nname bit (16) unal,
    2 nindex bit (18) unal,
    2 dtm bit (36) unal,
    2 dtu bit (36) unal,
    2 mode bit (5) unal,
    2 pad bit (13) unal,
    2 records bit (18) unal;

dcl  ecc fixed bin (35);

dcl  any_other condition;

dcl  continue_to_signal_ entry (fixed bin(35));
dcl  find_condition_info_ entry (ptr,ptr,fixed bin(35));

dcl  condition_name(5) char(32) aligned int static
	init ("no_read_permission","not_in_read_bracket","seg_fault_error",
	      "program_interrupt","out_of_bounds");

dcl  1 cond_info,
%include cond_info;;

	     on any_other 
		begin;

		dcl (i,code) fixed bin(35);

		     cond_info.version=1;
		     call find_condition_info_(null,addr(cond_info),code);
		     do i=1 to hbound(condition_name,1);
		          if condition_name(i)=cond_info.condition_name
		     	then go to bypass_segment;
		end;
		     call continue_to_signal_(code);
		end;

	     if branch.type^="01"b
		then return; /* do not process links or directories */
	     if sdn^=">"
		then call ioa_$rsnnl ("^a>^a", xp, xi, sdn, sen);
		else call ioa_$rsnnl (">^a", xp, xi, sen);
	     xi = bin (branch.type, 2);
	     namec = bin (branch.nname, 16);
	     do j = 1 to namec;
		ename = names (bin (branch.nindex, 18)+j-1);
		ecc = index (ename, ".");
		if ecc = 0 then do;
		     if xp = ">"
			then call ioa_$rsnnl (">^a", message, ml, een);
			else call ioa_$rsnnl ("^a>^a", message, ml, xp, een);

		     call hcs_$initiate_count(xp, ename, "", bit_count, 0b, segp, ecc);
		     if segp^=null
			then
			     do;
			     call examine_object_(segp, bit_count, rtrim (message), "", prog_list, total);
			     call hcs_$terminate_noname(segp,ecc);
			     end;

		     return;
		end;
		k = length (rtrim (ename));
		if k > 8 & substr (ename, k-7, 8) = ".archive" then do;
		     call hcs_$initiate (xp, ename, "", 0b, 0b, segp, ecc);
		     if segp = null then return;
		     header_ptr = segp;
		     call archive_util_$first_disected(header_ptr, comp_ptr, comp_name, bit_count, ecc);
		     do while (ecc = 0);
			ecc = index (header_ptr -> archive_header.name, ".");
			if ecc = 0 then do;
			     if xp ^= ">"
				then call ioa_$rsnnl ("^a>^a", message, ml, xp, ename);
				else call ioa_$rsnnl (">^a", message, ml, ename);
			     call examine_object_ (comp_ptr, bit_count, rtrim(header_ptr -> archive_header.name),
				rtrim (message), prog_list, total);
			end;
loop:			call archive_util_$disected_element(header_ptr, comp_ptr, comp_name, bit_count, ecc);
		     end;
		     call hcs_$terminate_noname (segp, ecc);
		     return;
		end;

	     end;
	return;

bypass_segment:
	revert any_other;		/* just in case a condition recurs while recovering */

	call hcs_$terminate_noname(segp,ecc);
	return;

	end counter;

/* process_ctl_args - process control arguments for hunt_dec */

process_ctl_args:
	procedure(code,message);

dcl  code fixed bin(35);
dcl  message char(*) varying;

dcl  specified(3) bit(1) aligned initial((3)(1)"0"b);
dcl  (arg_count,arg_index) fixed bin;
dcl  ctl_index fixed bin;
dcl  sc fixed bin(35);

dcl  arg_string char(arg_length) based(arg_ptr);
dcl  arg_length fixed bin;
dcl  arg_ptr pointer;

dcl  suffixed_path character(168) varying;
dcl  dir char(168);
dcl  entry char(32);

dcl  error_table_$badopt fixed bin(35) ext static;
dcl  expand_pathname_$add_suffix entry(char(*),char(*),char(*),char(*),fixed bin(35));

dcl  suffix char(2) init("hd") int static;

	code=0;
	message="";

	arg_count=cu_$arg_count();
	arg_index=2;

	     do while(arg_index<=arg_count);
		call cu_$arg_ptr(arg_index,arg_ptr,arg_length,sc);
		ctl_index=valid_ctl(arg_string);
		if ctl_index=0
		     then do;
			code=error_table_$badopt;
			message=arg_string;
			return;
			end;
		if specified(ctl_index)
		     then do;
			message=arg_string || " ctl argument specified more than once";
			return;
			end;
		arg_index=arg_index+1;
		if arg_index>arg_count
		     then do;
			code=0;
			message="pathname must follow ctl argument";
			return;
			end;
		call cu_$arg_ptr(arg_index,arg_ptr,arg_length,sc);
		call expand_pathname_$add_suffix(arg_string,suffix,dir,entry,code);
		suffixed_path=rtrim(arg_string) || "." || suffix;
		if code ^=0
		     then do;
			message=suffixed_path;
			return;
			end;
		specified(ctl_index)="1"b;
		attach_description(ctl_index)="record_stream_ -target vfile_ " || suffixed_path;
		arg_index=arg_index+1;
	     end;

	return;


/* valid_ctl - validate and encode control arguments */

valid_ctl:
	procedure(ctl_arg) returns(fixed bin);

dcl  valid_arg(3,2) char(18) aligned int static init("-nd","-no_decimal","-ad","-aligned_decimal","-ud","-unaligned_decimal");

dcl  ctl_arg character(*);
dcl  i fixed bin;

	do i=2 to hbound(valid_arg,1);
	     if ctl_arg=valid_arg(i,1) | ctl_arg=valid_arg(i,2)
		then return(i);
	end;

	return(0);

	end valid_ctl;

	end process_ctl_args;

/*  */

%include archive_header;
     end hunt_dec;




		    sweep_disk_dec_.pl1             11/15/82  1829.3rew 11/15/82  1506.4       74826



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


sweep_disk_dec_: proc (path, counter);

/* SWEEP_DISK_ - driver for statistics programs.

   This program is called with a pathname, the root node of a tree
   to sweep, and a function, which will be called for each directory entry.
   The program recursively walks down the directory tree and
   calls the user function for each entry found.

   This version of the program will try to give itself access if it doesn't have it

   THVV

   Modified January 14, 1978 by Peter C. Krupp to be used with hunt_dec.
   Modified March 16, 1977 by S. Webber to remove long entry, and to chase links that go to dirs (via chase_links entry).
   Modified on 9 September 1976 by R. G. Bratt to not terminate and to use (get release)_temp_segments_.
   Modified on 5 June 1975 by J. C. Whitmore to attempt to set system privileges.

   */

dcl  path char (168),				/* path name to sweep */
     counter entry (char (168), char (32), fixed bin,
     char (32), ptr, ptr);

dcl  dummy_dir char (168),
     dummy_ename char (32);

dcl  areap ptr,					/* ptr to area segment. */
     two_ptr (2) ptr init (null,null),
     myname char (15) init ("sweep_disk_dec_") static options (constant),
     n_ids fixed bin init (0),			/* number of dir UIDs we've processed */
     ec fixed bin (35);				/* err code */

dcl  ids (1) bit (36) aligned based (two_ptr (2));

dcl  chase_links_sw bit (1) aligned init ("0"b);		/* Indicates if links to dirs are to be chased */
dcl  priv_off bit (1);				/* flag to tell that system privileges are off */
dcl  priv_set fixed bin (35);				/* this will be zero if we set system privileges */

dcl  sys_info$max_seg_size fixed bin (35) ext;

dcl 1 acla (1) aligned,
    2 userid char (32),
    2 modes bit (36),
    2 erc fixed bin (35);

dcl 1 delacla (1) aligned,
    2 userid char (32),
    2 erc fixed bin (35);


dcl  com_err_ entry options (variable),
     get_group_id_ entry () returns (char (32) aligned),
     expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)),
     area_ entry (fixed bin (35), ptr);

dcl  system_privilege_$dir_priv_on entry (fixed bin (35));
dcl  system_privilege_$dir_priv_off entry (fixed bin (35));
dcl  hcs_$add_dir_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
dcl  hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
dcl  hcs_$get_link_target entry (char (*), char (*), char (*), char (*), fixed bin (35));
dcl  hcs_$delete_dir_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
dcl  hcs_$star_list_ entry (char (*), char (*), fixed bin (3),
     ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35)),
     get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)),
     release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));

dcl (cleanup, linkage_error) condition;
dcl (addr, null, index, fixed) builtin;

/* - - - - */


start:
	call get_temp_segments_ (myname, two_ptr, ec);
	areap = two_ptr (1);
	call area_ (sys_info$max_seg_size, areap);
	acla (1).userid = get_group_id_ ();
	delacla (1).userid = acla (1).userid;
	acla (1).modes = "111"b;

	priv_off = "1"b;				/* assume that we don't have dir privilege */
	priv_set = 1;				/* and that we did not set dir priv */

	on cleanup call clean_up;			/* so we can undo what we did */

/*	Now we will try to set dir privilege so we can look at each dir in the system. */

	on linkage_error go to revert_handler;		/* in case of no access to system_privilege_ */
	call system_privilege_$dir_priv_on (priv_set);	/* try to set it */
	priv_off = "0"b;				/* privileges are on now for sure */
revert_handler:
	revert linkage_error;			/* it was only to catch system_privilege_ error */

	if priv_off then do;			/* see if we now have the dir priv */

	     call com_err_ (0, myname, "Unable to set directory privilege. Access to storage system may not be complete.");
	     priv_set = 1;				/* just to be safe */
	end;
	call expand_pathname_ (path, dummy_dir, dummy_ename, ec); /* Just check for syntax error */
	if ec ^= 0 then do;
	     call com_err_ (ec, myname, "^a", path);
	     call clean_up;
	     return;
	end;
	call process (path, 0);			/* Looks innocent ... */
	call clean_up;

	return;					/* Done. */


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

process:	proc (apth, lvl);

/* internal doit procedure */

dcl  apth char (168),				/* path of tree to process */
     lvl fixed bin;					/* recursion level */

dcl  npth char (168),				/* new path for recursion */
     dstar char (2) init ("**") internal static options (constant), /* for star, gets all. */
     ddn char (168),				/* ... for expand */
     een char (32),					/* ... */
     c32 char (32),
     new_dirname char (168),
     new_ename char (32),
     ifail fixed bin (35),
    (eptr, nptr) ptr init (null),			/* for star and status */
     ecc fixed bin (35),
    (t, bcount, lc, ii, nix, i) fixed bin;			/* indices */

dcl  names (100) char (32) aligned based (nptr);		/* Structure returned by star_ */

dcl 1 branches (100) aligned based (eptr),		/* ... */
    2 type bit (2) unaligned,				/* 10b is directory */
    2 nnam bit (16) unaligned,			/* number of names this seg */
    2 nindex bit (18) unaligned,			/* index in names structure */
    2 padx bit (108) unaligned;

dcl 1 entry aligned,
    2 type bit (2) unaligned,
    2 nnam fixed bin (15) unaligned,
    2 nindex fixed bin (17) unaligned,
    2 padx bit (288) aligned,
    2 uid bit (36) aligned;

	     on cleanup begin;
		if eptr ^= null then free eptr -> branches;
		if nptr ^= null then free nptr -> names;
		if ifail = 0 then call hcs_$delete_dir_acl_entries (ddn, een, addr (delacla), 1, ecc);
	     end;

	     call expand_pathname_ (apth, ddn, een, ecc); /* needn't check ecc, cause we made path */
						/* except for first time which is checked */

/* Now get UID of the dir and place on stack */

	     call hcs_$status_long (ddn, een, 0, addr (entry), null, ecc);
	     n_ids = n_ids + 1;
	     ids (n_ids) = entry.uid;
	     call hcs_$add_dir_acl_entries (ddn, een, addr (acla), 1, ifail);
	     call hcs_$star_list_ (apth, dstar, 111b, areap, bcount, lc, eptr, nptr, ecc);
	     if ecc = 0 then do;
		do ii = 1 to bcount + lc;		/* Now do all branches, look for sub-dirs. */
		     nix = fixed (eptr -> branches (ii).nindex);
		     c32 = nptr -> names (nix);
		     call counter (ddn, een, lvl, c32, addr (eptr -> branches (ii)), nptr);
		     if eptr -> branches (ii).type = "10"b then do;
			if apth = ">"
			     then npth = ">" || c32;
			     else npth = rtrim (apth) || ">" || c32;
			call process (npth, lvl+1);	/* recursion here */
		     end;

/* Now check to see if we have a link to a directory */

		     else if eptr -> branches (ii).type = "00"b & chase_links_sw then do;
			call hcs_$get_link_target (apth, c32, new_dirname, new_ename, ecc);
			if ecc = 0 then do;
			     call hcs_$status_long (new_dirname, new_ename, 0, addr (entry), null, ecc);
			     if ecc = 0 then do;
				if entry.type = "10"b then do;
				     do i = 1 to n_ids;
					if ids (i) = entry.uid then goto already_done;
				     end;
				     n_ids = n_ids + 1;
				     ids (n_ids) = entry.uid;
				     call process (rtrim (new_dirname) || ">" || new_ename, lvl+1);
				end;
			     end;
			end;
already_done:
		     end;
		end;
		free eptr -> branches;		/* Clean up area. */
		free nptr -> names;			/* ... */
	     end;
	     if ifail = 0 then call hcs_$delete_dir_acl_entries (ddn, een, addr (delacla), 1, ecc);
	end process;				/* Whew. */

/* CHASE_LINK: Entry to chase links to directories */

chase_links: entry (path, counter);

	chase_links_sw = "1"b;
	goto start;



clean_up:	proc;
	     if priv_set = 0 then call system_privilege_$dir_priv_off (priv_set);
	     call release_temp_segments_ (myname, two_ptr, ec);
	     return;
	end clean_up;

     end;





		    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
