/* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* This command uses an edit_header file to create a new mst header from an old mst header: edit_mst_header edit_header old_header -new_header- Originally coded by R. J. Feiertag on May 16, 1970 */ edit_mst_header: emh: proc; dcl name_ptr ptr, /* pointer to argument */ namel fixed bin(17), /* length of argument */ name char(namel) based(name_ptr), /* argument to command */ acinfo fixed bin(35), /* ACL information for ti_ about new header segment */ code fixed bin(17), /* error code */ dir char(168), /* directory of segment , also used for error comments */ entry char(32), /* entry of segment */ leave label init(finish), /* place to go for return */ i fixed bin(17), /* miscellaneous index */ nposition fixed bin(17) init(1), /* current position in new header */ nptr ptr init(null), /* pointer to segment for new header */ nstring char(262144) based(nptr), /* new_ header */ bc fixed bin(17), /* bit count of segment */ estring char(einfo.end_of_data) based(einfo.segment_ptr), /* edit_header */ ostring char(oinfo.end_of_data) based(oinfo.segment_ptr), /* old header */ optr ptr, /* pointer to status block of old header segment */ eptr ptr, /* pointer to status block of edit header segment */ okey char(40) aligned, /* current line of old header */ ekey char(40) aligned, /* current line of edit header */ action fixed bin(17); /* index specifying action to be taken */ dcl nl char(1) internal static init(" "); /* new line */ dcl 1 oinfo, /* status information about old header segment */ 2 segment_ptr ptr init(null), /* pointer to segment */ 2 begin_section fixed bin(17), /* index to beginning of current section */ 2 position fixed bin(17) init(0), /* current position in segment */ 2 finish fixed bin(17) init(0), /* 1 if end of data reached */ 2 end_of_data fixed bin(17); /* last character of segment */ dcl 1 einfo, /* status information about edit header segment */ 2 segment_ptr ptr init(null), 2 begin_section fixed bin(17), 2 position fixed bin(17) init(0), 2 finish fixed bin(17) init(0), 2 end_of_data fixed bin(17); dcl get_section internal entry(ptr,fixed bin(17),char(40) aligned); /* internal procedure to get next header section */ dcl hcs_$terminate_noname ext entry(ptr,fixed bin(17)), hcs_$fs_search_get_wdir ext entry(ptr,fixed bin(17)), ti_$getseg ext entry, ti_$findata ext entry(ptr,fixed bin(17),fixed bin(35),fixed bin(17)), expand_path_ ext entry(ptr,fixed bin(17),ptr,ptr,fixed bin(17)), cu_$arg_ptr ext entry(fixed bin(17),ptr,fixed bin(17),fixed bin(17)), hcs_$initiate_count ext entry, com_err_ ext entry; dcl error_table_$entlong ext fixed bin(17); /* */ call cu_$arg_ptr(2,name_ptr,namel,code); /* get second argument */ if code ^= 0 then do; /* print error message */ dir = ""; error: call com_err_(code,"edit_mst_header",dir); /* print out error */ finish: if nptr ^= null then do; /* cleanup new header segment */ substr(nstring,nposition,1) = nl; /* append new line character */ call ti_$findata(nptr,9*nposition,acinfo,code); /* cleanup segment */ end; if einfo.segment_ptr ^= null then call hcs_$terminate_noname(einfo.segment_ptr,code); /* terminate edit header segment */ if oinfo.segment_ptr ^= null then call hcs_$terminate_noname(oinfo.segment_ptr,code); /* terminate old header segment */ return; end; if name = "-hard" then do; /* editing hardcore header */ dir = ">library_dir_dir>hard>info"; entry = "hardcore.header"; end; else if name = "-soft" then do; /* editing softcore header */ dir = ">library_dir_dir>soft>info"; entry = "softcore.header"; end; else do; /* header path name is being supplied */ call expand_path_(name_ptr,namel,addr(dir),addr(entry),code); /* parse path name */ if code ^= 0 then do; /* error */ dir = name; go to error; end; do i = 32 by -1 to 1 while(substr(entry,i,1) = " "); end; /* get length of entry name */ if i < 1 | i > 25 then do; /* entry name too long */ code = error_table_$entlong; /* return error code */ dir = substr(entry,1,i)||".header"; go to error; end; substr(entry,i+1,7) = ".header"; /* add suffix */ end; call hcs_$initiate_count(dir,entry,"",bc,1,oinfo.segment_ptr,code); /* get pointer to old header segment */ if oinfo.segment_ptr = null then do; /* error */ path_err: do i = 168 by -1 to 1 while(substr(dir,i,1) = " "); end; /* find end of directory name */ substr(dir,i+1,1) = ">"; /* insert greater than */ substr(dir,i+2,min(32,167-i)) = entry; /* concatenate entry name */ go to error; end; oinfo.end_of_data = divide(bc,9,17,0); /* compute last character */ call cu_$arg_ptr(1,name_ptr,namel,code); /* get first argument */ if code ^= 0 then do; /* error*/ dir = ""; go to error; end; call expand_path_(name_ptr,namel,addr(dir),addr(entry),code); /* parse path name */ if code ^= 0 then do; /* error */ dir = name; go to error; end; do i = 32 by -1 to 1 while(substr(entry,i,1) = " "); end; /* get length of entry name */ if i < 1 | i > 20 then do; /* name too long */ code = error_table_$entlong; /* return error code */ dir = substr(entry,1,i)||".edit_header"; go to error; end; substr(entry,i+1,12) = ".edit_header"; /* add suffix */ call hcs_$initiate_count(dir,entry,"",bc,1,einfo.segment_ptr,code); /* get pointer to edit header segment */ if einfo.segment_ptr = null then go to path_err; /* error */ einfo.end_of_data = divide(bc,9,17,0); /* get index of last character in edit header */ call cu_$arg_ptr(3,name_ptr,namel,code); /* get third argument */ if code ^= 0 then do; /* no third arg, assume same name as edit header */ substr(entry,i+1,32-i) = ".header"; /* new header has same name as edit header */ call hcs_$fs_search_get_wdir(addr(dir),code); /* put header in working dir */ end; else do; /* new header name has been provided */ call expand_path_(name_ptr,namel,addr(dir),addr(entry),code); /* parse path name */ if code ^= 0 then do; /* error */ dir = name; go to error; end; do i = 32 by -1 to 1 while(substr(entry,i,1) = " "); end; /* find length of entry name */ if i < 1 | i > 25 then do; /* name too long */ code = error_table_$entlong; /* return error code */ dir = substr(entry,1,i)||".header"; go to error; end; substr(entry,i+1,7) = ".header"; /* add suffix */ end; call ti_$getseg(dir,entry,nptr,acinfo,code); /* create and initiate new header segment */ if nptr = null then go to path_err; /* error */ optr = addr(oinfo); /* initialize pointer to old header segment status block */ eptr = addr(einfo); /* initialize pointer to edit header segment status block */ call get_section(optr,i,okey); /* get first header section from old header */ next: call get_section(eptr,action,ekey); /* get next header section form edit header */ if einfo.finish = 1 then go to finish; /* end of data reached in edit header segment, we are done */ if action > 3 then do; /* this is a skip instruction */ do while(ekey ^= okey); /* look for matching header section in old header */ call get_section(optr,i,okey); /* get next old header section for comparison */ end; if action = 5 then call get_section(optr,i,okey); /* if skip_thru then go to next old header section */ end; else if action > 0 then do; /* this is a copy instruction */ do while(ekey ^= okey); /* search for matching header section in old header */ i = oinfo.position-oinfo.begin_section+1; /* copy header section to new header */ substr(nstring,nposition,i) = substr(ostring,oinfo.begin_section,i); nposition = nposition + i; call get_section(optr,i,okey); /* get next old header section for comparison */ end; if action = 2 then do; /* this is a copy thru instruction so copy old header section */ i = oinfo.position-oinfo.begin_section+1; /* copy old header section to new header */ substr(nstring,nposition,i) = substr(ostring,oinfo.begin_section,i); nposition = nposition + i; end; if action < 3 then call get_section(optr,i,okey); /* copy thru or copy_to,replace so go to next old header section */ end; if action < 2 then do; /* copy edit header section */ i = einfo.position-einfo.begin_section+1; substr(nstring,nposition,1) = nl; /* insert new line */ substr(nstring,nposition+1,i) = substr(estring,einfo.begin_section,i); nposition = nposition + i + 1; end; go to next; /* */ /* This next procedure gets the next header section in the specified segment and returns an action indicator and the primary line of the header section */ get_section: proc(segptr,action,key); dcl segptr ptr, /* pointer to current header segment status block */ action fixed bin(17), /* action to be taken */ key char(40) aligned, /* primary statement from current section */ string char(stringl) based(string_ptr), /* current header segment */ stringl fixed bin(17), /* length of string */ string_ptr ptr, /* pointer to string */ linespace char(40), /* space for line */ line char(ll) based(line_ptr), /* current primary line for section */ line_ptr ptr init(addr(linespace)), /* pointer to linespace */ ll fixed bin(17); /* current line length */ dcl 1 info based(segptr), /* header segment status block */ 2 seg_ptr ptr, /* pointer to header segment */ 2 begin_sect fixed bin(17), /* index to beginning of current section */ 2 pos fixed bin(17), /* index to current position in header segment */ 2 fin fixed bin(17), /* end of data reached in this header segment */ 2 eod fixed bin(17); /* number of characters in header segment */ dcl get_line internal entry; /* internal procedure to get next line to specified breaks */ stringl = eod; /* get length of current header segment */ string_ptr = seg_ptr; /* get pointer to current header segment */ if fin = 1 then do; /* we are trying to read off the end of the segment,error */ call com_err_(0,"edit_mst_header","Premature end of data reached on old header segment. Current line is: ^a",ekey); go to leave; end; begin_sect = pos + 1; /* am starting a new section */ call get_line(0,":;"); /* get first line of section */ if fin = 1 then if ll = 0 then return; /* no more data */ if line = "copy_to,replace:" then action = 1; /* map key words into instructions */ else if line = "copy_to,reload:" then action = 1; else if line = "copy_to:" then action = 3; else if line = "copy_thru:" then action = 2; else if line = "skip_to:" then action = 4; else if line = "skip_thru:" then action = 5; else do; /* not a control word so already have beginning of section */ action = 0; /* insert section */ go to skip; end; begin_sect = pos + 1; /* control word is not part of section */ call get_line(0,":;"); /* get first line of section */ skip: if line = "collection:" then do; /* collection mark haxs no end statement */ call get_line(11,",;"); /* get rest of line */ end; else if line ^= "fini:" then do; /* regular header section, must find end statement */ call get_line(ll,",;"); /* get rest of primary line */ call get_line(ll,""); /* find end statement */ end; key = line; /* return primary line */ if fin = 1 then do; /* data has ended in middle of header section */ call com_err_(0,"edit_mst_header","Premature end of header section. ^a",substr(string,begin_sect, eod-begin_sect+1)); /* print out error message */ go to leave; /* abort */ end; return; /* */ /* This next procedure returns the next statement up to the specified break in the string line. */ get_line: proc(offset,breaks); dcl offset fixed bin(17), /* offset in line of where to start placing new line */ breaks char(*), /* characters on which to break for this call */ ch char(1), /* current character */ i fixed bin(17), /* miscellaneous index */ end_flag fixed bin(17) init(0), /* 1 if we are searching for an end statement */ tab char(1) internal static init(" "); /* tab */ if length(breaks) = 0 then end_flag = 1; /* we are looking for an end statement */ ll = offset; /* set line length to starting position in line */ do pos = pos + 1 to eod; /* scan each character */ new_char: ch = substr(string,pos,1); /* get character */ if ch = "/" then if eod-pos > 2 then if substr(string,pos+1,1) = "*" then do; /* we are at the beginning of a comment */ i = index(substr(string,pos+2,eod-pos-1),"*/"); /* get position of end of comment */ if i = 0 then do; /* comment never ends */ call com_err_(0,"edit_mst_header","Unended comment. ^a", substr(string,pos,eod-pos+1)); /* print out bad comment */ go to leave; /* abort */ end; pos = i + pos + 3; /* move position to end of comment */ go to new_char; /* go pick up new character */ end; if ch ^= " " then if ch ^= tab then if ch ^= nl then do; /* skip blanks, tabs, and new lines */ if end_flag ^= 0 then do; /* search for end statement */ if ch = "e" then end_flag = 2; /* have found e */ else if end_flag ^= 1 then do; /* have already found part of end statement */ if ch = "n" & end_flag = 2 then end_flag = 3; /* have found en */ else if ch = "d" & end_flag = 3 then end_flag = 4; /* have found end */ else if ch = ";" & end_flag = 4 then return; /* have found end statement */ else end_flag = 1; end; end; else do; /* place character in line */ ll = ll + 1; /* increment line length */ if ll > 40 then do; /* line is too long */ call com_err_(0,"edit_mst_header","Statement too long. ^a",line); go to leave; end; do i = 1 to length(breaks); /* check for break character */ if ch = substr(breaks,i,1) then do; /* it is a break */ substr(linespace,ll,1) = substr(breaks,1,1); /* store character into line */ return; end; end; substr(linespace,ll,1) = ch; /* if not break then transfer character to line */ end; end; end; fin = 1; /* end of data reached */ end get_line; end get_section; end edit_mst_header; */ ----------------------------------------------------------- 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 */