



		    absolute_pathname_.pl1          11/11/89  1139.5r w 11/11/89  0839.2       23526



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


absolute_pathname_:
     procedure (p_relpath, p_abspath, p_code);

/* ABSOLUTE_PATHNAME_ - Procedure to convert a relative pathname into an absolute pathname. */
/* Written 770628 by PG (separated from expand_pathname_) */
/* Modified 790823 by PG to check for error_table_$pathlong case, which
   arise from the way expand_pathname_ handles archive components */

/* This program has to be separate from expand_pathname_ because */
/* both programs have an entry of the same name. */

/* parameters */

declare	(
	p_relpath		char (*),
	p_suffix		char (*),
	p_abspath		char (*),
	p_code		fixed bin (35)
	)		parameter;

/* automatic */

declare	dname		char (168),
	dname_len		fixed bin (21),
	ename		char (32),
	ename_len		fixed bin (21);

/* entries */

declare	expand_pathname_	entry (char (*), char (*), char (*), fixed bin (35)),
	expand_pathname_$add_suffix
			entry (char (*), char (*), char (*), char (*), fixed bin (35));

/* external static */

declare	error_table_$pathlong
			fixed bin (35) external static;

/* program */

	call expand_pathname_ (p_relpath, dname, ename, p_code);
	if p_code ^= 0
	then return;

	call build_absolute_pathname;
	return;

absolute_pathname_$add_suffix:
     entry (p_relpath, p_suffix, p_abspath, p_code);

	call expand_pathname_$add_suffix (p_relpath, p_suffix, dname, ename, p_code);
	if p_code ^= 0
	then return;

	call build_absolute_pathname;
	return;

build_absolute_pathname:
     procedure;

/* builtins */

declare	rtrim		builtin;

/* program */

	if dname = ">"
	then p_abspath = ">" || ename;		/* ROOT case */
	else do;
		dname_len = length (rtrim (dname));
		ename_len = length (rtrim (ename));

		if dname_len + ename_len + 1 > 168
		then do;
			p_code = error_table_$pathlong;
			return;
		     end;
		p_abspath = substr (dname, 1, dname_len) || ">" || substr (ename, 1, ename_len);
	     end;

     end /* build_absolute_pathname */;

     end /* absolute_pathname_ */;




		    expand_pathname_.pl1            11/11/89  1139.5r w 11/11/89  0839.2       89892



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


expand_pathname_:
     procedure (p_pathname, p_dname, p_ename, p_code);

/* Subroutine to convert a relative pathname into an absolute pathname */
/* Coded by Bob Frankston in January 1974 as a replacement for expand_path_ */
/* Improved by D.A. Moon for bound_lisp_library_ */
/* Searches changed to indexes by B. Greenberg 8/76 */
/* Modified 770628 by PG to add expand_pathname_$add_suffix */
/* Modified 790821 by PG to add expand_pathname_$component and expand_pathname_$component_add_suffix */
/* Modified 790830 by PG to add write-around for expand_path_ */
/* Modified 830810 by Jim Lippard to diagnose "::foo" */

/* Note: the only syntax errors checked for are:			*/
/* name too long - Will lose nonblank characters when converting to   */
/* 		a 168 character absolute string		*/
/* too many <'s  - More "<" than ">" in working directory name	*/
/* bad name      - "<" embedded in absolute pathname		*/
/*	       - ">>" in absolute pathname		          */
/* archive comp  - Archive component pathname given to entrypoint	*/
/*		that doesn't accept it.			*/

/* Note:	(1) Embedded blanks and bad star names are accepted. 	*/
/*	(2) Relative pathnames may be up to 202 characters as long	*/
/*	as the separated names are within the 168 or 32 char limits.*/
/*	(3) All errors are diagnosed before any output arguments	*/
/*	are changed.					*/

/* parameters */

declare	p_pathname	char (*),			/* (Input) the relative (or absolute) pathname to be expanded */
	p_suffix		char (*),			/* (Input) suffix to be added to ename or cname */
	p_dname		char (*),			/* (Output) the directory name */
	p_ename		char (*),			/* (Output) the entry name */
	p_cname		char (*),			/* (Output) the component name */
	p_code		fixed binary (35);		/* (Output) standard status code */

/* automatic */

declare	archive_path	bit (1) aligned,		/* ON if the entryname contains "::" */
	cname		char (32),		/* local copy of component name */
	dname		char (168),		/* local copy of dir name */
	ename		char (32);		/* local copy of ename */

/* entries */

declare	hcs_$fs_search_get_wdir
			entry (pointer, fixed bin (21));

/* builtins */

declare	(addr, index, length, max, reverse, rtrim, substr)
			builtin;

/* external static */

declare	(error_table_$archive_pathname, error_table_$badpath, error_table_$entlong, error_table_$lesserr,
	error_table_$no_wdir, error_table_$pathlong, error_table_$root)
			fixed bin (35) external static;

/* program */

/* expand_pathname_:
     entry (p_pathname, p_dname, p_ename, p_code); */

	call expand (p_pathname);

	if archive_path
	then go to archive_pathname;

	p_dname = dname;
	p_ename = ename;
	p_code = 0;
	return;

expand_pathname_$add_suffix:
     entry (p_pathname, p_suffix, p_dname, p_ename, p_code);

	if p_pathname = ">" then go to root;
	if p_pathname = "" then go to badpath;

	call expand (p_pathname);

	if archive_path
	then go to archive_pathname;

	call suffix (ename, p_suffix);
	p_dname = dname;
	p_ename = ename;
	p_code = 0;
	return;

expand_pathname_$component:
     entry (p_pathname, p_dname, p_ename, p_cname, p_code);

	call expand (p_pathname);

	if archive_path
	then call suffix (ename, "archive");

	p_dname = dname;
	p_ename = ename;
	p_cname = cname;
	p_code = 0;
	return;

expand_pathname_$component_add_suffix:
     entry (p_pathname, p_suffix, p_dname, p_ename, p_cname, p_code);

	call expand (p_pathname);

	if archive_path
	then do;
		call suffix (ename, "archive");
		call suffix (cname, p_suffix);
	     end;
	else call suffix (ename, p_suffix);

	p_dname = dname;
	p_ename = ename;
	p_cname = cname;
	p_code = 0;
	return;

/* Write-around for obsolete expand_path_ subroutine */

expand_path_:
     entry (p_relpath_ptr, p_relpath_len, p_dname_ptr, p_ename_ptr, p_code);

/* parameters */

declare	(
	p_relpath_ptr	ptr,			/* (Input) ptr to relative pathname */
	p_relpath_len	fixed bin (21),		/* (Input) length of relative pathname */
	p_dname_ptr	ptr,			/* (Input) ptr to char(168) output dirname */
	p_ename_ptr	ptr			/* (Input) ptr to char(32) output entryname (may be null) */
	)		parameter;

/* based */

declare	based_dname	char (168) based (p_dname_ptr),
	based_ename	char (32) based (p_ename_ptr),
	relpath		char (p_relpath_len) based (p_relpath_ptr);

/* builtins */

declare	null		builtin;

/* entries */

declare	absolute_pathname_	entry (char (*), char (*), fixed bin (35));

/* program */

	if p_ename_ptr = null
	then do;
		if p_relpath_len<=0
		then call absolute_pathname_ ("", based_dname, p_code);
		else call absolute_pathname_ (relpath, based_dname, p_code);
		return;
	     end;

	if p_relpath_len <= 0
	then call expand("");
	else call expand (relpath);

	if archive_path
	then go to archive_pathname;

	based_dname = dname;
	based_ename = ename;
	p_code = 0;
	return;

/* ERROR BRANCHES */

archive_pathname:
	p_code = error_table_$archive_pathname;
	return;

badpath:
	p_code = error_table_$badpath;
	return;

entlong:
	p_code = error_table_$entlong;
	return;

lesserr:
	p_code = error_table_$lesserr;
	return;

no_wdir:
	p_code = error_table_$no_wdir;
	return;

pathlong:
	p_code = error_table_$pathlong;
	return;

root:
	p_code = error_table_$root;
	return;

/* INTERNAL PROCEDURES */

/* Procedure to split a relative pathname into dname, ename, and cname */

expand:
     procedure (p_pathname);

/* parameters */

declare	p_pathname	char (*) parameter;

/* automatic */

declare	ename_idx		fixed bin (21),		/* index of first char of ename */
	ename_len		fixed bin (21),		/* number of characters before "::" */
	dir_length	fixed bin (21),		/* length of directory name */
	name		char (202),		/* for local munging...202=168+2+32 */
	position		fixed bin (21),		/* offset of first char in name after "<"s */
	wdir_length	fixed bin (21),		/* length of wdir being kept to replace "<"s */
	working_directory	char (168) aligned;		/* user's current working dir */

/* program */

	if length (p_pathname) > length (name)
	then if substr (p_pathname, length (name) + 1) ^= ""
	     then go to pathlong;

	name = p_pathname;				/* copy so it can be munged */
	if substr (name, 1, 1) ^= ">"
	then do;					/* we will need wdir */
		call hcs_$fs_search_get_wdir (addr (working_directory), wdir_length);
		if wdir_length = 0
		then go to no_wdir;

		if working_directory = ">" & index (name, "<") ^= 0 then go to lesserr;

		do position = 1 repeat (position + 1) while (substr (name, position, 1) = "<");
		     if wdir_length < 1
		     then go to lesserr;

		     wdir_length = wdir_length - index (reverse (substr (working_directory, 1, wdir_length)), ">");
		end;

		wdir_length = max (1, wdir_length);	/* must be at least 1 char for ">" (root) */

		if substr (name, position) = ""	/* null is special */
		then name = substr (working_directory, 1, wdir_length);
		else do;
			if wdir_length = 1
			then wdir_length = 0;	/* the root has null name */

			if length (name) - wdir_length - position + 1 >= 0
			then if substr (name, length (name) - wdir_length - position + 1) ^= ""
			     then go to pathlong;	/* don't lose nonblanks */

			name = substr (working_directory, 1, wdir_length) || ">" || substr (name, position);
		     end;
	     end;

	if index (name, "<") ^= 0
	then go to badpath;

	if index (name, ">>") ^= 0
	then go to badpath;

	dir_length = length (name) - index (reverse (name), ">") - 1 + 1;

	if substr (name, dir_length + 1) = ">"
	then if name ^= ">"				/* special-case the root */
	     then go to badpath;			/* pathname ends in ">" */

	if dir_length > length (dname)
	then if substr (name, dir_length + 1) ^= ""
	     then go to pathlong;

	dname = substr (name, 1, dir_length);
	if dname = ""
	then dname = ">";				/* special-case the root */

	ename_idx = dir_length + 2;			/* step over dname and ">" */

/* Look for archive component specification. */

	ename_len = index (substr (name, ename_idx), "::") - 1;
	if ename_len = -1
	then do;
		if length (name) - ename_idx + 1 > length (ename)
		then if substr (name, ename_idx + length (ename)) ^= ""
		     then go to entlong;

		ename = substr (name, ename_idx);
		cname = "";
		archive_path = "0"b;
		return;
	     end;
	else if ename_len = 0 then go to badpath;
	else archive_path = "1"b;

	if ename_len > length (ename)
	then go to entlong;

	ename = substr (name, ename_idx, ename_len);

	if length (name) - (ename_idx + ename_len + 2) + 1 > length (cname)
	then if substr (name, (ename_idx + ename_len + 2) + length (cname)) ^= ""
	     then go to entlong;

	cname = substr (name, ename_idx + ename_len + 2);
	return;

     end /* expand */;

/* Procedure to add a suffix to an entryname */

suffix:
     procedure (p_name, p_suffix);

/* parameters */

declare	(p_name, p_suffix)	char (*) parameter;

/* automatic */

declare	name_len		fixed bin (21),
	suffix		char (32) varying;

/* program */

	if p_suffix = ""
	then return;

	suffix = "." || rtrim (p_suffix);
	name_len = length (rtrim (p_name));

	if name_len > length (suffix)			/* enough chars to have this suffix? */
	then if substr (p_name, name_len - length (suffix) + 1, length (suffix)) = suffix
	     then return;				/* AOK...right suffix is there */
	if name_len + length (suffix) > length (p_name)
	     then go to entlong;
	     else substr (p_name, name_len + 1, length (suffix)) = suffix;

	return;

     end /* suffix */;

     end /* expand_pathname_ */;



		    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
