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