$CONTROL USLINIT,CODE,MAP                                      <<01549>>00010000
<<command interpreter - module 51>>                            <<01549>>00015000
<< hp32002c mpe source c.00.00 >>                                       00020000
$copyright     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$thirty                                                                 00055000
$title "IMS"                                                            00060000
                                                               <<04705>>00065000
<<*********************************************************>>  <<04705>>00070000
<<                                                         >>  <<04705>>00075000
<<              cimgr   --  module 5c                      >>  <<04705>>00080000
<<                                                         >>  <<04705>>00085000
<<*********************************************************>>  <<04705>>00090000
                                                               <<04705>>00095000
                                                               <<04705>>00100000
                                                               <<04705>>00105000
<<*************************************************************<<u.rao>>00110000
<<*****************  command interpreter ims  *****************<<u.rao>>00115000
<<*************************************************************<<u.rao>>00120000
<<                                                             <<u.rao>>00125000
<<*************************************************************<<u.rao>>00130000
<<************************  overview  *************************<<u.rao>>00135000
<<*************************************************************<<u.rao>>00140000
<<                                                             <<u.rao>>00145000
<<who:                                                         <<u.rao>>00150000
<<   larry birenbaum designed the basic structures of the      <<u.rao>>00155000
<<command interpreter for version a of mpe.  work was begun in <<u.rao>>00160000
<<1970 or 1971.                                                <<u.rao>>00165000
<<   bob olson substantially redesigned the parsers of the     <<u.rao>>00170000
<<command interpreter for version b of mpe ii.  work was begun <<u.rao>>00175000
<<in november 1976 and completed in late 1977.  the basic      <<u.rao>>00180000
<<algorithms for executing the commands remained essentially   <<u.rao>>00185000
<<the same even though the parsers were rewritten.  several    <<u.rao>>00190000
<<new commands were added at this time, as were user defined   <<u.rao>>00195000
<<commands.                                                    <<u.rao>>00200000
<<   other people who have added commands or modified existing <<u.rao>>00205000
<<commands for mpe iib are ron hoyt and bob vannucci (private  <<u.rao>>00210000
<<volumes, including modification of the accounting commands   <<u.rao>>00215000
<<and store/restore), neal mack (transaction logging user      <<u.rao>>00220000
<<commands), mike philben (revision of ds commands), ed basart <<u.rao>>00225000
<<(revision of hello, job, and data and the addition of user   <<u.rao>>00230000
<<defined commands), and bob gerstmeyer (cline command).       <<u.rao>>00235000
<<                                                             <<u.rao>>00240000
<<where:                                                       <<u.rao>>00245000
<<   pieces of the command interpreter are scattered all over  <<u.rao>>00250000
<<the system.  this module contains the bulk of the executors. <<u.rao>>00255000
<<the spooling commands (showjob, showout, stream, and showin) <<u.rao>>00260000
<<may be found in the spoolcoms module.  the ds commands       <<u.rao>>00265000
<<(rfa, dsline, remote) will be found in the ds code.  store   <<u.rao>>00270000
<<and restore have a module of their own.  the bulk of the work<<u.rao>>00275000
<<for user defined commands is done in a module called udc.    <<u.rao>>00280000
<<help resides in module helpuser.  job, hello and data are    <<u.rao>>00285000
<<parsed by code in module nursery.  in general, it is better  <<u.rao>>00290000
<<to put the executors in the same module as the routines which<<u.rao>>00295000
<<do the work.  this will reduce confusion and simplify        <<u.rao>>00300000
<<maintenance.  there is no inherent benefit to accumulating   <<u.rao>>00305000
<<executors in common segments, assuming that there is         <<u.rao>>00310000
<<non-trivial work to do.                                      <<u.rao>>00315000
<<                                                             <<u.rao>>00320000
<<why:                                                         <<u.rao>>00325000
<<   the purpose served by the command interpreter is to       <<u.rao>>00330000
<<provide the user access to the operating system functions    <<u.rao>>00335000
<<without requiring him/her to go through the irritation of    <<u.rao>>00340000
<<writing a program to do so.  there are three primary function<<u.rao>>00345000
<<provided by the commands.  most important is the ability to  <<u.rao>>00350000
<<execute programs, evidenced by the run command and the variou<<u.rao>>00355000
<<compiler commands.  second is the ability to manage one's    <<u.rao>>00360000
<<resources, such as files.  finally there are a large number o<<u.rao>>00365000
<<utility functions, primarily for status checking.  when a new<<u.rao>>00370000
<<capability is added to the system, the user should be given  <<u.rao>>00375000
<<commands which allow him to manipulate the capability and to <<u.rao>>00380000
<<determine the status of the new resource created by the      <<u.rao>>00385000
<<capability.                                                  <<u.rao>>00390000
<<                                                             <<u.rao>>00395000
$page                                                                   00400000
<<*************************************************************<<u.rao>>00405000
<<****************  adding a command to the ci  ***************<<u.rao>>00410000
<<*************************************************************<<u.rao>>00415000
<<                                                             <<u.rao>>00420000
<<step 1:  designing the command.                              <<u.rao>>00425000
<<   a reasonable and parseable command syntax is one of the   <<u.rao>>00430000
<<important parts of designing a good command.  your goal is   <<u.rao>>00435000
<<to minimize user irritation when using the command.  always  <<u.rao>>00440000
<<remember that for most users the problem for which they are  <<u.rao>>00445000
<<using a computer is probably solved within an application    <<u.rao>>00450000
<<program of some sort and the command interpreter in general  <<u.rao>>00455000
<<and your command in particular are necessary annoyances.     <<u.rao>>00460000
<<you must strive to limit that annoyance to the unavoidable.  <<u.rao>>00465000
<<   unfortunately, there are a wide variety of ways in which  <<u.rao>>00470000
<<you can annoy people.  some of the solutions are mutually    <<u.rao>>00475000
<<incompatible.  the following is a list of the issues you     <<u.rao>>00480000
<<should consider.                                             <<u.rao>>00485000
<<   1)  verbose versus terse command names                    <<u.rao>>00490000
<<       in general it is desireable to have command names     <<u.rao>>00495000
<<       which accurately reflect the function of the          <<u.rao>>00500000
<<       command.  the tradeoff is that verbose command        <<u.rao>>00505000
<<       names which describe the command are easier to        <<u.rao>>00510000
<<       pick out in documentation whereas terse names are     <<u.rao>>00515000
<<       easier to type.  thus the deciding factor should      <<u.rao>>00520000
<<       be how often the user will use the command.  a        <<u.rao>>00525000
<<       side consideration is that the use of archaic         <<u.rao>>00530000
<<       english or bizarre abbreviations will work a          <<u.rao>>00535000
<<       hardship on our users who are not native english      <<u.rao>>00540000
<<       speakers.                                             <<u.rao>>00545000
<<   2)  keyword versus positional parameters                  <<u.rao>>00550000
<<       positional parameters can be dangerous, especially    <<u.rao>>00555000
<<       when the parameters can be similar data types.        <<u.rao>>00560000
<<       for example, a positional string of numbers can       <<u.rao>>00565000
<<       result in erroneous operation due to the accidental   <<u.rao>>00570000
<<       omission of a delimiter.  keyworded parameters        <<u.rao>>00575000
<<       can be very verbose, especially on complex commands.  <<u.rao>>00580000
<<       they can also work a hardship when a user uses a      <<u.rao>>00585000
<<       particular command heavily, since it drastically      <<u.rao>>00590000
<<       enlarges the amount of typing.  this last objection   <<u.rao>>00595000
<<       can be gotten around through the agency of user       <<u.rao>>00600000
<<       defined commands.  another major objection to         <<u.rao>>00605000
<<       keywords is that it requires several different        <<u.rao>>00610000
<<       delimiters, often leading to typing errors and        <<u.rao>>00615000
<<       mental confusion.                                     <<u.rao>>00620000
<<   3)  delimiters & other special characters                 <<u.rao>>00625000
<<       the typical delimiters in commands are commas to      <<u.rao>>00630000
<<       separate positional parameters and semicolons to      <<u.rao>>00635000
<<       separate keywords.  the file command shows this       <<u.rao>>00640000
<<       in full generality.  periods are sometimes            <<u.rao>>00645000
<<       terminators (as in the label option on the file       <<u.rao>>00650000
<<       command) and sometimes separators, as in the logon    <<u.rao>>00655000
<<       user id and file names.  blanks are tough to deal     <<u.rao>>00660000
<<       with and should be avoided as delimiters.             <<u.rao>>00665000
<<       non-printing characters should be avoided at all      <<u.rao>>00670000
<<       costs.  all commands will be terminated with a        <<u.rao>>00675000
<<       carriage return when passed to the command parser.    <<u.rao>>00680000
<<   4)  hardware/software peculiarities                       <<u.rao>>00685000
<<       too frequently the command syntax reflects some       <<u.rao>>00690000
<<       strange and unpleasant aspect of the mechanism        <<u.rao>>00695000
<<       underlying the command.  we should not require the    <<u.rao>>00700000
<<       user to be cognizant of our design problems.  to      <<u.rao>>00705000
<<       do so violates the principle of lowering the          <<u.rao>>00710000
<<       annoyance factor.                                     <<u.rao>>00715000
<<   5)  extensibility                                         <<u.rao>>00720000
<<       no matter how well your command does its job, one     <<u.rao>>00725000
<<       of these days someone will want to modify or          <<u.rao>>00730000
<<       extend it.  in particular, one should be careful      <<u.rao>>00735000
<<       about the use of delimiters in ways other than the    <<u.rao>>00740000
<<       "traditional" way.  for example, periods, commas,     <<u.rao>>00745000
<<       semicolons and others have fairly standardized        <<u.rao>>00750000
<<       meanings, and to use them in a different way reduces  <<u.rao>>00755000
<<       the options of your successor to extend your command. <<u.rao>>00760000
<<       another related issue is that listing formats should  <<u.rao>>00765000
<<       be extensible.                                        <<u.rao>>00770000
<<   6)  defaults                                              <<u.rao>>00775000
<<       defaults are vital, dangerous and difficult to choose.<<u.rao>>00780000
<<       the design goal is that the command should be simple  <<u.rao>>00785000
<<       for simple minded users.  this implies restraint in   <<u.rao>>00790000
<<       the use of defaults which vary depending on some other<<u.rao>>00795000
<<       parameter to the command.  too smart defaults can be  <<u.rao>>00800000
<<       just as bad as no defaults, since many users will     <<u.rao>>00805000
<<       use the command defensively to avoid surprises from   <<u.rao>>00810000
<<       the default mechanism.  good luck.                    <<u.rao>>00815000
<<   7)  ambiguity                                             <<u.rao>>00820000
<<       careful design will avoid the need for lookahead to   <<u.rao>>00825000
<<       resolve abiguous situations.  lookahead should be     <<u.rao>>00830000
<<       avoided if at all possible, as it results in          <<u.rao>>00835000
<<       much code with complicated data structures.           <<u.rao>>00840000
<<   8)  computerese                                           <<u.rao>>00845000
<<       keywords should be couched in english, not computerese<<u.rao>>00850000
<<                                                             <<u.rao>>00855000
<<in summary, the user of your command will probably not be a  <<u.rao>>00860000
<<computer professional and probably will be annoyed at the nee<<u.rao>>00865000
<<to use your command at all.  simplicity, understandability an<<u.rao>>00870000
<<regularity are the keys to good command syntax.              <<u.rao>>00875000
<<                                                             <<u.rao>>00880000
<<step 2: code the executor.                                   <<u.rao>>00885000
<<   for the most part this is quite straightforward.  most of <<u.rao>>00890000
<<the existing executors can be used as models.  there are a fe<<u.rao>>00895000
<<good concepts to keep in mind, however.                      <<u.rao>>00900000
<<   generating good error messages is just as important as    <<u.rao>>00905000
<<executing the command.  the whole error message issue is deal<<u.rao>>00910000
<<with below.                                                  <<u.rao>>00915000
<<   the code of the command should be easily extensible.  this<<u.rao>>00920000
<<implies the use of a simple parsing scheme with very obvious <<u.rao>>00925000
<<techniques.  probably more often than any other part of the  <<u.rao>>00930000
<<system, the ci is modified by people who have no proprietary <<u.rao>>00935000
<<interest in it.  in the interests of reliability and         <<u.rao>>00940000
<<maintainability, it is desireable to start with as clean code<<u.rao>>00945000
<<as possible.  unfortunately, no universal parsing scheme has <<u.rao>>00950000
<<yet been developed for the ci.                               <<u.rao>>00955000
<<   A trap to avoid is called the "parse a little, execute a  <<U.RAO>>00960000
<<little" syndrome.  It results in the need to back out of a   <<U.RAO>>00965000
<<situation when an error is detected further down stream.  a  <<u.rao>>00970000
<<secondary problem is that it tends to result in the          <<u.rao>>00975000
<<partial destruction of the context of the error.  a command  <<u.rao>>00980000
<<should be parsed completely before being executed at all.    <<u.rao>>00985000
<<   don't worry about having particularly efficient code.  the<<u.rao>>00990000
<<ci's execution time is trivial compared to the time it takes <<u.rao>>00995000
<<for the user to recover from a poorly designed error message <<u.rao>>01000000
<<or even from a poorly designed syntax.  the customer always  <<u.rao>>01005000
<<comes first.                                                 <<u.rao>>01010000
<<   the use of global storage is discouraged.  most important <<u.rao>>01015000
<<is the fact that there are some performance consequences     <<u.rao>>01020000
<<related to the need to constantly enlarge the ci's stack.    <<u.rao>>01025000
<<if you find you do need global storage, be sure to initialize<<u.rao>>01030000
<<it in procedure commandinterp, as the ci is procreated and   <<u.rao>>01035000
<<thus has no global initialization capability.  be careful    <<u.rao>>01040000
<<about where you put new globals.  certain other modules such <<u.rao>>01045000
<<as udc know about the ci global space.                       <<u.rao>>01050000
<<   in general, the execution part of the command should simpl<<u.rao>>01055000
<<be a call to the appropriate user callable intrinsic.  the   <<u.rao>>01060000
<<ci usually should not provide the user any special services  <<u.rao>>01065000
<<that are not available programmatically.  in this way we avoi<<u.rao>>01070000
<<such undesireable situations as users getting their accountin<<u.rao>>01075000
<<information through a call to the report command and setting <<u.rao>>01080000
<<up their files through a call to the file command through the<<u.rao>>01085000
<<command intrinsic.  see the setjcw command for an example of <<u.rao>>01090000
<<this.                                                        <<u.rao>>01095000
<<   exchangedb is to be avoided if at all possible, even if   <<u.rao>>01100000
<<you have to do data segment moves iteratively.  the speed cos<<u.rao>>01105000
<<is nothing compared to the cost of the crash which is        <<u.rao>>01110000
<<inevitable when doing split stack operations.  all of the ci <<u.rao>>01115000
<<utility routines assume no split stack operation.            <<u.rao>>01120000
<<   similarly there is rarely any valid reason for accessing  <<u.rao>>01125000
<<system primitives directly from the ci.  the ci should be a  <<u.rao>>01130000
<<very high level module.  it rarely has any business rooting  <<u.rao>>01135000
<<around in some system table.  this principle unfortunately ha<<u.rao>>01140000
<<been rather imperfectly adhered to.                          <<u.rao>>01145000
<<   these almost random thoughts about writing executors hardl<<u.rao>>01150000
<<provide a good framework for writing code.  cursory          <<u.rao>>01155000
<<examination of some of the executors currently in the module <<u.rao>>01160000
<<probably will give you a better idea of the tricks of the    <<u.rao>>01165000
<<trade.  a few ideas stand out.                               <<u.rao>>01170000
<<                                                             <<u.rao>>01175000
<<      code assuming someone else will be changing it.        <<u.rao>>01180000
<<                                                             <<u.rao>>01185000
<<      code for good error messages, not speed.               <<u.rao>>01190000
<<                                                             <<u.rao>>01195000
<<      it is far better to detect a problem at the            <<u.rao>>01200000
<<      time the command is put in than when it is             <<u.rao>>01205000
<<      executed.  that is, at parse time as opposed           <<u.rao>>01210000
<<      to execution time.                                     <<u.rao>>01215000
<<                                                             <<u.rao>>01220000
<<      cleverness will get you in trouble, usually for        <<u.rao>>01225000
<<      no good reason.                                        <<u.rao>>01230000
<<                                                             <<u.rao>>01235000
<<step 3:  add the command to the command interpreter.         <<u.rao>>01240000
<<   other than physically adding the executor to the system,  <<u.rao>>01245000
<<the only task is to add the command name to the list in      <<u.rao>>01250000
<<procedure comsearch.  this procedure is called for each      <<u.rao>>01255000
<<command to determine if it is one of the ones known to the   <<u.rao>>01260000
<<system.  the mechanics of this process are described in that <<u.rao>>01265000
<<procedure.  if the executor is physically outside the ci     <<u.rao>>01270000
<<module, don't forget to add the option external declaration. <<u.rao>>01275000
<<congratulations.  now all you need to do is make sure it     <<u.rao>>01280000
<<works.                                                       <<u.rao>>01285000
<<                                                             <<u.rao>>01290000
$page                                                                   01295000
<<*************************************************************<<u.rao>>01300000
<<**************  error messages from the ci  **************** <<u.rao>>01305000
<<*************************************************************<<u.rao>>01310000
<<                                                             <<u.rao>>01315000
<<philosophical aspects:                                       <<u.rao>>01320000
<<     the essential goal of an error message from the ci is to<<u.rao>>01325000
<<help the user quickly recover from his problem.  in general, <<u.rao>>01330000
<<a good error message should indicate:                        <<u.rao>>01335000
<<    1)  what the ci did not like.  on syntax errors this     <<u.rao>>01340000
<<        typically is done with a caret underneath where the  <<u.rao>>01345000
<<        problem was detected.  if the caret isn't sufficient <<u.rao>>01350000
<<        to identify the problem then some of the text of the <<u.rao>>01355000
<<        message should further elaborate.  on semantic errors<<u.rao>>01360000
<<        this usually is done with the text of the message.   <<u.rao>>01365000
<<    2)  how to recover.  this usually will take the form of  <<u.rao>>01370000
<<        telling the user what the valid input might be.  for <<u.rao>>01375000
<<        example, on an invalid record type in the :file      <<u.rao>>01380000
<<        command, the ci will put out a message something like<<u.rao>>01385000
<<        expected record type to be f, v or u.                <<u.rao>>01390000
<<        this serves to identify to the user very quickly what<<u.rao>>01395000
<<        the valid syntax is and thus how to get on with his  <<u.rao>>01400000
<<        business.  sometimes it is hard to figure out what th<<u.rao>>01405000
<<        user had in mind.  for example, it isn't really      <<u.rao>>01410000
<<        possible to second guess the user on an unknown      <<u.rao>>01415000
<<        command name.  in these relatively rare cases, it is <<u.rao>>01420000
<<        sufficient to tell the user just what was wrong.     <<u.rao>>01425000
<<        in general, if it is a syntax error of any sort, it  <<u.rao>>01430000
<<        is possible to give a good error message outlining   <<u.rao>>01435000
<<        what was expected.  a cop-out on this is really      <<u.rao>>01440000
<<        sloppy workmanship.                                  <<u.rao>>01445000
<<    3)  in many cases it is desireable to tell the user what <<u.rao>>01450000
<<        was done about the error.  this is particularly true <<u.rao>>01455000
<<        in the case of warnings, where the user may be left  <<u.rao>>01460000
<<        wondering whether some default was taken.  for exampl<<u.rao>>01465000
<<        in the accounting structure commands we ignore many  <<u.rao>>01470000
<<        errors.  in each case it is necessary to tell the use<<u.rao>>01475000
<<        what default we took so that he can then do an altxxx<<u.rao>>01480000
<<        to fix up the particular error, if necessary.  of    <<u.rao>>01485000
<<        course, in each case we try to pick a reasonable     <<u.rao>>01490000
<<        default so that he doesn't have to do any recovery.  <<u.rao>>01495000
<<                                                             <<u.rao>>01500000
<<in any case, messages should be very specific.  given the    <<u.rao>>01505000
<<very simple mechanism for generating error and warning       <<u.rao>>01510000
<<messages, there is no acceptable excuse for generic messages.<<u.rao>>01515000
<<examples:                                                    <<u.rao>>01520000
<<   "INVALID NUMBER" is unacceptable.  such messages should be<<u.rao>>01525000
<<of the form "EXPECTED <item> TO BE BETWEEN <n1> AND <n2>."   <<u.rao>>01530000
<<this message should be used only once in the ci.             <<u.rao>>01535000
<<   "UNKNOWN KEYWORD" is unacceptable.  the proper form is    <<u.rao>>01540000
<<"EXPECTED ONE OF <item1>, <item2>....".                      <<u.rao>>01545000
<<   in general, "<item>", "<n1>" and so forth should not be   <<u.rao>>01550000
<<passed to cierr as parameters but rather be embedded as part <<u.rao>>01555000
<<of the error message.  the reason for this is that you will  <<u.rao>>01560000
<<need to give a fuller description of the error in the error  <<u.rao>>01565000
<<messages part of the mpe manual.  it is awkward at best and  <<u.rao>>01570000
<<embarrassing at worst to have to tell the manual writer "Well<<U.RAO>>01575000
<<it could be this, or it could be that, or even this third    <<u.rao>>01580000
<<thing."  The one exception is where truly dynamic information<<U.RAO>>01585000
<<is involved.  examples might include configuration data and  <<u.rao>>01590000
<<user supplied information like file names.>>                 <<u.rao>>01595000
<<   in most cases, redundantly specified parameters should    <<u.rao>>01600000
<<result not in a fatal error but in a warning.  if a value is <<u.rao>>01605000
<<associated with the redundant keyword then the message should<<u.rao>>01610000
<<specify that the last value found was used.                  <<u.rao>>01615000
<<   similarly unacceptable messages are                       <<u.rao>>01620000
<<   "INSUFFICIENT PARAMETERS" - what is missing?              <<u.rao>>01625000
<<   "INSUFFICIENT CAPABILITY" should say what capability is   <<u.rao>>01630000
<<missing.                                                     <<u.rao>>01635000
<<   "INSUFFICIENT RESOURCES" should say what resources are    <<u.rao>>01640000
<<lacking.                                                     <<u.rao>>01645000
<<and so forth for all messages.                               <<u.rao>>01650000
<<                                                             <<u.rao>>01655000
<<mechanical aspects of adding error messages:                 <<u.rao>>01660000
<<                                                             <<u.rao>>01665000
<<1)  numbering                                                <<u.rao>>01670000
<<    the number chosen for a message is largely irrelevant.  i<<u.rao>>01675000
<<    is nice, however, if it is near the other messages       <<u.rao>>01680000
<<    associated with the same command.  be sure to declare it <<u.rao>>01685000
<<    as an equate in the ci globals (or spoolcoms or whatever)<<u.rao>>01690000
<<    note that the message should be tagged as to whether it i<<u.rao>>01695000
<<    a cierr or ciwarn or whatever.  put it in message set 2. <<u.rao>>01700000
<<2)  generation                                               <<u.rao>>01705000
<<    there is a procedure called cierr which is responsible fo<<u.rao>>01710000
<<    processing related to the handling of errors.  in        <<u.rao>>01715000
<<    particular this procedure decides whether to print the   <<u.rao>>01720000
<<    message, abort the job, and other related cleanup        <<u.rao>>01725000
<<    problems.  note that it always returns to the caller if  <<u.rao>>01730000
<<    the job is not aborted.  it is the responsibility of the <<u.rao>>01735000
<<    caller to assure that the job is clean enough to be      <<u.rao>>01740000
<<    aborted at the time of the call.  cierr cannot be called <<u.rao>>01745000
<<    in split stack mode.  see the listing of cierr for the   <<u.rao>>01750000
<<    details of the call.                                     <<u.rao>>01755000
<<3)  errors detected by other parts of the system.            <<u.rao>>01760000
<<    errors such as file system errors, loader errors, ds     <<u.rao>>01765000
<<    runtime errors and private volume errors are really of   <<u.rao>>01770000
<<    little meaning in the context of the ci.  accordingly,   <<u.rao>>01775000
<<    when such errors are detected, several messages may be   <<u.rao>>01780000
<<    displayed.  this is done through the agency of routines  <<u.rao>>01785000
<<    like ferror', cydirerr', loaderror, and createerror.     <<u.rao>>01790000
<<    the development of such routines is encouraged whenever  <<u.rao>>01795000
<<    message sets outside the ci error message set is         <<u.rao>>01800000
<<    involved.  when such a message is output, the ci should  <<u.rao>>01805000
<<    also print a message translating the error into the      <<u.rao>>01810000
<<    context of the command which failed.  for example, when  <<u.rao>>01815000
<<    a purge fails for an unusual reason, we print the file   <<u.rao>>01820000
<<    system error message as well as a message saying that the<<u.rao>>01825000
<<    purge was not done.                                      <<u.rao>>01830000
<<4)  general purpose parsing routines                         <<u.rao>>01835000
<<    some parses, such as file names, are done so often that  <<u.rao>>01840000
<<    generalized routines exist.  usually these will be found <<u.rao>>01845000
<<    in the neighborhood of the error handling routines.      <<u.rao>>01850000
<<5)  programmatically callable commands                       <<u.rao>>01855000
<<    for errors in programmatically callable commands you must<<u.rao>>01860000
<<    also return the error number to the caller of the command<<u.rao>>01865000
<<    intrinsic.  this is done by returning the number through <<u.rao>>01870000
<<    the errnum parameter to all executors.  also it is       <<u.rao>>01875000
<<    required that you return the parameter number in the     <<u.rao>>01880000
<<    parmnum parameter.  parameter number is roughly defined  <<u.rao>>01885000
<<    as one for each entity such as a keyword or value past   <<u.rao>>01890000
<<    the command name.  in other words, 1 is the first        <<u.rao>>01895000
<<    parameter past the command name, 2 might be the value to <<u.rao>>01900000
<<    be associated with the keyword which was parameter 1.    <<u.rao>>01905000
<<                                                             <<u.rao>>01910000
<<   error message generation is one of the most important     <<u.rao>>01915000
<<tasks to be performed by the command interpreter.  the best  <<u.rao>>01920000
<<error messages are generated when the coder tries to envision<<u.rao>>01925000
<<the user's perception of the error.  for example, in many    <<u.rao>>01930000
<<cases it seems to the user that it was obvious what he meant <<u.rao>>01935000
<<even though it was not expressed in correct form.  this      <<u.rao>>01940000
<<includes redundantly specified keywords like nocctl in the   <<u.rao>>01945000
<<file command.  the user does not think highly of a command   <<u.rao>>01950000
<<parser which gives him an error message on something like tha<<u.rao>>01955000
<<which is obviously non-fatal.  the key to success with error <<u.rao>>01960000
<<messages is to identify errors in the user's frame of        <<u.rao>>01965000
<<reference, not the system programmer's.                      <<u.rao>>01970000
<<                                                             <<u.rao>>01975000
$title "GLOBAL DECLARATIONS"                                            01980000
$page "GLOBAL DECLARATIONS"                                             01985000
$control main=command'interp                                   <<06.eb>>01990000
begin                                                                   01995000
      <<miscellaneous declarations >>                                   02000000
      integer                                                           02005000
      deltaq=q-0,                                                       02010000
      s0=s-0,                                                           02015000
      s1=s-1,                                                           02020000
      s2=s-2,                                                           02025000
      s4=s-4,                                                           02030000
      s5=s-5,                                                           02035000
      x=x;                                                              02040000
                                                                        02045000
      logical                                                           02050000
      ls0=s-0,                                                          02055000
      ls1=s-1,                                                          02060000
      ls2=s-2,                                                          02065000
      status=q-1;                                                       02070000
                                                                        02075000
      double                                                            02080000
      ds1=s-1;                                                 << i.a >>02085000
                                                                        02090000
      byte pointer                                                      02095000
      bps0=s-0;                                                << i.a >>02100000
                                                                        02105000
      integer pointer                                                   02110000
      ps0=s-0;                                                 << i.a >>02115000
                                                                        02120000
      double pointer                                                    02125000
      dps0=s-0;                                                << i.a >>02130000
                                                                        02135000
      integer array arrdb0(*)=db+0;                                     02140000
      integer array arrdb2(*)=db+2;                                     02145000
      integer array arrq0(*)=q-0;                                       02150000
      integer array arrqp1(*)=q+1;                                      02155000
      integer array arrqp2(*)=q+2;                                      02160000
$include inclpxg                                               <<06585>>02165000
$include inclcis                                               <<04705>>02170000
      <<equates used throughout>>                                       02175000
                                                                        02180000
      equate                                                            02185000
      << series 33 cpu number returned from 'thiscpu' >>       <<00492>>02190000
      <<condition codes>>                                               02195000
      cce=2,                                                            02200000
      ccl=1,                                                            02205000
      ccg=0,                                                            02210000
      <<ci message set numbers>>                               <<u.rao>>02215000
      cierrmsgset=2,                                           <<u.rao>>02220000
      cigeneralmsgset=7,                                       <<u.rao>>02225000
      fserrormsgset = 8,                                       <<u.rao>>02230000
   <<equates for general messages (not error messages)>>       <<u.rao>>02235000
   jobprival       = 1,                                        <<u.rao>>02240000
   reportline1     =   4,  <<report header>>                   <<u.rao>>02245000
   reportline2     =   5,  <<report header>>                   <<u.rao>>02250000
   purgegroupq     =  30,  <<purge group ?>>                   <<rv.pv>>02255000
   << end of prepare = 51, >>                                  <<u.rao>>02260000
   << end of subsystem = 52, >>                                <<u.rao>>02265000
   << end of compile = 53, >>                                  <<u.rao>>02270000
   << end of remote program = 54>>                             <<u.rao>>02275000
   <<jcw = warn, msg 56>>                                      <<u.rao>>02280000
   <<jcw = fatal, msg 57>>                                     <<u.rao>>02285000
   <<jcw = system, msg 58>>                                    <<u.rao>>02290000
   <<ds message, msg 59>>                                      <<u.rao>>02295000
   <<ds message, msg 60>>                                      <<u.rao>>02300000
      <<error equates refer to c.i. error number>>                      02305000
                                                                        02310000
<< listf command >>                                            <<u.rao>>02315000
   listffserr       = 425, <<listf file sys error>>            <<u.rao>>02320000
   listfflabioerr  = 428,  <<io error reading file label>>     <<u.rao>>02325000
   noxxxlisted     = 431,                                      <<03.km>>02330000
   nogrpslisted    = 432,                                      <<03.km>>02335000
   novsdslisted    = 435,                                      <<03.km>>02340000
<< group name errors >>                                        <<u.rao>>02345000
   grpexpectalpha  = 540  ,                                    <<u.rao>>02350000
   fgnamebase=grpexpectalpha-1,                                <<u.rao>>02355000
<< account name errors >>                                      <<u.rao>>02360000
   acctexpectalpha = 550  ,                                    <<u.rao>>02365000
   fanamebase=acctexpectalpha-1,                               <<u.rao>>02370000
   acctnametoolong = 552  ,                                    <<u.rao>>02375000
<< volume set definition name errors >>                        <<u.rao>>02380000
   vsdexpectalpha  = 570  ,                                    <<u.rao>>02385000
   vsdnamebase     = vsdexpectalpha-1,                         <<u.rao>>02390000
<< user name errors >>                                         <<u.rao>>02395000
   userexpectalpha = 590,                                      <<u.rao>>02400000
   usernamebase    = userexpectalpha-1,                        <<u.rao>>02405000
<< other subsystem errors (basic, spl, rje, etc. >>            <<u.rao>>02410000
   subsnotfound    = 641,                                      <<u.rao>>02415000
   subs2mp         = 642,                                      <<u.rao>>02420000
   dumpfilenotopt  = 645,                                      <<u.rao>>02425000
   dumpfilenotbackref = 646,                                   <<u.rao>>02430000
   dssubsnotfound  = 647,  <<ds not found>>                    <<u.rao>>02435000
   subsyscreateerr = 650,  <<unable to create subsystem>>      <<u.rao>>02440000
   subsysloaderr   = 651,  <<unable to load subsystem>>        <<u.rao>>02445000
   subsnotcreate   = 660,  <<createprocess failed on subsys.>> <<01452>>02450000
<<organizational management command error messages>>           <<u.rao>>02455000
<< resetacct command >>                                        <<u.rao>>02460000
   resacctjustat   = 700,   <<expected just "@">>              <<u.rao>>02465000
   resacctexpect   = 701,   <<expected cpu or connect>>        <<u.rao>>02470000
   resacct2mp      = 702,                                      <<u.rao>>02475000
<< report command >>                                           <<u.rao>>02480000
   reportnotamat   = 705,   <<said "@", is not am>>            <<u.rao>>02485000
   reportnotamlogon= 706,   <<not logon group>>                <<u.rao>>02490000
   reportnotsmat   = 707,   <<wants all accts, not sm>>        <<u.rao>>02495000
   reportnotsmlogon= 708,   <<wants other acct, not sm>>       <<u.rao>>02500000
   reportexpectlist= 709,   <<expected list file name>>        <<u.rao>>02505000
   report2mp       = 710,                                      <<u.rao>>02510000
   reportextranleaf= 711,  <<extraneous data in leaf name>>    <<rv.pv>>02515000
<< purgeacct, purgegroup, purgeuser, purgevsd commands >>      <<u.rao>>02520000
   purgegroup2mp   = 715,                                      <<u.rao>>02525000
<< listacct, listgroup, listuser, listvsd commands >>          <<u.rao>>02530000
   listacctextran  = 723,  <<unidentifiable garbage in name>>  <<rv.pv>>02535000
   listacctnotat   = 724,  <<not sm, can't look outside acct>> <<rv.pv>>02540000
   listacctsmlogon = 725,  <<not sm, can't look outside acct>> <<rv.pv>>02545000
   listacctxpctlst = 726,  <<expected list file>>              <<rv.pv>>02550000
   listacct2mp     = 727,                                      <<rv.pv>>02555000
<< newacct, newgroup, newuser, altacct, altuser, altgroup >>   <<u.rao>>02560000
   altacct2mp      = 730,  <<max of 71 parameters>>            <<rv.pv>>02565000
   altgroup2mp     = 731,  <<ditto>>                           <<rv.pv>>02570000
   altuser2mp      = 732,                                      <<rv.pv>>02575000
   newacct2mp      = 733,                                      <<rv.pv>>02580000
   newgroup2mp     = 734,                                      <<rv.pv>>02585000
   newuser2mp      = 735,                                      <<rv.pv>>02590000
   newacctxpctcma  = 736,  <<expect comma before mgr name>>    <<rv.pv>>02595000
   orgcomnokey     = 737,  <<expected keyword>>                <<rv.pv>>02600000
   orgcomxpctequals= 738,  <<expected = after keyword>>        <<rv.pv>>02605000
   orgcomunknonkey = 739,  <<unknown keyword>>                 <<rv.pv>>02610000
   orgcomxpctkeywd = 740,  <<unidentifiable keyword>>          <<rv.pv>>02615000
   orgcomunotaccess= 741,  <<not appropriate for user>>        <<rv.pv>>02620000
   orgcomaccessrdnd= 742,  <<access redundantly specified>>    <<rv.pv>>02625000
   orgcomunksubq   = 743,  <<unidentified subq name>>          <<rv.pv>>02630000
   orgcomrdndmaxpri= 744,  <<maxpri redundantly specified>>    <<rv.pv>>02635000
   orgcomgnotmaxpri= 745,  <<not appropriate for group>>       <<rv.pv>>02640000
   orgcomrdndcapky = 746,  <<redundant capability list>>       <<rv.pv>>02645000
   orgcomissingcap = 747,  <<no capability specified - ignored><<rv.pv>>02650000
   orgcomunkcap    = 748,  <<unknown capability type>>         <<rv.pv>>02655000
   orgcomcapcontxt = 749,  <<not allowed cap for group>>       <<rv.pv>>02660000
   orgcomredundcap = 750,  <<redundantly specified capability>><<rv.pv>>02665000
   orgcomforcaiaba = 751,  <<forced ia & ba on account>>       <<rv.pv>>02670000
   orgcomforcuiaba = 752,  <<forced ia & ba on user>>          <<rv.pv>>02675000
   orgcomglocattr  = 753,  <<inappropriate for groups>>        <<rv.pv>>02680000
   orgcommgrmising = 754,  <<required manager name missing>>   <<u.rao>>02685000
   mgrnamebase = orgcommgrmising-1,                            <<rv.pv>>02690000
   orgcompassnota  = 760,  <<password must start with alpha>>  <<rv.pv>>02695000
   passwordbase    = orgcompassnota-1,                         <<rv.pv>>02700000
   orgcomrdndpass  = 761,  <<password redundantly defined>>    <<rv.pv>>02705000
   orgcomuhomegrp  = 765,  <<only appropriate for user>>       <<rv.pv>>02710000
   orgcomfunotdbl  = 767,  <<inappropriate for user>>          <<rv.pv>>02715000
   orgcomfilesbase = orgcomfunotdbl,                           <<rv.pv>>02720000
   orgcomunotvs    = 771,  <<inappropriate for user>>          <<00580>>02725000
   orgcomcpunotdbl = 773,  <<cpu inappropriate for user>>      <<rv.pv>>02730000
   orgcomcpubase   = orgcomcpunotdbl,                          <<rv.pv>>02735000
   dirugotnoiaba   = 777,  << user without ia, ba >>           <<01320>>02740000
   dirggotnoiaba   = 778,  << group without ia,ba >>           <<01320>>02745000
   orgcomconnotdbl = 779,  <<connect inappropriate for user>>  <<rv.pv>>02750000
   orgcomconnectbs = orgcomconnotdbl,                          <<rv.pv>>02755000
   altumgrsmcap    = 784,  <<removed sm cap from himself>>     <<00539>>02760000
   altacctsmcap    = 785,  <<override on removal of sys sm cap><<rv.pv>>02765000
   flimit'lt'used  = 786,  <<request less than actual>>        <<rv.pv>>02770000
   altgrpconnectlm = 787,  <<exceeds account limit>>           <<04703>>02775000
   altgrpcpulimits = 788,  <<exceeds account limit>>           <<04703>>02780000
   altgrpfilelimit = 789,  <<exceeds account limit>>           <<rv.pv>>02785000
   altgrpexcap     = 790,  <<exceeds account capabilites>>     <<rv.pv>>02790000
   altgrpfileactul = 791,  <<limit less than actual>>          <<rv.pv>>02795000
   altumgramcap    = 792,  <<removed am cap from self>>        <<rv.pv>>02800000
   altumaxpri      = 793,  <<exceeds account maxpri>>          <<rv.pv>>02805000
   altusercaps     = 794,  <<exceeds account capabilities>>    <<rv.pv>>02810000
   altuserlattr    = 795,  <<exceeds account locattr>>         <<rv.pv>>02815000
   orgcomrdndgroup = 796,  <<redundantly specified home group>><<u.rao>>02820000
   orgcomrdndlattr = 797,  <<redundantly specified locattr>>   <<u.rao>>02825000
   orgcominvldlatr = 798,  <<invalid integer>>                 <<u.rao>>02830000
   orgcomunkgcap   = 799,  <<invalid group capability>>        <<07.ro>>02835000
   am'switchedcaps = 800,  << altacct removed ia/ba from am>>  <<01450>>02840000
                                                                        02845000
   vsdefspechar    = 850,  <<contains spec char(s)>>           <<rv.pv>>02850000
   vsdefnotalpha   = 851,  <<first chaar must be alpha>>       <<rv.pv>>02855000
   vsdeftoolong    = 852,  <<name gtr than 8 chars>>           <<rv.pv>>02860000
   vsdefmissname   = 853,  <<name missing>>                    <<rv.pv>>02865000
   vsdeftoomany    = 854,  <<too many parms>>                  <<rv.pv>>02870000
   vsdeftoofew     = 855,  <<too few parms>>                   <<rv.pv>>02875000
   vsdefmisscolon  = 856,  <<missing colon in definition>>     <<rv.pv>>02880000
   vsdefdupmembdef = 857,  <<dup member definition>>           <<rv.pv>>02885000
   vsdefundfntype  = 858,  <<undefined disk type designator>>  <<rv.pv>>02890000
   vsdefundfnmastr = 859,  <<master vol undefined>>            <<rv.pv>>02895000
   vsdefillegalkey = 860,  <<illegal keyword>>                 <<rv.pv>>02900000
   vsdefmissequal  = 861,  <<missing equal after keyword>>     <<rv.pv>>02905000
   vsdefundfn      = 862,  <<volume name unidentified>>        <<rv.pv>>02910000
   vsdefdupmemb    = 863,  <<dup class member spec>>           <<rv.pv>>02915000
   <<864-863 are in catalog -- who uses them??>>               <<03.km>>02920000
   vsdnovolset     = 869,  <<class w/o parent set>>            <<03.km>>02925000
<< errors on $stdin >>                                         <<u.rao>>02930000
   errstdinio     =  901,     <<i/o error on $stdin>>          <<u.rao>>02935000
<< capability errors >>                                        <<u.rao>>02940000
   invldresp       = 985, <<expect "YES" or "NO">>             <<u.rao>>02945000
<< 1000's reserved for store/restore >>                        <<u.rao>>02950000
<< 1100's reserved for private volumes messages >>             <<u.rao>>02955000
   vcsrefnotalpha  = 1100, <<must start with alpha>>           <<rv.pv>>02960000
   vcsrefbase      = vcsrefnotalpha,                           <<rv.pv>>02965000
   orgcomrdndvs    = 1103, <<redundantly specified vs parm>>   <<rv.pv>>02970000
   orgcomspancntxt = 1104, <<span keyword out of context>>     <<rv.pv>>02975000
   altgrpbound     = 1106, <<current hvs is bound>>            <<rv.pv>>02980000
   altgrpfdomain   = 1107, <<group file domain not empty>>     <<rv.pv>>02985000
   altgrpvsnotmntd = 1108, <<vol set not previously mounted>>  <<rv.pv>>02990000
   xxxgrpspanfaild = 1109, <<span operation failed>>           <<rv.pv>>02995000
   listvbadint      = 1110, <<bad level # in listv>>           <<rh.pv>>03000000
   listvintovfl     = 1111, <<out of bounds>>                  <<rh.pv>>03005000
   listvsmcap       = 1112, <<need sm capability>>             <<rh.pv>>03010000
   listvamcap       = 1113, <<need am capability>>             <<rh.pv>>03015000
   listvexpectfile  = 1114, <<expected file name>>             <<rh.pv>>03020000
   listvfserr       = 1115, <<listv file sys error>>           <<rh.pv>>03025000
   listvextraneous  = 1116, <<unidentified fileset name>>      <<rh.pv>>03030000
   listv2mp         = 1117,  <<2 many parms to listv>>         <<rh.pv>>03035000
   altvsdvmax       = 1118, <<max allowable (8) members>>      <<rv.pv>>03040000
   altvsddupmemb    = 1119, <<dup set member specified>>       <<rv.pv>>03045000
   altvcsdupmemb    = 1120, <<dup class member specified>>     <<rv.pv>>03050000
   altvsdnotavsd    = 1121, <<specified vsname not set def>>   <<rv.pv>>03055000
   altvcsnotavcd    = 1122, <<specified vcname not class def>> <<rv.pv>>03060000
   xxxacctspanfaild= 1123, <<span operation failed>>           <<rv.pv>>03065000
   xxxacctprmnotopt= 1125, <<span parameter not optional>>     <<rv.pv>>03070000
   <<1126-1135 reserved for implicitmnt errors>>               <<03.km>>03075000
   im'mnterr       = 1126,   <<mount error recorded in dst>>   <<03.km>>03080000
   im'nodst        = 1127,   <<out of dst's>>                  <<03.km>>03085000
   im'novds        = 1128,   <<out of virtual mem for dst>>    <<03.km>>03090000
   im'nospace      = 1129,   <<out of space in dst>>           <<03.km>>03095000
   im'syserr       = 1130,   <<unknown error using dst>>       <<03.km>>03100000
<< 1200's reserved for user logging >>                         <<u.rao>>03105000
<< 1300's reserved for ds >>                                   <<u.rao>>03110000
<< 1400's reserved for startdevice (hello, job, data)>>        <<u.rao>>03115000
<< 1500 - 1529 reserved for showjob >>                         <<u.rao>>03120000
<< 1530 - 1579 reserved for showin and showout >>              <<u.rao>>03125000
<< 1580 - 1589 reserved for showdev >>                         <<u.rao>>03130000
<< 1590 - 1609 reserved for stream >>                          <<u.rao>>03135000
<< allocate and deallocate commands >>                         <<u.rao>>03140000
   alloc2mp        = 1650, <<de/allocate more than 2 parameters<<u.rao>>03145000
   allocnotenuf    = 1651, <<no parms to [de]allocate>>        <<u.rao>>03150000
   procnotall      = 1652,<<procedure not allocated>>          <<u.rao>>03155000
   procalloc       = 1653,<<procedure already allocated>>      <<u.rao>>03160000
   prognotall      = 1654,<<program not allocated>>            <<u.rao>>03165000
   progalloc       = 1655,<<program already allocated>>        <<u.rao>>03170000
   allocxprogproc  = 1656,  <<expect "PROGRAM","PROCEDURE">>   <<u.rao>>03175000
   allocnobackref  = 1657, <<no back ref for allocate>>        <<08.ro>>03180000
   allocnosysdef   = 1658, <<disallow sysdef file for alloc>>  <<08.ro>>03185000
<< quantum command >>                                          <<u.rao>>03190000
   quantum'nomo    = 1664, <<quantum replaced by tune.>>       <<01724>>03195000
<< allocate and deallocate  (cont.) >>                         <<00833>>03200000
   nodealocproc    = 1666, <<unable to deallocate procedure>>  <<00833>>03205000
   noalocproc      = 1667, <<unable to allocate procedure>>    <<00833>>03210000
   nodealocprog    = 1668, <<unable to deallocate program>>    <<00833>>03215000
   noalocprog      = 1669, <<unable to allocate program>>      <<00833>>03220000
<< showq command >>                                            <<u.rao>>03225000
   warnxparmsignored=1670, <<command has no parms, parms ignore<<u.rao>>03230000
<< jobpri command >>                                           <<u.rao>>03235000
   jobpri2mp       = 1700, <<more than two parms>>             <<u.rao>>03240000
   jobpriunknownq  = 1701, <<not one of cs,ds,es,0>>           <<u.rao>>03245000
   jobpriwarnnot0  = 1702, <<0 not allowed, forced to cs>>     <<u.rao>>03250000
   jobpridefcsmaxds= 1703,                                     <<u.rao>>03255000
   jobpridefcsmaxes= 1704,                                     <<u.rao>>03260000
   jobpridefdsmaxes= 1705,                                     <<u.rao>>03265000
<< cline command >>                                            <<u.rao>>03270000
   errctabfull     = 1760, <<cline equation table full>>       <<u.rao>>03275000
   errcnotfound    = 1761, <<back cline re. not found>>        <<u.rao>>03280000
   err2mcref       = 1762, <<too many back cline refs.>>       <<u.rao>>03285000
   errclinedesig   = 1763, <<invalid cline designator>>        <<u.rao>>03290000
   cln'no'name     = 1765, <<name  missing>>                   <<u.rao>>03295000
   clnmbedspecials = 1766, <<embedded specials in proper name>><<u.rao>>03300000
   clnleadingnum   = 1767, <<name may not begin with numeric>> <<u.rao>>03305000
   clnname2long    = 1768, <<name > 8 char long>>              <<u.rao>>03310000
   clnxpcteqsign   = 1769, <<expected equals sign>>            <<u.rao>>03315000
   clnkeyvalnotopt = 1770, <<value not optional>>              <<u.rao>>03320000
   clnbadint       = 1772, <<binary failed on integer>>        <<u.rao>>03325000
   clnbndserr0'377 = 1773, <<out of range>>                    <<u.rao>>03330000
   clnxpctkey      = 1775, <<expected a keyword>>              <<u.rao>>03335000
   clndev2long     = 1776, <<device name > 8 char long>>       <<u.rao>>03340000
   clndupkey       = 1777, <<redundant keyword>>               <<u.rao>>03345000
   clnbndserr0'63  = 1778, <<int out of range>>                <<u.rao>>03350000
   clnbndserr0'15  = 1779, <<int out of range>>                <<u.rao>>03355000
   clndrivernam2ln = 1780, <<driver name > 8 char long>>       <<u.rao>>03360000
   clnbndserr0'127 = 1781, <<int out of range>>                <<u.rao>>03365000
   clnreqline      = 1782, <<requires at least a line name>>   <<u.rao>>03370000
   clnreqadesig    = 1783, <<requires actual line designator>> <<u.rao>>03375000
   clnbref2mp      = 1784, <<back ref with parms illegal>>     <<u.rao>>03380000
      <<processing user defined commands - too deeply nested.>><<08.ro>>03385000
   comopenfail     = 1910, << error opening command file >>    <<00256>>03390000
   comlockfail     = 1912, << error locking command file >>    <<00256>>03395000
   comunlockfail   = 1913, << error unlocking command file >>  <<00256>>03400000
   comreadfail     = 1914, << error reading command file >>    <<00256>>03405000
   altuserunknownparm  = 1255,                                 <<04703>>03410000
   altacctunknownparm  = 1256,                                 <<04703>>03415000
   altgroupunknownparm = 1257,                                 <<04703>>03420000
   altunknownvsparm    = 1258,                                 <<04703>>03425000
                                                               <<03.eb>>03430000
      <<dst entries used throughout>>                                   03435000
                                                                        03440000
      ddsdst=20,                                                        03445000
                                                               <<00851>>03450000
      <<definitions for finding the plabel for showcom>>                03455000
                                                                        03460000
      sysdb=%1000,                                                      03465000
      plab'showcom=%133,                                                03470000
      << fcontrol definitions >>                               <<00851>>03475000
                                                               <<00851>>03480000
      <<words/flags>>                                                   03485000
                                                                        03490000
      linfo=%1167,                                                      03495000
      flagx=%1176,                                                      03500000
      logfileno=%1205,                                                  03505000
      logfilesize=%1203,                                                03510000
      logprocess=%1150,                                                 03515000
      maxqueue=%1333,                                                   03520000
      defaultqueue = %1334;                                    <<06586>>03525000
$include inclpcb5                                              <<06586>>03530000
logical pointer pcb = syspcbindex;                             <<06586>>03535000
$include incljmat                                              << 8879>>03540000
                                                                        03545000
      <<defines used throughout>>                                       03550000
                                                                        03555000
      <<code definitions>>                                              03560000
                                                                        03565000
      define                                                            03570000
      duplicate = assemble (dup)#,                                      03575000
      cc = status . (6:2)#,                                             03580000
      lbparmdecs=array lparm (*) = parms;                               03585000
                 byte array bparm (*) = parms #,                        03590000
      nextline=assemble (zero,dzro);                           <<01881>>03595000
               print (*, *, *)#,                               <<01881>>03600000
<<        def'movefromdseg          >>                         <<u.rao>>03605000
<< to use, declare subroutine def'movefromdseg >>              <<u.rao>>03610000
   def'movefromdseg =                                          <<u.rao>>03615000
      movefromdseg(target,dstn,offset,count);                  <<u.rao>>03620000
         value target,dstn,offset,count;                       <<u.rao>>03625000
         logical target,dstn,offset,count;                     <<u.rao>>03630000
      begin                                                    <<u.rao>>03635000
         x := tos; << save return address >>                   <<u.rao>>03640000
         assemble(mfds 0);                                     <<u.rao>>03645000
         tos := x; << restore return address >>                <<u.rao>>03650000
      end #,                                                   <<u.rao>>03655000
                                                               <<u.rao>>03660000
<<        def'movetodseg            >>                         <<u.rao>>03665000
<< to use, declare subroutine def'movetodseg >>                <<u.rao>>03670000
   def'movetodseg =                                            <<u.rao>>03675000
      movetodseg(dstn,offset,source,count);                    <<u.rao>>03680000
         value dstn,offset,source,count;                       <<u.rao>>03685000
         logical dstn,offset,source,count;                     <<u.rao>>03690000
      begin                                                    <<u.rao>>03695000
         x := tos;                                             <<u.rao>>03700000
         assemble(mtds 0);                                     <<u.rao>>03705000
         tos := x;                                             <<u.rao>>03710000
      end #,                                                   <<u.rao>>03715000
                                                               <<u.rao>>03720000
                                                                        03725000
      << fields/flags>>                                                 03730000
                                                                        03735000
                                                               <<02.ro>>03740000
<<delimiter array declarations>>                               <<u.rao>>03745000
                                                               <<u.rao>>03750000
commacr = [8/",",8/%15]#,                                      <<u.rao>>03755000
commasemicr = [8/",",8/";",8/%15,8/0]d#,                       <<u.rao>>03760000
                                                               <<u.rao>>03765000
      <<executor procedure heading>>                                    03770000
                                                                        03775000
      executorhead =                                                    03780000
      (parmsp,errnum,parmnum);                                          03785000
      byte array parmsp;                                                03790000
      integer errnum,parmnum #,                                         03795000
                                                                        03800000
                                                                        03805000
                                                              <<00.gen>>03810000
                                                              <<00.gen>>03815000
<<  p r o d u c e p a r m s   d e f i n i t i o n s  >>       <<00.gen>>03820000
                                                              <<00.gen>>03825000
       d'inx1=     ppresult #,                                <<00.gen>>03830000
       d'inx2=     ppresult(1) #,                             <<04.gen>>03835000
       d'type=     ppresult(2) #,                             <<00.gen>>03840000
       d'fname=    ppresult(3) #,                             <<00.gen>>03845000
       d'vname=    ppresult(3) #,                             <<00.gen>>03850000
       d'gname=    ppresult(7) #,                             <<00.gen>>03855000
       d'uname=    ppresult(7) #,                             <<00.gen>>03860000
       d'aname=    ppresult(11) #,                            <<00.gen>>03865000
       g'fname=    ppresult(19) #,                            <<00.gen>>03870000
       g'vname=    ppresult(19) #,                            <<00.gen>>03875000
       g'gname=    ppresult(23) #,                            <<00.gen>>03880000
       g'uname=    ppresult(23) #,                            <<00.gen>>03885000
       g'aname=    ppresult(27) #,                            <<00.gen>>03890000
       d'bgname=    bppresult(14) #,                          <<00.gen>>03895000
       d'baname=    bppresult(22) #;                           << i.a >>03900000
                                                              <<00.gen>>03905000
  <<length of "DIRECSCAN" recip parameter  >>                 <<00.gen>>03910000
  <<and offset therein to "PPRESULT" at end>>                 <<00.gen>>03915000
  <<of parameter to facilitate extensions  >>                 <<00.gen>>03920000
                                                              <<00.gen>>03925000
                                                               <<01.pv>>03930000
                                                               <<01.pv>>03935000
<<  d i r e c t o r y   e n t r y   d e f i n i t i o n s  >>  <<01.pv>>03940000
equate                                                         <<01.pv>>03945000
   namesize        = 4,                  <<unpacked rep>>      <<01.pv>>03950000
                   <<entry equates>>                           <<01.pv>>03955000
                                                               <<01.pv>>03960000
                                                               <<01.pv>>03965000
<< account entry >>                                            <<01.pv>>03970000
   aname           = 0,                  <<name>>              <<01.pv>>03975000
   agipntr         = aname+namesize,     <<group index pntr>>  <<01.pv>>03980000
   auipntr         = agipntr+1,          <<user index pntr>>   <<01.pv>>03985000
   acap            = auipntr+1,          <<capability>>        <<01.pv>>03990000
   alattr          = acap+2,                                   <<01.pv>>03995000
   apass           = alattr+2,                                 <<01.pv>>04000000
   adfscount       = apass+namesize,     <<disc file space>>   <<01.pv>>04005000
   adfslimit       = adfscount+2,                              <<01.pv>>04010000
   acpucount       = adfslimit+2,        <<cpu time>>          <<01.pv>>04015000
   acpulimit       = acpucount+2,                              <<01.pv>>04020000
   acontimecount   = acpulimit+2,        <<connect time>>      <<01.pv>>04025000
   acontimelimit   = acontimecount+2,                          <<01.pv>>04030000
   asecw           = acontimelimit+2,                          <<01.pv>>04035000
   amaxjobw        = asecw+1,            <<max. job priority>> <<01.pv>>04040000
   aspare1         = amaxjobw+1,                               <<rv.pv>>04045000
   aspare2         = aspare1 +1,                               <<rv.pv>>04050000
   asize           = aspare2 +1,                               <<rv.pv>>04055000
                                                               <<01.pv>>04060000
<<group entry>>                                                <<01.pv>>04065000
   gname           = 0,                  <<name>>              <<01.pv>>04070000
   gfipntr         = gname+namesize,     <<file index>>        <<01.pv>>04075000
   gpass           = gfipntr+1,          <<password>>          <<01.pv>>04080000
   gdfscount       = gpass+namesize,     <<disc file space>>   <<01.pv>>04085000
   gdfslimit       = gdfscount+2,                              <<01.pv>>04090000
   gcpucount       = gdfslimit+2,        <<cpu time>>          <<01.pv>>04095000
   gcpulimit       = gcpucount+2,                              <<01.pv>>04100000
   gcontimecount   = gcpulimit+2,                              <<01.pv>>04105000
   gcontimelimit   = gcontimecount+2,                          <<01.pv>>04110000
   gsec            = gcontimelimit+2,                          <<01.pv>>04115000
   gcap            = gsec +2,                                  <<01.pv>>04120000
   glinkage        = gcap+1,                                   <<01.pv>>04125000
   gvsdipntr       = glinkage+1,         <<vs def index pntr>> <<01.pv>>04130000
   ghvsname        = gvsdipntr+1,        <<home vs name>>      <<01.pv>>04135000
   ghvsaname       = ghvsname,           << "   "  acct name>> <<01.pv>>04140000
   ghvsgname       = ghvsaname+namesize, << "   "  grp  name>> <<01.pv>>04145000
   ghvsvsname      = ghvsgname+namesize, << "   "  vs   name>> <<01.pv>>04150000
   gsavefipntr     = ghvsvsname+namesize,                      <<13.pv>>04155000
   gmountrefcntr   = gsavefipntr+1,                            <<13.pv>>04160000
   gspare          = gmountrefcntr+1,                          <<13.pv>>04165000
   gsize           = gspare +1;                                <<01.pv>>04170000
<<glinkage definitions>>                                       <<01.pv>>04175000
define                                                         <<01.pv>>04180000
   pvf             = 0:1 #,                                    <<01.pv>>04185000
   mvtabxf         = 8:8 #;                                    <<01.pv>>04190000
define                                                         <<10.km>>04195000
   pvmvtabxf= 4:4 #;                   <<pvinfo field>>        <<10.km>>04200000
equate                                                         <<01.pv>>04205000
   pv              = 1,                                        <<01.pv>>04210000
   vmax            = 8,                  <<vol membership max>><<01.pv>>04215000
                                                               <<01.pv>>04220000
                                                               <<01.pv>>04225000
<<user entry>>                                                 <<01.pv>>04230000
   uname           = 0,                  <<name>>              <<01.pv>>04235000
   ucap            = uname+namesize,     <<capability>>        <<01.pv>>04240000
   ulattr          = ucap+2,                                   <<01.pv>>04245000
   upass           = ulattr+2,                                 <<01.pv>>04250000
   uhgroup         = upass+namesize,     <<home group>>        <<01.pv>>04255000
   ulogcount       = uhgroup+namesize,   <<# of users logged>> <<01.pv>>04260000
   umaxjob         = ulogcount+1,                              <<01.pv>>04265000
   uspare          = umaxjob +1,                               <<01.pv>>04270000
   usize           = uspare +1,                                <<01.pv>>04275000
                                                               <<01.pv>>04280000
<<volume set definition entry>>                                <<01.pv>>04285000
   gvsname         = 0,                  <<volume set name>>   <<01.pv>>04290000
   gvslinkagew     = gvsname+namesize,   <<mvtab linkage>>     <<01.pv>>04295000
   gvsinfo         = gvslinkagew+1,      <<definition info>>   <<01.pv>>04300000
   gvsmembers      = gvsinfo+1,          <<vmax members>>      <<01.pv>>04305000
                                         <<member info>>       <<01.pv>>04310000
                                         <<vmax members>>      <<01.pv>>04315000
   gvsvolname      = gvsmembers,         <<member name>>       <<01.pv>>04320000
   gvsvolflags     = gvsvolname+namesize,<<member stat flags>> <<01.pv>>04325000
   gvsvolinfo      = gvsvolflags+1,      <<member attribs>>    <<01.pv>>04330000
   gvsdrefcnt      = (gvsinfo-gvsname+1)*(vmax+1),             <<rv.pv>>04335000
   gvsdspare2      = gvsdrefcnt+1,                             <<rv.pv>>04340000
   gvsdsize        = gvsdspare2+1,                             <<rv.pv>>04345000
                                                               <<01.pv>>04350000
<<volume class definition entry>>                              <<01.pv>>04355000
   gvcname        = 0,                   <<volume class name>> <<01.pv>>04360000
   gvclinkagew     = gvcname+namesize,                         <<01.pv>>04365000
   gvcinfo         = gvclinkagew+1,      <<definition info>>   <<01.pv>>04370000
   gvcpname        = gvcinfo+1,          <<parent def  name>>  <<01.pv>>04375000
   gvcpaname       = gvcpname,           <<  "    ACCT   " >>  <<01.pv>>04380000
   gvcpgname       = gvcpaname+namesize, <<  "    GRP    " >>  <<01.pv>>04385000
   gvcpvsname      = gvcpgname+namesize, <<  "    VS     " >>  <<01.pv>>04390000
   gvcunused       = gvcpvsname+namesize,                      <<01.pv>>04395000
   gvcdsize        = gvsdsize,                                 <<01.pv>>04400000
                                                               <<01.pv>>04405000
                                                               <<01.pv>>04410000
<<entry types>>                                                <<01.pv>>04415000
   filelevel       = 0,                                        <<01.pv>>04420000
   grouplevel      = 1,                                        <<01.pv>>04425000
   accountlevel    = 2,                                        <<01.pv>>04430000
   userlevel       = 3,                                        <<01.pv>>04435000
   vsdeflevel      = 4;                                        <<rv.pv>>04440000
                                                               <<01.pv>>04445000
<<directory search type word definitions>>                     <<01.pv>>04450000
define                                                         <<01.pv>>04455000
   startlevelf     = 13:3 #,                                   <<01.pv>>04460000
   endlevelf       = 10:3 #,                                   <<01.pv>>04465000
   allflag         =  9:1 #,                                   <<01.pv>>04470000
   endlevelfx      =  9:4 #,                                   <<01.pv>>04475000
   tolevelf        =  6:3 #,                                   <<01.pv>>04480000
   hitflag         =  5:1 #;                                   <<01.pv>>04485000
equate                                                         <<01.pv>>04490000
   allxxx          = %(2)1000,                                 <<04.pv>>04495000
   allaccts        = allxxx + accountlevel,                    <<04.pv>>04500000
   allgroups       = allxxx + grouplevel,                      <<04.pv>>04505000
   allusers        = allxxx + userlevel;                       << i.a >>04510000
equate                                                         <<04178>>04515000
   ppr'len         = 31 +    << "ppresult" size >>             <<04178>>04520000
                     asize+1+<< account entry size >>          <<04178>>04525000
                     gsize+1,<< group entry size   >>          <<04178>>04530000
   sysl'parmlen    = 35 + ppr'len,<< "syslist" parm >>         <<04178>>04535000
   sysl'pprinx     = sysl'parmlen - ppr'len,                   <<04178>>04540000
   rcr'parmlen     = 4 + ppr'len, << "rcreport" parm >>        <<04178>>04545000
   rcr'pprinx      = rcr'parmlen - ppr'len,                    <<04178>>04550000
   savebuffindex = sysl'pprinx + 31;                           <<04178>>04555000
                                                               <<03.km>>04560000
<<directory search states (returned by recip)>>                <<03.km>>04565000
equate gotsir=          1,                                     << i.a >>04570000
       nextson=         0,                                     <<03.km>>04575000
       nextbrother=     2,                                     <<03.km>>04580000
       nextuncle=       nextbrother,   <<not implemented>>     <<03.km>>04585000
       revisit=         %100000,                               <<03.km>>04590000
       abortscan=       4,                                     <<03.km>>04595000
       nextson'sir=     nextson+gotsir,                        <<03.km>>04600000
       nextbrother'sir= nextbrother+gotsir,                    <<03.km>>04605000
       nextuncle'sir=   nextuncle+gotsir,                      <<03.km>>04610000
                                                               <<01.pv>>04615000
<< organizational commands :newxxx, :altxxx communication >>   <<rv.pv>>04620000
    vsspecified   = %100000,                                   <<rv.pv>>04625000
    spanspecified = %040000,                                   <<rv.pv>>04630000
    altspecified  = %020000,                                   <<00086>>04635000
    vsmask        = 0,                                         <<rv.pv>>04640000
    vshaname      = vsmask+1,                                  <<rv.pv>>04645000
    vshgname      = vshaname+namesize,                         <<rv.pv>>04650000
    vshvname      = vshgname+namesize,                         <<rv.pv>>04655000
    vscommsz'     = vshvname+namesize,                         <<rv.pv>>04660000
    vscommsz      = vscommsz'+1,                               <<rv.pv>>04665000
    specmaskln    = 3;                                         <<rv.pv>>04670000
$page   "EXTERNAL DECLARATIONS"                                         04675000
                                                               << i.a >>04680000
<< external/forward mpe intrinsics >>                          << i.a >>04685000
                                                               << i.a >>04690000
   procedure date'line(string);                                <<0u.eb>>04695000
      byte array string; option external;                      <<0u.eb>>04700000
                                                               <<0u.eb>>04705000
intrinsic setjcw,getjcw;                                       << i.a >>04710000
   logical procedure binary (string, length);                           04715000
   value length;                                                        04720000
   byte array string;                                                   04725000
   integer length;                                                      04730000
   option external;                                                     04735000
                                                                        04740000
   integer procedure exchangedb(dstno);                                 04745000
   value dstno;                                                         04750000
   integer dstno;                                                       04755000
   option external;                                                     04760000
                                                                        04765000
   double procedure dbinary(string,length);                             04770000
   value length;                                                        04775000
   byte array string;  integer length;                                  04780000
   option external;                                                     04785000
                                                                        04790000
   integer procedure ascii (word, base, string);                        04795000
   value word, base;                                                    04800000
   logical word;                                                        04805000
   integer base;                                                        04810000
   byte array string;                                                   04815000
   option external;                                                     04820000
                                                                        04825000
   integer procedure dascii(word,base,string);                          04830000
   value word,base;                                                     04835000
   double word;                                                         04840000
   integer base;                                                        04845000
   byte array string;                                                   04850000
   option external;                                                     04855000
                                                                        04860000
   integer procedure read (string, expectedl);                          04865000
   value expectedl;                                                     04870000
   array string;                                                        04875000
   integer expectedl;                                                   04880000
   option external;                                                     04885000
                                                                        04890000
   procedure print (string, length, type);                              04895000
   value length, type;                                                  04900000
   array string;                                                        04905000
   integer length;                                                      04910000
   logical type;                                                        04915000
   option external;                                                     04920000
                                                                        04925000
   integer procedure search (target, length, dict, defn);               04930000
   value length;                                                        04935000
   byte array target, dict;                                             04940000
   integer length;                                                      04945000
   byte pointer defn;                                                   04950000
   option external, variable;                                           04955000
                                                               <<01.01>>04960000
   integer procedure mycommand                                          04965000
   (comimage,delims,maxparms,numparms,parms,dict,defn);                 04970000
   value maxparms;                                                      04975000
   byte array comimage,delims,dict;                                     04980000
   integer maxparms, numparms;                                          04985000
   double array parms;                                                  04990000
   byte pointer defn;                                                   04995000
   option variable,external;                                            05000000
                                                                        05005000
   procedure who(mode,cap,lattr,usern,groupn,acctn,homen,termnum);      05010000
   logical mode;                                                        05015000
   double cap,lattr;                                                    05020000
   byte array usern,groupn,acctn,homen;                                 05025000
   logical termnum;                                                     05030000
   option variable,external;                                            05035000
                                                                        05040000
   logical procedure parse'density(parm,parmlen,den'value);    <<02569>>05045000
   value parmlen;                                              <<02569>>05050000
   integer den'value,parmlen;                                  <<02569>>05055000
   byte array parm;                                            <<02569>>05060000
   option external;                                            <<02569>>05065000
                                                               <<02569>>05070000
   integer procedure fopen (filedesignator,foptions, aoptions, recsize, 05075000
   device, formmsg, recmode, blockfactor, numbuffers, filesize,         05080000
   numextents, initalloc, filecode);                                    05085000
   value foptions, aoptions, recsize, recmode, blockfactor, numbuffers, 05090000
   filesize, numextents, initalloc, filecode;                           05095000
   byte array filedesignator,  device, formmsg;                         05100000
   logical foptions, aoptions;                                          05105000
   integer recsize, recmode, blockfactor, numbuffers, numextents,       05110000
   initalloc, filecode;                                                 05115000
   double filesize;                                                     05120000
   option variable, external;                                           05125000
                                                               <<00098>>05130000
   procedure fclose (filenum, disposition, seccode);                    05135000
   value filenum, disposition, seccode;                                 05140000
   integer filenum, disposition, seccode;                               05145000
   option external;                                                     05150000
                                                                        05155000
   procedure fwrite(fnum,target,count,cont);                            05160000
   value fnum,count,cont;                                               05165000
   integer fnum,count,cont;                                             05170000
   array target;                                                        05175000
   option external;                                                     05180000
                                                                        05185000
   procedure fcheck(filenum,errorcode,tlog,blknum,numrecs);             05190000
   value filenum;                                                       05195000
   integer filenum,errorcode,tlog,numrecs;                              05200000
   double blknum;                                                       05205000
   option variable,external;                                            05210000
                                                                        05215000
   procedure fgetinfo                                                   05220000
   (fnum,filename,foptions,aoptions,recsize,devtype,ldnum,hdaddr,       05225000
    filecode,recptr,eof,limit,logcount,physcount,blksize,extsize,       05230000
    numextents,userlabels,creatorid,labaddr);                           05235000
   value fnum;                                                          05240000
   integer fnum,recsize,devtype,filecode,blksize,numextents,userlabels; 05245000
   byte array filename,creatorid;                                       05250000
   logical foptions,aoptions,ldnum,hdaddr,extsize;                      05255000
   double recptr,eof,limit,logcount,physcount,labaddr;                  05260000
   option variable,external;                                            05265000
                                                                        05270000
   double procedure direcinsert (type, linkage'indexp, an,     <<38.pv>>05275000
                                 gun, fn, e, mvtabx);          <<38.pv>>05280000
   value type, linkage'indexp, mvtabx;                         <<38.pv>>05285000
   integer type, mvtabx;                                       <<38.pv>>05290000
   double  linkage'indexp;                                     <<38.pv>>05295000
   array an, gun, fn;                                                   05300000
   array e;                                                             05305000
   option external, variable;                                  <<12.pv>>05310000
                                                                        05315000
   double procedure direcpurge (t, linkage'indexp, an,         <<38.pv>>05320000
                                gun, fn, mvtabx);              <<38.pv>>05325000
   value t, linkage'indexp, mvtabx;                            <<38.pv>>05330000
   integer t, mvtabx;                                          <<38.pv>>05335000
   double  linkage'indexp;                                     <<38.pv>>05340000
   array an, gun, fn;                                                   05345000
   option external, variable;                                  <<21.pv>>05350000
                                                                        05355000
   double procedure subqueue (n, c);                                    05360000
   value n, c;                                                          05365000
   integer n, c;                                                        05370000
   option external;                                                     05375000
                                                                        05380000
   procedure createprocess (error,pin,progname,optnums,opts);  <<01200>>05385000
   integer error,pin;                                          <<01200>>05390000
   byte array progname;                                        <<01200>>05395000
   integer array optnums;                                      <<01200>>05400000
   logical array opts;                                         <<01200>>05405000
   option variable, external;                                  <<01200>>05410000
                                                               <<01200>>05415000
   procedure create(progname,entryname,pin,parm,flags,                  05420000
   stack,dl,maxdata,pri,rank);                                          05425000
   value parm,stack,dl,pri,flags,maxdata,rank;                          05430000
   logical pin,parm,flags,pri;                                          05435000
   integer stack,dl,maxdata,rank;                                       05440000
   byte array progname, entryname;                                      05445000
   option external, variable;                                           05450000
                                                                        05455000
   procedure awake(pcbpt,n,wtflg);                                      05460000
   value pcbpt,n,wtflg;                                                 05465000
   integer pcbpt,n,wtflg;                                               05470000
   option external;                                                     05475000
                                                               <<02318>>05480000
logical procedure setcritical;                                 <<02318>>05485000
option external;                                               <<02318>>05490000
                                                                        05495000
procedure resetcritical( parm );                               <<04792>>05500000
   value parm;  logical parm;                                  <<04792>>05505000
option external;                                               <<04792>>05510000
                                                               <<04792>>05515000
   logical procedure getsir (n);                                        05520000
   value n;                                                             05525000
   logical n;                                                           05530000
   option external;                                                     05535000
                                                                        05540000
   procedure relsir (n,t);                                              05545000
   value n, t;                                                          05550000
   logical n, t;                                                        05555000
   option external;                                                     05560000
                                                                        05565000
   double procedure direcfind (type,linkage'indexp,aname,      <<38.pv>>05570000
                               guname,fname,enry);             <<38.pv>>05575000
   value type,linkage'indexp;                                  <<38.pv>>05580000
   integer type;                                               <<38.pv>>05585000
   double  linkage'indexp;                                     <<38.pv>>05590000
   array aname,guname,fname,enry;                                       05595000
   option external;                                                     05600000
                                                                        05605000
   double procedure direcscan (type,linkage'indexp,aname,      <<38.pv>>05610000
                               guname,fname,recip,ldn,mvtabx); <<38.pv>>05615000
   value type,linkage'indexp,mvtabx;                           <<38.pv>>05620000
   integer type,mvtabx;                                        <<38.pv>>05625000
   double  linkage'indexp;                                     <<38.pv>>05630000
   array aname,guname,fname,ldn;                                        05635000
   integer procedure recip;                                             05640000
   option external,variable;                                   <<35.pv>>05645000
                                                                        05650000
   integer procedure addjtentry(n1,n2,n3,tno,size,info);                05655000
   value size,tno;                                                      05660000
   integer size,tno;                                                    05665000
   byte array n1,n2,n3;                                                 05670000
   integer array info;                                                  05675000
   option external;                                                     05680000
                                                                        05685000
   integer procedure xaddjtentry(n1,n2,n3,tno,size,info,xn1,xn2,xn3);   05690000
   value size,tno;                                                      05695000
   integer size,tno;                                                    05700000
   byte array n1,n2,n3,xn1,xn2,xn3;                                     05705000
   integer array info;                                                  05710000
   option external;                                                     05715000
                                                                        05720000
   integer procedure xremjtentry(n1,n2,n3,tno);                         05725000
   value tno;                                                           05730000
   integer tno;                                                         05735000
   byte array n1,n2,n3;                                                 05740000
   option external;                                                     05745000
                                                                        05750000
   double procedure attachio(ldev,qmisc,dstx,addr,func,cnt,p1,p2,flags);05755000
   value ldev,qmisc,dstx,addr,func,cnt,p1,p2,flags;                     05760000
   integer ldev,qmisc,dstx,addr,func,cnt,p1,p2,flags;                   05765000
   option external;                                                     05770000
                                                                        05775000
   integer procedure allocateproc(nam);                                 05780000
   byte array nam;                                                      05785000
   option external;                                                     05790000
                                                                        05795000
   integer procedure allocateprog(nam);                                 05800000
   byte array nam;                                                      05805000
   option external;                                                     05810000
                                                                        05815000
   integer procedure deallocateproc(nam);                               05820000
   byte array nam;                                                      05825000
   option external;                                                     05830000
                                                                        05835000
   integer procedure deallocateprog(nam);                               05840000
   byte array nam;                                                      05845000
   option external;                                                     05850000
                                                                        05855000
   procedure showmq;                                                    05860000
   option external;                                                     05865000
                                                                        05870000
integer procedure genmsg(setno,msgno,mask,a,b,c,d,e,           <<0u.eb>>05875000
      dest,reply,buff,dst,iotype);                             <<0u.eb>>05880000
   value setno,msgno,mask,a,b,c,d,e,dest,reply,buff,           <<0u.eb>>05885000
      dst,iotype;                                              <<0u.eb>>05890000
   logical setno,msgno,mask,a,b,c,d,e,dest,reply,buff,         <<0u.eb>>05895000
      dst,iotype;                                              <<0u.eb>>05900000
   option variable,external;                                   <<0u.eb>>05905000
                                                               <<u.rao>>05910000
   procedure suddendeath(errornumber);                                  05915000
   value errornumber;                                                   05920000
   integer errornumber;                                                 05925000
   option external;                                                     05930000
                                                                        05935000
procedure ctranslate(code,instring,outstring,stringlength,table);       05940000
   value code,stringlength;                                             05945000
   integer code,stringlength;                                           05950000
   byte array instring,outstring,table;                                 05955000
   option variable,external;                                            05960000
                                                                        05965000
integer procedure get'dsdevice( ldev );                        <<02848>>05970000
   value   ldev;                                               <<02848>>05975000
   integer ldev;                                               <<02848>>05980000
   option  privileged, uncallable, external;                   <<02848>>05985000
                                                               <<02848>>05990000
procedure mount (vsname,vsgroup,vsaccnt,reqtype,gen,           <<00211>>05995000
                 pvinfo,some'other'pin);                       <<00211>>06000000
   value gen,some'other'pin;                                   <<00211>>06005000
   integer reqtype,gen,pvinfo,some'other'pin;                  <<00211>>06010000
   byte array vsname,vsgroup,vsaccnt;                          <<rh.pv>>06015000
   option variable,external;                                   <<rh.pv>>06020000
                                                               <<rh.pv>>06025000
procedure dismount (vsname,vsgroup,vsaccnt,reqtype,            <<00211>>06030000
                    mvtabx,some'other'pin);                    <<00211>>06035000
   value mvtabx,some'other'pin;                                <<00211>>06040000
   integer reqtype,mvtabx,some'other'pin;                      <<00211>>06045000
   byte array vsname,vsgroup,vsaccnt;                          <<rh.pv>>06050000
   option variable,external;                                   <<rh.pv>>06055000
                                                               <<rh.pv>>06060000
integer procedure lun (vtabinx,mvtabx);                        <<rv.pv>>06065000
    value   vtabinx,mvtabx;                                    <<rv.pv>>06070000
    integer vtabinx,mvtabx;                                    <<rv.pv>>06075000
    option external;                                           <<rv.pv>>06080000
                                                               <<rv.pv>>06085000
procedure checkdisc(ldn,stat);                                 <<rh.pv>>06090000
   value ldn;                                                  <<rh.pv>>06095000
   integer ldn;                                                <<rh.pv>>06100000
   logical stat;                                               <<rh.pv>>06105000
   option external;                                            <<rh.pv>>06110000
                                                               <<rh.pv>>06115000
double procedure vtabindex(vid,vsid,ldn,gen);                  <<rh.pv>>06120000
   value ldn;                                                  <<rh.pv>>06125000
   integer ldn,gen;                                            <<rh.pv>>06130000
   byte array vid,vsid;                                        <<rh.pv>>06135000
   option variable,external;                                   <<rh.pv>>06140000
                                                               <<rh.pv>>06145000
procedure relcomrec(comfn,recno,errno);                        <<00256>>06150000
   value comfn,recno; integer comfn,recno,errno;               <<00256>>06155000
   option external;                                            <<00256>>06160000
                                                               <<00256>>06165000
procedure freaddir(filenum,target,tcount,recnum);              <<00256>>06170000
   value filenum,tcount,recnum;                                <<00256>>06175000
   integer filenum,tcount;                                     <<00256>>06180000
   logical array target;                                       <<00256>>06185000
   double recnum;                                              <<00256>>06190000
   option external;                                            <<00256>>06195000
                                                               <<00256>>06200000
procedure flock(filenum,lockcond);                             <<00256>>06205000
   value filenum,lockcond; integer filenum; logical lockcond;  <<00256>>06210000
   option external;                                            <<00256>>06215000
                                                               <<00256>>06220000
procedure funlock(filenum);                                    <<00256>>06225000
   value filenum; integer filenum;                             <<00256>>06230000
   option external;                                            <<00256>>06235000
                                                               <<00256>>06240000
procedure searchcomfile(comfn,uname,aname,urec,frec,errno);    <<00884>>06245000
   value comfn;  byte array uname,aname;                       <<00884>>06250000
   integer comfn,urec,frec,errno;                              <<00884>>06255000
   option variable,external;                                   <<00884>>06260000
                                                               <<00256>>06265000
   integer procedure cyimplctfile'(lhs,rhs,lenr);              <<u.rao>>06270000
   value lenr;                                                 <<u.rao>>06275000
   integer lenr;                                               <<u.rao>>06280000
   byte array lhs, rhs;                                        <<u.rao>>06285000
   option privileged, uncallable, external;                    << i.a >>06290000
                                                               <<u.rao>>06295000
procedure ferror'(fnum,parmnum);                               <<u.rao>>06300000
value fnum;                                                    <<u.rao>>06305000
integer fnum,parmnum;                                          <<u.rao>>06310000
option privileged, uncallable,external;                        << i.a >>06315000
                                                                        06320000
   procedure cierr(errnum,erradr,parmmask,parm);               <<u.rao>>06325000
   value errnum,parmmask,parm;                                 <<u.rao>>06330000
   integer errnum,parmmask,parm;                               <<u.rao>>06335000
   byte array erradr;                                          <<u.rao>>06340000
   option privileged,uncallable,variable,external;             << i.a >>06345000
                                                               <<u.rao>>06350000
logical procedure cyorgcoms'(errnum,parmnum,image,level,newentry,       06355000
                             vscomm,specmask);                 <<rv.pv>>06360000
value level;                                                   <<u.rao>>06365000
integer errnum;                                                <<u.rao>>06370000
integer parmnum;                                               <<u.rao>>06375000
byte array image;                                              <<u.rao>>06380000
integer level;                                                 <<u.rao>>06385000
integer array newentry;                                        <<u.rao>>06390000
array vscomm;                                                  <<rv.pv>>06395000
array specmask;                                                <<rv.pv>>06400000
option variable,privileged,uncallable,forward;                 <<u.rao>>06405000
                                                                        06410000
   integer procedure syslist (element, level, parms, sirs);             06415000
   value level, parms, sirs;                                            06420000
   array element;                                                       06425000
   integer level, parms;                                                06430000
   double sirs;                                                         06435000
   option forward, privileged, uncallable;                              06440000
                                                                        06445000
procedure cydirerr'(direcreturn,okmask,errnum);                <<u.rao>>06450000
value direcreturn,okmask;                                      <<u.rao>>06455000
double direcreturn;                                            <<u.rao>>06460000
integer errnum;                                                <<u.rao>>06465000
logical okmask;                                                <<u.rao>>06470000
option privileged,uncallable,external;                         << i.a >>06475000
                                                                        06480000
integer procedure checkfilename'(pdef,gptr,aptr,errptr);       <<u.rao>>06485000
value pdef; double pdef;                                       <<u.rao>>06490000
logical gptr,aptr,errptr;                                      <<u.rao>>06495000
option privileged, uncallable, external;                       << i.a >>06500000
                                                               <<u.rao>>06505000
logical procedure cibadfilename(errnum,parm);                  <<u.rao>>06510000
value parm;                                                    <<u.rao>>06515000
integer errnum;                                                <<u.rao>>06520000
double parm;                                                   <<u.rao>>06525000
option privileged,uncallable,external;                         << i.a >>06530000
                                                               <<u.rao>>06535000
integer procedure checkhomeacct(ppresult);                     <<u.rao>>06540000
integer array ppresult;                                        <<u.rao>>06545000
option privileged, uncallable, forward;                        <<u.rao>>06550000
                                                                        06555000
integer procedure checkhomegroup(ppresult);                    <<u.rao>>06560000
integer array ppresult;                                        <<u.rao>>06565000
option privileged, uncallable, forward;                        <<u.rao>>06570000
procedure unlockjir(a);                                                 06575000
value a; integer a;                                                     06580000
option external;                                                        06585000
                                                                        06590000
integer procedure findjtentry(n1,n2,n3,tno,a,jdt);                      06595000
value tno;                                                              06600000
integer tno,jdt;                                                        06605000
byte array n1,n2,n3;                                                    06610000
logical a;                                                              06615000
option external;                                                        06620000
                                                                        06625000
                                                                        06630000
procedure loaderror(errnum);                                   <<u.rao>>06635000
value errnum; integer errnum;                                  <<u.rao>>06640000
option privileged,uncallable,external;                         << i.a >>06645000
                                                               <<u.rao>>06650000
logical procedure createerror;                                 <<u.rao>>06655000
option privileged,uncallable,external;                         << i.a >>06660000
                                                               <<u.rao>>06665000
   logical procedure requestservice;                                    06670000
   option privileged,uncallable,external;                      << i.a >>06675000
                                                                        06680000
   procedure cxdslined executorhead;                           <<ds0.0>>06685000
   option forward,privileged,uncallable;                       <<ds0.0>>06690000
                                                               <<ds0.0>>06695000
   procedure cxremoted executorhead;                           <<ds0.0>>06700000
   option forward,privileged,uncallable;                       <<ds0.0>>06705000
                                                               <<ds0.0>>06710000
   logical procedure createproc'err(error,errnum);             <<01452>>06715000
   value error; integer error,errnum;                          <<01452>>06720000
   option privileged,uncallable,external;                      << i.a >>06725000
                                                               <<01452>>06730000
   procedure cxrfad executorhead;                              <<ds0.0>>06735000
   option forward,privileged,uncallable;                       <<ds0.0>>06740000
                                                                        06745000
   procedure cxshowcom executorhead;                                    06750000
   option forward,privileged,uncallable;                                06755000
                                                               <<01115>>06760000
logical procedure cisubsysfinish(messgtype,errnum,parmnum);    <<01452>>06765000
   value messgtype;                                            <<01452>>06770000
   integer messgtype,errnum,parmnum;                           <<01452>>06775000
   option uncallable,privileged,external;                      << i.a >>06780000
                                                                        06785000
integer procedure formaccess'(level,accstring,sec,numparms     << i.a >>06790000
                               ,errnum);                       << i.a >>06795000
  value level;                                                 << i.a >>06800000
  integer level,                                               << i.a >>06805000
          numparms,                                            << i.a >>06810000
          errnum;                                              << i.a >>06815000
  byte array accstring;                                        << i.a >>06820000
  double sec;                                                  << i.a >>06825000
  option uncallable,privileged,                                << i.a >>06830000
         external;                                             << i.a >>06835000
                                                               << i.a >>06840000
integer procedure dirmatch(designator,realname);               << i.a >>06845000
  value designator,realname;                                   << i.a >>06850000
  byte pointer designator,                                     << i.a >>06855000
               realname;                                       << i.a >>06860000
  option uncallable,                                           << i.a >>06865000
         external;                                             << i.a >>06870000
                                                               << i.a >>06875000
logical procedure produceparms(leaflevel,qname,ppresult,       << i.a >>06880000
                               delim,errnum);                  << i.a >>06885000
  value leaflevel,qname;                                       << i.a >>06890000
  integer leaflevel,                                           << i.a >>06895000
          errnum;                                              << i.a >>06900000
  byte pointer qname,                                          << i.a >>06905000
               delim;                                          << i.a >>06910000
  array ppresult;                                              << i.a >>06915000
  option privileged,uncallable,                                << i.a >>06920000
         external;                                             << i.a >>06925000
                                                               << i.a >>06930000
procedure getdirinfo(startinx,deflevel,ppresult);              << i.a >>06935000
  value startinx,deflevel;                                     << i.a >>06940000
  integer startinx,                                            << i.a >>06945000
          deflevel;                                            << i.a >>06950000
  integer array ppresult;                                      << i.a >>06955000
  option privileged,uncallable,                                << i.a >>06960000
         external;                                             << i.a >>06965000
                                                               << i.a >>06970000
                                                                        06975000
$page   "FILE MANAGEMENT COMMAND EXECUTORS--RESET,SAVE,PURGE,RENAME"    06980000
$control   segment  =  cicomsys                                         06985000
$page "COMMAND'INTERP NM EXECUTOR HEAD-LINK/NET/SNA/NRJE(CONTROL)"      06990000
comment                                                        <<06853>>06995000
this procedure is one of the procedures maintained by          <<06853>>07000000
csy ci group.  the procedure will call an external network mgmt<<06853>>07005000
error procedure, and determine the action to take for the      <<06853>>07010000
user request.                                                  <<06853>>07015000
                                                               <<06853>>07020000
;                                                              <<06853>>07025000
procedure cxnetmgmt    executorhead;                           <<06853>>07030000
   option privileged,uncallable;                               <<06853>>07035000
                                                               <<06853>>07040000
begin                                                          <<06853>>07045000
                                                               <<06853>>07050000
entry                                                          <<06853>>07055000
     cxsnacontrol,                                             <<06853>>07060000
     cxnrjecontrol2,                                           <<06853>>07065000
     cxlinkcontrol,                                            <<06853>>07070000
     cxswitchnmlog,                                            <<06853>>07075000
     cxshownmlog,                                              <<06853>>07080000
     cxnetcontrol,                                             <<06853>>07085000
     cxresumenmlog;                                            <<06853>>07090000
                                                               <<06853>>07095000
                                                               <<06853>>07100000
intrinsic loadproc,unloadproc;                                 <<06853>>07105000
                                                               <<06853>>07110000
byte array                                                     <<06853>>07115000
 subparser(0:40);  << subsystem parser name      >>            <<06853>>07120000
                                                               <<06853>>07125000
byte array                                                     <<06853>>07130000
 subparm(0:40);    << parameter for ci call      >>            <<06853>>07135000
                                                               <<06853>>07140000
integer                                                        <<06853>>07145000
 plabel,           << returned from loadproc     >>            <<06853>>07150000
 subparmpoint,     << integer pointer to message >>            <<06853>>07155000
 subid;            << id number for uloadproc    >>            <<06853>>07160000
                                                               <<06853>>07165000
     cxsnacontrol:                                             <<06853>>07170000
      move subparser := "CXSNACONTROL' ";                      <<06853>>07175000
      go to startup;                                           <<06853>>07180000
                                                               <<06853>>07185000
     cxnrjecontrol2:                                           <<06853>>07190000
      move subparser := "CXNRJECONTROL' ";                     <<06853>>07195000
      go to startup;                                           <<06853>>07200000
                                                               <<06853>>07205000
     cxlinkcontrol:                                            <<06853>>07210000
      move subparser := "CXLINKCONTROL' ";                     <<06853>>07215000
      go to startup;                                           <<06853>>07220000
                                                               <<06853>>07225000
     cxswitchnmlog:                                            <<06853>>07230000
      move subparser := "CXSWITCHNMLOG' ";                     <<07451>>07235000
      go to startup;                                           <<06853>>07240000
                                                               <<06853>>07245000
     cxshownmlog:                                              <<06853>>07250000
      move subparser := "CXSHOWNMLOG' ";                       <<06853>>07255000
      go to startup;                                           <<06853>>07260000
                                                               <<06853>>07265000
     cxresumenmlog:                                            <<06853>>07270000
      move subparser := "CXRESUMENMLOG' ";                     <<06853>>07275000
      go to startup;                                           <<06853>>07280000
                                                               <<06853>>07285000
     cxnetcontrol:                                             <<06853>>07290000
      move subparser := "CXNETCONTROL' ";                      <<06853>>07295000
                                                               <<06853>>07300000
startup: << come here to begin execution >>                    <<06853>>07305000
                                                               <<06853>>07310000
                                                               <<06853>>07315000
subid := loadproc(subparser,0,plabel);  << check for exist >>  <<06853>>07320000
 if < then                                                     <<06853>>07325000
   begin                     << fail >>                        <<06853>>07330000
   unloadproc(subid);                                          <<06853>>07335000
   move subparm := ("NM-ERROR ROUTINE",0);                     <<06853>>07340000
   subparmpoint := @subparm;                                   <<06853>>07345000
   cierr(subsnotfound,,1,subparmpoint);                        <<06853>>07350000
   return;                                                     <<06853>>07355000
   end;                                                        <<06853>>07360000
                                                               <<06853>>07365000
<< plabel exists. use plabel, and unloadproc when done. >>     <<06853>>07370000
                                                               <<06853>>07375000
  tos := @parmsp;       <<   parmsp is the actual cmd buffer >><<06853>>07380000
  tos := @errnum;       << error number for ci calls         >><<06853>>07385000
  tos := @parmnum;      << parameter number                  >><<06853>>07390000
  tos := plabel;        << address to stack call to pcal.    >><<06853>>07395000
  assemble(pcal 0);     << call external procedure           >><<06853>>07400000
  unloadproc(subid);                                           <<06853>>07405000
                                                               <<06853>>07410000
 return;                                                       <<06853>>07415000
                                                               <<06853>>07420000
end; << of cxnetmgmt >>                                        <<06853>>07425000
                                                               <<ds0.0>>07430000
comment                                                        <<01452>>07435000
this procedure creates the dscopy process and passes to it the <<01452>>07440000
necessary information. the command string is passed using the  <<01452>>07445000
"INFO" facility in createprocess.                              <<01452>>07450000
;                                                              <<01452>>07455000
                                                               <<01452>>07460000
procedure cxdscopy executorhead;                               <<01452>>07465000
   option privileged,uncallable;                               <<01452>>07470000
                                                               <<01452>>07475000
begin                                                          <<01452>>07480000
array name'(0:7);                                              <<01452>>07485000
byte array name(*) = name';                                    <<01452>>07490000
integer pin,                                                   <<01452>>07495000
        len,                                                   <<01452>>07500000
        error;                                                 <<01452>>07505000
array itemcodes(0:10);                                         <<01452>>07510000
array items(0:10);                                             <<01452>>07515000
byte pointer tempbp;  << pointer to parameter string >>        <<01452>>07520000
                                                               <<01452>>07525000
equate                                                         <<01452>>07530000
  unknown'prog    =  6;   << createproc. can't find program >> <<01452>>07535000
                                                               <<01452>>07540000
<< get address and length of parameter string >>               <<01452>>07545000
scan parmsp while %6440,1;  << cr, blank >>                    <<01452>>07550000
if carry then   << all blanks >>                               <<01452>>07555000
   begin                                                       <<01452>>07560000
   del;                                                        <<01452>>07565000
   @tempbp := @parmsp;                                         <<01452>>07570000
   len := 0;                                                   <<01452>>07575000
   end                                                         <<01452>>07580000
else                                                           <<01452>>07585000
   begin        << something there >>                          <<01452>>07590000
   @tempbp := tos;                                             <<01452>>07595000
   scan tempbp until %15,1;  << cr >>                          <<01452>>07600000
   len := tos - @tempbp;                                       <<01452>>07605000
   end;                                                        <<01452>>07610000
                                                               <<01452>>07615000
move name := "DSCOPY.PUB.SYS ";                                <<01452>>07620000
                                                               <<01452>>07625000
move itemcodes := (3, << flags >>                              <<01452>>07630000
                  11, << info string address >>                <<01452>>07635000
                  12, << info string length >>                 <<01452>>07640000
                   0);                                         <<01452>>07645000
                                                               <<01452>>07650000
items(0) := 1;                                                 <<01452>>07655000
items(1) := @tempbp;                                           <<01452>>07660000
items(2) := len;                                               <<01452>>07665000
items(3) := 0;                                                 <<01452>>07670000
                                                               <<01452>>07675000
setjcw(getjcw land %37777);  << clear abort bits >>            <<01452>>07680000
                                                               <<01452>>07685000
createprocess (error, pin, name, itemcodes, items);            <<01452>>07690000
if < then                                                      <<01452>>07695000
   begin         << error. process not created >>              <<01452>>07700000
   name(6) := 0;                                               <<01452>>07705000
   if error = unknown'prog then                                <<01452>>07710000
      cierr( errnum := subsnotfound, , 0, @name )              <<01452>>07715000
   else                                                        <<01452>>07720000
      begin                                                    <<01452>>07725000
      createproc'err( error, errnum );                         <<01452>>07730000
      cierr( errnum := subsnotcreate, , 0, @name );            <<01452>>07735000
      end;                                                     <<01452>>07740000
   end                                                         <<01452>>07745000
else                                                           <<01452>>07750000
   begin                                                       <<01452>>07755000
   << check for createprocess warning. >>                      <<01452>>07760000
   if > then createproc'err( -error, errnum );                 <<01452>>07765000
                                                               <<01452>>07770000
   awake( pin * pcbsize, 1, 2 );                               <<01452>>07775000
   cisubsysfinish( 3, errnum, parmnum );                       <<01452>>07780000
   end;                                                        <<01452>>07785000
                                                               <<01452>>07790000
end;  << cxdscopy >>                                           <<01452>>07795000
                                                               <<01452>>07800000
procedure cxrfad executorhead;                                 <<ds0.0>>07805000
option privileged,uncallable;                                  <<ds0.0>>07810000
begin                                                          <<ds0.0>>07815000
<<  dummy procedure for commands "REMOTE", "DSLINE", and "RFA".         07820000
    if the ds/3000 subsystem resides in the system the plabels          07825000
    will be located in system db locations 360,361, and 362.            07830000
    if the plabel is zero the subsystem is not present and the          07835000
    corresponding ci error number is reported.  if the label does       07840000
    exist the respective procedure is called to process the command.    07845000
                                                                        07850000
                                                                      >>07855000
     entry                                                     <<ds0.0>>07860000
        cxdslined,                                             <<ds0.0>>07865000
        cxremoted;                                             <<ds0.0>>07870000
                                                               <<ds0.0>>07875000
     errnum := 1;                                              <<ds0.0>>07880000
    cxdslined:                                                 <<ds0.0>>07885000
     errnum := errnum + 1;                                     <<ds0.0>>07890000
    cxremoted:                                                 <<ds0.0>>07895000
     errnum := errnum + %1342;                                 <<ds0.0>>07900000
     tos := @parmsp;                                           <<ds0.0>>07905000
     tos := @errnum;                                           <<ds0.0>>07910000
     tos := @parmnum;                                          <<ds0.0>>07915000
     tos := absolute(errnum);                                  <<ds0.0>>07920000
     if <> then                                                <<ds0.0>>07925000
        begin                                                  <<ds0.0>>07930000
           errnum := 0;                                        <<ds0.0>>07935000
           assemble(pcal 0);                                   <<ds0.0>>07940000
        end                                                    <<ds0.0>>07945000
        else                                                   <<ds0.0>>07950000
             cierr(errnum := dssubsnotfound);                  <<u.rao>>07955000
end;                                                           <<ds0.0>>07960000
$control segment=cicomsys                                               07965000
                                                                        07970000
  <<this procedure calls the showcom command in cs>>                    07975000
                                                                        07980000
  procedure cxshowcom executorhead;                                     07985000
    option privileged,uncallable;                                       07990000
    begin                                                               07995000
      tos:=0;                                                           08000000
      tos:=@parmsp;                                                     08005000
      tos:=@errnum;                                                     08010000
      tos:=@parmnum;                                                    08015000
      tos:=absolute(sysdb+plab'showcom);                                08020000
      if < then assemble(pcal 0)                                        08025000
           else assemble(ddel,ddel);                                    08030000
    end;                                                                08035000
                                                                        08040000
procedure cxcline executorhead;                                         08045000
   option privileged,uncallable;                               <<02317>>08050000
begin                                                                   08055000
<< note that this command, cline, is really part of the cs >>  <<u.rao>>08060000
<< subsystem.                                   >>             <<01165>>08065000
<< september 1, 1978        bob gerstmyer          >>          <<01165>>08070000
     integer numparms;                                                  08075000
     equate maxparms = 50,                                              08080000
            parmsize = maxparms - 1;                                    08085000
     double array parms(0:parmsize);                                    08090000
     lbparmdecs;                                                        08095000
   byte pointer parmptr;   << pointer to current parameter >>  <<01165>>08100000
   integer parmlen,    << length of current parameter >>       <<01165>>08105000
      nextdelim;   << delimiter following current parameter >> <<01165>>08110000
     logical t3;                                               <<01165>>08115000
   integer binarydigit,        << used by binary intrinsic >>  <<01165>>08120000
      entrynum, t1, parm'indx;                                 <<01165>>08125000
     logical notfinished = t3,                                 <<01165>>08130000
         moreparms := false;<< need to call mycommand again >> <<01165>>08135000
     logical                                                   <<01165>>08140000
         lastparm'done,<<true if last parm for this key done>> <<01165>>08145000
          flags := 0,                                          <<01165>>08150000
          flags1 := 0,                                         <<01165>>08155000
          flags2 := 0,                                         <<01165>>08160000
          coptions := 0,                                       <<01165>>08165000
          aoptions := 0,                                       <<01165>>08170000
          doptions := 0,                                       <<01165>>08175000
          buffsize := 0,                                       <<01165>>08180000
          numbuffers := 0,                                     <<01165>>08185000
          ctraceinfo := 0;                                     <<01165>>08190000
     integer                                                   <<01165>>08195000
          devlen := 0,                                         <<01165>>08200000
          misclen := 0,                                        <<01165>>08205000
          locidlen := 0,                                       <<01165>>08210000
          remidlen := 0,                                       <<01165>>08215000
          driverlen := 0,                                      <<01165>>08220000
          suplistlen := 0,                                     <<01165>>08225000
          phlistlen := 0,                                      <<01165>>08230000
          pollistlen := 0;                                     <<01165>>08235000
   integer stringlen := 0,phlistnum := 0;                      <<01165>>08240000
     double                                                    <<01165>>08245000
          inspeed := 0d,                                       <<01165>>08250000
          outspeed := 0d;                                      <<01165>>08255000
     integer i,loc,len,listlen,seqnum,seqtype,                 <<01165>>08260000
             digitype,stringtype;                              <<01165>>08265000
   equate errname=%176;                                        <<01165>>08270000
     equate                                                    <<01165>>08275000
          pkeylistl     = 170,                                 <<01165>>08280000
          pdelimitersl  =   6;                                 <<01165>>08285000
     equate                                                    <<01165>>08290000
          codemax      = 63,                                   <<01165>>08295000
          lmodemax     = 15,                                   <<01165>>08300000
          protomax     = 255;                                  <<01165>>08305000
     equate                                                    <<01165>>08310000
          maxphonelen    = 20,                                 <<01165>>08315000
          maxidseqlen    = 16,                                 <<01165>>08320000
        << delimiter indices >>                                <<01165>>08325000
        comma      = 0,                                        <<01165>>08330000
        equals     = 1,                                        <<01165>>08335000
        semicolon  = 2,                                        <<01165>>08340000
        quote      = 3,                                        <<01165>>08345000
        leftparen  = 4,                                        <<01165>>08350000
        rightparen = 5,                                        <<01165>>08355000
        cr         = 6,                                        <<01165>>08360000
          string      = 0,                                     <<01165>>08365000
          digits      = 1,                                     <<01165>>08370000
          hex         = 0,                                     <<01165>>08375000
          octal       = 1,                                     <<01165>>08380000
          ascii       = 0,                                     <<01165>>08385000
          ebcdic      = 1,                                     <<01165>>08390000
          toebcdic    = 2;                                     <<01165>>08395000
     equate carriagereturn = %15;                              <<01165>>08400000
     equate                                                    <<01165>>08405000
          startofptrs      = 30,                               <<01165>>08410000
          locidptr         = startofptrs,                      <<01165>>08415000
          remidptr         = locidptr + 1,                     <<01165>>08420000
          suplistptr       = remidptr + 1,                     <<01165>>08425000
          phlistptr        = suplistptr + 1,                   <<01165>>08430000
          pollistptr       = phlistptr + 1,                    <<01165>>08435000
          miscptr          = pollistptr + 1,                   <<01165>>08440000
          startoflists     = miscptr + 1,                      <<01165>>08445000
          minentrysize1    = 7,                                <<01165>>08450000
          minentrysize2    = startoflists;                     <<01165>>08455000
     logical pointer misc,pollist;                             <<01165>>08460000
   equate                                                      <<01165>>08465000
      cln'dialval       = 1769,   << expect w,r,rw,no or 1-3 >><<01165>>08470000
      cln'lmodeval   = 1769,  << expect pri,sec,mpcnt,mpsec,dte,dce >>  08475000
      cln'codeval    = 1769,  << expect >>                     <<01165>>08480000
      cln'dualval    = 1769,  << expect low or high >>         <<01165>>08485000
      cln'protoval   = 1769,  << expect bsc, mrje, or hpdlci >><<01165>>08490000
      cln'xpctcomma  = 1769,  << expect comma >>               <<01165>>08495000
      cln'xpctquote   = 1769,   << expect quote >>             <<01165>>08500000
      cln'xpct1alpha  = 1769,   << expect a,e,o,h >>           <<01165>>08505000
       clnundefkeyval  =  1769,                                <<01165>>08510000
       cln2mp          =  1769,                                <<01165>>08515000
       clnparm2long    =  1769,                                <<01165>>08520000
       clnbadelimiter  =  1769,                                <<01165>>08525000
      cln'undefkeyval  =  1769,                                <<01165>>08530000
      clnxpctastrsk    =  1769,                                <<01165>>08535000
      cln'xpctparen   =  1769,                                 <<01165>>08540000
      clnxpctkeyval   =  1769,   << key value expected >>      <<01165>>08545000
      cln'xpctqu'par  = 1769;   << expect quote or paren for string >>  08550000
                                                               <<01165>>08555000
     logical pointer wfentry;                                  <<01165>>08560000
     byte pointer fentry;                                      <<01165>>08565000
     byte array pdelimiters(*)=pb:=",=;""()";                  <<01165>>08570000
     byte array pkeylist (*) = pb :=                           <<01165>>08575000
          5,3,"DEV",        << key words recognized >>         <<01165>>08580000
          6,4,"MISC",                                          <<01165>>08585000
          5,3,"BUF",                                           <<01165>>08590000
          6,4,"DIAL",                                          <<01165>>08595000
          7,5,"PROTO",                                         <<01165>>08600000
          6,4,"CODE",                                          <<01165>>08605000
          6,4,"DUAL",                                          <<01165>>08610000
          7,5,"LMODE",                                         <<01165>>08615000
          8,6,"DRIVER",                                        <<01165>>08620000
          7,5,"SPEED",                                         <<01165>>08625000
         10,8,"DOPTIONS",                                      <<01165>>08630000
          7,5,"TRACE",                                         <<01165>>08635000
          9,7,"NOTRACE",                                       <<01165>>08640000
          6,4,"NOID",                                          <<01165>>08645000
         10,8,"TIMEOUTS",                                      <<01165>>08650000
         12,10,"NOTIMEOUTS",                                   <<01165>>08655000
          4,2,"ID",                                            <<01165>>08660000
          7,5,"LOCID",                                         <<01165>>08665000
          7,5,"REMID",                                         <<01165>>08670000
          9,7,"POLLIST",                                       <<01165>>08675000
          8,6,"PHLIST",                                        <<01165>>08680000
         10,8,"DOWNFILE",                                      <<01165>>08685000
         9,7,"SUPLIST",                                        <<01165>>08690000
          0;                                                   <<01165>>08695000
     byte array keylist(0:pkeylistl);                          <<01165>>08700000
     byte array delimiters(0:pdelimitersl);                    <<01165>>08705000
     byte array n1(0:1),n2(*)=n1;                              <<01165>>08710000
     byte pointer                                              <<01165>>08715000
          dev,                                                 <<01165>>08720000
          list,                                                <<01165>>08725000
          locid,                                               <<01165>>08730000
          remid,                                               <<01165>>08735000
          suplist,                                             <<01165>>08740000
          phlist,                                              <<01165>>08745000
          driver,                                              <<01165>>08750000
          formdes,                                             <<01165>>08755000
          backrefname;                                         <<01165>>08760000
     define  << partial fields >>                              <<01165>>08765000
          dialfld     = (12: 2)#,                              <<01165>>08770000
          codefld     = (10: 6)#,                              <<01165>>08775000
          dualfld     = ( 4: 2)#,                              <<01165>>08780000
          lmodefld    = ( 6: 4)#,                              <<01165>>08785000
          protofld    = ( 0: 8)#,                              <<01165>>08790000
          inhibtout   = ( 0: 1)#,                              <<01165>>08795000
          tracewrap   = ( 1: 1)#,                              <<01165>>08800000
          delimtype   = (11: 5)#,                              <<01165>>08805000
          tracespec   = ( 2: 1)#,                              <<01165>>08810000
          tracetype   = ( 0: 1)#,                              <<01165>>08815000
          tracemask   = ( 2:9)#,                                        08820000
          tracentnum  = (11:5)#,                                        08825000
          inhibidseq  = ( 1: 1)#;                              <<01165>>08830000
                                                               <<01165>>08835000
subroutine cexit(errorvalue);                                  <<01165>>08840000
value errorvalue; integer errorvalue;                          <<01165>>08845000
   begin             << exit with error >>                     <<01165>>08850000
   cierr(errnum := errorvalue,parmptr);                        <<01165>>08855000
   assemble (exit 3);                                          <<01165>>08860000
   end;                                                        <<01165>>08865000
                                                               <<01165>>08870000
subroutine movestring;                                         <<01165>>08875000
   << move string pointed to by parmptr to list(loc) >>        <<01165>>08880000
   begin                                                       <<01165>>08885000
   if stringtype = ascii then                                  <<01165>>08890000
      move list(loc) := parmptr , (parmlen)                    <<01165>>08895000
   else ctranslate(toebcdic,parmptr,list(loc),parmlen);        <<01165>>08900000
   tos := parmlen;     << add integer to byte value below >>   <<01165>>08905000
   list(len) := tos + list(len);   << add parameter length >>  <<01165>>08910000
   loc := loc + parmlen;                                       <<01165>>08915000
   stringlen := stringlen + parmlen;                           <<01165>>08920000
   end <<movestring>>;                                         <<01165>>08925000
                                                               <<01165>>08930000
subroutine checkname(allowspecials);                           <<01165>>08935000
value allowspecials; logical allowspecials;                    <<01165>>08940000
   << checks formaldesignator  - no special chars allowed               08945000
             back reference    - special chars allowed                  08950000
   >>                                                          <<01165>>08955000
   begin                                                       <<01165>>08960000
   if parmlen = 0 then cexit(cln'no'name);                     <<01165>>08965000
   tos:=parms(parmnum - 1);  << parmnum incremented already >> <<01165>>08970000
   tos := tos & lsr(5);     << special char info >>            <<01165>>08975000
   if ls0 and not allowspecials then                           <<01165>>08980000
        cexit(clnmbedspecials);                                <<01165>>08985000
     tos:=tos & lsr(1);         << lose special char info >>   <<01165>>08990000
   if ls0 then  <<numerics>>                                   <<01165>>08995000
      if parmptr = numeric then cexit(clnleadingnum);          <<01165>>09000000
   if parmlen > 8 then cexit(clnname2long);                    <<01165>>09005000
   assemble(ddel);        <<delete parms>>                     <<01165>>09010000
end <<checkname>>;                                             <<01165>>09015000
                                                               <<01165>>09020000
subroutine trybinaryconvert(errvalue);                         <<01165>>09025000
value errvalue; integer errvalue;                              <<01165>>09030000
   begin                                                       <<01165>>09035000
   << attempts to convert current parameter using binary intrinsic.     09040000
      if not numeric, then cexit with error=errvalue.                   09045000
      if successful, result is returned in binarydigit.            >>   09050000
   if parmptr <> numeric then cexit(errvalue);                 <<01165>>09055000
   binarydigit := binary(parmptr,parmlen);                     <<01165>>09060000
   if <> then cexit(clnbadint);                                <<01165>>09065000
   end;     << trybinaryconvert >>                             <<01165>>09070000
                                                               <<01165>>09075000
                                                               <<01165>>09080000
logical subroutine getnextparm;                                <<01165>>09085000
   << this subroutine extracts the next parameter from parms and        09090000
      decomposes the mycommand returned entry. also checks for          09095000
      too many parameter case.                                          09100000
   >>                                                          <<01165>>09105000
   begin                                                       <<01165>>09110000
   if parmnum >= numparms then                                 <<01165>>09115000
     if moreparms then      << more parms are available >>     <<01165>>09120000
      begin                                                    <<01165>>09125000
        mycommand(parmptr(parmlen+1),delimiters,maxparms,      <<01165>>09130000
               numparms,parms);                                <<01165>>09135000
        if = then moreparms := false;                          <<01165>>09140000
        parmnum := 0;                                          <<01165>>09145000
        end                                                    <<01165>>09150000
      else return;<<getnextparm=false-no more parms available>><<01165>>09155000
   getnextparm := true;                                        <<01165>>09160000
   tos := parms(parmnum);       << get next entry >>           <<01165>>09165000
   nextdelim := s0.delimtype;   << get trailing delimiter >>   <<01165>>09170000
   parmlen := tos & lsr(8);     << length of entry >>          <<01165>>09175000
   @parmptr := tos;             << first word of mycommand entry >>     09180000
   parmnum := parmnum + 1;                                     <<01165>>09185000
   if parmnum > maxparms then cexit(cln2mp);   << too many para<<01165>>09190000
   end <<getnextparm>>;                                        <<01165>>09195000
                                                               <<01165>>09200000
subroutine checkbackref;                                       <<01165>>09205000
   begin                                                       <<01165>>09210000
   << checks back referenced line designator.                           09215000
      processing ends in this subroutine        >>             <<01165>>09220000
   getnextparm;                                                <<01165>>09225000
   if parmlen = 0 then cexit(clnreqadesig);                    <<01165>>09230000
   if parmptr <> "*" then cexit(clnxpctastrsk);                <<01165>>09235000
   if numparms > 2 then                                        <<01165>>09240000
      begin                                                    <<01165>>09245000
      @parmptr := @parmptr + parmlen;   << update for cexit >> <<01165>>09250000
      cexit(clnbref2mp);                                       <<01165>>09255000
      end;                                                     <<01165>>09260000
    @backrefname := @backrefname + 1;                          <<01165>>09265000
    @parmptr := @parmptr + 1;       << move past asterisk >>   <<01165>>09270000
    parmlen := parmlen - 1;                                    <<01165>>09275000
    checkname(errclinedesig);                                  <<01165>>09280000
    tos := minentrysize1;                                      <<04689>>09285000
    push(s); duplicate;                                        <<01165>>09290000
    @wfentry := tos;                                           <<01165>>09295000
    @fentry := tos & lsl(1);                                   <<01165>>09300000
    assemble(adds 0);                                          <<01165>>09305000
    wfentry := 1;                                              <<01165>>09310000
    wfentry(1) := %1000;                                       <<01165>>09315000
    wfentry(2) := parmlen;                                     <<01165>>09320000
    move fentry(6) := backrefname , (parmlen);                 <<01165>>09325000
    tos := parmlen;                                            <<01165>>09330000
    duplicate;                                                 <<01165>>09335000
    if tos then tos := tos + 1;     << make length even >>     <<01165>>09340000
    tos := tos & lsr(1);                                       <<01165>>09345000
    t1 := tos + 3;                                             <<01165>>09350000
    t1 := xaddjtentry(formdes,n1,n2,-4,t1,wfentry,             <<01165>>09355000
                      backrefname,n1,n2);                      <<01165>>09360000
    tos := minentrysize1;                                      <<04689>>09365000
    assemble (subs 0); << remove wfentry from top of stack >>  <<04689>>09370000
      case * t1 of                                             <<01165>>09375000
      begin                                                    <<01165>>09380000
           return;                                             <<01165>>09385000
           begin   <<table full>>                              <<01165>>09390000
           cierr(errnum := errctabfull);                       <<01165>>09395000
           return                                              <<01165>>09400000
           end;                                                <<01165>>09405000
           ;                                                   <<01165>>09410000
           begin   <<back ref not found>>                      <<01165>>09415000
           cierr(errnum := errcnotfound);                      <<01165>>09420000
           return                                              <<01165>>09425000
           end;                                                <<01165>>09430000
           begin   <<too many cline equations in table >>      <<01165>>09435000
           cierr(errnum := err2mcref);                         <<01165>>09440000
           return                                              <<01165>>09445000
           end;                                                <<01165>>09450000
      end;         << case statement >>                        <<01165>>09455000
      return;                                                  <<01165>>09460000
    end;   << checkbackref >>                                  <<01165>>09465000
                                                               <<01165>>09470000
subroutine traceparms;                                         <<01165>>09475000
   << handles the specified trace parameters >>                <<01165>>09480000
   begin                                                       <<01165>>09485000
   getnextparm;                                                <<01165>>09490000
   if nextdelim <> comma and parmlen = 0 then cexit(cln'xpctcomma);     09495000
   parm'indx := -1;                                            <<01165>>09500000
   while (parm'indx := parm'indx + 1) <= 3 do                  <<01165>>09505000
      begin                                                    <<01165>>09510000
      if parmlen <> 0 then                                     <<01165>>09515000
         case * parm'indx of                                   <<01165>>09520000
            begin                                              <<01165>>09525000
                begin    << "ALL" specified >>                 <<01165>>09530000
                if parmptr = "ALL" then ctraceinfo.tracetype := 1       09535000
                else cexit(cln'undefkeyval);                   <<01165>>09540000
                end;                                           <<01165>>09545000
                begin    << trace mask specified >>            <<01165>>09550000
                trybinaryconvert(clnundefkeyval);              <<01165>>09555000
                if binarydigit > %777  then cexit(clnbndserr0'127);     09560000
                ctraceinfo.tracemask := binarydigit;           <<01165>>09565000
                end;                                           <<01165>>09570000
                begin    << num trace entries spec >>          <<01165>>09575000
                trybinaryconvert(clnundefkeyval);              <<01165>>09580000
                if binarydigit > 256 then cexit(clnbndserr0'377);       09585000
                ctraceinfo.tracentnum := binarydigit;          <<01165>>09590000
                end;                                           <<01165>>09595000
                if parmptr = "WRAP" then ctraceinfo.tracewrap := 1      09600000
                else cexit(clnundefkeyval);                    <<01165>>09605000
            end <<case>>;                                      <<01165>>09610000
         if nextdelim <> comma then parm'indx := 3             <<01165>>09615000
         else getnextparm;                                     <<01165>>09620000
      end;      << do while parm'indx < 3 >>                   <<01165>>09625000
   end;      << traceparms >>                                  <<01165>>09630000
                                                               <<01165>>09635000
subroutine extractarg(notoptional);                            <<01165>>09640000
value notoptional; logical notoptional;                        <<01165>>09645000
   begin                                                       <<01165>>09650000
   << gets argument of key word (if any) >>                    <<01165>>09655000
   if nextdelim <> equals then                                 <<01165>>09660000
      begin    << equal sign expected >>                       <<01165>>09665000
      @parmptr := @parmptr + parmlen;    << update for cexit >><<01165>>09670000
      cexit(clnxpcteqsign);                                    <<01165>>09675000
      end;                                                     <<01165>>09680000
   getnextparm;                                                <<01165>>09685000
   if parmlen = 0 and notoptional then cexit(clnkeyvalnotopt); <<01165>>09690000
   end <<extractarg>>;                                         <<01165>>09695000
subroutine checkstringseq;                                     <<01165>>09700000
   << parmptr points to "A,E,O,H" character >>                 <<01165>>09705000
   << checks ascii strings (lengths and delimiters) >>         <<01165>>09710000
   begin                                                       <<01165>>09715000
   notfinished := true; stringlen := 0;                        <<01165>>09720000
   len := loc; list(len) := 0;                                 <<01165>>09725000
   loc := loc + 1;                                             <<01165>>09730000
   while notfinished do                                        <<01165>>09735000
      begin                                                    <<01165>>09740000
      getnextparm;                                             <<01165>>09745000
      if nextdelim <> quote then                               <<01165>>09750000
         begin        << error - needed quote >>               <<01165>>09755000
         @parmptr := @parmptr + parmlen;     << update for cexit >>     09760000
         cexit(cln'xpctquote);                                 <<01165>>09765000
         end;                                                  <<01165>>09770000
      if parmlen <> 0 then movestring;                         <<01165>>09775000
      getnextparm;                                             <<01165>>09780000
      << does this work ??? >>                                 <<01165>>09785000
      if nextdelim = quote and parmlen = 0 then                <<01165>>09790000
         begin     << double quotes >>                         <<01165>>09795000
         parmlen := 1;                                         <<01165>>09800000
         movestring;                                           <<01165>>09805000
         end                                                   <<01165>>09810000
       else notfinished := false;                              <<01165>>09815000
       end;                                                    <<01165>>09820000
    end;      << checkstringseq >>                             <<01165>>09825000
                                                               <<01165>>09830000
subroutine checkdigitseq;                                      <<01165>>09835000
<< checks numeric string (octal or hex) for bounds violation.           09840000
   converts to desired form.                                            09845000
>>                                                             <<01165>>09850000
   begin                                                       <<01165>>09855000
   loc := loc + 1; stringlen := 1;                             <<01165>>09860000
   do begin                                                    <<01165>>09865000
      getnextparm;                                             <<01165>>09870000
      if nextdelim <> comma and nextdelim <> rightparen then   <<01165>>09875000
         begin                                                 <<01165>>09880000
         @parmptr := @parmptr + parmlen; << update for cexit >><<01165>>09885000
         cexit(clnbadelimiter);                                <<01165>>09890000
         end;                                                  <<01165>>09895000
      if parmlen = 0 then cexit(clnkeyvalnotopt);              <<01165>>09900000
      if digitype = octal then                                 <<01165>>09905000
         begin                                                 <<01165>>09910000
         if (len := parmlen) > 3 then cexit(clnparm2long);     <<01165>>09915000
         i := -1; while (i := i + 1) < len do                  <<01165>>09920000
            if parmptr(i) > %67 then cexit(clnundefkeyval);    <<01165>>09925000
         tos := binary(parmptr,parmlen);                       <<01165>>09930000
         if <> then cexit(clnbadint);                          <<01165>>09935000
         i := x := 0;                                          <<01165>>09940000
         do begin                                              <<01165>>09945000
            tos := 10;                                         <<01165>>09950000
            assemble(div);                                     <<01165>>09955000
            i := i + (tos & lsl(x));                           <<01165>>09960000
            x := x + 3;                                        <<01165>>09965000
            duplicate;                                         <<01165>>09970000
            end until tos = 0;                                 <<01165>>09975000
         assemble(del);                                        <<01165>>09980000
         if not (0<=i<=%377) then cexit(clnbndserr0'377);      <<01165>>09985000
         list(loc) := i;                                       <<01165>>09990000
         end                                                   <<01165>>09995000
      else                                                     <<01165>>10000000
         begin      << digitype  is hex  >>                    <<01165>>10005000
         if not (1<=parmlen<=2) then cexit(clnparm2long);      <<01165>>10010000
         if (%60<=integer(parmptr)<=%71) then   << it's 0-9 >> <<01165>>10015000
            tos := parmptr - %60                               <<01165>>10020000
         else if (%101<=integer(parmptr)<=%106) then << a-e >> <<01165>>10025000
              tos := parmptr - %67                             <<01165>>10030000
         else cexit(clnundefkeyval);                           <<01165>>10035000
         if parmlen = 2 then                                   <<01165>>10040000
            begin                                              <<01165>>10045000
            tos := tos & lsl(4);    << multiply digit by 16 >> <<01165>>10050000
            @parmptr := @parmptr + 1;<< move to second digit >><<01165>>10055000
            if (%60<=integer(parmptr)<=%71) then << it's 0-9 >><<01165>>10060000
               tos := parmptr - %60                            <<01165>>10065000
            else if(%101<=integer(parmptr)<=%106) then<< a-e >><<01165>>10070000
               tos := parmptr - %67                            <<01165>>10075000
            else cexit(clnundefkeyval);                        <<01165>>10080000
            end                                                <<01165>>10085000
         else tos := 0;                                        <<01165>>10090000
         list(loc) := tos + tos;                               <<01165>>10095000
         end;                                                  <<01165>>10100000
      loc := loc + 1;                                          <<01165>>10105000
      end until (listlen := listlen + 1) > maxidseqlen or      <<01165>>10110000
          nextdelim = rightparen;                              <<01165>>10115000
   if nextdelim <> rightparen then cexit(cln'xpctparen);       <<01165>>10120000
   list(loc - listlen) := listlen - 1;                         <<01165>>10125000
   getnextparm;                                                <<01165>>10130000
   end;      << checkdigitseq >>                               <<01165>>10135000
                                                               <<01165>>10140000
subroutine checksequence;                                      <<01165>>10145000
   begin                                                       <<01165>>10150000
   if parmlen = 0 then     <<maybe special character>>         <<01165>>10155000
      begin                                                    <<01165>>10160000
      if nextdelim = quote then                                <<01165>>10165000
         begin     << quoted string >>                         <<01165>>10170000
         seqtype := string;                                    <<01165>>10175000
         stringtype := ascii;                                  <<01165>>10180000
         end                                                   <<01165>>10185000
      else if nextdelim = leftparen then                       <<01165>>10190000
         begin     << digit string >>                          <<01165>>10195000
         seqtype := digits;                                    <<01165>>10200000
         digitype := octal;                                    <<01165>>10205000
         end                                                   <<01165>>10210000
      else cexit(cln'xpctqu'par);                              <<01165>>10215000
      end                                                      <<01165>>10220000
   else if parmptr = alpha and parmlen = 1 then                <<01165>>10225000
      begin     << one alpha character >>                      <<01165>>10230000
      if parmptr = "A" then                                    <<01165>>10235000
         begin                                                 <<01165>>10240000
         seqtype := string;                                    <<01165>>10245000
         stringtype := ascii;                                  <<01165>>10250000
         end                                                   <<01165>>10255000
      else if parmptr = "E" then                               <<01165>>10260000
         begin                                                 <<01165>>10265000
         seqtype := string;                                    <<01165>>10270000
         stringtype := ebcdic;                                 <<01165>>10275000
         end                                                   <<01165>>10280000
      else if parmptr = "O" then                               <<01165>>10285000
         begin                                                 <<01165>>10290000
         seqtype := digits;                                    <<01165>>10295000
         digitype := octal;                                    <<01165>>10300000
         end                                                   <<01165>>10305000
      else if parmptr = "H" then                               <<01165>>10310000
         begin                                                 <<01165>>10315000
         seqtype := digits;                                    <<01165>>10320000
         digitype := hex;                                      <<01165>>10325000
         end                                                   <<01165>>10330000
      else cexit(cln'xpct1alpha);                              <<01165>>10335000
                                                               <<01165>>10340000
      << first alpha character ok >>                           <<01165>>10345000
      if seqtype = string and nextdelim <> quote then          <<01165>>10350000
         cexit(cln'xpctquote);                                 <<01165>>10355000
      if seqtype = digits and nextdelim <> leftparen then      <<01165>>10360000
         cexit(cln'xpctparen);                                 <<01165>>10365000
        end       << end one alpha character >>                <<01165>>10370000
     else cexit(cln'xpct1alpha);                               <<01165>>10375000
     if seqtype = string then checkstringseq                   <<01165>>10380000
     else checkdigitseq;                                       <<01165>>10385000
   end <<checksequence>>;                                      <<01165>>10390000
                                                               <<01165>>10395000
subroutine prockey;                                            <<01165>>10400000
   << process all key words allowed in :cline >>               <<01165>>10405000
   begin                                                       <<01165>>10410000
   tos := flags;                                               <<01165>>10415000
   while getnextparm do                                        <<01165>>10420000
      begin                                                    <<01165>>10425000
      if parmlen = 0 then cexit(clnxpctkey);                   <<01165>>10430000
      entrynum := search(parmptr,parmlen,keylist);             <<01165>>10435000
      case entrynum of                                         <<01165>>10440000
         begin                                                 <<01165>>10445000
                                                               <<01165>>10450000
         cexit(clnxpctkey);                                    <<01165>>10455000
                                                               <<01165>>10460000
         begin            << dev >>                            <<01165>>10465000
         extractarg(1);                                        <<01165>>10470000
         if (devlen := parmlen) > 8 then cexit(clndev2long);   <<01165>>10475000
          @dev := @parmptr;                                    <<01165>>10480000
          assemble(tsbc 15);                                   <<01165>>10485000
          end;                                                 <<01165>>10490000
                                                               <<01165>>10495000
         begin          << misc >>                             <<01165>>10500000
         extractarg(1);                                        <<01165>>10505000
         if nextdelim <> comma then cexit(cln'xpctcomma);      <<01165>>10510000
         lastparm'done := false;     << more miscarray values yet >>    10515000
         @misc := (@parmptr - 1)&lsr(1); loc := 0;             <<01165>>10520000
         do begin                                              <<01165>>10525000
            trybinaryconvert(clnundefkeyval);                  <<01165>>10530000
            misc(loc) := binarydigit;                          <<01165>>10535000
            loc := loc + 1;                                    <<01165>>10540000
            if nextdelim = comma then getnextparm              <<01165>>10545000
            else lastparm'done := true;   << no more miscarray <<01165>>10550000
            end until lastparm'done;                           <<01165>>10555000
         tos := loc;     << check for odd number of values >>  <<01165>>10560000
         if tos then cexit(clnxpctkeyval);                     <<01165>>10565000
         misclen := loc;                                       <<01165>>10570000
         tos := flags2;                                        <<01165>>10575000
         assemble(tsbc  0);                                    <<01165>>10580000
         flags2 := tos;                                        <<01165>>10585000
         end;                                                  <<01165>>10590000
                                                               <<01165>>10595000
         begin          << buff >>                             <<01165>>10600000
         duplicate;                                            <<01165>>10605000
         tos:=tos land %6;                                     <<01165>>10610000
         if tos <> 0 then cexit(clndupkey);                    <<01165>>10615000
         extractarg(0);                                        <<01165>>10620000
         if parmlen <> 0 then                                  <<01165>>10625000
            begin    << first parameter, numbuffs, expected >> <<01165>>10630000
            trybinaryconvert(clnundefkeyval);                  <<01165>>10635000
            numbuffers := binarydigit;                         <<01165>>10640000
            assemble(tsbc 14);                                 <<01165>>10645000
            end                                                <<01165>>10650000
         else if nextdelim = semicolon then cexit(clnxpctkeyval);       10655000
         if nextdelim = comma then                             <<01165>>10660000
            begin   << second parameter, buffsize, expected >> <<01165>>10665000
            getnextparm;                                       <<01165>>10670000
            if parmlen = 0 then cexit(clnxpctkeyval);          <<01165>>10675000
            trybinaryconvert(clnundefkeyval);                  <<01165>>10680000
            buffsize := binarydigit;                           <<01165>>10685000
            assemble(tsbc 13);                                 <<01165>>10690000
            end;                                               <<01165>>10695000
         end;                                                  <<01165>>10700000
                                                               <<01165>>10705000
         begin          << dial >>                             <<01165>>10710000
         extractarg(1);                                        <<01165>>10715000
         if parmlen = 1 then                                   <<01165>>10720000
            begin                                              <<01165>>10725000
            if parmptr = "W" then tos := 0                     <<01165>>10730000
            else if parmptr = "R" then tos := 1                <<01165>>10735000
            else cexit(cln'dialval);                           <<01165>>10740000
            end                                                <<01165>>10745000
         else if parmlen = 2 then                              <<01165>>10750000
            begin                                              <<01165>>10755000
            if parmptr = "RW" then tos := 2                    <<01165>>10760000
            else if parmptr = "NO" then tos := 3               <<01165>>10765000
            else cexit(cln'dialval);                           <<01165>>10770000
            end                                                <<01165>>10775000
         else cexit(cln'dialval);                              <<01165>>10780000
         aoptions.dialfld := tos;                              <<01165>>10785000
         assemble(tsbc 12);                                    <<01165>>10790000
         end;                                                  <<01165>>10795000
                                                               <<01165>>10800000
         begin          << proto >>                            <<01165>>10805000
         extractarg(1);                                        <<01165>>10810000
         if parmptr = "BSC" then tos := 1                      <<01165>>10815000
         else if parmptr = "MRJE" then tos := 2                <<01165>>10820000
         else if parmptr = "HPDLC1" then tos := 3              <<01165>>10825000
         else                                                  <<01165>>10830000
            begin       << protocol number specified >>        <<01165>>10835000
            trybinaryconvert(cln'protoval);                    <<01165>>10840000
            if not (0 <=binarydigit <=protomax) then           <<01165>>10845000
               cexit(clnbndserr0'377)                          <<01165>>10850000
            else tos:=binarydigit;                             <<01165>>10855000
            end;                                               <<01165>>10860000
         aoptions.protofld := tos;                             <<01165>>10865000
         assemble(tsbc 11);                                    <<01165>>10870000
         end;                                                  <<01165>>10875000
                                                               <<01165>>10880000
          begin          << code >>                            <<01165>>10885000
          extractarg(1);                                       <<01165>>10890000
          if parmptr = "SENSE" then tos := 1                   <<01165>>10895000
          else if parmptr = "ASCII" then tos := 2              <<01165>>10900000
          else if parmptr = "EBCDIC" then tos := 3             <<01165>>10905000
          else                                                 <<01165>>10910000
             begin    << code specified by number >>           <<01165>>10915000
             trybinaryconvert(cln'codeval);                    <<01165>>10920000
             if not (0 <= binarydigit <= codemax) then         <<01165>>10925000
                cexit(clnbndserr0'63)                          <<01165>>10930000
             else tos:=binarydigit;                            <<01165>>10935000
             end;                                              <<01165>>10940000
         coptions.codefld := tos;                              <<01165>>10945000
         assemble(tsbc 10);                                    <<01165>>10950000
         end;                                                  <<01165>>10955000
                                                               <<01165>>10960000
         begin          << dual >>                             <<01165>>10965000
         extractarg(1);                                        <<01165>>10970000
         if not (3 <= parmlen <= 4) then cexit(cln'dualval);   <<01165>>10975000
         if parmptr = "LOW" then tos := 1                      <<01165>>10980000
         else if parmptr = "HIGH" then tos := 2                <<01165>>10985000
         else cexit(cln'dualval);                              <<01165>>10990000
         coptions.dualfld := tos;                              <<01165>>10995000
         assemble(tsbc  9);                                    <<01165>>11000000
         end;                                                  <<01165>>11005000
                                                               <<01165>>11010000
         begin          << lmode >>                            <<01165>>11015000
         extractarg(1);                                        <<01165>>11020000
         if parmptr = "PRI" then tos := 1                      <<01165>>11025000
         else if parmptr = "SEC" then tos := 2                 <<01165>>11030000
         else if parmptr = "MPCNT" then tos := 3               <<01165>>11035000
         else if parmptr = "MPSEC" then tos := 4               <<01165>>11040000
         else if parmptr = "DTE" then tos := 5                 <<01165>>11045000
         else if parmptr = "DCE" then tos := 6                 <<01165>>11050000
         else                                                  <<01165>>11055000
            begin      << local mode number specified >>       <<01165>>11060000
            trybinaryconvert(cln'lmodeval);                    <<01165>>11065000
            if not (0<= binarydigit <=lmodemax) then           <<01165>>11070000
               cexit(clnbndserr0'15)                           <<01165>>11075000
            else tos:=binarydigit;                             <<01165>>11080000
            end;                                               <<01165>>11085000
         coptions.lmodefld := tos;                             <<01165>>11090000
         assemble(tsbc  8);                                    <<01165>>11095000
         end;                                                  <<01165>>11100000
                                                               <<01165>>11105000
         begin          << driver >>                           <<01165>>11110000
         extractarg(1);                                        <<01165>>11115000
         if (driverlen := parmlen) > 8 then cexit(clndrivernam2ln);     11120000
         @driver := @parmptr;                                  <<01165>>11125000
         assemble(tsbc  7);                                    <<01165>>11130000
         end;                                                  <<01165>>11135000
                                                               <<01165>>11140000
         begin          << speed >>                            <<01165>>11145000
         duplicate;                                            <<01165>>11150000
         if (tos land %14000) <> 0 then cexit(clndupkey);      <<01165>>11155000
         extractarg(0);                                        <<01165>>11160000
         if parmlen <> 0 then                                  <<01165>>11165000
            begin    << first parm, inspeed, expected >>       <<01165>>11170000
            tos := dbinary(parmptr,parmlen);                   <<01165>>11175000
            if <> then cexit(clnbadint);                       <<01165>>11180000
            inspeed := tos;                                    <<01165>>11185000
            assemble(tsbc 4);                                  <<01165>>11190000
            end                                                <<01165>>11195000
         else if nextdelim = semicolon then cexit(clnxpctkeyval);       11200000
         if nextdelim = comma then                             <<01165>>11205000
            begin  << second parameter, outspeed, expected >>  <<01165>>11210000
            getnextparm;                                       <<01165>>11215000
            if parmlen = 0 then cexit(clnxpctkeyval);          <<01165>>11220000
            tos := dbinary(parmptr,parmlen);                   <<01165>>11225000
            if <> then cexit(clnbadint);                       <<01165>>11230000
            outspeed := tos;                                   <<01165>>11235000
            assemble(tsbc 3);                                  <<01165>>11240000
            end;                                               <<01165>>11245000
          end;                                                 <<01165>>11250000
                                                               <<01165>>11255000
         begin          << doptions >>                         <<01165>>11260000
         extractarg(1);                                        <<01165>>11265000
         trybinaryconvert(clnundefkeyval);                     <<01165>>11270000
         doptions := binarydigit;                              <<01165>>11275000
         assemble(tsbc 2);                                     <<01165>>11280000
         end;                                                  <<01165>>11285000
                                                               <<01165>>11290000
         begin          << trace >>                            <<01165>>11295000
         coptions.tracespec := true;                           <<01165>>11300000
         if nextdelim = equals then                            <<01165>>11305000
            begin                                              <<01165>>11310000
            traceparms;                                        <<01165>>11315000
            assemble(tsbc  0);                                 <<01165>>11320000
            end;                                               <<01165>>11325000
         assemble(tsbc  1);                                    <<01165>>11330000
         end;    << end of "TRACE" specified >>                <<01165>>11335000
                                                               <<01165>>11340000
         begin          << notrace >>                          <<01165>>11345000
         assemble(tsbc  1);                                    <<01165>>11350000
         end;                                                  <<01165>>11355000
                                                               <<01165>>11360000
         begin          << noid >>                             <<01165>>11365000
         coptions.inhibidseq := true;                          <<01165>>11370000
         tos := flags1;                                        <<01165>>11375000
         assemble(tsbc 15);                                    <<01165>>11380000
         flags1 := tos;                                        <<01165>>11385000
         end;                                                  <<01165>>11390000
                                                               <<01165>>11395000
         begin      << timeouts >>                             <<01165>>11400000
         tos := flags1;                                        <<01165>>11405000
         assemble(tsbc 14);                                    <<01165>>11410000
         coptions.inhibtout := 0;                              <<01165>>11415000
         flags1 := tos;                                        <<01165>>11420000
         end;                                                  <<01165>>11425000
                                                               <<01165>>11430000
         begin      << no time outs >>                         <<01165>>11435000
         tos := flags1;                                        <<01165>>11440000
         assemble(tsbc 14);                                    <<01165>>11445000
         coptions.inhibtout := 1;                              <<01165>>11450000
         flags1 := tos;                                        <<01165>>11455000
         end;                                                  <<01165>>11460000
                                                               <<01165>>11465000
         begin          << id >>                               <<01165>>11470000
         tos := flags1;                                        <<01165>>11475000
         assemble(tsbc 15);                                    <<01165>>11480000
         flags1 := tos;                                        <<01165>>11485000
         end;                                                  <<01165>>11490000
                                                               <<01165>>11495000
         begin          << locid >>                            <<01165>>11500000
         extractarg(0);                                        <<01165>>11505000
         @list := @locid := @parmptr - 1; loc := 0;            <<01165>>11510000
         checksequence;                                        <<01165>>11515000
         locidlen := stringlen + 1;                            <<01165>>11520000
         tos := flags2;                                        <<01165>>11525000
         assemble(tsbc  6);                                    <<01165>>11530000
         flags2 := tos;                                        <<01165>>11535000
         end;                                                  <<01165>>11540000
                                                               <<01165>>11545000
         begin          << remid >>                            <<01165>>11550000
         extractarg(0);                                        <<01165>>11555000
         @list := @remid := @parmptr - 1; loc := 1;            <<01165>>11560000
   seqnum := listlen := 0;                                     <<01165>>11565000
   lastparm'done := false;   << haven't completed all remote ids >>     11570000
   do begin                                                    <<01165>>11575000
      seqnum := seqnum + 1;                                    <<01165>>11580000
      checksequence;                                           <<01165>>11585000
      listlen := listlen + stringlen +1;                       <<01165>>11590000
      if nextdelim = comma then getnextparm                    <<01165>>11595000
      else lastparm'done := true;<< no more remote ids left >> <<01165>>11600000
      end until lastparm'done;                                 <<01165>>11605000
         remid := seqnum;                                      <<01165>>11610000
         remidlen := listlen + 1;                              <<01165>>11615000
         tos := flags2;                                        <<01165>>11620000
         assemble(tsbc  5);                                    <<01165>>11625000
         flags2 := tos;                                        <<01165>>11630000
         end;                                                  <<01165>>11635000
                                                               <<01165>>11640000
         begin          << pollist >>                          <<01165>>11645000
         end;                                                  <<01165>>11650000
                                                               <<01165>>11655000
         begin          << phlist >>                           <<01165>>11660000
         extractarg(1);                                        <<01165>>11665000
         lastparm'done := false;  << more phone numbers yet >> <<01165>>11670000
         @phlist := @parmptr - 1; loc := 0;                    <<01165>>11675000
         do begin                                              <<01165>>11680000
            if parmlen > maxphonelen then cexit(clnparm2long); <<01165>>11685000
            phlist(loc) := parmlen;                            <<01165>>11690000
            move phlist(loc+1) := parmptr, (parmlen);          <<01165>>11695000
            loc := loc + parmlen + 1;                          <<01165>>11700000
            phlistnum := phlistnum + 1;                        <<01165>>11705000
            if nextdelim = comma then getnextparm              <<01165>>11710000
            else lastparm'done := true;                        <<01165>>11715000
            end until lastparm'done;                           <<01165>>11720000
         phlistlen := loc;                                     <<01165>>11725000
         tos := flags2;                                        <<01165>>11730000
         assemble(tsbc  1);                                    <<01165>>11735000
         flags2 := tos;                                        <<01165>>11740000
         end;                                                  <<01165>>11745000
                                                               <<01165>>11750000
         begin      << down file name >>                       <<01165>>11755000
         end;                                                  <<01165>>11760000
                                                               <<01165>>11765000
         begin      << suplist >>                              <<01165>>11770000
         end;                                                  <<01165>>11775000
                                                               <<01165>>11780000
      end <<case>>;                                            <<01165>>11785000
     end;    << end of getnextparm = true >>                   <<01165>>11790000
      << no more parameters to process >>                      <<01165>>11795000
     flags := tos;                                             <<01165>>11800000
     if nextdelim <> cr then cexit(clnbadelimiter);            <<01165>>11805000
end <<prockey>>;                                               <<01165>>11810000
                                                               <<01165>>11815000
         << ****   main of cxcline   **** >>                   <<01165>>11820000
     move keylist:=pkeylist,(pkeylistl);                       <<01165>>11825000
     move delimiters:=pdelimiters,(pdelimitersl);              <<01165>>11830000
     delimiters(pdelimitersl) := carriagereturn;               <<01165>>11835000
     parmnum := 0;                                             <<01165>>11840000
     mycommand(parmsp,delimiters,maxparms,numparms,parms);     <<01165>>11845000
     if <> then moreparms := true;  <<more than maxparm parameters>>    11850000
     if numparms = 0 then cexit(clnreqline);                   <<01165>>11855000
     getnextparm;                                              <<01165>>11860000
     checkname(errname);                                       <<01165>>11865000
     n1 := " ";     <<for jobtable procedures>>                <<01165>>11870000
     @formdes := lparm;                                        <<01165>>11875000
     if nextdelim = equals then                                <<01165>>11880000
        checkbackref;    << back reference indicated >>        <<01165>>11885000
     prockey;         << process all key words >>              <<01165>>11890000
     tos := 0;                                                 <<01165>>11895000
     push(s); duplicate;                                       <<01165>>11900000
     @wfentry := tos;                                          <<01165>>11905000
     @fentry := tos & lsl(1);                                  <<01165>>11910000
     tos := minentrysize2 +                                    <<01165>>11915000
            (locidlen + 1) & lsr(1) +                          <<01165>>11920000
            (remidlen + 1) & lsr(1) +                          <<01165>>11925000
            (suplistlen + 1) & lsr(1) +                        <<01165>>11930000
            (phlistlen + 2) & lsr(1) +                         <<01165>>11935000
            (pollistlen + 1) +                                 <<01165>>11940000
            (misclen + 1);                                     <<01165>>11945000
     assemble(adds 0);                                         <<01165>>11950000
     wfentry := flags;                                         <<01165>>11955000
     wfentry(1) := flags1;                                     <<01165>>11960000
     wfentry(2) := devlen;                                     <<01165>>11965000
     if devlen <> 0 then move fentry(14) := dev , (devlen);    <<01165>>11970000
     wfentry(11) := flags2;                                    <<01165>>11975000
     wfentry(12) := driverlen & lsl(8);                        <<01165>>11980000
     if driverlen <> 0 then move fentry(26) := driver , (driverlen);    11985000
     wfentry(17) := startofptrs;     <<leqlistprt>>;           <<01165>>11990000
     wfentry(x := x + 1) := coptions;                          <<01165>>11995000
     wfentry(x := x + 1) := aoptions;                          <<01165>>12000000
     wfentry(x := x + 1) := doptions;                          <<01165>>12005000
     wfentry(x := x + 1) := numbuffers;                        <<01165>>12010000
     wfentry(x := x + 1) := buffsize;                          <<01165>>12015000
     tos := outspeed; tos := inspeed;                          <<01165>>12020000
     assemble(xch);                                            <<01165>>12025000
     wfentry(x := x + 1) := tos;                               <<01165>>12030000
     wfentry(x := x + 1) := tos;                               <<01165>>12035000
     assemble(xch);                                            <<01165>>12040000
     wfentry(x := x + 1) := tos;                               <<01165>>12045000
     wfentry(x := x + 1) := tos;                               <<01165>>12050000
     wfentry(x := x + 1) := 0;    << not currently used >>     <<01165>>12055000
     wfentry(x := x + 1) := 0;   << not currently used >>      <<01165>>12060000
     wfentry(x := x + 1) := ctraceinfo;                        <<01165>>12065000
     loc := startoflists & lsl(1);                             <<01165>>12070000
     if locidlen <> 0 then                                     <<01165>>12075000
        begin                                                  <<01165>>12080000
        move fentry(loc) := locid , (locidlen);                <<01165>>12085000
        wfentry(locidptr) := loc & lsr(1);                     <<01165>>12090000
        loc := (loc + locidlen + 1) & lsr(1) & lsl(1);         <<01165>>12095000
        end                                                    <<01165>>12100000
     else wfentry(locidptr) := 0;                              <<01165>>12105000
     if remidlen <> 0 then                                     <<01165>>12110000
        begin                                                  <<01165>>12115000
        move fentry(loc) := remid , (remidlen);                <<01165>>12120000
        wfentry(remidptr) := loc & lsr(1);                     <<01165>>12125000
        loc := (loc + remidlen + 1) & lsr(1) & lsl(1);         <<01165>>12130000
        end                                                    <<01165>>12135000
     else wfentry(remidptr) := 0;                              <<01165>>12140000
     if suplistlen <> 0 then                                   <<01165>>12145000
        begin                                                  <<01165>>12150000
        move fentry(loc) := suplist , (suplistlen);            <<01165>>12155000
        wfentry(suplistptr) := loc & lsr(1);                   <<01165>>12160000
        loc := (loc + suplistlen + 1) & lsr(1) & lsl(1);       <<01165>>12165000
        end                                                    <<01165>>12170000
     else wfentry(suplistptr) := 0;                            <<01165>>12175000
     if phlistlen <> 0 then                                    <<01165>>12180000
        begin                                                  <<01165>>12185000
        move fentry(loc+1) := phlist , (phlistlen);            <<01165>>12190000
        fentry(loc) := phlistnum;                              <<01165>>12195000
        wfentry(phlistptr) := loc & lsr(1);                    <<01165>>12200000
        loc := (loc + phlistlen + 2) & lsr(1) & lsl(1);        <<01165>>12205000
        end                                                    <<01165>>12210000
     else wfentry(phlistptr) := 0;                             <<01165>>12215000
     loc := loc & lsr(1);     << for word arrays >>            <<01165>>12220000
     if pollistlen <> 0 then                                   <<01165>>12225000
        begin                                                  <<01165>>12230000
        move wfentry(loc+1) := pollist , (pollistlen);         <<01165>>12235000
        wfentry(loc) := pollistlen;                            <<01165>>12240000
        wfentry(pollistptr) := loc;                            <<01165>>12245000
        loc := loc + pollistlen + 1;                           <<01165>>12250000
        end                                                    <<01165>>12255000
     else wfentry(pollistptr) := 0;                            <<01165>>12260000
     if misclen <> 0 then                                      <<01165>>12265000
        begin                                                  <<01165>>12270000
        move wfentry(loc+1) := misc , (misclen);               <<01165>>12275000
        wfentry(loc) := misclen;                               <<01165>>12280000
        wfentry(miscptr) := loc;                               <<01165>>12285000
        loc := loc + misclen + 1;                              <<01165>>12290000
        end                                                    <<01165>>12295000
     else wfentry(miscptr) := 0;                               <<01165>>12300000
     tos := addjtentry(formdes,n1,n2,-4,loc,wfentry);          <<01165>>12305000
     if tos <> 0 then cierr(errnum := errctabfull);            <<01165>>12310000
     return;                                                   <<01165>>12315000
end <<cxcline>>;                                                        12320000
$page "FILE MANAGEMENT COMMAND EXECUTORS--RESET,SAVE,PURGE,RENAME"      12325000
                                                               <<04.km>>12330000
                                                               <<04.km>>12335000
$control  segment=cisysmgr                                     <<04.km>>12340000
<<********************************************************************>>12345000
<< i m p l i c i t m n t >>                                    <<04.km>>12350000
                                                               <<04.km>>12355000
logical procedure implicitmnt(group,acct,mountdst,pv'error);   <<04.km>>12360000
  array group,acct;                                            <<04.km>>12365000
  integer mountdst,pv'error;                                   <<04.km>>12370000
  option privileged,uncallable;                                <<04.km>>12375000
begin                                                          <<04.km>>12380000
  comment:                                                     <<04.km>>12385000
                                                               <<04.km>>12390000
    imp-mount dst:                                             <<04.km>>12395000
                                                               <<04.km>>12400000
    *********************                                      <<04.km>>12405000
    * dstlen          --+-------+                              <<04.km>>12410000
    * dstinfolen      --+-----+ :                              <<04.km>>12415000
    * dstentlen         *     : :                              <<04.km>>12420000
    * dstentloc       --+---+ : :                              <<04.km>>12425000
    * dstentcnt         *   : : :                              <<04.km>>12430000
    * dsterrcnt         *   : : :                              <<04.km>>12435000
    * dstmaxlen         *   : : :                              <<04.km>>12440000
    *         :         *   : : :                              <<04.km>>12445000
    *===================*   : : :                              <<04.km>>12450000
    *         :         * <-+-+ :  (first avail entry)         <<04.km>>12455000
    *-------------------*   :   :                              <<04.km>>12460000
    * dstenterr         *   :   :                              <<04.km>>12465000
    * dstentpvinfo      *   :   :                              <<04.km>>12470000
    * dstentgrp  (4wds) *   :   :                              <<04.km>>12475000
    * dstentacct (4wds) *   :   :                              <<04.km>>12480000
    *         :         *   :   :                              <<04.km>>12485000
    *-------------------*   :   :                              <<04.km>>12490000
    *         :         * <-+   :  (next avail entry)          <<04.km>>12495000
    *===================*       :                              <<04.km>>12500000
    *         :         * <-----+  (avail dst space)           <<04.km>>12505000
    *********************                                      <<04.km>>12510000
                                                               <<04.km>>12515000
                                                               <<04.km>>12520000
    procedure implicitly mounts home-vol-set of specified      <<04.km>>12525000
    group/acct.  group/acct and mount status may be recorded in<<04.km>>12530000
    spceified data-seg for subsequent implicit dismount.  "DB" <<04.km>>12535000
    must be pointing to the stack.                             <<04.km>>12540000
                                                               <<04.km>>12545000
    group=    name of home-vol-set group                       <<04.km>>12550000
                                                               <<04.km>>12555000
    acct=     name of home-vol-set acct                        <<04.km>>12560000
                                                               <<04.km>>12565000
    mountdst= dst# of data-seg in which we track home-vol-sets <<04.km>>12570000
              implicitly mounted and errors encountered.  entry<<04.km>>12575000
              values are:                                      <<04.km>>12580000
                -1= don't use data-seg                         <<04.km>>12585000
                 0= allocate data-seg -- "MOUNTDST" is new dst#<<04.km>>12590000
                    on exit                                    <<04.km>>12595000
                >0= dst# of previously allocated data-seg      <<04.km>>12600000
                                                               <<04.km>>12605000
    pv'error= depends on "IMPLICITMNT", viz:                   <<04.km>>12610000
                true=  "PV'ERROR" is pvinfo from mount         <<04.km>>12615000
                       intrinsic                               <<04.km>>12620000
                false= "PV'ERROR" is an error code.            <<04.km>>12625000
              error codes are:                                 <<04.km>>12630000
                <0= mount error (iff "MOUNTDST" is -1)         <<04.km>>12635000
                 0= no data-seg error -- mount error recorded  <<04.km>>12640000
                    in data-seg                                <<04.km>>12645000
                 1= out of dst's -- no data-seg allocated & no <<04.km>>12650000
                    mount attempted                            <<04.km>>12655000
                 2= out of vds -- no data-seg allocated & no   <<04.km>>12660000
                    mount attempted                            <<04.km>>12665000
                 3= out of space in data-seg -- no mount       <<04.km>>12670000
                    attempted                                  <<04.km>>12675000
                 4= system error                               <<04.km>>12680000
                                                               <<04.km>>12685000
    implicitmnt= true:  mount successful                       <<04.km>>12690000
               = false: mount unsuccessful.  if "PV'ERROR" is  <<04.km>>12695000
                        zero, mount error is recorded in       <<04.km>>12700000
                        data-seg                               <<04.km>>12705000
                                                               <<04.km>>12710000
    "IMPLICITMNT" should be called during a system directory   <<04.km>>12715000
    file search when we want to branch off to a pv directory.  <<04.km>>12720000
    (note that caller is responsible for determining that group<<04.km>>12725000
    resides on a vol set.)  we bind vol set to group.  thus,   <<04.km>>12730000
    caller initiates the pv directory search by "REDOING" the  <<04.km>>12735000
    group entry.  if "IMPLICITMNT" returns false, it is not    <<04.km>>12740000
    necessary to "REVISIT" group entry.                        <<04.km>>12745000
                                                               <<04.km>>12750000
    implicitly mounting home-vol-set prevents physical dismount<<04.km>>12755000
    of vol set during the remainder of the file search.  we do <<04.km>>12760000
    this conditionally so that we cannot cause a physical      <<04.km>>12765000
    mount.  that is, our mount will succeed iff the vol set is <<04.km>>12770000
    already mounted by some user (with uv cap).  thus, current <<04.km>>12775000
    user need not have uv-cap for file search since he cannot  <<04.km>>12780000
    tie up pv resource (theoretically).                        <<04.km>>12785000
    ;                                                          <<04.km>>12790000
                                                               <<04.km>>12795000
  <<**************************>>                               <<04.km>>12800000
  <<  local "DST" structures  >>                               <<04.km>>12805000
  <<**************************>>                               <<04.km>>12810000
                                                               <<04.km>>12815000
  equate  dstfudge=   4,               <<kludge, "EXPANDDST">> <<04.km>>12820000
          pagesize=   64,              <<expansion unit>>      <<04.km>>12825000
          segsize=    4000,            <<data-seg size>>       <<04.km>>12830000
          infosize=   16;                                      <<04.km>>12835000
                                                               <<04.km>>12840000
  integer array impinfo(0:infosize-1)= q;                      <<04.km>>12845000
  integer implen=     impinfo;                                 <<04.km>>12850000
  equate  impinfolen= infosize,                                <<04.km>>12855000
          impentlen=  16;                                      <<04.km>>12860000
  integer impentloc=  impinfo+3,                               <<04.km>>12865000
          impentcnt=  impentloc+1,                             <<04.km>>12870000
          imperrcnt=  impentcnt+1;                             <<04.km>>12875000
  equate  impmaxlen=  (segsize+pagesize-1)/pagesize*pagesize;  <<04.km>>12880000
                                                               <<04.km>>12885000
  integer array entinfo(0:impentlen-1)= q;                     <<04.km>>12890000
  integer enterr=           entinfo,                           <<04.km>>12895000
          entpvinfo=        enterr+1;                          <<04.km>>12900000
  integer array entname(*)= entpvinfo+1;                       <<04.km>>12905000
                                                               <<04.km>>12910000
  <<******************>>                                       <<04.km>>12915000
  <<  dst structures  >>                                       <<04.km>>12920000
  <<******************>>                                       <<04.km>>12925000
                                                               <<04.km>>12930000
  equate  dstinfo=    0;                                       << i.a >>12935000
  integer dstentinfo;                                          <<04.km>>12940000
                                                               <<04.km>>12945000
  << allocation values >>                                      <<04.km>>12950000
                                                               <<04.km>>12955000
  equate  incalloc=    (impentlen+pagesize-1)/pagesize *       <<04.km>>12960000
                         pagesize,                             <<04.km>>12965000
          maxalloc=    impmaxlen+dstfudge;                     <<04.km>>12970000
  define  minalloc=    (incalloc-initalloc) #;                 <<04.km>>12975000
  integer initalloc;                                           <<04.km>>12980000
  array   initinfo(*)= pb:=                                    <<04.km>>12985000
    0,impinfolen,impentlen,impinfolen,0,0,impmaxlen;           <<04.km>>12990000
                                                               <<04.km>>12995000
  <<**************************>>                               <<04.km>>13000000
  <<  other local structures  >>                               <<04.km>>13005000
  <<**************************>>                               <<04.km>>13010000
                                                               <<04.km>>13015000
  equate nomount= 0,                                           <<04.km>>13020000
         nodst=   im'mnterr-im'nodst,                          <<04.km>>13025000
         novds=   im'mnterr-im'novds,                          <<04.km>>13030000
         nospace= im'mnterr-im'nospace,                        <<04.km>>13035000
         syserr=  im'mnterr-im'syserr;                         <<04.km>>13040000
                                                               <<04.km>>13045000
  equate condmount'bind= -3,                                   <<04.km>>13050000
         anygen=         -1;                                   <<04.km>>13055000
  byte array homevs(0:7);                                      <<04.km>>13060000
  integer req'error:= condmount'bind;                          <<04.km>>13065000
  integer pointer ps0= s-0;                                    <<04.km>>13070000
                                                               <<04.km>>13075000
  array zeroes(*)=pb:= impentlen(0);                           <<04.km>>13080000
  intrinsic getdseg,freedseg;                                  <<04.km>>13085000
  integer procedure altdsegsize(dst,incsize);                  <<04.km>>13090000
    value dst,incsize; integer dst,incsize; option external;   <<04.km>>13095000
                                                               <<04.km>>13100000
  subroutine def'movefromdseg;                                 <<04.km>>13105000
  subroutine def'movetodseg;                                   <<04.km>>13110000
                                                               <<04.km>>13115000
                                                               <<04.km>>13120000
  <<****************>>                                         <<04.km>>13125000
  << subroutine min >>                                         <<04.km>>13130000
  <<****************>>                                         <<04.km>>13135000
                                                               <<04.km>>13140000
  integer subroutine min(i,j); value i,j; integer i,j;         <<04.km>>13145000
  begin                                                        <<04.km>>13150000
    min:=if i<=j then i else j;                                <<04.km>>13155000
  end <<subroutine min>>;                                      <<04.km>>13160000
                                                               <<04.km>>13165000
                                                               <<04.km>>13170000
  <<************************>>                                 <<04.km>>13175000
  << subroutine allocatedst >>                                 <<04.km>>13180000
  <<************************>>                                 <<04.km>>13185000
                                                               <<04.km>>13190000
  logical subroutine allocatedst;                              <<04.km>>13195000
  begin                                                        <<04.km>>13200000
    comment:                                                   <<04.km>>13205000
      allocatedst= true:  data-seg allocated                   <<04.km>>13210000
                   false: could not allocate data-seg.         <<04.km>>13215000
                          "PV'ERROR" is set to appropriate     <<04.km>>13220000
                          value.                               <<04.km>>13225000
                                                               <<04.km>>13230000
      we use (callable) "GETDSEG" here so that data-seg will be<<04.km>>13235000
      released automatically if process terminates abnormally  <<04.km>>13240000
      (highly unexpected!).  consequently, we must decrease    <<04.km>>13245000
      size of data-seg after allocation;                       <<04.km>>13250000
                                                               <<04.km>>13255000
    allocatedst:=true;                                         <<04.km>>13260000
    initalloc:=-maxalloc;                                      <<04.km>>13265000
    getdseg(mountdst,initalloc,0);                             <<04.km>>13270000
    if <> then                                                 <<04.km>>13275000
      begin                                                    <<04.km>>13280000
      pv'error:=if > or mountdst=%2000 then syserr             <<04.km>>13285000
                else if mountdst=%2001 then nodst              <<04.km>>13290000
                else novds;                                    <<04.km>>13295000
      allocatedst:=mountdst:=0;                                <<04.km>>13300000
      end                                                      <<04.km>>13305000
    else                                                       <<04.km>>13310000
      begin                                                    <<04.km>>13315000
      move impinfo:=initinfo,(impinfolen);                     <<04.km>>13320000
      do implen:=altdsegsize(mountdst,minalloc) until >=;      <<04.km>>13325000
      if > then                                                <<04.km>>13330000
        begin                                                  <<04.km>>13335000
        pv'error:=syserr;                                      <<04.km>>13340000
        freedseg(mountdst,0);                                  <<04.km>>13345000
        allocatedst:=mountdst:=0;                              <<04.km>>13350000
        end;                                                   <<04.km>>13355000
      end;                                                     <<04.km>>13360000
  end <<subroutine allocatedst>>;                              <<04.km>>13365000
                                                               <<04.km>>13370000
                                                               <<04.km>>13375000
  <<**********************>>                                   <<04.km>>13380000
  << subroutine expanddst >>                                   <<04.km>>13385000
  <<**********************>>                                   <<04.km>>13390000
                                                               <<04.km>>13395000
  logical subroutine expanddst;                                <<04.km>>13400000
  begin                                                        <<04.km>>13405000
    comment:                                                   <<04.km>>13410000
      expanddst= true:  data-seg expanded for at least one     <<04.km>>13415000
                        entry                                  <<04.km>>13420000
                 false: could not expand data-seg.  "PV'ERROR" <<04.km>>13425000
                        is set to appropriate value.           <<04.km>>13430000
                                                               <<04.km>>13435000
      on entry, "IMPENTLOC" is index of last+1 word of next    <<04.km>>13440000
      dst enrty.                                               <<04.km>>13445000
                                                               <<04.km>>13450000
      we must avoid using the "DSTFUDGE" area.  this avoids    <<04.km>>13455000
      bugs relating to attempting to use the entire data-seg.  <<04.km>>13460000
      (note that if/when these bugs are fixed, the "MIN"       <<04.km>>13465000
      function can be replaced with simply "INCALLOC");        <<04.km>>13470000
                                                               <<04.km>>13475000
    expanddst:=true;                                           <<04.km>>13480000
    if impentloc<=impmaxlen then                               <<04.km>>13485000
      begin                                                    <<04.km>>13490000
      do                                                       <<04.km>>13495000
        implen:=altdsegsize(mountdst,                          <<04.km>>13500000
                            min(incalloc,impmaxlen-implen))    <<04.km>>13505000
      until >=;                                                <<04.km>>13510000
      end;                                                     <<04.km>>13515000
    if impentloc>implen then                                   <<04.km>>13520000
      begin                                                    <<04.km>>13525000
      pv'error:=nospace;                                       <<04.km>>13530000
      expanddst:=false;                                        <<04.km>>13535000
      end;                                                     <<04.km>>13540000
  end <<subroutine expanddst>>;                                <<04.km>>13545000
                                                               <<04.km>>13550000
                                                               <<04.km>>13555000
  <<************************>>                                 <<04.km>>13560000
  << subroutine getdstentry >>                                 <<04.km>>13565000
  <<************************>>                                 <<04.km>>13570000
                                                               <<04.km>>13575000
  logical subroutine getdstentry;                              <<04.km>>13580000
  begin                                                        <<04.km>>13585000
    comment:                                                   <<04.km>>13590000
      getdstentry= true:  new entry added to data-seg          <<04.km>>13595000
                   false: could not allocate or expand         <<04.km>>13600000
                          data-seg.                            <<04.km>>13605000
                          "PV'ERROR" set to appropriate value. <<04.km>>13610000
                                                               <<04.km>>13615000
      if "MOUNTDST" is zero, allocate data-seg.  if necessary, <<04.km>>13620000
      expand data-seg.  update parametric information and      <<04.km>>13625000
      initialize new entry to "MOUNTED" condition.  note that  <<04.km>>13630000
      we also alter certain globals, viz:  "IMPINFO" &         <<04.km>>13635000
      "ENTINFO".                                               <<04.km>>13640000
                                                               <<04.km>>13645000
      on exit, "IMPENTLOC" is index of last+1 word of next     <<04.km>>13650000
      dst entry, regardless of success of "GETDSTENTRY";       <<04.km>>13655000
                                                               <<04.km>>13660000
    getdstentry:=false;                                        <<04.km>>13665000
    if mountdst>0                                              <<04.km>>13670000
       then movefromdseg(@impinfo,mountdst,dstinfo,impinfolen);<<04.km>>13675000
    if mountdst>0 or allocatedst then                          <<04.km>>13680000
      begin                                                    <<04.km>>13685000
      dstentinfo:=impentloc;                                   <<04.km>>13690000
      impentloc:=impentloc+impentlen;                          <<04.km>>13695000
      impentcnt:=impentcnt+1;                                  <<04.km>>13700000
      if impentloc<=implen or expanddst then                   <<04.km>>13705000
        begin                                                  <<04.km>>13710000
        enterr:=0;                                             <<04.km>>13715000
        entpvinfo:=0;                                          <<04.km>>13720000
        move entname:=group,(4),2;                             <<04.km>>13725000
        move * := acct,(4),2;                                  <<04.km>>13730000
        move * := zeroes,(@entinfo(impentlen)-@ps0); <<0-fill>><<04.km>>13735000
        getdstentry:=true;                                     <<04.km>>13740000
      end;                                                     <<04.km>>13745000
    end;                                                       <<04.km>>13750000
  end <<subroutine getdstentry>>;                              <<04.km>>13755000
                                                               <<04.km>>13760000
                                                               <<04.km>>13765000
  <<*********************>>                                    <<04.km>>13770000
  << main procedure body >>                                    <<04.km>>13775000
  <<*********************>>                                    <<04.km>>13780000
                                                               <<04.km>>13785000
  implicitmnt:=false;                                          <<04.km>>13790000
  if mountdst<0 or getdstentry then                            <<04.km>>13795000
    begin                                                      <<04.km>>13800000
    move homevs:="*       ";                                   <<04.km>>13805000
    mount(homevs,group,acct,req'error,anygen,pv'error);        <<04.km>>13810000
    if >= then                                                 <<04.km>>13815000
      begin                                                    <<04.km>>13820000
      implicitmnt:=true;                                       <<04.km>>13825000
      entpvinfo:=pv'error;                                     <<04.km>>13830000
      end                                                      <<04.km>>13835000
    else if mountdst<0 then pv'error:=-req'error               <<04.km>>13840000
    else                                                       <<04.km>>13845000
      begin                                                    <<04.km>>13850000
      pv'error:=nomount;                                       <<04.km>>13855000
      enterr:=req'error;                                       <<04.km>>13860000
      imperrcnt:=imperrcnt+1;                                  <<04.km>>13865000
      end;                                                     <<04.km>>13870000
    if mountdst>0 then                                         <<04.km>>13875000
      begin                                                    <<04.km>>13880000
      movetodseg(mountdst,dstentinfo,@entinfo,impentlen);      <<04.km>>13885000
      movetodseg(mountdst,dstinfo,@impinfo,impinfolen);        <<04.km>>13890000
      end;                                                     <<04.km>>13895000
    end;                                                       <<04.km>>13900000
end <<procedure implicitmnt>>;                                 <<04.km>>13905000
                                                               <<04.km>>13910000
                                                               <<04.km>>13915000
                                                               <<01.km>>13920000
                                                               <<01.km>>13925000
$control  segment=cisysmgr                                     <<01.km>>13930000
                                                               <<01.km>>13935000
integer procedure listvsdefn(parms);                           <<rh.pv>>13940000
   integer array parms;                                        <<rh.pv>>13945000
   option privileged, uncallable;                              <<rh.pv>>13950000
begin                                                          <<rh.pv>>13955000
   equate noerror=  0,                                         <<03.km>>13960000
          ioerror=  1,                                         <<03.km>>13965000
          novolset= 2;                                         <<03.km>>13970000
   integer i,gen,loc,cntrl,stype,mvtabx;                       << i.a >>13975000
   logical vmask,tmask,status,vclass;                          <<rh.pv>>13980000
   logical                                                     <<03513>>13985000
          bfdflag,                                             <<06015>>13990000
          floppy'flag;                                         <<03513>>13995000
   double diresult;                                            <<rh.pv>>14000000
   double vtabinfo = diresult;                                 <<rh.pv>>14005000
   integer                                                     <<rh.pv>>14010000
        vtabinfo1 = vtabinfo;                                  << i.a >>14015000
   equate vsdefnsize = 56;                                     <<07.km>>14020000
   array wname(0:4);                                           <<03.km>>14025000
   byte array name(*)= wname;                                  <<03.km>>14030000
   array vsdefn(0:vsdefnsize-1);                               <<rh.pv>>14035000
   byte array vsdefnb(*) = vsdefn;                             <<rh.pv>>14040000
   equate maxvolnum = 8;  <<members per volume set>>           <<rh.pv>>14045000
   integer array ldev(0:maxvolnum);                            <<rh.pv>>14050000
   integer array statn(0:maxvolnum);                           <<rh.pv>>14055000
   array buf(0:35);                                            <<rh.pv>>14060000
   byte array bufb(*) = buf;                                   <<rh.pv>>14065000
   array extraline(0:16);                                      <<06015>>14070000
   byte array extralineb(*)=extraline; <<for hp7902 & hp7935>> <<06015>>14075000
   double array dparms(*) = parms;                             <<rh.pv>>14080000
   integer array                                               <<rh.pv>>14085000
        vsname(*)    = parms,                                  <<rh.pv>>14090000
        currentg(*)  = parms(4),                               <<rh.pv>>14095000
        currenta(*)  = parms(8);                               <<rh.pv>>14100000
   byte array                                                  <<rh.pv>>14105000
        vsid(*)      = vsname;                                 << i.a >>14110000
   array master(0:11);  <<master reference>>                   <<rh.pv>>14115000
   byte array masterb(*) = master;                             <<rh.pv>>14120000
   array title1(*)=pb:=                                        <<rh.pv>>14125000
     " VOLSET        MEMBERS      TYPE     LDEV    STATUS   "; <<07161>>14130000
   array title2(*)=pb:=                                        <<rh.pv>>14135000
     " --------      --------   --------   ----   --------  "; <<07161>>14140000
   array title3(*)=pb:=                                        <<rh.pv>>14145000
     " VOLCLASS      MASTER REFERENCE           ";             <<rh.pv>>14150000
   array title4(*)=pb:=                                        <<rh.pv>>14155000
     " --------      --------------------       ";             <<rh.pv>>14160000
   array agtitle (*)=pb:=                                      <<rh.pv>>14165000
       " ACCOUNT=              GROUP=              (CONT.)";   <<rh.pv>>14170000
   define                                                      <<rh.pv>>14175000
        availf   = ( 3:1)#,                                    <<rh.pv>>14180000
        classf   = ( 0:1)#,                                    <<rh.pv>>14185000
        vmaskf   = ( 8:8)#;                                    <<rh.pv>>14190000
   equate  << volume set definition information >>             <<rh.pv>>14195000
        vdmisc  =  4,  << mvtab index >>                       <<rh.pv>>14200000
        vdinfo  =  5;  << num. vols., vol. mask >>             <<rh.pv>>14205000
   equate                                                      <<rh.pv>>14210000
        acctpos  =  5,                                         <<rh.pv>>14215000
        grouppos = 15;                                         <<rh.pv>>14220000
   equate                                                      <<rh.pv>>14225000
        dirdst     =  20,                                      <<rh.pv>>14230000
        longdev    = 128,                                      <<rh.pv>>14235000
        vdventsize =   6;  <<vol. entry in vs definition>>     <<rh.pv>>14240000
                                                               <<rh.pv>>14245000
   equate typelen = 8;                                         <<rh.pv>>14250000
   byte array typekey(*)=pb:=                                  <<rh.pv>>14255000
        "FIXED HD",                                            <<rh.pv>>14260000
        "7900(U) ",                                            <<03513>>14265000
        "7900(L) ",                                            <<03513>>14270000
        "7900    ",                                            <<rh.pv>>14275000
        "ISS     ",                                            <<rh.pv>>14280000
        "HP7905  ",                                            <<rh.pv>>14285000
        "7905(F) ",                                            <<rh.pv>>14290000
        "7905(T) ",                                            <<rh.pv>>14295000
        "7905(SD)",                                            <<rh.pv>>14300000
        "HP7920  ",                                            <<03.km>>14305000
        "HP7925  ",                                            <<00263>>14310000
        "HP7906  ",                                            <<00263>>14315000
    21 ("        "), <<unassigned pseudo subtypes 12-31>>      <<00263>>14320000
        "HP9895/ ",                                            <<03513>>14325000
    16 ("        "),                                           <<06015>>14330000
        "HP7911  ",                                            <<06015>>14335000
        "HP7912  ",                                            <<06015>>14340000
        "        ",                                            <<06015>>14345000
        "HP7914  ",   << pseudo subtype 52 >>                  <<06015>>14350000
        "HP7945  ",   << 53 >>  << falstaff >>                 << 8820>>14355000
        "        ",   << 54 >>                                 <<06015>>14360000
        "        ",   << 55 >>                                 <<06015>>14365000
        "HP7933/ ";                                            <<06015>>14370000
   equate statlen = 9;                                         <<07161>>14375000
   equate notmounted = 8;                                      <<07161>>14380000
   equate                                                      <<03513>>14385000
        extralinelen= 17,                                      <<06015>>14390000
        bfddisc     = 57,                                      <<06015>>14395000
        floppy      = 33;                                      <<03513>>14400000
   byte array statkey(*)=pb:=                                  <<07161>>14405000
        "SYSTEM   ",                                           <<07161>>14410000
        "OFF-LINE ",                                           <<07161>>14415000
        "SERIAL   ",                                           <<07161>>14420000
        "RESERVED ",                                           <<07161>>14425000
        "DOWNED   ",                                           <<07161>>14430000
        "DOWN-PND ",                                           <<07161>>14435000
        "MOUNTED  ",                                           <<07161>>14440000
        "PV-AVAIL ",                                           <<07161>>14445000
        "UNMOUNTED";                                           <<07161>>14450000
   define                                                      <<rh.pv>>14455000
        p'ganame   = parms ( 4) #,                             <<03.km>>14460000
        sirs       = dparms( 8) #,                             <<rh.pv>>14465000
        detail     = parms (12) #,                             <<rh.pv>>14470000
        detailen   = parms (13) #,                             <<rh.pv>>14475000
        newag      = parms (14) #,                             <<rh.pv>>14480000
        entaddr    = parms (15) #,                             <<rh.pv>>14485000
        filenum    = parms (18) #,                             <<rh.pv>>14490000
        devsize    = parms (19) #,   <<bytes>>                 <<rh.pv>>14495000
        linenum    = parms (20) #,                             <<rh.pv>>14500000
        numperline = parms (21) #,                             <<rh.pv>>14505000
        p'vcname   = parms (27) #,                             <<03.km>>14510000
        p'vsname   = parms (31) #;                             <<03.km>>14515000
   define                                                      <<rh.pv>>14520000
        pageject = begin                                       <<rh.pv>>14525000
                   fwrite(filenum,buf,0,%61);                  <<01.ro>>14530000
                   if <> then cxexit(ioerror);                 <<03.km>>14535000
                   linenum:=1;                                 <<rh.pv>>14540000
                   end#,                                       <<rh.pv>>14545000
                                                               <<rh.pv>>14550000
        space    = begin                                       <<rh.pv>>14555000
                   fwrite(filenum,buf,0,%40);                  <<01.ro>>14560000
                   if <> then cxexit(ioerror);                 <<03.km>>14565000
                   linenum:=linenum+1;                         <<rh.pv>>14570000
                   end#,                                       <<rh.pv>>14575000
                                                               <<rh.pv>>14580000
        dblspace = begin                                       <<rh.pv>>14585000
                   fwrite(filenum,buf,0,%60);                  <<01.ro>>14590000
                   if <> then cxexit(ioerror);                 <<03.km>>14595000
                   linenum:=linenum+2;                         <<rh.pv>>14600000
                   end#;                                       <<rh.pv>>14605000
                                                               <<rh.pv>>14610000
   subroutine cxexit(exitype);                                 <<rh.pv>>14615000
   value exitype; integer exitype;                             <<rh.pv>>14620000
   begin                                                       <<rh.pv>>14625000
      listvsdefn:=exitype;                                     <<rh.pv>>14630000
      assemble(exit 1);                                        <<rh.pv>>14635000
   end <<cxexit>>;                                             <<rh.pv>>14640000
                                                               <<rh.pv>>14645000
   subroutine movefds(toaddr,fraddr,len);                      <<rh.pv>>14650000
   value toaddr,fraddr,len;                                    <<rh.pv>>14655000
   integer toaddr,fraddr,len;                                  <<rh.pv>>14660000
   begin                                                       <<rh.pv>>14665000
      tos:=toaddr;                                             <<rh.pv>>14670000
      tos:=dirdst;                                             <<rh.pv>>14675000
      tos:=s4;                                                 <<rh.pv>>14680000
      tos:=s4;                                                 <<rh.pv>>14685000
      assemble(mfds 4);                                        <<rh.pv>>14690000
   end <<movefds>>;                                            <<rh.pv>>14695000
                                                               <<rh.pv>>14700000
   subroutine getinfo;                                         <<rh.pv>>14705000
   begin                                                       <<rh.pv>>14710000
      movefds(@vsdefn,entaddr,vsdefnsize);                     <<rh.pv>>14715000
      tos := sirs;                                             <<rh.pv>>14720000
      relsir (*, *);                                           <<rh.pv>>14725000
      vmask:=vsdefn(vdinfo).vmaskf;                            <<rh.pv>>14730000
      if (vclass:=vsdefn(vdmisc).classf) then                  <<rh.pv>>14735000
         begin                                                 <<rh.pv>>14740000
         mvtabx:=0;  <<class aren't marked as mounted>>        <<rh.pv>>14745000
         move name:=vsdefnb,(8);  <<save class name>>          <<rh.pv>>14750000
         move master:=vsdefn(6),(12);                          <<rh.pv>>14755000
         diresult:=direcfind(%40,0d,vsdefn(6),vsdefn(10),      <<38.pv>>14760000
                             vsdefn(14),vsdefn);               <<rh.pv>>14765000
         if <> then                                            <<rh.pv>>14770000
            begin                                              <<rh.pv>>14775000
            move p'vcname:=wname,(4);                          <<03.km>>14780000
            move p'ganame:=master,(8);                         <<03.km>>14785000
            move p'vsname:=master(8),(4);                      <<03.km>>14790000
            cxexit(novolset);                                  <<03.km>>14795000
            end;                                               <<rh.pv>>14800000
         end                                                   <<rh.pv>>14805000
      else                                                     <<rh.pv>>14810000
         mvtabx:=vsdefn(vdmisc).(mvtabxf);                     <<rh.pv>>14815000
      if detail = 0 then return;  <<names only>>               <<rh.pv>>14820000
      if detail = 2 and mvtabx <> 0 then                       <<rh.pv>>14825000
         begin                                                 <<rh.pv>>14830000
         i:=0;                                                 <<rh.pv>>14835000
         tmask:=vmask;  <<use temporary copy of vmask>>        <<rh.pv>>14840000
         while tmask <> 0 do                                   <<rh.pv>>14845000
            begin                                              <<rh.pv>>14850000
            i:=i+1;                                            <<rh.pv>>14855000
            if tmask then                                      <<rh.pv>>14860000
               begin                                           <<rh.pv>>14865000
               ldev:=0; gen:=-1;  <<for vtabindex proc.>>      <<rh.pv>>14870000
               tos:=vtabindex(vsdefnb((i*6) & lsl(1)),         <<rh.pv>>14875000
                              vsid,ldev,gen);                  <<rh.pv>>14880000
               if (vtabinfo:=tos) <> 0d then <<mounted member>><<rh.pv>>14885000
                  begin                                        <<rh.pv>>14890000
                  statn(i):=15;                                <<rh.pv>>14895000
                  ldev(i):=vtabinfo1.(0:8);                    <<rh.pv>>14900000
                  checkdisc(ldev(i),status);                   <<rh.pv>>14905000
                  status.availf:=1; <<assume pv avail>>        <<07.km>>14910000
                  while not status do                          <<rh.pv>>14915000
                     begin                                     <<rh.pv>>14920000
                     statn(i):=statn(i)-1;                     <<rh.pv>>14925000
                     status:=status & lsr(1);                  <<rh.pv>>14930000
                     end;                                      <<rh.pv>>14935000
                  statn(i):=10-statn(i);                       <<rh.pv>>14940000
               end                                             <<07161>>14945000
               else                                            <<07161>>14950000
                  begin                                        <<07161>>14955000
                  ldev(i) := 0;                                <<07161>>14960000
                  statn(i) := notmounted;                      <<07161>>14965000
                  end;                                         <<07161>>14970000
               end;                                            <<rh.pv>>14975000
            tmask:=tmask & lsr(1);                             <<rh.pv>>14980000
            end;                                               <<rh.pv>>14985000
         end;                                                  <<rh.pv>>14990000
   end <<getinfo>>;                                            <<rh.pv>>14995000
                                                               <<rh.pv>>15000000
   subroutine printag(length);                                 <<rh.pv>>15005000
   value length;                                               <<rh.pv>>15010000
   integer length;                                             <<rh.pv>>15015000
   << print "ACCOUNT/GROUP" title >>                           <<rh.pv>>15020000
   begin                                                       <<rh.pv>>15025000
      move buf := agtitle,(length);                            <<rh.pv>>15030000
      move buf (acctpos) := currenta, (4);                     <<rh.pv>>15035000
      move buf (grouppos) := currentg, (4);                    <<rh.pv>>15040000
      fwrite(filenum,buf,length,0);                            <<rh.pv>>15045000
      if <> then cxexit(ioerror);                              <<03.km>>15050000
      linenum:=linenum+1;                                      <<rh.pv>>15055000
      space;                                                   <<rh.pv>>15060000
   end <<printag>>;                                            <<rh.pv>>15065000
                                                               <<rh.pv>>15070000
   subroutine printitle;                                       <<rh.pv>>15075000
   begin                                                       <<rh.pv>>15080000
      if detail <> 3 then                                      <<rh.pv>>15085000
         move buf:=title1,(detailen)                           <<rh.pv>>15090000
      else                                                     <<rh.pv>>15095000
         move buf:=title3,(detailen);                          <<rh.pv>>15100000
      fwrite(filenum,buf,detailen,0);                          <<rh.pv>>15105000
      if detail <> 3 then                                      <<rh.pv>>15110000
         move buf:=title2,(detailen)                           <<rh.pv>>15115000
      else                                                     <<rh.pv>>15120000
         move buf:=title4,(detailen);                          <<rh.pv>>15125000
      fwrite(filenum,buf,detailen,0);                          <<rh.pv>>15130000
      numperline:=0;                                           <<rh.pv>>15135000
      space;                                                   <<rh.pv>>15140000
   end <<printitle>>;                                          <<rh.pv>>15145000
                                                               <<rh.pv>>15150000
   subroutine fillname;                                        <<rh.pv>>15155000
   begin                                                       <<rh.pv>>15160000
      buf:="  ";                             <<blank name>>    <<07161>>15165000
      move buf(1) := buf,(27);                                 <<07161>>15170000
      name(8):=" ";                                            <<rh.pv>>15175000
      if not vclass then move name:=vsdefnb,(8);               <<rh.pv>>15180000
      move bufb(1):=name while an,1;                           <<rh.pv>>15185000
      if vclass and detail <> 3 then move * :="(C)",2;         <<rh.pv>>15190000
      if mvtabx <> 0 then  << mounted >>                       <<rh.pv>>15195000
         move * :="*"                                          <<rh.pv>>15200000
      else                                                     <<rh.pv>>15205000
         move * :=" ";                                         <<rh.pv>>15210000
      if (numperline:=numperline-1) < 0 then                   <<rh.pv>>15215000
      numperline:=if detail = 0 then                           <<rh.pv>>15220000
                  if devsize >= longdev then 8 else 5 else 0;  <<rh.pv>>15225000
      cntrl:=if numperline = 0 then 0 else %320;               <<rh.pv>>15230000
      if vclass and detail = 3 then  <<look at class defn>>    <<rh.pv>>15235000
      begin                                                    <<rh.pv>>15240000
           i:=3;                                               <<rh.pv>>15245000
           tos:=@bufb(15);  <<master name location>>           <<rh.pv>>15250000
           while (i:=i-1) >= 0 do  <<format name for print>>   <<rh.pv>>15255000
           begin                                               <<rh.pv>>15260000
                move name:=masterb(i*8),(8);                   <<rh.pv>>15265000
                move * :=name while an,1;                      <<rh.pv>>15270000
                if i > 0 then                                  <<rh.pv>>15275000
                   move * :=".",2                              <<rh.pv>>15280000
                else                                           <<rh.pv>>15285000
                   move * :=" ";                               <<rh.pv>>15290000
           end;                                                <<rh.pv>>15295000
      end;                                                     <<rh.pv>>15300000
   end <<fillname>>;                                           <<rh.pv>>15305000
                                                               <<rh.pv>>15310000
   subroutine printinfo;                                       <<rh.pv>>15315000
   begin                                                       <<rh.pv>>15320000
        move buf := "  ";                                      <<03513>>15325000
        move buf(1) := buf,(35);                               <<03513>>15330000
        move extraline := "  ";                                <<06015>>15335000
        move extraline(1) := extraline,(16);                   <<06015>>15340000
      if detail = 3 and not vclass then return;                <<rh.pv>>15345000
      if newag <> 0 then  <<new group/account>>                <<rh.pv>>15350000
         begin                                                 <<rh.pv>>15355000
         newag:=0;                                             <<rh.pv>>15360000
         if (2<=linenum<=52) then dblspace else                <<rh.pv>>15365000
         if (53<=linenum<=61) then pageject;                   <<rh.pv>>15370000
         printag(19);                                          <<rh.pv>>15375000
         printitle;                                            <<rh.pv>>15380000
         end                                                   <<rh.pv>>15385000
      else                                                     <<rh.pv>>15390000
         if (59<=linenum<=61) then                             <<rh.pv>>15395000
            begin                                              <<rh.pv>>15400000
            pageject;                                          <<rh.pv>>15405000
            printag(25);                                       <<rh.pv>>15410000
            printitle;                                         <<rh.pv>>15415000
            end;                                               <<rh.pv>>15420000
floppy'flag := 0;                                              << 8820>>15425000
bfdflag := 0;                                                  << 8820>>15430000
      i:=0;  <<volume member count>>                           <<rh.pv>>15435000
      fillname;                                                <<rh.pv>>15440000
      if (1<=detail<=2) then                                   <<rh.pv>>15445000
      while vmask <> 0 do                                      <<rh.pv>>15450000
         begin                                                 <<rh.pv>>15455000
         if (i:=i+1) = 2 then move bufb(1):=bufb,(12);         <<rh.pv>>15460000
         if vmask then                                         <<rh.pv>>15465000
            begin                                              <<rh.pv>>15470000
            loc:=i * vdventsize;                               <<rh.pv>>15475000
        << the subtype is stored in vsdef entry as a pseudo >> <<03513>>15480000
        << subtype.  the algorithm is as follows.           >> <<03513>>15485000
        << [pseudo sub-type] = ([actual type]  * 16) +      >> <<03513>>15490000
        <<                     [actual subtype]             >> <<03513>>15495000
        <<                                                  >> <<03513>>15500000
        << stype = pseudo subtype + 1                       >> <<03513>>15505000
            stype:=vsdefn(loc+vdinfo).(0:8)+1;                 <<rh.pv>>15510000
            move bufb(15):=vsdefnb(loc & lsl(1)),(8);          <<rh.pv>>15515000
        <<**************************************************>> <<03513>>15520000
        <<               k l u d g e                        >> <<03513>>15525000
        << the following is a kludge to accomodate both the >> <<03513>>15530000
        << hp9895 and hp7902 floppy drives.  both devices   >> <<03513>>15535000
        << have the same type and subtype which causes the  >> <<03513>>15540000
        << algorithm to index to the same place in the array>> <<03513>>15545000
        << typekey.  when the hp7902 is no longer supported >> <<03513>>15550000
        << this kludge should be removed.  after the kludge >> <<03513>>15555000
        << is removed the code should read as follows:      >> <<03513>>15560000
        << move bufb(26) := typekey(stype * typelen),       >> <<03513>>15565000
        <<                  (typelen);                      >> <<03513>>15570000
        <<**************************************************>> <<03513>>15575000
                                                               <<03513>>15580000
            if stype = floppy then                             <<06015>>15585000
               floppy'flag := true;                            <<06015>>15590000
            if stype = bfddisc then                            <<06015>>15595000
               bfdflag := true;                                <<06015>>15600000
            move bufb(26):=typekey(stype * typelen),           <<rh.pv>>15605000
                           (typelen);                          <<rh.pv>>15610000
            if detail = 2 and mvtabx <> 0 then                 <<rh.pv>>15615000
               begin                                           <<rh.pv>>15620000
               if ldev(i) <> 0 then                            <<07161>>15625000
                  ascii(ldev(i),-10,bufb(39))                  <<07161>>15630000
               else                                            <<07161>>15635000
                  move bufb(36) := "    ";                     <<07161>>15640000
               move bufb(44):=statkey(statn(i) * statlen),     <<rh.pv>>15645000
                              (statlen);                       <<rh.pv>>15650000
               end;                                            <<rh.pv>>15655000
        if vmask&lsr(1) <> 0 then                              <<03513>>15660000
           begin                                               <<03513>>15665000
           fwrite(filenum,buf,detailen,0);                     <<03513>>15670000
           if floppy'flag or bfdflag then                      <<06015>>15675000
              begin                                            <<03513>>15680000
              if floppy'flag then                              <<06015>>15685000
                 move extralineb(26) := "HP7902  "             <<06015>>15690000
              else   << must be bfd disc >>                    <<06015>>15695000
                 move extralineb(26) := "HP7935  ";            <<06015>>15700000
              fwrite(filenum,extraline,extralinelen,0);        <<06015>>15705000
              floppy'flag := false;                            <<03513>>15710000
              bfdflag := false;                                <<06015>>15715000
              end;                                             <<03513>>15720000
         end;                                                  <<03513>>15725000
            end;                                               <<rh.pv>>15730000
         vmask:=vmask&lsr(1);                                  <<07.km>>15735000
         end;                                                  <<rh.pv>>15740000
      fwrite(filenum,buf,detailen,cntrl);                      <<rh.pv>>15745000
         if floppy'flag or bfdflag then                        <<06015>>15750000
            begin                                              <<03513>>15755000
            if floppy'flag then                                <<06015>>15760000
               move extralineb(26) := "HP7902  "               <<06015>>15765000
            else  << must be bfd disc >>                       <<06015>>15770000
               move extralineb(26) := "HP7935  ";              <<06015>>15775000
            fwrite(filenum,extraline,extralinelen,cntrl);      <<06015>>15780000
            floppy'flag := false;                              <<03513>>15785000
            bfdflag := false;                                  <<06015>>15790000
            end;                                               <<03513>>15795000
   end <<printinfo>>;                                          <<rh.pv>>15800000
                                                               <<rh.pv>>15805000
   getinfo;  <<obtain definition information>>                 <<rh.pv>>15810000
   printinfo;                                                  <<rh.pv>>15815000
   cxexit(noerror);                                            <<03.km>>15820000
end <<procedure listvsdefn>>;                                  <<03.km>>15825000
                                                               <<01.km>>15830000
                                                               <<01.km>>15835000
$control  segment=cisysmgr                                     <<01.km>>15840000
                                                               <<01.km>>15845000
                                                               <<rh.pv>>15850000
integer procedure listvsinfo(element,level,parms,sirs);        <<rh.pv>>15855000
   value level, parms, sirs;                                   <<rh.pv>>15860000
   integer array element;                                      <<rh.pv>>15865000
   integer level, parms;                                       <<rh.pv>>15870000
   double sirs;                                                <<rh.pv>>15875000
   option privileged, uncallable;                              <<rh.pv>>15880000
begin                                                          <<rh.pv>>15885000
   define p'gotentry= lparms(24) #;                            <<03.km>>15890000
   array leafname(*)= s-3;                                    <<00.gen>>15895000
   double ds3= s-3;                                           <<00.gen>>15900000
   integer x=x;                                               <<00.gen>>15905000
   integer pointer ppresult;                                  <<00.gen>>15910000
                                                              <<00.gen>>15915000
   logical newmask := 0;                                       <<rh.pv>>15920000
   define                                                      <<rh.pv>>15925000
        newaccnt = newmask.(15:1)#,                            <<rh.pv>>15930000
        newgroup   = newmask.(14:1)#;                          <<rh.pv>>15935000
   integer elementaddr = q-8;                                  <<rh.pv>>15940000
   integer array rparms(*);                                    <<rh.pv>>15945000
   logical array lparms(*) = rparms;                           <<rh.pv>>15950000
   double array                                                <<rh.pv>>15955000
        parmsd(*) = rparms,                                    <<rh.pv>>15960000
        delement(*) = element;                                 <<rh.pv>>15965000
   equate dirdst = 20;                                         <<rh.pv>>15970000
                                                               <<rh.pv>>15975000
   if requestservice then                                      <<rh.pv>>15980000
      begin                                                    <<rh.pv>>15985000
      tos := 5;                                                <<rh.pv>>15990000
      go to exit2;                                             <<rh.pv>>15995000
      end;                                                     <<rh.pv>>16000000
   tos := delement (1);                                       <<00.gen>>16005000
   tos := delement;                                           <<00.gen>>16010000
   exchangedb(0);                                             <<00.gen>>16015000
   @rparms := @arrq0(parms - deltaq);                         <<00.gen>>16020000
                                                              <<00.gen>>16025000
   @ppresult:=@rparms(sysl'pprinx);                           <<00.gen>>16030000
   if logical(d'type.(allflag)) then                          <<00.gen>>16035000
   begin                                                      <<00.gen>>16040000
     comment:                                                 <<00.gen>>16045000
       (s-3,s-2) = last 4 bytes of leaf name                  <<00.gen>>16050000
       (s-1,s-0) = first 4 bytes of leaf name;                <<00.gen>>16055000
                                                              <<00.gen>>16060000
     tos:=ds3;                         <<correct str order>>   <<03.km>>16065000
     case *level of begin                                     <<00.gen>>16070000
       tos:=-1;                        <<shouldn't happen>>    <<03.km>>16075000
       tos:=dirmatch(g'gname,leafname);                       <<00.gen>>16080000
       tos:=dirmatch(g'aname,leafname);                       <<00.gen>>16085000
       tos:=-1;                        <<shouldn't happen>>    <<03.km>>16090000
       tos:=dirmatch(g'vname,leafname);                       <<00.gen>>16095000
     end;                                                     <<00.gen>>16100000
     x:=tos;                           <<set cc on tos>>      <<00.gen>>16105000
     ddel;                                                    <<00.gen>>16110000
     if <> then                        <<dirmatch<>0>>        <<00.gen>>16115000
     begin                                                    <<00.gen>>16120000
       tos:=if < then nextuncle'sir else nextbrother'sir;      <<03.km>>16125000
       go exit1;                                              <<00.gen>>16130000
     end;                                                     <<00.gen>>16135000
   end;                                                       <<00.gen>>16140000
                                                              <<00.gen>>16145000
   if level <> vsdeflevel then                                 <<rh.pv>>16150000
      begin                                                    <<rh.pv>>16155000
      if level = accountlevel then newaccnt:=true;             <<rh.pv>>16160000
      if level = grouplevel then newgroup := true;             <<rh.pv>>16165000
      end;                                                     <<rh.pv>>16170000
   if newmask <> 0 then  <<new account/group>>                 <<rh.pv>>16175000
      begin                                                    <<rh.pv>>16180000
      lparms (14) := lparms (14) lor newmask;                  <<rh.pv>>16185000
      parmsd (2 + (2 * newmask.(15:1))) := tos;                <<rh.pv>>16190000
      parmsd(x+1) := tos;                                      <<rh.pv>>16195000
      tos := 1;                                                <<rh.pv>>16200000
      go to exit1;                                             <<rh.pv>>16205000
      end                                                      <<rh.pv>>16210000
   else                                                        <<rh.pv>>16215000
      begin                                                    <<rh.pv>>16220000
      parmsd:=tos;                                             <<rh.pv>>16225000
      parmsd(1):=tos;                                          <<rh.pv>>16230000
      end;                                                     <<rh.pv>>16235000
   parmsd (8) := sirs;                                         <<rh.pv>>16240000
   rparms (15) := elementaddr;                                 <<rh.pv>>16245000
   p'gotentry:=true;                                           <<03.km>>16250000
   tos := listvsdefn(rparms);                                  <<rh.pv>>16255000
   if s0=0 then tos:=tos+nextson                               <<06.km>>16260000
   else                                                        <<03.km>>16265000
      begin                                                    <<03.km>>16270000
      rparms(1):=-tos;                                         <<03.km>>16275000
      tos:=abortscan;                                          <<03.km>>16280000
      end;                                                     <<03.km>>16285000
exit1:                                                         <<rh.pv>>16290000
   exchangedb(dirdst);                                         <<rh.pv>>16295000
exit2:                                                         <<rh.pv>>16300000
   listvsinfo := tos;                                          <<rh.pv>>16305000
end << listvsinfo >>;                                          <<rh.pv>>16310000
                                                               <<01.km>>16315000
                                                               <<01.km>>16320000
$control  segment=cisysmgr                                     <<01.km>>16325000
                                                               <<01.km>>16330000
                                                               <<rh.pv>>16335000
procedure cxlistvs executorhead;                               <<rh.pv>>16340000
option privileged, uncallable;                                 <<rh.pv>>16345000
begin                                                          <<rh.pv>>16350000
$include inclcap                                               <<06585>>16355000
double dl := commasemicr;                                      <<rh.pv>>16360000
integer numparms;                                              <<rh.pv>>16365000
double array parms(0:3)=q;                                     <<rh.pv>>16370000
integer array recipparms(0:sysl'parmlen-1);                   <<00.gen>>16375000
integer array ppresult(*)=recipparms(sysl'pprinx);            <<00.gen>>16380000
define p'gname=    recipparms(4) #,                            <<03.km>>16385000
       p'aname=    recipparms(8) #,                            <<03.km>>16390000
       p'filenum=  recipparms(18) #,                           <<04.km>>16395000
       p'gotentry= recipparms(24) #,                           <<03.km>>16400000
       p'vcname=   recipparms(27) #,                           <<03.km>>16405000
       p'vsname=   recipparms(31) #;                           <<03.km>>16410000
equate ioerror=  -1;                                           << i.a >>16415000
array wbuf(0:17);                                              <<03.km>>16420000
byte array buf(*)= wbuf;                                       <<03.km>>16425000
byte pointer next,                                             <<03.km>>16430000
             last;                                             <<03.km>>16435000
byte pointer leafname = parms;                                 <<rh.pv>>16440000
integer leafnamechar = parms+1;                                <<rh.pv>>16445000
byte leafnamelen = parms+1;                                    <<rh.pv>>16450000
byte pointer listlevel = parms+2;                              <<rh.pv>>16455000
byte listlevellen = parms+3;                                   <<rh.pv>>16460000
byte pointer listvile = parms+2;  <<tricky bit>>               <<rh.pv>>16465000
integer listvilechar = parms+3;                                <<rh.pv>>16470000
byte pointer extraparm = parms+6;                              <<rh.pv>>16475000
byte extraparmlen = parms+7;                                   <<rh.pv>>16480000
equate comma = 0, semi = 1, cr = 2;                            <<rh.pv>>16485000
byte pointer delim;                                           <<00.gen>>16490000
integer lev := vsdeflevel;  <<assume vs definition>>           <<rh.pv>>16495000
integer fnum := 2;  <<default to $stdlist>>                    <<u.rao>>16500000
logical stdlist := true;  <<default to $stdlist>>              <<u.rao>>16505000
array datebuf(0:13);  <<for time stamp for output>>            <<02.ro>>16510000
integer dev := 0;  <<list file device type>>                   <<03.ro>>16515000
array qarray(*) = q + 0;                                       <<06585>>16520000
integer pcbglobloc;                                            <<06585>>16525000
pointer ucapptr;                                               <<06585>>16530000
                                                               <<03.km>>16535000
                                                               <<03.km>>16540000
  <<*******************>>                                      <<03.km>>16545000
  << subroutine append >>                                      <<03.km>>16550000
  <<*******************>>                                      <<03.km>>16555000
                                                               <<03.km>>16560000
  logical subroutine append(name,suffix,buf);                  <<03.km>>16565000
    value suffix; byte array name,buf; integer suffix;         <<03.km>>16570000
  begin                                                        <<03.km>>16575000
    if name(7)=" " then move buf:=name while ans,1             <<03.km>>16580000
    else move buf:=name,(8),2;                                 <<03.km>>16585000
    @last:=tos;                                                <<03.km>>16590000
    last:=suffix;                                              <<03.km>>16595000
    append:=@last(1);                                          <<03.km>>16600000
  end <<subroutine append>>;                                   <<03.km>>16605000
                                                               <<03.km>>16610000
                                                               <<03.km>>16615000
  <<***********************>>                                  <<03.km>>16620000
  << subroutine classerror >>                                  <<03.km>>16625000
  <<***********************>>                                  <<03.km>>16630000
                                                               <<03.km>>16635000
  subroutine classerror;                                       <<03.km>>16640000
  begin                                                        <<03.km>>16645000
    if logical(p'gotentry) then fwrite(fnum,wbuf,0,0);         <<03.km>>16650000
    @next:=append(p'vsname,".",buf);                           <<03.km>>16655000
    @next:=append(p'gname,".",next);                           <<03.km>>16660000
    @next:=append(p'aname,0,next);                             <<03.km>>16665000
    append(p'vcname,0,next);                                   <<03.km>>16670000
    cierr((errnum:=vsdnovolset),,2,@buf);                      <<03.km>>16675000
  end <<subroutine classerror>>;                               <<03.km>>16680000
                                                               <<03.km>>16685000
                                                               <<03.km>>16690000
  <<*********************>>                                    <<03.km>>16695000
  << main procedure body >>                                    <<03.km>>16700000
  <<*********************>>                                    <<03.km>>16705000
                                                                        16710000
<<initialize parms array>>                                     <<rh.pv>>16715000
p'gotentry := false;                                           << 7896>>16720000
<< this fixes an old bug.  p'gotentry is set to true if any  >><< 7896>>16725000
<< qualifying entrys are found, otherwise it is not touched. >><< 7896>>16730000
<< it was never set to false, so a message wasn't necessarily>><< 7896>>16735000
<< printed if there were no qualifying entries. (however the >><< 7896>>16740000
<< odds of having a garbage value that was an even number was>><< 7896>>16745000
<< at least 50-50 and probably higher, so it was never       >><< 7896>>16750000
<< noticed.                                                  >><< 7896>>16755000
parms := 0d;                                                   <<rh.pv>>16760000
tos := @parms+2;                                               <<rh.pv>>16765000
tos := @parms+1;                                               <<rh.pv>>16770000
tos := 6;                                                      <<rh.pv>>16775000
assemble(move);                                                <<rh.pv>>16780000
mycommand(parmsp,dl,4,numparms,parms);                         <<rh.pv>>16785000
parmnum := 1;                                                  <<rh.pv>>16790000
if not produceparms(lev,parmsp,ppresult,delim,errnum) then    <<00.gen>>16795000
    return;  <<error in parsing leafname>>                     <<rh.pv>>16800000
if (numparms > 0) and  <<not just a cr>>                       <<rh.pv>>16805000
   (@delim < @leafname+integer(leafnamelen)) then             <<00.gen>>16810000
   begin  <<extraneous stuff in leafname>>                     <<rh.pv>>16815000
   tos := errnum := listvextraneous;                           <<rh.pv>>16820000
   tos := @delim;                                             <<00.gen>>16825000
   cierr(*,*);                                                 <<rh.pv>>16830000
   return                                                      <<rh.pv>>16835000
   end;                                                        <<rh.pv>>16840000
                                                               <<rh.pv>>16845000
if numparms=0 then leafnamechar := cr;                         <<rh.pv>>16850000
                                                               <<rh.pv>>16855000
<<check for listlevel, if any>>                                <<rh.pv>>16860000
if leafnamechar.(11:5)=comma then  <<listlevel present>>       <<rh.pv>>16865000
   begin                                                       <<rh.pv>>16870000
   parmnum := 2;                                               <<rh.pv>>16875000
   tos := binary(listlevel,integer(listlevellen));             <<rh.pv>>16880000
   if < then   <<bad char in convert>>                         <<rh.pv>>16885000
      begin                                                    <<rh.pv>>16890000
      cierr(errnum := listvbadint, listlevel);                 <<rh.pv>>16895000
      return                                                   <<rh.pv>>16900000
      end;                                                     <<rh.pv>>16905000
   if > then  <<integer out of bounds>>                        <<rh.pv>>16910000
      begin                                                    <<rh.pv>>16915000
      cierr(errnum := listvintovfl,listlevel);                 <<rh.pv>>16920000
      return                                                   <<rh.pv>>16925000
      end;                                                     <<rh.pv>>16930000
   if s0 > 3 then tos := 3;  <<max level>>                     <<rh.pv>>16935000
   if s0 < 0 then  <<listvs, -1 case?>>                        <<rh.pv>>16940000
      begin  <<check capability>>                              <<rh.pv>>16945000
      if d'type.(startlevelf) = 0 then  <<system level file>> <<00.gen>>16950000
         begin                                                 <<rh.pv>>16955000
         pxglobal;                                             <<06585>>16960000
         @ucapptr := @pxg'userattributes;                      <<06585>>16965000
         if ucapsm <> 1 then                                   <<06585>>16970000
            begin                                              <<rh.pv>>16975000
            cierr(errnum := listvsmcap);                       <<rh.pv>>16980000
            return                                             <<rh.pv>>16985000
            end;                                               <<rh.pv>>16990000
         end                                                   <<rh.pv>>16995000
      else                                                     <<03.km>>17000000
         begin                                                 <<03.km>>17005000
         pxglobal;                                             <<06585>>17010000
         @ucapptr := @pxg'userattributes;                      <<06585>>17015000
         if ucapam <> 1 and ucapsm <> 1 then << plain user >>  <<06585>>17020000
            begin                                              <<03.km>>17025000
            cierr(errnum:=listvamcap);                         <<03.km>>17030000
            return;                                            <<03.km>>17035000
            end;                                               <<03.km>>17040000
         end;                                                  <<03.km>>17045000
      recipparms(13) := 0;                                     <<rh.pv>>17050000
      end;  <<listvs, -1 case>>                                <<rh.pv>>17055000
   parms := parms(1);                                          <<rh.pv>>17060000
   parms(1) := parms(2);  <<fixup for missing listlevel>>      <<rh.pv>>17065000
   end                                                         <<rh.pv>>17070000
else                                                           <<rh.pv>>17075000
   tos := 0;   <<listlevel default>>                           <<rh.pv>>17080000
recipparms(12) := s0;  <<listlevel in binary>>                 <<rh.pv>>17085000
case tos of                                                    <<rh.pv>>17090000
   begin                                                       <<rh.pv>>17095000
   recipparms(13) := 7;                                        <<rh.pv>>17100000
   recipparms(13) := 17;                                       <<rh.pv>>17105000
   recipparms(13) := 27;                                       <<07161>>17110000
   recipparms(13) := 21;                                       <<rh.pv>>17115000
   end;                                                        <<rh.pv>>17120000
<<we have now processed the listlevel. now do listvile>>       <<rh.pv>>17125000
parmnum := parmnum+1;                                          <<rh.pv>>17130000
if leafnamechar.(11:5)=semi then  <<probably is one>>          <<rh.pv>>17135000
   begin                                                       <<rh.pv>>17140000
   if cibadfilename(errnum,parms(1)) then return;              <<rh.pv>>17145000
   stdlist := false;   <<valid list file name provided>>       <<u.rao>>17150000
   end                                                         <<rh.pv>>17155000
else if leafnamechar.(11:5)=comma then  <<error>>              <<rh.pv>>17160000
   begin                                                       <<rh.pv>>17165000
   cierr(errnum := listvexpectfile, listvile);                 <<rh.pv>>17170000
   return                                                      <<rh.pv>>17175000
   end;                                                        <<u.rao>>17180000
                                                               <<rh.pv>>17185000
if (listvilechar.(11:5) <> cr) and (extraparmlen<>0) then      <<rh.pv>>17190000
   begin                                                       <<rh.pv>>17195000
   parmnum := parmnum+1;                                       <<rh.pv>>17200000
   cierr(errnum := listv2mp,extraparm);                        <<rh.pv>>17205000
   return                                                      <<rh.pv>>17210000
   end;                                                        <<rh.pv>>17215000
parmnum := 0;                                                  <<rh.pv>>17220000
                                                               <<rh.pv>>17225000
if not stdlist then                                            <<u.rao>>17230000
   begin   <<open list file for recipparms>>                   <<u.rao>>17235000
   fnum := fopen(listvile, %2504, %101);                       <<00267>>17240000
   if carry then  <<open failed on user defined list file>>    <<u.rao>>17245000
      begin                                                    <<u.rao>>17250000
      ferror'(fnum, parmnum);                                  <<u.rao>>17255000
      cierr(errnum := listvfserr);                             <<u.rao>>17260000
      return;                                                  <<u.rao>>17265000
      end;                                                     <<u.rao>>17270000
   end;                                                        <<u.rao>>17275000
p'filenum:=fnum;                                               <<04.km>>17280000
                                                               <<rh.pv>>17285000
fgetinfo(fnum,,,,recipparms(19),dev);                          <<03.ro>>17290000
tos := recipparms(19);                                         <<rh.pv>>17295000
if < then tos := -tos                                          <<rh.pv>>17300000
else tos := tos&lsl(1);  <<convert to byte count>>             <<rh.pv>>17305000
recipparms(19) := tos;  <<line length>>                        <<rh.pv>>17310000
                                                               <<rh.pv>>17315000
<<set other file attributes>>                                  <<rh.pv>>17320000
recipparms(20) := 1;                                           <<rh.pv>>17325000
recipparms(21) := 0;                                           <<rh.pv>>17330000
move recipparms := d'fname,(4),2;                             <<00.gen>>17335000
move * := d'gname,(4),2;                                      <<00.gen>>17340000
move * := d'aname,(4);                                        <<00.gen>>17345000
recipparms(14) := 3;  <<new account/group flag>>               <<rh.pv>>17350000
recipparms(15) := 0;  <<call to listvsdefn>>                   <<rh.pv>>17355000
<<set up type>>                                                <<rh.pv>>17360000
recipparms (22) := d'type;                                    <<00.gen>>17365000
recipparms(savebuffindex) := 0;  << see syslist >>             <<04178>>17370000
recipparms(savebuffindex + asize + 1) := 0;                    <<04178>>17375000
                                                               <<rh.pv>>17380000
<<time stamp list file if not interactive or if list >>        <<02.ro>>17385000
<<file name was supplied.>>                                    <<02.ro>>17390000
pxglobal;                                                      <<06585>>17395000
tos := pxg'interactive;                                        <<06585>>17400000
if not tos <<not interactive>> and stdlist or                  <<03.ro>>17405000
   not stdlist and dev.(8:8) >= 8 then                         <<03.ro>>17410000
   begin                                                       <<02.ro>>17415000
   date'line(datebuf);                                         <<02.ro>>17420000
   fwrite(fnum, datebuf, -27, %60);                            <<02.ro>>17425000
   end;                                                        <<02.ro>>17430000
                                                               <<02.ro>>17435000
<<now set up common direcscan stuff on stack>>                 <<rh.pv>>17440000
tos := 0d;  <<return value>>                                   <<rh.pv>>17445000
tos := d'type;                                                <<00.gen>>17450000
tos.(hitflag) := 1;                                            <<rh.pv>>17455000
tos := d'inx1.(mvtabxf);               <<linkage>>            <<04.gen>>17460000
tos := d'inx2;                         <<indexp>>             <<05.gen>>17465000
tos := @d'aname;                                              <<00.gen>>17470000
tos := @d'gname;                                              <<00.gen>>17475000
tos := @d'fname;                                              <<00.gen>>17480000
if recipparms(12)<0 then  <<listvs , -1>>                      <<rh.pv>>17485000
   tos := direcscan(*,*,*,*,*,syslist,recipparms)              <<rh.pv>>17490000
else                                                           <<rh.pv>>17495000
   tos := direcscan(*,*,*,*,*,listvsinfo,recipparms);          <<rh.pv>>17500000
if <> then   <<directory error>>                               <<rh.pv>>17505000
   begin                                                       <<rh.pv>>17510000
   if not stdlist then fclose(fnum, 0, 0);                     <<u.rao>>17515000
   cydirerr'(*,%120000,errnum);                                <<rh.pv>>17520000
   return;                                                     <<rh.pv>>17525000
   end;                                                        <<rh.pv>>17530000
ddel;                                                          <<rh.pv>>17535000
if recipparms(1)<=ioerror then                                 <<03.km>>17540000
   begin                                                       <<rh.pv>>17545000
   if < then classerror                                        <<03.km>>17550000
   else                                                        <<03.km>>17555000
      begin                                                    <<03.km>>17560000
      ferror'(fnum,parmnum);                                   <<03.km>>17565000
      cierr(errnum := listvfserr,,%10000,parmnum);             <<03.km>>17570000
      end;                                                     <<03.km>>17575000
   return                                                      <<rh.pv>>17580000
   end;                                                        <<rh.pv>>17585000
if logical(p'gotentry) then fwrite(fnum,recipparms,0,0)        <<03.km>>17590000
else cierr(errnum := -novsdslisted);                           <<04790>>17595000
             <<xparent to programmatic call for upward compat>><<03.km>>17600000
if not stdlist then                                            <<u.rao>>17605000
   begin                                                       <<u.rao>>17610000
   fclose(fnum, 0, 0);                                         <<u.rao>>17615000
   if carry then                                               <<u.rao>>17620000
      begin                                                    <<u.rao>>17625000
      ferror'(fnum, parmnum);  <<report reason for close failur<<u.rao>>17630000
      cierr(errnum := listvfserr);                             <<u.rao>>17635000
      end;                                                     <<u.rao>>17640000
   end;                                                        <<u.rao>>17645000
end;  <<cxlistvs>>                                             <<rh.pv>>17650000
procedure check'for'jobs;                                      << 8879>>17655000
option internal,uncallable,privileged;                         << 8879>>17660000
begin                                                          << 8879>>17665000
<< this procedure is called from the sysdump, partbackup,    >><< 8879>>17670000
<< and fullbackup executors to determine if there are other  >><< 8879>>17675000
<< users on the system that could affect the files being     >><< 8879>>17680000
<< backed up.  note: if the command is executed from a job   >><< 8879>>17685000
<< stream, then no message will be printed if there is one or>><< 8879>>17690000
<< zero sessions because we will assume that if there is one >><< 8879>>17695000
<< session, then it is the person who streamed the job.      >><< 8879>>17700000
                                                               << 8879>>17705000
logical array jmatarr(0:jmatheadersize-1);                     << 8879>>17710000
logical interactive;                                           << 8879>>17715000
                                                               << 8879>>17720000
subroutine def'movefromdseg;                                   << 8879>>17725000
                                                               << 8879>>17730000
<< determine whether we are interactive or not >>              << 8879>>17735000
who(interactive);<< if true, then we are interactive >>        << 8879>>17740000
                                                               << 8879>>17745000
movefromdseg(@jmatarr,jmatdst,0,jmatheadersize);               << 8879>>17750000
if interactive and (jmatsnum > 1 or jmatjnum > 0)              << 8879>>17755000
    then genmsg(1,185);  << $stdlist >>                        << 8879>>17760000
                                                               << 8879>>17765000
if not interactive and (jmatsnum > 1 or jmatjnum >1)           << 8879>>17770000
   then genmsg(1,185,,,,,,,0);  << console >>                  << 8879>>17775000
                                                               << 8879>>17780000
end;  << check'for'jobs >>                                     << 8879>>17785000
                                                               <<rh.pv>>17790000
$page    "SUBSYSTEM EXECUTORS"                                          17795000
<<    implementation details on the commands                   <<03.ro>>17800000
<<            run, preprun or prep                             <<03.ro>>17805000
<<               or subsystems                                 <<03.ro>>17810000
<<                                                             <<03.ro>>17815000
<<        run, preprun and prep commands                       <<03.ro>>17820000
<<                                                             <<03.ro>>17825000
<<there is really nothing very unusual or interesting about    <<03.ro>>17830000
<<these particular commands.  in essence they parse the user's <<03.ro>>17835000
<<request and translate it almost verbatim into requests to    <<03.ro>>17840000
<<the segmenter and the create and awake intrinsics.  the only <<03.ro>>17845000
<<information needed to understand these commands is the       <<03.ro>>17850000
<<details on the segmenter and create functions.               <<03.ro>>17855000
<<                                                             <<03.ro>>17860000
<<                   subsystems                                <<03.ro>>17865000
<<                                                             <<03.ro>>17870000
<<the subsystem commands are mildly interesting but mostly     <<03.ro>>17875000
<<just complicated.  i will use :spl, :splprep and :splgo as   <<03.ro>>17880000
<<examples.  all of the rest follow the same general pattern   <<03.ro>>17885000
<<with minor deviations for special problems.                  <<03.ro>>17890000
<<                                                             <<03.ro>>17895000
<<the major problem in the subsystem commands is to handle     <<03.ro>>17900000
<<the file names passed as parameters.  since the subsystems   <<03.ro>>17905000
<<cannot be passed strings as parameters, the communication    <<03.ro>>17910000
<<is done through the job global file equate table. in         <<03.ro>>17915000
<<general the executor sets up file equates for each of        <<03.ro>>17920000
<<the parameters according to an agreed upon scheme.  for      <<03.ro>>17925000
<<example, in the case of spl the first parameter, if          <<03.ro>>17930000
<<present, is equated to spltext, the second to splusl and     <<03.ro>>17935000
<<so forth.  the presence or absence of a given parameter      <<03.ro>>17940000
<<is indicated to the subsystem through a bit map in the       <<03.ro>>17945000
<<parm parameter in the create intrinsic call.  the            <<03.ro>>17950000
<<correspondence typically is                                  <<03.ro>>17955000
<<          bit 15 = xxxtext                                   <<03.ro>>17960000
<<          bit 14 = xxxlist                                   <<03.ro>>17965000
<<          bit 13 = xxxusl                                    <<03.ro>>17970000
<<          bit 12 = xxxmast                                   <<03.ro>>17975000
<<          bit 11 = xxxnew                                    <<03.ro>>17980000
<<the file equate itself is done by procedure cyimplctfile'.   <<03.ro>>17985000
<<on completion of the command the file equate is              <<03.ro>>17990000
<<deleted by procedure delimpfile.  final cleanup is usually   <<03.ro>>17995000
<<done by procedure cisubsysfinish.                            <<03.ro>>18000000
<<                                                             <<03.ro>>18005000
$control segment = cisysmgr                                    <<u.rao>>18010000
$control segment = cisysmgr                                             18015000
procedure cxpartbackup executorhead;                                    18020000
   option privileged, uncallable;                                       18025000
begin                                                                   18030000
   byte pointer fname;                                                  18035000
   logical dl := %26015;                                                18040000
   integer numparms,cnt;                                                18045000
   double array parms(0:2);                                             18050000
   lbparmdecs;                                                          18055000
   logical temp;                                                        18060000
   integer stat;                                                        18065000
   intrinsic command;                                                   18070000
   integer a,d1;                                                        18075000
   byte array tempbuff(0:30);                                           18080000
   byte array lhs(0:15);                                                18085000
   integer parm := 0, pin;                                              18090000
   byte array tapfil(0:8) = pb := "DUMPTAPE ";                          18095000
   byte array auxlist(0:8) = pb := "SYSDLIST ";                         18100000
   byte array entryname(0:8);                                           18105000
   byte blank := " ";                                                   18110000
   logical implicit := false;                                           18115000
   entry cxfullbackup,cxsysdump;                               << 8879>>18120000
subroutine cleanup;                                                     18125000
begin move lhs := tapfil , (9);                                         18130000
      if implicit                                                       18135000
        then xremjtentry(lhs,blank,blank,3);                            18140000
      if parm = 0 then return;                                          18145000
      move lhs := auxlist , (9);                                        18150000
      xremjtentry(lhs,blank,blank,3)                                    18155000
end;                                                                    18160000
   move entryname := "PARTBKUP ";                                       18165000
   go around;                                                           18170000
cxsysdump:                                                     << 8879>>18175000
   move entryname := "  ";  << outerblock >>                   << 8879>>18180000
   go around;                                                  << 8879>>18185000
cxfullbackup:                                                           18190000
    move entryname := "FULLBKUP ";                                      18195000
around:                                                                 18200000
   mycommand(parmsp,dl,3,numparms,parms);                               18205000
   if numparms > 2 then  <<too many parameters>>                        18210000
      begin                                                             18215000
      parmnum := 3;                                                     18220000
      tos := errnum := subs2mp;                                         18225000
      tos := lparm(4);  <<address of 3rd parm>>                         18230000
      cierr(*,*,%10000,2);                                              18235000
      return                                                            18240000
      end;                                                              18245000
   @fname := lparm;                                                     18250000
   if (numparms=0) or ((temp := logical(bparm(2)))=0) then              18255000
    begin  <<dump file specification missing>>                          18260000
        << if he doesn't have a file equation for dumptape >>           18265000
        << then we will create one for him.                >>           18270000
                                                                        18275000
        move tempbuff := "DUMPTAPE ";                                   18280000
        cnt := findjtentry(tempbuff,blank,blank,3,a,d1);                18285000
        exchangedb(0);                                                  18290000
        unlockjir(a);                                                   18295000
                                                                        18300000
                                                                        18305000
        if cnt = 0 then  << no file equation exists >>                  18310000
        begin                                                           18315000
          move tempbuff :=  ("FILE DUMPTAPE;DEV=TAPE ",%15);            18320000
          command(tempbuff,stat,parm);                                  18325000
          if stat <> 0 then                                             18330000
          begin                                                         18335000
            cierr(errnum := 656);                                       18340000
          return;                                                       18345000
          end;                                                          18350000
          implicit := true;                                             18355000
        end;                                                            18360000
   end                                                                  18365000
   else                                                                 18370000
   begin                                                                18375000
     if fname <> "*" and fname<>"$NULL" then <<must be backref>>        18380000
        begin                                                           18385000
          parmnum := 1;                                                 18390000
          cierr(errnum := dumpfilenotbackref, fname);                   18395000
          return;                                                       18400000
        end;                                                            18405000
      if ((fname <> "*DUMPTAPE") or (lparm(1).(0:8) <> 9)) then<< 8386>>18410000
      begin                                                             18415000
       move lhs := tapfil , (9);                                        18420000
       implicit := true;  << will attempt to do implicit eq. >>         18425000
       errnum := cyimplctfile'(lhs,fname,temp);                         18430000
       if <> then   <<error in name>>                                   18435000
          begin                                                         18440000
          parmnum :=1;                                                  18445000
          return                                                        18450000
          end;                                                          18455000
      end;                                                              18460000
   end;                                                                 18465000
   if (numparms<=1) or ((temp := logical(bparm(6)))=0) then             18470000
      go to skip;  <<no auxiliary list file>>                           18475000
   @fname := lparm(2);                                                  18480000
   move lhs := auxlist , (9);                                           18485000
   errnum := cyimplctfile'(lhs,fname,temp);                             18490000
   if <> then   <<error in name>>                                       18495000
      begin                                                             18500000
      cleanup;                                                          18505000
      parmnum :=2;                                                      18510000
      return                                                            18515000
      end;                                                              18520000
   parm := 2;                                                           18525000
skip:                                                                   18530000
   if fname <> "$NULL" then check'for'jobs;                    << 9029>>18535000
   move lhs := "SYSDUMP.PUB.SYS ";                                      18540000
   setjcw(getjcw land %37777);  <<clear jcw abort bits>>                18545000
      tos := tos + 0;            <<clear carry>>                        18550000
   create(lhs,entryname,pin,parm,1);                                    18555000
      if carry then                                                     18560000
            begin                                                       18565000
            lhs(7) := 0;    <<set up as parm to genmsg>>                18570000
            if createerror then                                         18575000
               cierr(errnum := subsyscreateerr,,0,@lhs)                 18580000
            else                                                        18585000
               cierr(errnum := subsysloaderr,,0,@lhs);                  18590000
            cleanup;                                                    18595000
            return                                                      18600000
      end;                                                              18605000
      if < then                                                         18610000
            begin                                                       18615000
         lhs(7) := 0;                                                   18620000
         cierr(errnum := subsnotfound,,0,@lhs);                         18625000
         cleanup;                                                       18630000
         return;                                                        18635000
      end;                                                              18640000
   nextline;                                                            18645000
   awake(pin*pcbsize,1,2);                                              18650000
                                                                        18655000
      cleanup;                                                          18660000
cisubsysfinish(3, errnum, parmnum);                                     18665000
end;                                                                    18670000
$control segment=cisysmgr                                      <<u.rao>>18675000
      procedure cxallocate executorhead;                                18680000
      option privileged, uncallable;                                    18685000
      begin                                                             18690000
      comment                                                           18695000
      cxallocate is the executor for allocate and deallocate            18700000
      command format                                                    18705000
      allocate[[program/procedure],] name                               18710000
      deallocate[[program/procedure],] name                             18715000
      ;                                                                 18720000
      entry cxdeallocate;                                               18725000
      integer numparms,temp;                                            18730000
      logical dealoc := false;                                 <<u.rao>>18735000
      double array parms(0:2);                                 <<u.rao>>18740000
      integer array iparm(*)=parms;                                     18745000
      byte array bparm(*)=parms;                                        18750000
      byte pointer name,pname;                                          18755000
      logical dummy;  <<used when checking program file name>> <<08.ro>>18760000
      byte pointer errptr;  <<return from checkfilename'>>     <<08.ro>>18765000
      logical lerrptr = errptr;                                <<08.ro>>18770000
                                                                        18775000
      go to process;                                                    18780000
cxdeallocate:                                                           18785000
      dealoc:=dealoc+1;<<de allocate in process>>                       18790000
process:                                                                18795000
      mycommand(parmsp,,3,numparms,parms);                     <<u.rao>>18800000
      if numparms > 2 then                                     <<u.rao>>18805000
         begin                                                 <<u.rao>>18810000
         parmnum := 3;                                         <<u.rao>>18815000
         tos := errnum := alloc2mp;                            <<u.rao>>18820000
         tos := iparm(4);                                      <<u.rao>>18825000
         cierr(*,*);                                           <<u.rao>>18830000
         return;                                               <<u.rao>>18835000
         end;                                                  <<u.rao>>18840000
      if numparms < 1 then                                     <<u.rao>>18845000
         begin  <<at least one is required>>                   <<u.rao>>18850000
         parmnum := 1;                                         <<u.rao>>18855000
         cierr(errnum := allocnotenuf, parmsp);                <<u.rao>>18860000
         return;                                               <<u.rao>>18865000
         end;                                                  <<u.rao>>18870000
      if=then                                                           18875000
        begin                                                           18880000
        @pname:=iparm;<<get name>>                                      18885000
        go to tryprog;<<default case program>>                          18890000
        end;                                                            18895000
      @name:=iparm;<<get procedure/program>>                            18900000
      @pname:=iparm(2);<<get program name>>                             18905000
      temp:=bparm(x);<<get length>>                                     18910000
      if (temp=9) and (name="PROCEDURE") then                           18915000
         begin<<procedure allocation/deallocation>>                     18920000
         tos:=if dealoc then deallocateproc(pname)                      18925000
                        else allocateproc(pname);                       18930000
         if <> then                                                     18935000
            begin<<error>>                                              18940000
            duplicate;<<make copy>>                                     18945000
            tos:= if dealoc then 86 else 84;<<get correct compare>>     18950000
            if tos=tos then<<check for errors>>                         18955000
            cierr((if dealoc then errnum := -procnotall        <<04790>>18960000
                            else errnum := -procalloc), pname) <<04790>>18965000
            else                                               <<00833>>18970000
               begin                                           <<00833>>18975000
               loaderror(*);                                   <<00833>>18980000
               cierr(errnum := if dealoc then nodealocproc     <<00833>>18985000
                               else noalocproc);               <<00833>>18990000
               end;                                            <<00833>>18995000
            end;                                                        19000000
         end                                                            19005000
      else if (temp=7) and (name="PROGRAM") then                        19010000
tryprog: begin <<program allocation/deallocation>>                      19015000
         errnum := checkfilename'(parms(numparms-1) & lsr(8),  <<08.ro>>19020000
            dummy, dummy, lerrptr);<<check for valid file name><<08.ro>>19025000
         if <> then  <<unacceptable file name>>                <<08.ro>>19030000
            begin   <<put out appropriate error, return>>      <<08.ro>>19035000
            if < then  <<illegal file name specification>>     <<08.ro>>19040000
               cierr(errnum, errptr)                           <<08.ro>>19045000
            else if errnum = 0 then  <<back referenced file>>  <<08.ro>>19050000
               cierr(errnum := allocnobackref, pname)          <<08.ro>>19055000
            else <<system defined file, as $null>>             <<08.ro>>19060000
               cierr(errnum := allocnosysdef, pname);          <<08.ro>>19065000
            parmnum := numparms;                               <<08.ro>>19070000
            return;                                            <<08.ro>>19075000
            end;                                               <<08.ro>>19080000
         tos:= if dealoc then deallocateprog(pname)                     19085000
                         else allocateprog(pname);                      19090000
         if <> then                                                     19095000
            begin<<error>>                                              19100000
            duplicate;<<make copy>>                                     19105000
            tos:=if dealoc then 82 else 80;<<get correct compare>>      19110000
            if tos=tos then<<check for error>>                          19115000
            cierr((if dealoc then errnum := -prognotall        <<04790>>19120000
                            else errnum := -progalloc), pname) <<04790>>19125000
            else                                               <<00833>>19130000
               begin                                           <<00833>>19135000
               loaderror(*);                                   <<00833>>19140000
               cierr(errnum := if dealoc then nodealocprog     <<00833>>19145000
                               else noalocprog);               <<00833>>19150000
               end;                                            <<00833>>19155000
            end;                                                        19160000
         end                                                   <<u.rao>>19165000
      else   <<unknown keyword>>                               <<u.rao>>19170000
         cierr(errnum := allocxprogproc, name);                <<u.rao>>19175000
      end;<<cxallocate/cxdeallocate>>                                   19180000
                                                               <<rh.pv>>19185000
$control segment=cisysmgr                                      <<u.rao>>19190000
      procedure cxquantum executorhead;                        <<rh.pv>>19195000
      option privileged,uncallable;                            <<rh.pv>>19200000
      begin                                                    <<rh.pv>>19205000
      comment                                                  <<rh.pv>>19210000
      cxquantum is the executor for the quantum command        <<rh.pv>>19215000
      command format                                           <<rh.pv>>19220000
      quantum time slice,terminal pri,normal pri,cpu bound pri <<rh.pv>>19225000
      ;                                                                 19230000
                                                               <<01724>>19235000
<< this command has been replaced by the tune command. >>      <<01724>>19240000
<< (see module opcommand, 85) >>                               <<01724>>19245000
                                                               <<01724>>19250000
cierr(errnum := quantum'nomo);                                 <<01724>>19255000
                                                               <<01724>>19260000
      end;<<quantum>>                                                   19265000
      procedure cxshowq executorhead;                                   19270000
      option privileged,uncallable;                                     19275000
      begin                                                             19280000
      comment                                                           19285000
      cxshowq is the executor for the show que command                  19290000
      command format                                                    19295000
      showque                                                           19300000
      ;                                                                 19305000
      logical dl:=%6400;                                                19310000
      array datebuf(0:13);  <<for time stamp>>                 <<02.ro>>19315000
      array qarray(*) = q + 0;                                 <<06585>>19320000
      integer pcbglobloc;                                      <<06585>>19325000
                                                                        19330000
      mycommand(parmsp,dl,0);<<check command for validity>>             19335000
      if <> then cierr(errnum := -warnxparmsignored,parmsp);   <<04790>>19340000
      pxglobal;                                                <<06585>>19345000
      tos := pxg'interactive;                                  <<06585>>19350000
      if not tos then   <<not interactive, time stamp>>        <<02.ro>>19355000
         begin                                                 <<02.ro>>19360000
         date'line(datebuf);                                   <<02.ro>>19365000
         print(datebuf, -27, %60);                             <<02.ro>>19370000
         end;                                                  <<02.ro>>19375000
      showmq;                                                  <<u.rao>>19380000
      end;<<cxshowq>>                                                   19385000
$control segment=cisysmgr                                      <<u.rao>>19390000
      procedure showlogfile;                                            19395000
      option privileged, uncallable;                                    19400000
      begin                                                             19405000
      comment                                                           19410000
      issues a message showing name of current log file as well         19415000
      as percentage of use.                                             19420000
      if no logging then returns approppriate message.                  19425000
      if logging returns cce,otherwise ccl.                             19430000
      ;                                                                 19435000
      array wbuf (0:14);                                                19440000
      integer t;                                                        19445000
      byte array buf(*)=wbuf,temp(0:4),logn(*)=buf(12),pc(*)=buf(20),   19450000
      mes1(0:10)=pb:="NO LOGGING";                                      19455000
      byte array mes0(0:28)=pb:="LOG FILE LOG0000 IS   % FULL";         19460000
                                                                        19465000
      integer subroutine percent(total,number);                         19470000
      value total,number;                                               19475000
      double total,number;                                              19480000
      begin<< computes the % for the % full message>>                   19485000
      percent:=integer(fixr((real(number)/real(total))*real(100)));     19490000
      end;  << p e r c e n t  >>                                        19495000
      status.(6:2) := cce; <<set normal print out status>>              19500000
      if not(absolute(linfo)) then                                      19505000
         begin                            <<no logging>>                19510000
         move buf(0):=mes1(0),(10);                                     19515000
         print (wbuf, -10, 0);<<print no logging msg>>                  19520000
         status.(6:2):=ccl;                                             19525000
         if absolute(flagx).(11:2)=0 then return else status.(6:2):=ccg;19530000
         end;                                                           19535000
      move buf(0):=mes0(0),(28);        <<transfer message>>            19540000
      t:=ascii(absolute(logfileno),10,temp);<<convert log# to ascii>>   19545000
      move logn(3):=temp(t-1),(-t);    <<log file number>>              19550000
      assemble(zero);                                                   19555000
      tos:=absolute(logfilesize);<<get block size>>                     19560000
      tos:=absolute(x:=x+1);                                            19565000
      tos:=absolute(x:=x+2);<<get block count>>                         19570000
      tos:=absolute(x:=x+1);                                            19575000
      tos:=percent(*,*);<<change to %>>                                 19580000
      assemble(zero,xch);                                               19585000
      t:=ascii(*,10,temp);<<convert % to ascii>>                        19590000
      move pc(1):=temp(t-1),(-t);                                       19595000
      print (wbuf, -28, 0);<<print logging message>>                    19600000
      end;<<showlogfile>>                                               19605000
      procedure cxshowlog executorhead;                                 19610000
      option privileged,uncallable;                                     19615000
      begin                                                             19620000
      comment                                                           19625000
      cxshowlog is the executor for the showlog,switchlog&resumelog     19630000
      commands                                                          19635000
      command format                                                    19640000
      showlog                                                           19645000
      resumelog                                                         19650000
      switchlog                                                         19655000
      ;                                                                 19660000
      entry cxresumelog,cxswitchlog;                                    19665000
      logical dl:=%6400,switchlog:=0,resumelog:=0;                      19670000
      define disaproc  = assemble(psdb)#,                      <<04789>>19675000
             enaproc   = assemble(pseb)#;                      <<04789>>19680000
      equate bufsir    = 26;                                   <<04789>>19685000
      integer                                                  <<04789>>19690000
         s;                                                    <<04789>>19695000
                                                                        19700000
      go to process;                                                    19705000
cxresumelog:<<entry point for resumelog command>>                       19710000
      resumelog:=resumelog+1;<<set flag>>                               19715000
      go to process;                                                    19720000
cxswitchlog:<<entry point for switchlog command>>                       19725000
      switchlog:=switchlog+1;<<set flag>>                               19730000
process:                                                                19735000
      mycommand(parmsp,dl,0);<<check command for validity>>             19740000
      if <> then cierr(errnum := -warnxparmsignored,parmsp);   <<04790>>19745000
      if switchlog then                                                 19750000
         begin<<switchlog>>                                             19755000
         showlogfile;<<print out statistics>>                           19760000
         if=then                                                        19765000
            begin<<logging enabled create new file>>                    19770000
            s := getsir(bufsir);   << get buffer sir>>         <<04789>>19775000
            disaproc;  << this is done to prevent the >>       <<04789>>19780000
                       << log process or system logging>>      <<04789>>19785000
                       << from running.                >>      <<04789>>19790000
            relsir(bufsir,s);  << release buffer sir   >>      <<04789>>19795000
            absolute(flagx).(14:1):=1;<<set switch log flag>>           19800000
            awake(absolute(logprocess),%20,0);<<do switch>>             19805000
            enaproc;  << allow log process to run  >>          <<04789>>19810000
            end;                                                        19815000
         end                                                            19820000
      else if resumelog then                                            19825000
         begin<<resume log file>>                                       19830000
         if absolute(linfo) then return;<<logging inhibited>>           19835000
         tos:=absolute(flagx);                                          19840000
         assemble(tbc 12);                                              19845000
         if <> then return;<<hard error>>                               19850000
         assemble(tbc 11);                                              19855000
         if = then return;<<we are on and working>>                     19860000
         assemble(sed 0);                                               19865000
         awake(absolute(logprocess),%20,0);<<resume>>                   19870000
         assemble(sed 1);                                               19875000
         end                                                            19880000
     else showlogfile;<<show log file>>                                 19885000
     end;<<cxshowlog/cxresumelog/cxswitchlog>>                          19890000
$control segment=cisysmgr                                      <<u.rao>>19895000
procedure cxjobpri executorhead;                               <<u.rao>>19900000
option privileged,uncallable;                                  <<u.rao>>19905000
begin                                                          <<u.rao>>19910000
                                                               <<u.rao>>19915000
logical dl := %26015; <<comma, cr>>                            <<u.rao>>19920000
integer numparms,                                              <<u.rao>>19925000
        newmaxq,  <<local temp for max job queue>>             <<u.rao>>19930000
        newdefq;  <<local temp for default job queue>>         <<u.rao>>19935000
double array parms(0:2) = q;                                   <<u.rao>>19940000
byte pointer bmaxq = parms;                                    <<u.rao>>19945000
byte lenmaxqparm = parms+1;                                    <<u.rao>>19950000
byte pointer bdefq = parms+2;                                  <<u.rao>>19955000
byte lendefqparm = parms+3;                                    <<u.rao>>19960000
byte pointer badparm = parms+4;                                <<u.rao>>19965000
equate cs=150,                                                 <<08.eb>>19970000
       ds=200,                                                 <<08.eb>>19975000
       es=250;                                                 <<u.rao>>19980000
equate qnamelen=20;                                            <<u.rao>>19985000
byte array qnamep(0:qnamelen-1)=pb :=                          <<u.rao>>19990000
   5,2,"CS",cs,                                                <<u.rao>>19995000
   5,2,"DS",ds,                                                <<u.rao>>20000000
   5,2,"ES",es,                                                <<u.rao>>20005000
   4,1,"0",0,                                                  <<u.rao>>20010000
   0;                                                          <<u.rao>>20015000
byte array qname(0:qnamelen-1);                                <<u.rao>>20020000
                                                               <<u.rao>>20025000
                                                               <<u.rao>>20030000
mycommand(parmsp,dl,3,numparms,parms);                         <<u.rao>>20035000
if numparms > 2 then                                           <<u.rao>>20040000
   begin                                                       <<u.rao>>20045000
   parmnum := 3;                                               <<u.rao>>20050000
   cierr(errnum := jobpri2mp,badparm);                         <<u.rao>>20055000
   end                                                         <<u.rao>>20060000
else                                                           <<u.rao>>20065000
   begin                                                       <<u.rao>>20070000
   <<0, 1, or 2 parameters.  if parameters are passed, validate<<u.rao>>20075000
   <<if invalid, print message and return.  otherwise, if param<<u.rao>>20080000
   <<passed, set the new values.  in any case, print the new va<<u.rao>>20085000
   newmaxq := absolute(maxqueue);                              <<u.rao>>20090000
   newdefq := absolute(defaultqueue);                          <<u.rao>>20095000
   move qname := qnamep, (qnamelen);  <<init name array>>      <<u.rao>>20100000
   if numparms >= 1 then                                       <<u.rao>>20105000
      begin  <<some parms exist>>                              <<u.rao>>20110000
      if lenmaxqparm > 0 then                                 <<u.rao>> 20115000
         begin  <<max queue parm present>>                     <<u.rao>>20120000
         tos := 0;                                             <<u.rao>>20125000
         if search(bmaxq,lenmaxqparm,qname,bps0) = 0 then      <<u.rao>>20130000
            begin <<unknown queue name>>                       <<u.rao>>20135000
            parmnum := 1;                                      <<u.rao>>20140000
            cierr(errnum := jobpriunknownq, bmaxq);            <<u.rao>>20145000
            return                                             <<u.rao>>20150000
            end;                                               <<u.rao>>20155000
         newmaxq := integer(bps0);                             <<u.rao>>20160000
         del;                                                  <<u.rao>>20165000
         end;                                                  <<u.rao>>20170000
      if (numparms=2) and (lendefqparm>0) then                 <<u.rao>>20175000
         begin <<default queue parm apparently present>>       <<u.rao>>20180000
         tos := 0;                                             <<u.rao>>20185000
         if search(bdefq,lendefqparm,qname,bps0) = 0 then      <<u.rao>>20190000
            begin  <<unknown queue name>>                      <<u.rao>>20195000
            parmnum := 2;                                      <<u.rao>>20200000
            cierr(errnum := jobpriunknownq, bdefq);            <<u.rao>>20205000
            return                                             <<u.rao>>20210000
            end;                                               <<u.rao>>20215000
         if bps0 = 0 then                                      <<u.rao>>20220000
            begin <<0 illegal for default queue>>              <<u.rao>>20225000
            cierr(errnum := -jobpriwarnnot0, bdefq);           <<04790>>20230000
            newdefq := cs;                                     <<u.rao>>20235000
            end                                                <<u.rao>>20240000
         else                                                  <<u.rao>>20245000
            newdefq := integer(bps0);                          <<u.rao>>20250000
         del;                                                  <<u.rao>>20255000
         end;                                                  <<u.rao>>20260000
      if newdefq < newmaxq then                                <<u.rao>>20265000
         begin                                                 <<u.rao>>20270000
         <<default priority has lower value and thus exceeds th<<u.rao>>20275000
         <<imposed by the maxq priority.  print error msg, retu<<u.rao>>20280000
         if newdefq + newmaxq < cs+es then                     <<u.rao>>20285000
            cierr(errnum := jobpridefcsmaxds)                  <<04790>>20290000
         else if = then                                        <<u.rao>>20295000
            cierr(errnum := jobpridefcsmaxes)                  <<04790>>20300000
         else                                                  <<u.rao>>20305000
            cierr(errnum := jobpridefdsmaxes);                 <<04790>>20310000
         return                                                <<u.rao>>20315000
         end;                                                  <<u.rao>>20320000
      end;                                                     <<u.rao>>20325000
   <<at this point we have good values.  it remains to set the <<u.rao>>20330000
   <<globals, print the current (new) values, then return>>    <<u.rao>>20335000
   absolute(maxqueue) := newmaxq;                              <<u.rao>>20340000
   absolute(defaultqueue) := newdefq;                          <<u.rao>>20345000
   qname(4) := qname(9) := qname(14) := 0;  <<for genmsg>>     <<u.rao>>20350000
   @bmaxq := (if newmaxq > ds then @qname(12)                  <<u.rao>>20355000
         else if = then @qname(7)                              <<u.rao>>20360000
         else if newmaxq > 0 then @qname(2)                    <<u.rao>>20365000
         else @qname(17));                                     <<u.rao>>20370000
   @bdefq := (if newdefq > ds then @qname(12)                  <<u.rao>>20375000
         else if = then @qname(7)                              <<u.rao>>20380000
         else @qname(2));                                      <<u.rao>>20385000
   genmsg( cigeneralmsgset, jobprival, 0, @bmaxq, @bdefq );    <<01525>>20390000
   end;                                                        <<u.rao>>20395000
end;  <<cxjobpri>>                                             <<u.rao>>20400000
$page   "ORGANIZATIONAL MANAGEMENT COMMANDS"                            20405000
$control segment= ciorgman                                              20410000
integer procedure check'n'movename (source,slngth,             <<rv.pv>>20415000
                             target,targetincrdecr,maxparts);  <<rv.pv>>20420000
    value   slngth,targetincrdecr,maxparts;                    <<rv.pv>>20425000
    integer slngth,targetincrdecr,maxparts;                    <<rv.pv>>20430000
    byte array source;                                         <<rv.pv>>20435000
    array target;                                              <<rv.pv>>20440000
    option privileged, uncallable;                             <<04.ro>>20445000
    begin                                                      <<rv.pv>>20450000
        byte array                                             <<rv.pv>>20455000
            string (0:slngth);                                 <<rv.pv>>20460000
        double array                                           <<rv.pv>>20465000
            parms (0:maxparts);                                <<rv.pv>>20470000
        double                                                 <<rv.pv>>20475000
            parm;                                              <<rv.pv>>20480000
        integer                                                <<rv.pv>>20485000
            result = check'n'movename,                         <<rv.pv>>20490000
            numparms,                                          <<rv.pv>>20495000
            parm0 = parm,                                      <<rv.pv>>20500000
            dl := [8/".", 8/%15],                              <<rv.pv>>20505000
            pnum := 0;                                         <<rv.pv>>20510000
        logical                                                <<rv.pv>>20515000
            parm1 = parm0+1;                                   <<rv.pv>>20520000
        byte pointer                                           <<rv.pv>>20525000
            here = parm0;                                      <<rv.pv>>20530000
        define                                                 <<rv.pv>>20535000
            badexit = begin                                    <<rv.pv>>20540000
                          cc := ccl;                           <<rv.pv>>20545000
                          return;                              <<rv.pv>>20550000
                      end #,                                   <<rv.pv>>20555000
            lngth = parm1.(0:8) #,                             <<rv.pv>>20560000
            spec = parm1.(10:1) #;                             <<rv.pv>>20565000
        equate                                                 <<rv.pv>>20570000
            expectalpha = 0, <<start of name must be alpha>>   <<rv.pv>>20575000
            spechar     = 1, <<contains spec char(s)>>         <<rv.pv>>20580000
            nametoolong = 2; <<exceeds 8 bytes>>               <<rv.pv>>20585000
<<>>                                                           <<rv.pv>>20590000
        cc := cce; <<ok until failure>>                        <<rv.pv>>20595000
        move string := source, (slngth);                       <<rv.pv>>20600000
        string (slngth) := %15;                                <<rv.pv>>20605000
        mycommand (string,dl,maxparts,numparms,parms);         <<rv.pv>>20610000
        if > then                                              <<rv.pv>>20615000
        begin                                                  <<rv.pv>>20620000
            result := nametoolong;                             <<rv.pv>>20625000
            badexit;                                           <<rv.pv>>20630000
        end;                                                   <<rv.pv>>20635000
        if numparms = 0 then return;                           <<rv.pv>>20640000
        do begin                                               <<rv.pv>>20645000
               parm := parms (pnum);                           <<rv.pv>>20650000
               if here <> alpha then                           <<rv.pv>>20655000
                if lngth = 1 and pnum=0 and here = "@" then    <<rv.pv>>20660000
                else                                           <<rv.pv>>20665000
                begin                                          <<rv.pv>>20670000
                    result := expectalpha;                     <<rv.pv>>20675000
                    badexit;                                   <<rv.pv>>20680000
                end                                            <<rv.pv>>20685000
               else                                            <<rv.pv>>20690000
                if spec then                                   <<rv.pv>>20695000
                begin                                          <<rv.pv>>20700000
                    result := spechar;                         <<rv.pv>>20705000
                    badexit;                                   <<rv.pv>>20710000
                end                                            <<rv.pv>>20715000
                else                                           <<rv.pv>>20720000
                 if lngth > 8 then                             <<rv.pv>>20725000
                  begin                                        <<rv.pv>>20730000
                     result := nametoolong;                    <<rv.pv>>20735000
                     badexit;                                  <<rv.pv>>20740000
                 end;                                          <<rv.pv>>20745000
               tos := @target & lsl (1);                       <<rv.pv>>20750000
               move * := here, (lngth);                        <<rv.pv>>20755000
               @target := @target + targetincrdecr;            <<rv.pv>>20760000
           end until (pnum:=pnum+1) = numparms;                <<rv.pv>>20765000
        result := numparms;                                    <<rv.pv>>20770000
    end;<<of check'n'movename>>                                <<rv.pv>>20775000
logical procedure cyorgcoms'(errnum,parmnum,image,level,newentry,       20780000
                             vscomm,specmask);                 <<rv.pv>>20785000
<<this procedure parses the parameter list supplied with :newxxxx>>     20790000
<<and :altxxx commands for accounts, groups and users.  all detected>>  20795000
<<errors are reported in this procedure.  a return value of true>>      20800000
<<indicates that no errors were detected.>>                    <<u.rao>>20805000
value level;                                                   <<u.rao>>20810000
integer errnum;  <<the usual errnum>>                          <<u.rao>>20815000
integer parmnum; <<the usual parmnum>>                         <<u.rao>>20820000
byte array image;  <<the parameter image to be parsed>>        <<u.rao>>20825000
integer level;  <<the level of operation - 1=g,2=a,3=u>>       <<u.rao>>20830000
integer array newentry;  <<where the parsed info is to go>>    <<u.rao>>20835000
array vscomm;  <<supplied by :xxxacct & :xxxgroup commands>>   <<rv.pv>>20840000
array specmask;   <<this is supplied by :altxxx commands.  >>  <<rv.pv>>20845000
  <<it indicates every word of newentry which was supplied by the user>>20850000
   <<this is so that only changed items are entered in the directory>>  20855000
option variable,privileged,uncallable;                         <<u.rao>>20860000
                                                               <<u.rao>>20865000
begin                                                          <<u.rao>>20870000
<<mycommand variables>>                                        <<u.rao>>20875000
integer numparms;  <<actual number of parms detected>>         <<u.rao>>20880000
double array parms(0:70);  <<approximate maximum on possible parms>>    20885000
double dl := [8/";",8/"=",8/",",8/":"]d;                       <<u.rao>>20890000
logical dlextension := %6400;  <<carriage return>>             <<u.rao>>20895000
equate semicolon=0,   <<indexes in the dl array>>              <<u.rao>>20900000
       equals   =1,                                            <<u.rao>>20905000
       comma    =2,                                            <<u.rao>>20910000
       colon    =3,                                            <<u.rao>>20915000
       cr       =4;                                            <<u.rao>>20920000
<<variables for global parse>>                                 <<u.rao>>20925000
define group = level=grouplevel#,                              <<u.rao>>20930000
       account = level=accountlevel#,                          <<u.rao>>20935000
       user = level=userlevel#;                                <<u.rao>>20940000
integer nextdelim;  <<holds dl index of next delimiter>>       <<u.rao>>20945000
byte pointer parmptr;  <<points to start of current parameter>>         20950000
integer parmlen;    <<length of current parameter>>            <<u.rao>>20955000
logical embeddedspecial;  <<for checking names for specials>>  <<u.rao>>20960000
define resultadr= integer(defn(level))#;  <<offset in newentry><<u.rao>>20965000
byte pointer defn;  <<points into keydict defn array>>         <<u.rao>>20970000
array tempspecmask (0:specmaskln-1);                           <<rv.pv>>20975000
<<misc variables>>                                             <<u.rao>>20980000
byte pointer bnewentry := @newentry;                           <<u.rao>>20985000
double pointer gsecurity := @newentry(gsec);                   <<u.rao>>20990000
integer acctsecdef := [2/1,2/1,2/1,2/1,2/1,2/1];               <<01.ro>>20995000
double groupsecdef := [5/2,5/2,5/2,5/2,5/2,5/2]d;              <<01.ro>>21000000
byte array                                                     <<rv.pv>>21005000
    bvshaname (*) = vscomm (vshaname),                         <<rv.pv>>21010000
    bvshgname (*) = vscomm (vshgname);                         <<rv.pv>>21015000
equate unotdbl = 0,  <<user not allowed double integer>>       <<u.rao>>21020000
       dblinvalid = 1,  <<problem with string>>                <<u.rao>>21025000
       dblneg  = 2,  <<double integer is negative>>            <<u.rao>>21030000
       redundant = 3,<<redundantly defined keyword>>           <<u.rao>>21035000
       expectalpha = 1, <<start of name must be alpha>>        <<u.rao>>21040000
       namemissing = 2, <<expected name>>                      <<u.rao>>21045000
       nametoolong = 3,  <<exceeds 8 bytes>>                   <<u.rao>>21050000
       embedspec = 5;  <<embedded special in name>>            <<u.rao>>21055000
byte pointer capdefn;  <<pointer to definition word of capdict><<u.rao>>21060000
logical pmask = q-4;  <<option variable word>>                 <<u.rao>>21065000
double sec;  <<the security word dummy>>                       <<u.rao>>21070000
integer sec1 = sec;  <<used for group security>>               <<u.rao>>21075000
logical vsparmacct; << true if vs= parm on xxxacct command >>  <<01460>>21080000
integer adjust;<<used for capability list parse>>              <<u.rao>>21085000
equate capdictlen = 106;                                       << 8151>>21090000
byte array capdictx(0:capdictlen-1) = pb :=                    <<u.rao>>21095000
   <<definition part is bit position in cap matrix>>           <<u.rao>>21100000
   5,2,"SF",15,                                                <<u.rao>>21105000
   5,2,"ND",14,                                                <<u.rao>>21110000
   5,2,"CS",13,                                                <<u.rao>>21115000
   5,2,"BA",23,                                                <<u.rao>>21120000
   5,2,"IA",24,                                                <<u.rao>>21125000
   5,2,"PM",25,                                                <<u.rao>>21130000
   5,2,"MR",28,                                                <<u.rao>>21135000
   5,2,"DS",30,                                                <<u.rao>>21140000
   5,2,"PH",31,                                                <<u.rao>>21145000
   5,2,"NM",12,                                                <<06854>>21150000
   5,2,"NA",11,                                                <<06854>>21155000
   5,2,"UV",7,                                                 <<rh.pv>>21160000
   5,2,"CV",6,                                                 <<rh.pv>>21165000
   5,2,"OP",5,                                                 <<u.rao>>21170000
   5,2,"DI",4,                                                 <<u.rao>>21175000
   5,2,"GL",3,                                                 <<u.rao>>21180000
   5,2,"AL",2,                                                 <<u.rao>>21185000
   5,2,"AM",1,                                                 <<u.rao>>21190000
   5,2,"SM",0,                                                 <<u.rao>>21195000
   5,2,"LG",8,                                                 <<00506>>21200000
   5,2,"PS",10,                                                << 8151>>21205000
   0;                                                          <<u.rao>>21210000
byte array capdict(0:capdictlen-1);                            <<u.rao>>21215000
equate subqlen = 21;                                           <<u.rao>>21220000
byte array subqx(0:subqlen-1) = pb :=                          <<u.rao>>21225000
   4,2,"ES",                                                   <<u.rao>>21230000
   4,2,"DS",                                                   <<u.rao>>21235000
   4,2,"CS",                                                   <<u.rao>>21240000
   4,2,"BS",                                                   <<u.rao>>21245000
   4,2,"AS",                                                   <<u.rao>>21250000
   0;                                                          <<u.rao>>21255000
byte array subqa(0:subqlen-1);                                 <<u.rao>>21260000
   equate            keydictl          = 117;                  <<rv.pv>>21265000
   byte array        keydictx (0:keydictl-1) = pb :=           <<01.pv>>21270000
         10, 4, "PASS", 4, gpass,apass,upass,                  <<01.pv>>21275000
         11, 5, "FILES", 2, gdfslimit,adfslimit,"X",           <<01.pv>>21280000
         9, 3, "CPU", 2, gcpulimit,acpulimit,"X",              <<01.pv>>21285000
         13, 7, "CONNECT", 2, gcontimelimit,acontimelimit,"X", <<01.pv>>21290000
         <<len=2 for a & u>>                                   <<01.pv>>21295000
         9,3,"CAP",1,gcap,acap,ucap,                           <<01.pv>>21300000
         <<len=2 for g>>                                       <<01.pv>>21305000
         12,6,"ACCESS",1,gsec,asecw,"X",                       <<01.pv>>21310000
         12, 6, "MAXPRI", 1, "X", amaxjobw,umaxjob,            <<01.pv>>21315000
         13, 7, "LOCATTR", 2, "X",alattr,ulattr,               <<01.pv>>21320000
         8, 2, "VS",12,ghvsname,"X","X",                       <<01460>>21325000
         10, 4, "HOME", 4, "X","X",uhgroup,                    <<01.pv>>21330000
              0,0,0;                                           <<p.rao>>21335000
   byte array        keydict (0:keydictl-1);                   <<01.pv>>21340000
   equate            subkeydictl          = 14;                <<00086>>21345000
   byte array        subkeydictx (0:subkeydictl-1) = pb :=     <<rv.pv>>21350000
         6, 4, "SPAN",                                         <<00086>>21355000
         5, 3, "ALT",                                          <<00086>>21360000
              0,0,0;                                           <<rv.pv>>21365000
   byte array        subkeydict (0:subkeydictl-1);             <<rv.pv>>21370000
define max = 32767,-1#;                                        <<u.rao>>21375000
   integer array     initialgroup (0:gsize-1) = pb :=          <<01.pv>>21380000
                                       "        ",             <<u.rao>>21385000
                                       0,                      <<u.rao>>21390000
                                       "        ",             <<u.rao>>21395000
                                       0, 0,                   <<u.rao>>21400000
                                       max,                    <<u.rao>>21405000
                                       0, 0,                   <<u.rao>>21410000
                                       max,                    <<u.rao>>21415000
                                       0, 0,                   <<u.rao>>21420000
                                       max,                    <<u.rao>>21425000
                                       [5/2,5/2,4/1],          <<u.rao>>21430000
                                       [1/0,5/2,5/2,5/2],      <<u.rao>>21435000
                                       [6/0, 10/%(2)0110000000],        21440000
                                       0, 0,                   <<01.pv>>21445000
                                       "        ",             <<01.pv>>21450000
                                       "        ",             <<01.pv>>21455000
                                       "        ",             <<01.pv>>21460000
                                       0, 0, 0;                <<16.pv>>21465000
   integer array     initialacct (0:asize-1) = pb :=           <<01460>>21470000
                                       "        ",             <<u.rao>>21475000
                                       0,                      <<u.rao>>21480000
                                       0,                      <<u.rao>>21485000
                                       [7/%(2)0111000,7/0,2/%(2)11],    21490000
                                       [6/0, 10/%(2)0110000000],        21495000
                                       0, 0,                   <<u.rao>>21500000
                                       "        ",             <<u.rao>>21505000
                                       0, 0,                   <<u.rao>>21510000
                                       max,                    <<u.rao>>21515000
                                       0, 0,                   <<u.rao>>21520000
                                       max,                    <<u.rao>>21525000
                                       0, 0,                   <<u.rao>>21530000
                                       max,                    <<u.rao>>21535000
                                       [2/1,2/1,2/1,2/1,2/1,   <<u.rao>>21540000
                                        2/1],                  <<u.rao>>21545000
                                       150,    <<"CS">>        <<u.rao>>21550000
                                       0,                      <<u.rao>>21555000
                                       0;                      <<01460>>21560000
   integer array     initialuser (0:usize-1) = pb :=           <<01.pv>>21565000
                                       "        ",             <<u.rao>>21570000
                                       [7/0,7/0,2/%(2)11],     <<u.rao>>21575000
                                       [6/0, 10/%(2)0110000000],        21580000
                                       0, 0,                   <<u.rao>>21585000
                                       "        ",             <<u.rao>>21590000
                                       "        ",             <<u.rao>>21595000
                                       0,                      <<u.rao>>21600000
                                       150,    <<"CS">>        <<u.rao>>21605000
                                       0;                      <<u.rao>>21610000
                                                               <<u.rao>>21615000
<<                 *********************                   >>  <<u.rao>>21620000
<<                 *    setspecmask    *                   >>  <<u.rao>>21625000
<<                 *********************                   >>  <<u.rao>>21630000
                                                               <<u.rao>>21635000
logical subroutine setspecmask(count);                         <<u.rao>>21640000
value count;                                                   <<u.rao>>21645000
integer count;  <<number of words in item>>                    <<u.rao>>21650000
<<this subroutine sets the bits in specmask corresponding>>    <<u.rao>>21655000
<<to the new items in newentry.  it returns false if those>>   <<u.rao>>21660000
<<bits were already set, indicating redundantly defined keyword<<u.rao>>21665000
begin                                                          <<u.rao>>21670000
setspecmask := true;  <<not redundantly defined item>>         <<u.rao>>21675000
tos := defn (level);  <<displacement within entry>>            <<rv.pv>>21680000
do begin  <<until count is 0>>                                 <<rv.pv>>21685000
       tos := s0 & lsr (4); <<displ div 16>>                   <<rv.pv>>21690000
       tos := tempspecmask (s0); <<appropriate mask word>>     <<rv.pv>>21695000
       x := ls2 land %17; <<displ mod 16>>                     <<rv.pv>>21700000
       assemble (tsbc 0,x); <<set appropriate bit>>            <<rv.pv>>21705000
       if <> then s5 := 0; <<setspecmask := 0>>                <<rv.pv>>21710000
       assemble (xch, stax);                                   <<rv.pv>>21715000
       tempspecmask (x) := tos; <<update mask word>>           <<rv.pv>>21720000
       tos := tos+1;  <<increm displ>>                         <<rv.pv>>21725000
   end until (s2 := s2-1) = 0;                                 <<rv.pv>>21730000
del; <<displ>>                                                 <<rv.pv>>21735000
end;  <<subroutine setspecmask>>                               <<u.rao>>21740000
                                                               <<u.rao>>21745000
<<                 *********************                   >>  <<u.rao>>21750000
<<                 *       next        *                   >>  <<u.rao>>21755000
<<                 *********************                   >>  <<u.rao>>21760000
                                                               <<u.rao>>21765000
subroutine next;                                               <<u.rao>>21770000
<<this subroutine simply decomposes the data returned by>>     <<u.rao>>21775000
<<mycommand into individual items for the next parameter>>     <<u.rao>>21780000
begin                                                          <<u.rao>>21785000
tos := parms(parmnum);                                         <<u.rao>>21790000
embeddedspecial := s0.(10:1);                                  <<u.rao>>21795000
nextdelim := s0.(11:5);                                        <<u.rao>>21800000
parmlen := tos&lsr(8);                                         <<u.rao>>21805000
@parmptr := tos;                                               <<u.rao>>21810000
parmnum := parmnum+1;                                          <<u.rao>>21815000
end;  <<subroutine next>>                                      <<u.rao>>21820000
                                                               <<u.rao>>21825000
<<                 *********************                   >>  <<u.rao>>21830000
<<                 *     checkname     *                   >>  <<u.rao>>21835000
<<                 *********************                   >>  <<u.rao>>21840000
                                                               <<u.rao>>21845000
logical subroutine checkname(delta,target,missingok);          <<u.rao>>21850000
value missingok,delta;                                         <<u.rao>>21855000
integer delta; <<error delta converts common errors into detailed>>     21860000
logical array target;  <<where the resulting string goes. 4 words>>     21865000
logical missingok;  <<true => null string ok, such as home=;>> <<u.rao>>21870000
<<this subroutine parses up to 8 characters as a name of some>><<u.rao>>21875000
<<sort.  if valid, the name is moved into target.  if error,>> <<u.rao>>21880000
<<call cierr, return false>>                                   <<u.rao>>21885000
begin                                                          <<u.rao>>21890000
checkname := false;                                            <<u.rao>>21895000
if parmlen=0 then                                              <<u.rao>>21900000
   if not missingok then                                       <<u.rao>>21905000
      cierr(errnum:=namemissing+delta,parmptr)                 <<u.rao>>21910000
   else  <<ok for it to be missing>>                           <<u.rao>>21915000
      begin  <<return blanks, return true>>                    <<u.rao>>21920000
      checkname := true;                                       <<u.rao>>21925000
      move target := "        ";                               <<u.rao>>21930000
      end                                                      <<u.rao>>21935000
else if parmptr <> alpha then                                  <<u.rao>>21940000
   cierr(errnum := expectalpha+delta,parmptr)                  <<u.rao>>21945000
else if parmlen > 8 then                                       <<u.rao>>21950000
   cierr(errnum := nametoolong+delta,parmptr)                  <<u.rao>>21955000
else if embeddedspecial then                                   <<u.rao>>21960000
   cierr(errnum := embedspec+delta, parmptr)                   <<u.rao>>21965000
else                                                           <<u.rao>>21970000
   begin  <<looks like legal name>>                            <<u.rao>>21975000
   move target := "        ";                                  <<u.rao>>21980000
   tos := @target&lsl(1);  <<make byte address>>               <<u.rao>>21985000
   move * := parmptr,(parmlen);                                <<u.rao>>21990000
   checkname := true;                                          <<u.rao>>21995000
   end;                                                        <<u.rao>>22000000
end;  <<subroutine checkname>>                                 <<u.rao>>22005000
                                                               <<u.rao>>22010000
<<                 *********************                   >>  <<u.rao>>22015000
<<                 *   doaccesslist    *                   >>  <<u.rao>>22020000
<<                 *********************                   >>  <<u.rao>>22025000
                                                               <<u.rao>>22030000
subroutine doaccesslist;                                       <<u.rao>>22035000
begin                                                          <<u.rao>>22040000
if user then                                                   <<u.rao>>22045000
   begin  <<not valid option for user - warn and ignore>>      <<u.rao>>22050000
   cierr(errnum := -orgcomunotaccess,parmptr);                 <<04790>>22055000
   next;  <<skip to start of access list>>                     <<u.rao>>22060000
   if parmlen <> 0 then  <<non-null access list, attempt recovery>>     22065000
      begin                                                    <<u.rao>>22070000
      formaccess'(level,parmptr,sec,adjust,errnum);  <<to skip list>>   22075000
      parmnum := parmnum+adjust-2;                             <<u.rao>>22080000
      end                                                      <<u.rao>>22085000
   else parmnum := parmnum-1;                                  <<u.rao>>22090000
   end                                                         <<u.rao>>22095000
else                                                           <<u.rao>>22100000
   begin                                                       <<u.rao>>22105000
   next;  <<skip to start of access list>>                     <<u.rao>>22110000
   if parmlen <> 0 then  <<access list present evidently>>     <<u.rao>>22115000
      begin                                                    <<u.rao>>22120000
      tos := @newentry(resultadr);  <<to get default from newentry>>    22125000
      sec := dps0;                                             <<u.rao>>22130000
      formaccess'(level,parmptr,sec,adjust,errnum);            <<u.rao>>22135000
      parmnum := adjust+parmnum-2;                             <<u.rao>>22140000
      if errnum > 0 then   <<bail out>>                        <<u.rao>>22145000
         begin                                                 <<u.rao>>22150000
         del;  <<pop stacked pointer>>                         <<u.rao>>22155000
         return                                                <<u.rao>>22160000
         end;                                                  <<u.rao>>22165000
      if account then  <<only 1 word mask>>                    <<u.rao>>22170000
         begin                                                 <<u.rao>>22175000
         ps0 := sec1;                                          <<u.rao>>22180000
         del;                                                  <<u.rao>>22185000
         end                                                   <<u.rao>>22190000
      else                                                     <<u.rao>>22195000
         begin                                                 <<u.rao>>22200000
         dps0 := sec;                                          <<u.rao>>22205000
         del;                                                  <<u.rao>>22210000
         end;                                                  <<u.rao>>22215000
      end                                                      <<u.rao>>22220000
   else  <<no access list present, use default>>               <<01.ro>>22225000
      begin                                                    <<01.ro>>22230000
      if account then                                          <<01.ro>>22235000
         newentry(asecw) := acctsecdef                         <<01.ro>>22240000
      else                                                     <<01.ro>>22245000
         gsecurity := groupsecdef;                             <<01.ro>>22250000
      parmnum := parmnum-1;  <<back up>>                       <<01.ro>>22255000
      end;                                                     <<01.ro>>22260000
   tos := 0;  <<return space for setspecmask>>                 <<u.rao>>22265000
   if account then tos := 1 else tos := 2;  <<# words in list>><<u.rao>>22270000
   if not setspecmask(*) then                                  <<04790>>22275000
         cierr(errnum := -orgcomaccessrdnd,parmptr);           <<04790>>22280000
   end;                                                        <<u.rao>>22285000
next;  <<move pointers to semicolon>>                          <<u.rao>>22290000
end;  <<doaccesslist>>                                         <<u.rao>>22295000
                                                               <<u.rao>>22300000
subroutine domaxpri;                                           <<u.rao>>22305000
<<                 *********************                   >>  <<u.rao>>22310000
<<                 *     domaxpri      *                   >>  <<u.rao>>22315000
<<                 *********************                   >>  <<u.rao>>22320000
                                                               <<u.rao>>22325000
begin                                                          <<u.rao>>22330000
if group then  <<not appropriate for group>>                   <<u.rao>>22335000
   begin                                                       <<u.rao>>22340000
   cierr(-orgcomgnotmaxpri,parmptr);                           <<u.rao>>22345000
   next                                                        <<u.rao>>22350000
   end                                                         <<u.rao>>22355000
else                                                           <<u.rao>>22360000
   begin                                                       <<u.rao>>22365000
   next;                                                       <<u.rao>>22370000
   if parmlen > 0 then                                         <<u.rao>>22375000
      begin                                                    <<u.rao>>22380000
      move subqa := subqx,(subqlen);                           <<u.rao>>22385000
      if search(parmptr,parmlen,subqa)=0 then                  <<u.rao>>22390000
         cierr(errnum := orgcomunksubq,parmptr)                <<u.rao>>22395000
      else                                                     <<u.rao>>22400000
         begin                                                 <<u.rao>>22405000
         tos := subqueue(4,parmptr);  <<get priority number>>  <<u.rao>>22410000
         tos := tos land %377;                                 <<u.rao>>22415000
         newentry(resultadr) := tos;                           <<u.rao>>22420000
         del;                                                  <<u.rao>>22425000
         end;                                                  <<u.rao>>22430000
      end                                                      <<01.ro>>22435000
   else                                                        <<01.ro>>22440000
      newentry(resultadr) := 150;  <<cs>>                      <<01.ro>>22445000
   if (errnum = 0) and not setspecmask(defn) then              <<u.rao>>22450000
      cierr(errnum := -orgcomrdndmaxpri);                      <<04790>>22455000
   end;                                                        <<u.rao>>22460000
end;                                                           <<u.rao>>22465000
                                                               <<u.rao>>22470000
<<                 *********************                   >>  <<u.rao>>22475000
<<                 *     docaplist     *                   >>  <<u.rao>>22480000
<<                 *********************                   >>  <<u.rao>>22485000
                                                               <<u.rao>>22490000
subroutine docaplist;  <<capability list parser>>              <<u.rao>>22495000
begin                                                          <<u.rao>>22500000
tos := parms(parmnum);                                                  22505000
delb;  <<poop pointer word>>                                            22510000
if (s0.(0:8)=0) and ((s0.(11:5)=cr) or (s0.(11:5)=semicolon)) then      22515000
   begin  <<use default caplist>>                              <<u.rao>>22520000
   if group then tos := 1 else tos := 2;                       <<u.rao>>22525000
   if not setspecmask(*) then cierr(errnum:= -orgcomrdndcapky);<<04790>>22530000
   next;  <<move to next key entry delimiter>>                 <<u.rao>>22535000
   return                                                      <<u.rao>>22540000
   end;                                                        <<u.rao>>22545000
del;    <<pop data word>>                                      <<u.rao>>22550000
tos := 0d;  <<temp space for capability matrix>>               <<u.rao>>22555000
move capdict := capdictx,(capdictlen);                         <<u.rao>>22560000
do begin  <<until nextdelim <> comma>>                         <<u.rao>>22565000
   next; <<get next capability type>>                                   22570000
   if parmlen = 0 then   <<evidently missing>>                 <<u.rao>>22575000
      cierr(errnum := -orgcomissingcap,parmptr)                <<04790>>22580000
   else  <<something there>>                                   <<u.rao>>22585000
      begin                                                    <<u.rao>>22590000
      if search(parmptr,parmlen,capdict,capdefn)=0 then        <<u.rao>>22595000
         begin  <<unknown parameter>>                          <<u.rao>>22600000
         ddel;  <<pop temp matrix>>                            <<u.rao>>22605000
         if group then                                         <<07.ro>>22610000
            cierr(errnum := orgcomunkgcap,parmptr)             <<07.ro>>22615000
         else  <<user or account>>                             <<07.ro>>22620000
            cierr(errnum := orgcomunkcap, parmptr);            <<07.ro>>22625000
         return                                                <<u.rao>>22630000
         end;                                                  <<u.rao>>22635000
      x := capdefn;  <<bit position in matrix>>                <<u.rao>>22640000
      if x < 16 then  <<in attributes word>>                   <<u.rao>>22645000
         begin                                                 <<u.rao>>22650000
         if group then cierr(errnum:=-orgcomcapcontxt,parmptr);<<04790>>22655000
         assemble(xch);  <<put attributes word on tos>>        <<u.rao>>22660000
         end;                                                  <<u.rao>>22665000
      assemble(tsbc 0,x);                                      <<u.rao>>22670000
      if <> then cierr(errnum := -orgcomredundcap,parmptr);    <<04790>>22675000
      if x < 16 then                                           <<00263>>22680000
      begin                                                    <<00263>>22685000
          assemble (xch); <<put attributes word back>>         <<00263>>22690000
      end;                                                     <<00263>>22695000
      end;                                                     <<u.rao>>22700000
   end until nextdelim <> comma;                               <<u.rao>>22705000
assemble(xch);                                                 <<02373>>22710000
if ls0.(6:1) then << if cv >>                                  <<02373>>22715000
   ls0.(7:1) := true; << give uv also >>                       <<02373>>22720000
assemble(xch);                                                 <<02373>>22725000
if ds1 = 0d then   <<no caps specified, take default>>         <<u.rao>>22730000
   begin                                                       <<u.rao>>22735000
   if group then tos := tos+1 else tos := tos+2;  <<trick>>    <<u.rao>>22740000
   if not setspecmask(*) then cierr(errnum :=-orgcomrdndcapky);<<04790>>22745000
   return                                                      <<u.rao>>22750000
   end;                                                        <<u.rao>>22755000
if not (group) and (s0.(7:2)=false) then                       <<u.rao>>22760000
   begin  <<neither ia nor ba specified>>                      <<u.rao>>22765000
   if account then cierr(errnum := -orgcomforcaiaba)           <<04790>>22770000
   else cierr(errnum := -orgcomforcuiaba);                     <<04790>>22775000
   tos.(7:2) := true;                                          <<u.rao>>22780000
   end;                                                        <<u.rao>>22785000
if group then  <<only 1 word>>                                 <<u.rao>>22790000
   begin                                                       <<u.rao>>22795000
   newentry(resultadr) := tos;                                 <<u.rao>>22800000
   del;                                                        <<u.rao>>22805000
                       << redundant >>                         <<04790>>22810000
   if not setspecmask(1) then cierr(errnum := -orgcomrdndcapky)<<04790>>22815000
   end                                                         <<u.rao>>22820000
else                                                           <<u.rao>>22825000
   begin  <<2 words>>                                          <<u.rao>>22830000
   if account then                                             <<u.rao>>22835000
      begin  <<force am capability>>                           <<u.rao>>22840000
      assemble(xch);                                           <<u.rao>>22845000
      tos.(1:1) := true;                                       <<u.rao>>22850000
      assemble(xch);                                           <<u.rao>>22855000
      end;                                                     <<u.rao>>22860000
   newentry(resultadr+1) := tos;                               <<u.rao>>22865000
   newentry(x:=x-1) := tos;                                    <<u.rao>>22870000
   if not setspecmask(2) then cierr(errnum :=-orgcomrdndcapky);<<04790>>22875000
   end;                                                        <<u.rao>>22880000
end;  <<subroutine docaplist>>                                 <<u.rao>>22885000
                                                               <<u.rao>>22890000
<<                 *********************                   >>  <<u.rao>>22895000
<<                 *     dodouble      *                   >>  <<u.rao>>22900000
<<                 *********************                   >>  <<u.rao>>22905000
                                                               <<u.rao>>22910000
subroutine dodouble(errdelta);                                 <<u.rao>>22915000
value errdelta;                                                <<u.rao>>22920000
integer errdelta;  <<offset for tailoring error messages>>     <<u.rao>>22925000
<<this subroutine processes double integers for cpu, connect,>><<u.rao>>22930000
<<files options.  it does not handle local attribute option>>  <<u.rao>>22935000
begin                                                          <<u.rao>>22940000
if user then  <<has no meaning for user definition>>           <<u.rao>>22945000
   begin                                                       <<u.rao>>22950000
   cierr(errnum := -(unotdbl+errdelta), parmptr);              <<04790>>22955000
   next;  <<attempt recovery>>                                 <<u.rao>>22960000
   end                                                         <<u.rao>>22965000
else                                                           <<u.rao>>22970000
   begin                                                       <<u.rao>>22975000
   next;                                                       <<u.rao>>22980000
   if parmlen <> 0 then <<i.e., parm present thus no default>> <<u.rao>>22985000
      begin                                                    <<u.rao>>22990000
      tos := dbinary(parmptr, parmlen);                        <<u.rao>>22995000
      if <> then   <<dbinary failed>>                          <<u.rao>>23000000
         begin                                                 <<u.rao>>23005000
         ddel;  <<pop result;                                  <<u.rao>>23010000
         cierr(errnum := dblinvalid+errdelta, parmptr);        <<u.rao>>23015000
         end                                                   <<u.rao>>23020000
      else                                                     <<u.rao>>23025000
         begin                                                 <<u.rao>>23030000
         assemble(ddup);                                       <<u.rao>>23035000
         newentry(resultadr+1) := tos;                         <<u.rao>>23040000
         newentry(x := x-1) := tos;                            <<u.rao>>23045000
         if tos < 0d then    <<negative number not allowed>>   <<u.rao>>23050000
            cierr(errnum := dblneg+errdelta, parmptr);         <<u.rao>>23055000
         end;                                                  <<u.rao>>23060000
      end;                                                     <<u.rao>>23065000
   if (errnum=0) and not setspecmask(defn) then                <<u.rao>>23070000
            << redundantly defined keyword >>                  <<04790>>23075000
      cierr(errnum := -(redundant+errdelta));                  <<04790>>23080000
   end;                                                        <<u.rao>>23085000
end;                                                           <<u.rao>>23090000
                                                               <<u.rao>>23095000
<<                 *********************                   >>  <<u.rao>>23100000
<<                 *     dolocattr     *                   >>  <<u.rao>>23105000
<<                 *********************                   >>  <<u.rao>>23110000
                                                               <<u.rao>>23115000
subroutine dolocattr;  <<local attributes - a double integer>> <<u.rao>>23120000
begin                                                          <<u.rao>>23125000
if group then                                                  <<u.rao>>23130000
   begin  <<not appropriate for group>>                        <<u.rao>>23135000
   cierr(errnum := -orgcomglocattr,parmptr);                   <<04790>>23140000
   next;  <<attempt recovery>>                                 <<u.rao>>23145000
   end                                                         <<u.rao>>23150000
else                                                           <<u.rao>>23155000
   begin                                                       <<u.rao>>23160000
   newentry(resultadr) := 0;                                   <<01.ro>>23165000
   newentry(resultadr+1) := 0;  <<zero entry>>                 <<01.ro>>23170000
   next;                                                       <<u.rao>>23175000
   if parmlen <> 0 then  <<exists, don't use default>>         <<u.rao>>23180000
      begin                                                    <<u.rao>>23185000
      tos := dbinary(parmptr,parmlen);                         <<u.rao>>23190000
      if <> then                                               <<u.rao>>23195000
         begin                                                 <<u.rao>>23200000
         ddel;                                                 <<u.rao>>23205000
         cierr(errnum := orgcominvldlatr,parmptr)              <<u.rao>>23210000
         end                                                   <<u.rao>>23215000
      else                                                     <<u.rao>>23220000
         begin                                                 <<u.rao>>23225000
         newentry(resultadr+1) := tos;                         <<u.rao>>23230000
         newentry(x := x-1) := tos;                            <<u.rao>>23235000
         end;                                                  <<u.rao>>23240000
      end;                                                     <<u.rao>>23245000
   if (errnum=0) and not setspecmask(defn) then  <<redundant>> <<u.rao>>23250000
      cierr(errnum := -orgcomrdndlattr);                       <<04790>>23255000
   end;                                                        <<u.rao>>23260000
end;  <<subroutine dolocattr>>                                 <<u.rao>>23265000
                                                               <<u.rao>>23270000
<<                 *********************                   >>  <<u.rao>>23275000
<<                 *     main body     *                   >>  <<u.rao>>23280000
<<                 *********************                   >>  <<u.rao>>23285000
                                                               <<u.rao>>23290000
<<main body of procedure                                     >><<u.rao>>23295000
<<there are three main tasks:                                >><<u.rao>>23300000
<<  1)  initialize newentry to defaults                      >><<u.rao>>23305000
<<  2)  find and validate required parameters                >><<u.rao>>23310000
<<        (that is, item name and, if newacct, manager's name>><<u.rao>>23315000
<<  3)  parse optional parms. this is mostly done by         >><<u.rao>>23320000
<<        subroutines.                                       >><<u.rao>>23325000
parmnum := 0;                                                  <<u.rao>>23330000
cyorgcoms' := false;                                           <<u.rao>>23335000
case level-1 of                                                <<u.rao>>23340000
   begin  <<initialize newentry with defaults in pb>>          <<u.rao>>23345000
   move newentry := initialgroup,(gsize);                      <<u.rao>>23350000
   move newentry := initialacct,(asize);                       <<u.rao>>23355000
   move newentry := initialuser,(usize);                       <<u.rao>>23360000
   end;                                                        <<u.rao>>23365000
if pmask.(14:1) then                                           <<rv.pv>>23370000
begin                                                          <<rv.pv>>23375000
    vscomm (vsmask) := 0;                                      <<rv.pv>>23380000
    vscomm (vshaname) := "  ";                                 <<rv.pv>>23385000
    move vscomm (vshaname+1) :=                                <<rv.pv>>23390000
         vscomm (vshaname), ((namesize*3)-1);                  <<rv.pv>>23395000
end;                                                           <<rv.pv>>23400000
move tempspecmask := specmaskln (0); <<initialize>>            <<rv.pv>>23405000
if pmask then move specmask := tempspecmask, (specmaskln);     <<rv.pv>>23410000
vsparmacct := false; << no vs= yet >>                          <<01460>>23415000
                                                               <<u.rao>>23420000
<<now crunch parameter image>>                                 <<u.rao>>23425000
tos := @image;  <<set up parms in case all missing>>           <<u.rao>>23430000
tos := cr;                                                     <<u.rao>>23435000
parms := tos;                                                  <<u.rao>>23440000
mycommand(image,dl,70,numparms,parms);                         <<u.rao>>23445000
if <> then  <<too many parameters>>                            <<u.rao>>23450000
   begin                                                       <<u.rao>>23455000
   parmnum := 72;                                              <<u.rao>>23460000
   if pmask then     <<:altxxx command>>                       <<u.rao>>23465000
      if account then tos := altacct2mp                        <<u.rao>>23470000
      else if < then tos := altgroup2mp                        <<u.rao>>23475000
      else tos := altuser2mp                                   <<u.rao>>23480000
   else  <<:newxxx command>>                                   <<u.rao>>23485000
      if account then tos := newacct2mp                        <<u.rao>>23490000
      else if < then tos := newgroup2mp                        <<u.rao>>23495000
      else tos := newuser2mp;                                  <<u.rao>>23500000
   errnum := s0;                                               <<u.rao>>23505000
   cierr(*);                                                   <<u.rao>>23510000
   return                                                      <<u.rao>>23515000
   end;                                                        <<u.rao>>23520000
                                                               <<u.rao>>23525000
<<now we look for required items, first the item name>>        <<u.rao>>23530000
next;  <<set up first parm>>                                   <<u.rao>>23535000
tos := 0;  <<return space for checkname>>                      <<u.rao>>23540000
if account then tos := fanamebase                              <<u.rao>>23545000
else if group then tos := fgnamebase                           <<u.rao>>23550000
else tos := usernamebase;                                      <<u.rao>>23555000
if not checkname(*,newentry,false) then return;  <<error detected>>     23560000
                                                               <<u.rao>>23565000
<<if newacct then look for manager's name>>                    <<u.rao>>23570000
if (account) and not pmask then  <<:newacct command>>          <<u.rao>>23575000
   begin                                                       <<u.rao>>23580000
   if nextdelim <> comma then  <<syntax error, at least>>      <<u.rao>>23585000
      begin                                                    <<u.rao>>23590000
      cierr(errnum := newacctxpctcma,parmptr(parmlen));        <<u.rao>>23595000
      return                                                   <<u.rao>>23600000
      end;                                                     <<u.rao>>23605000
   next;  <<actually get name>>                                <<u.rao>>23610000
   if not checkname(mgrnamebase,newentry(asize),false) then return;     23615000
   end;                                                        <<u.rao>>23620000
                                                               <<u.rao>>23625000
<<now finish up initialization stage>>                         <<u.rao>>23630000
<<problem is to set special security mask for sys account and>><<u.rao>>23635000
<<pub group>>                                                  <<u.rao>>23640000
if (account) and (bnewentry = "SYS ") then                     <<u.rao>>23645000
   begin  <<set up special security>>                          <<01.ro>>23650000
   acctsecdef := [2/2,2/1,2/1,2/1,2/2,2/1];                    <<01.ro>>23655000
   newentry(asecw) := acctsecdef;                              <<01.ro>>23660000
   end                                                         <<01.ro>>23665000
else if (group) and (bnewentry = "PUB ") then                  <<u.rao>>23670000
   begin                                                       <<01.ro>>23675000
   groupsecdef := [5/16,5/6,5/6,5/6,5/16,5/6]d;                <<01.ro>>23680000
   gsecurity := groupsecdef;                                   <<01.ro>>23685000
   end;                                                        <<01.ro>>23690000
                                                               <<u.rao>>23695000
<<now we finally get around to parsing the optional parms>>    <<u.rao>>23700000
move keydict := keydictx,(keydictl);                           <<u.rao>>23705000
move subkeydict := subkeydictx, (subkeydictl);                 <<rv.pv>>23710000
while nextdelim = semicolon do                                 <<u.rao>>23715000
   begin                                                       <<u.rao>>23720000
   next;  <<get keyword>>                                      <<u.rao>>23725000
   if parmlen = 0 then                                         <<u.rao>>23730000
      begin                                                    <<u.rao>>23735000
      cierr(errnum := orgcomnokey,parmptr);                    <<u.rao>>23740000
      return                                                   <<u.rao>>23745000
      end;                                                     <<u.rao>>23750000
   if nextdelim <> equals then  <<missing equal sign after key><<u.rao>>23755000
      begin                                                    <<u.rao>>23760000
      cierr(errnum := orgcomxpctequals, parmptr(parmlen));     <<u.rao>>23765000
      return                                                   <<u.rao>>23770000
      end;                                                     <<u.rao>>23775000
   case search(parmptr,parmlen,keydict,defn) of                <<u.rao>>23780000
      begin                                                    <<u.rao>>23785000
                                                               <<u.rao>>23790000
      <<case 0 --- unknown keyword>>                           <<u.rao>>23795000
      << case 0 --- unknown keyword >>                         <<04703>>23800000
      begin                                                    <<04703>>23805000
      if level = 3 then                                        <<04703>>23810000
         cierr(errnum:=altuserunknownparm,parmptr);            <<04703>>23815000
      if level = 2 then                                        <<04703>>23820000
         cierr(errnum:=altacctunknownparm,parmptr);            <<04703>>23825000
      if level = 1 then                                        <<04703>>23830000
         cierr(errnum:=altgroupunknownparm,parmptr);           <<04703>>23835000
      end; << case 0 >>                                        <<04703>>23840000
                                                               <<u.rao>>23845000
      begin  <<password, a string>>                            <<u.rao>>23850000
      next;   <<point to password value>>                      <<u.rao>>23855000
      if checkname(passwordbase,newentry(resultadr),true) then <<u.rao>>23860000
         if not setspecmask(defn) then                         <<u.rao>>23865000
            cierr(errnum := -(orgcomrdndpass));                <<04790>>23870000
      end;                                                     <<u.rao>>23875000
                                                               <<u.rao>>23880000
      <<files - file limits in sectors, a double integer>>     <<u.rao>>23885000
      dodouble(orgcomfilesbase);                               <<u.rao>>23890000
                                                               <<u.rao>>23895000
      <<cpu - cpu usage limit in seconds, a double integer>>   <<u.rao>>23900000
      dodouble(orgcomcpubase);                                 <<u.rao>>23905000
                                                               <<u.rao>>23910000
      <<connect - connect time usage, a double integer>>       <<u.rao>>23915000
      dodouble(orgcomconnectbs);                               <<u.rao>>23920000
                                                               <<u.rao>>23925000
      <<capability list>>                                      <<u.rao>>23930000
      docaplist;                                               <<u.rao>>23935000
                                                               <<u.rao>>23940000
      <<access list>>                                          <<u.rao>>23945000
      doaccesslist;                                            <<u.rao>>23950000
                                                               <<u.rao>>23955000
      <<maxpri>>                                               <<u.rao>>23960000
      domaxpri;                                                <<u.rao>>23965000
                                                               <<u.rao>>23970000
      <<local attributes>>                                     <<u.rao>>23975000
      dolocattr;                                               <<u.rao>>23980000
                                                               <<u.rao>>23985000
      <<vs - home volume set>>                                 <<u.rao>>23990000
      begin <<vs>>                                             <<rv.pv>>23995000
      if user then                                             <<00580>>24000000
      begin  <<not valid option for user - warn and ignore>>   <<00580>>24005000
          cierr (errnum := -orgcomunotvs,parmptr);             <<04790>>24010000
          << try to recover >>                                 <<00580>>24015000
          next; << skip vsname >>                              <<00580>>24020000
          << skip 'span' if present >>                         <<00580>>24025000
          if nextdelim = colon then next;                      <<00580>>24030000
      end                                                      <<00580>>24035000
      else                                                     <<00580>>24040000
      begin                                                    <<00580>>24045000
          next;                                                <<rv.pv>>24050000
          tos := check'n'movename (parmptr,parmlen,            <<rv.pv>>24055000
                                   vscomm (vshvname),-4,3);    <<rv.pv>>24060000
          if <> then                                           <<rv.pv>>24065000
           cierr (errnum := tos+vcsrefbase,parmptr)            <<rv.pv>>24070000
          else                                                 <<rv.pv>>24075000
          begin  << no error in volset >>                      <<01460>>24080000
                                                               <<01460>>24085000
               << check for redundantly specified vs= >>       <<01460>>24090000
               if (group) then                                 <<01460>>24095000
               begin                                           <<01460>>24100000
                   if not setspecmask(defn) then               <<01460>>24105000
                      cierr(errnum := -orgcomrdndvs);          <<04790>>24110000
               end      << of group redundant check >>         <<01460>>24115000
               else                                            <<01460>>24120000
               begin    << account check >>                    <<01460>>24125000
                   vsparmacct.(15:1) := 1; << got vs= parm >>  <<01460>>24130000
                   if <> then cierr(errnum := -orgcomrdndvs);  <<04790>>24135000
               end;                                            <<01460>>24140000
                                                               <<01460>>24145000
               <<# of names goes to vsmask.(14:2)>>            <<rv.pv>>24150000
               vscomm (vsmask) := vsspecified lor ls0;         <<rv.pv>>24155000
               case tos of                                     <<rv.pv>>24160000
               begin                                           <<rv.pv>>24165000
                   ; <<no name supplied. attempt to reset hvs>><<rv.pv>>24170000
                   who (,,,,bvshgname,bvshaname);              <<rv.pv>>24175000
                   who (,,,,,bvshaname);                       <<rv.pv>>24180000
                   ; <<all names supplied>>                    <<rv.pv>>24185000
               end;                                            <<rv.pv>>24190000
               if nextdelim = colon then                       <<rv.pv>>24195000
               begin                                           <<rv.pv>>24200000
                   next;                                       <<rv.pv>>24205000
                   if (tos := search (parmptr,parmlen,         <<00086>>24210000
                              subkeydict)) <> 0 then           <<00086>>24215000
                    if (vscomm (vsmask) land 3) <> 0 then      <<rv.pv>>24220000
                    begin                                      <<00086>>24225000
                        case (s0-1) of                         <<00086>>24230000
                        begin                                  <<00086>>24235000
                            tos := spanspecified; <<1>>        <<00086>>24240000
                            tos := altspecified;  <<2>>        <<00086>>24245000
                        end;                                   <<00086>>24250000
                        vscomm (vsmask) := vscomm (vsmask) lor ls0;     24255000
                        del; <<value from case stmt>>          <<00086>>24260000
                    end                                        <<00086>>24265000
                    else                                       <<rv.pv>>24270000
                     cierr (errnum:=orgcomspancntxt)           <<rv.pv>>24275000
                   else                                        <<rv.pv>>24280000
                     cierr(errnum:=altunknownvsparm,parmptr);  <<04703>>24285000
                   del; <<return from search>>                 <<00086>>24290000
               end;                                            <<rv.pv>>24295000
          end;  << of no error in volset >>                    <<01460>>24300000
      end;                                                     <<00580>>24305000
      end;<<of vs>>                                            <<rv.pv>>24310000
                                                               <<rv.pv>>24315000
      <<home group specification>>                             <<u.rao>>24320000
      if not(user) then                                        <<u.rao>>24325000
         begin  <<inappropriate keyword>>                      <<u.rao>>24330000
         cierr(errnum := -orgcomuhomegrp,parmptr);             <<04790>>24335000
         next;                                                 <<u.rao>>24340000
         end                                                   <<u.rao>>24345000
      else                                                     <<u.rao>>24350000
         begin                                                 <<u.rao>>24355000
         next;                                                 <<u.rao>>24360000
         if checkname(fgnamebase,newentry(resultadr),true) then<<u.rao>>24365000
            if not setspecmask(defn) then  <<redundant>>       <<u.rao>>24370000
               cierr(errnum := -orgcomrdndgroup);              <<04790>>24375000
         end;                                                  <<u.rao>>24380000
                                                               <<u.rao>>24385000
      end;  <<of case statement on keywords>>                  <<u.rao>>24390000
   if errnum > 0 then return;  <<some fatal error along the way<<u.rao>>24395000
   end;  <<of while loop on semicolon>>                        <<u.rao>>24400000
                                                               <<u.rao>>24405000
<<now final cleanup before exit>>                              <<u.rao>>24410000
if nextdelim <> cr then   <<garbage in string>>                <<u.rao>>24415000
   begin                                                       <<u.rao>>24420000
   next;                                                       <<u.rao>>24425000
   cierr(errnum := orgcomxpctkeywd,parmptr)                    <<u.rao>>24430000
   end                                                         <<u.rao>>24435000
else                                                           <<u.rao>>24440000
   begin                                                       <<u.rao>>24445000
   parmnum := 0;                                               <<u.rao>>24450000
   cyorgcoms' := true;                                         <<u.rao>>24455000
   if pmask then                                               <<rv.pv>>24460000
   begin <<only the ones needed>>                              <<rv.pv>>24465000
       x := specmaskln-1;                                      <<rv.pv>>24470000
       do                                                      <<rv.pv>>24475000
        specmask (x) := specmask (x) xor tempspecmask (x)      <<rv.pv>>24480000
       until (x:=x-1) < 0;                                     <<rv.pv>>24485000
   end;                                                        <<rv.pv>>24490000
   end;                                                        <<u.rao>>24495000
end;  <<cyorgcoms'>>                                           <<u.rao>>24500000
procedure cap'err(errnum,cap'denied);                          <<00879>>24505000
value errnum;                                                  <<00879>>24510000
integer errnum;           <<errnum for cierr>>                 <<00879>>24515000
integer array cap'denied; <<2 word array of denied cap>>       <<00879>>24520000
option uncallable,privileged;                                  <<00879>>24525000
begin                                                          <<00879>>24530000
   comment:                                                    <<00879>>24535000
      this procedure handles capability errors for the         <<00879>>24540000
      organization management commands.;                       <<00879>>24545000
   equate                                                      <<00879>>24550000
      caplen     = 3,                                          <<00879>>24555000
      capdictlen = caplen*32;                                  <<00879>>24560000
   byte array capdict(0:capdictlen-1) = pb :=                  <<00879>>24565000
      <<0>> "SM,",                                             <<00879>>24570000
      <<1>> "AM,",                                             <<00879>>24575000
      <<2>> "AL,",                                             <<00879>>24580000
      <<3>> "GL,",                                             <<00879>>24585000
      <<4>> "DI,",                                             <<00879>>24590000
      <<5>> "OP,",                                             <<00879>>24595000
      <<6>> "CV,",                                             <<00879>>24600000
      <<7>> "UV,",                                             <<00879>>24605000
      <<8>> "LG,",                                             <<01724>>24610000
      <<9>> "   ",                                             <<00879>>24615000
      <<10>>"   ",                                             <<00879>>24620000
      <<11>>"NA,",                                             <<06854>>24625000
      <<12>>"NM,",                                             <<06854>>24630000
      <<13>>"CS,",                                             <<00879>>24635000
      <<14>>"ND,",                                             <<00879>>24640000
      <<15>>"SF,",                                             <<00879>>24645000
      <<16>>"   ",                                             <<00879>>24650000
      <<17>>"   ",                                             <<00879>>24655000
      <<18>>"   ",                                             <<00879>>24660000
      <<19>>"   ",                                             <<00879>>24665000
      <<20>>"   ",                                             <<00879>>24670000
      <<21>>"   ",                                             <<00879>>24675000
      <<22>>"   ",                                             <<00879>>24680000
      <<23>>"BA,",                                             <<00879>>24685000
      <<24>>"IA,",                                             <<00879>>24690000
      <<25>>"PM,",                                             <<00879>>24695000
      <<26>>"   ",                                             <<00879>>24700000
      <<27>>"   ",                                             <<00879>>24705000
      <<28>>"MR,",                                             <<00879>>24710000
      <<29>>"   ",                                             <<00879>>24715000
      <<30>>"DS,",                                             <<00879>>24720000
      <<31>>"PH,";                                             <<00879>>24725000
   byte array string(0:capdictlen-1);                          <<00879>>24730000
   integer                                                     <<00879>>24735000
      inx,                                                     <<00879>>24740000
      cap'num,                                                 <<00879>>24745000
      i;                                                       <<00879>>24750000
                                                               <<00879>>24755000
   << >>                                                       <<00879>>24760000
   inx := -3;                                                  <<00879>>24765000
   string := " ";                                              <<00879>>24770000
   move string(1) := string(0),(capdictlen-1);                 <<00879>>24775000
   for i := 0 until 1 do                                       <<00879>>24780000
      begin                                                    <<00879>>24785000
      cap'num := i*16-1; << init to left most bit position >>  <<00879>>24790000
      tos := cap'denied(i);                                    <<00879>>24795000
      while s0 <> 0 do                                         <<00879>>24800000
         begin                                                 <<00879>>24805000
         x := cap'num;                                         <<00879>>24810000
         assemble (scan ,x);                                   <<00879>>24815000
         cap'num := x;<<cap'num gets bit position of next cap>><<00879>>24820000
         move string(inx:=inx+caplen):=capdict(cap'num*caplen) <<00879>>24825000
                                         ,(caplen);            <<00879>>24830000
         end;                                                  <<00879>>24835000
      del;  << remove cap'denied(i) >>                         <<00879>>24840000
      end;                                                     <<00879>>24845000
   string(inx+2) := 0;                                         <<00879>>24850000
   cierr(errnum,,0,@string);                                   <<00879>>24855000
                                                               <<00879>>24860000
end; << cap'error >>                                           <<00879>>24865000
$control segment=cialtorg                                               24870000
integer procedure get'put'name (hereinfo, there,               <<rv.pv>>24875000
                                whichkind, where);             <<rv.pv>>24880000
    value   hereinfo, whichkind, where;                        <<rv.pv>>24885000
    double  hereinfo;                                          <<rv.pv>>24890000
    array   there;                                             <<rv.pv>>24895000
    integer whichkind, where;                                  <<rv.pv>>24900000
    option privileged, internal;                               <<rv.pv>>24905000
    begin                                                      <<rv.pv>>24910000
        byte pointer                                           <<rv.pv>>24915000
            whereadr = where,                                  <<rv.pv>>24920000
            here = hereinfo;                                   <<rv.pv>>24925000
        logical                                                <<rv.pv>>24930000
            errno,                                             <<rv.pv>>24935000
            parm1 = here+1;                                    <<rv.pv>>24940000
        define                                                 <<rv.pv>>24945000
            lngth = parm1.(0:8) #,                             <<rv.pv>>24950000
            spec  = parm1.(10:1) #,                            <<rv.pv>>24955000
            delno = parm1.(11:5) #;                            <<rv.pv>>24960000
                                                               <<rv.pv>>24965000
        cc := cce;                                             <<rv.pv>>24970000
        there := "  ";                                         <<rv.pv>>24975000
        move there (1) := there, (namesize-1);                 <<rv.pv>>24980000
        get'put'name := delno;                                 <<rv.pv>>24985000
        if lngth = 0 then                                      <<rv.pv>>24990000
        begin <<ommitted>>                                     <<rv.pv>>24995000
            cierr (vsdefmissname,here,0, @whichkind);          <<04790>>25000000
            cc := ccg;                                         <<rv.pv>>25005000
        end                                                    <<rv.pv>>25010000
        else                                                   <<rv.pv>>25015000
        begin                                                  <<rv.pv>>25020000
            if spec or here <> alpha or lngth > 8 then         <<rv.pv>>25025000
            begin  <<illegal name>>                            <<rv.pv>>25030000
                errno := if spec then vsdefspechar else        <<rv.pv>>25035000
                          if here <> alpha then vsdefnotalpha  <<rv.pv>>25040000
                                           else vsdeftoolong;  <<rv.pv>>25045000
                cierr (errno, whereadr,0, whichkind);          <<04790>>25050000
                cc := ccl;                                     <<rv.pv>>25055000
            end                                                <<rv.pv>>25060000
            else                                               <<rv.pv>>25065000
            begin                                              <<rv.pv>>25070000
                tos := @there & lsl (1); <<byte pointer>>      <<rv.pv>>25075000
                move * := here, (lngth);                       <<rv.pv>>25080000
            end;                                               <<rv.pv>>25085000
        end;                                                   <<rv.pv>>25090000
    end;<<of get'put'name>>                                    <<rv.pv>>25095000
logical procedure cyclass (hereinfo, vsdef, vcdef, parmsp);    <<rv.pv>>25100000
    value   hereinfo;                                          <<rv.pv>>25105000
    double  hereinfo;                                          <<rv.pv>>25110000
    array   vsdef, vcdef;                                      <<rv.pv>>25115000
    byte array parmsp;                                         <<rv.pv>>25120000
    option privileged, internal;                               <<rv.pv>>25125000
    begin                                                      <<rv.pv>>25130000
        entry cyclass';                                        <<rv.pv>>25135000
        byte pointer                                           <<rv.pv>>25140000
            where',                                            <<rv.pv>>25145000
            here = hereinfo,                                   <<rv.pv>>25150000
            string;                                            <<rv.pv>>25155000
        double                                                 <<rv.pv>>25160000
                  <<  =      :      ,      cr >>               <<rv.pv>>25165000
            x1 := [8/%75, 8/%72, 8/%54, 8/%15] d;              <<rv.pv>>25170000
        logical                                                <<rv.pv>>25175000
            found,                                             <<rv.pv>>25180000
            mv := false,                                       <<rv.pv>>25185000
            stop = cyclass,                                    <<rv.pv>>25190000
            parm1 = here+1;                                    <<rv.pv>>25195000
        equate                                                 <<rv.pv>>25200000
            cr = %15,                                          <<rv.pv>>25205000
            gvsmembsz = gvsinfo-gvsname+1;                     <<rv.pv>>25210000
        define                                                 <<rv.pv>>25215000
            bad'return = begin stop := true; return; end #,    <<rv.pv>>25220000
            where = @parmsp+(@here-@string) #,                 <<rv.pv>>25225000
            lngth = parm1.(0:8) #;                             << i.a >>25230000
        byte array                                             <<rv.pv>>25235000
            class' (0:5),                                      <<rv.pv>>25240000
            bvsdef (*) = vsdef,                                <<rv.pv>>25245000
            bvcdef (*) = vcdef,                                <<rv.pv>>25250000
            delims (*) = x1;                                   <<rv.pv>>25255000
        integer                                                <<rv.pv>>25260000
            class = class',                                    <<rv.pv>>25265000
            num'members,                                       <<rv.pv>>25270000
            gvcinfo' := 0,                                     <<rv.pv>>25275000
            volcnt := 0,                                       <<rv.pv>>25280000
            numparms,                                          <<rv.pv>>25285000
            pnum := 0;                                         <<rv.pv>>25290000
        double array                                           <<rv.pv>>25295000
            parms (0:vmax+1); <<includes keyword parameter>>   <<rv.pv>>25300000
                                                               <<rv.pv>>25305000
                                                               <<rv.pv>>25310000
        if false then                                          <<rv.pv>>25315000
    cyclass':                                                  <<rv.pv>>25320000
         mv := true;                                           <<rv.pv>>25325000
        move class' := ("CLASS",0);                            <<rv.pv>>25330000
        tos := (lngth+2) & lsr (1);                            <<rv.pv>>25335000
        push (s);                                              <<rv.pv>>25340000
        @string := tos & lsl (1);                              <<rv.pv>>25345000
        assemble (adds 0);                                     <<rv.pv>>25350000
        move string := here, (lngth);                          <<rv.pv>>25355000
        @parmsp := @here;                                      <<rv.pv>>25360000
        string (lngth) := cr;                                  <<rv.pv>>25365000
        mycommand (string, delims, vmax+2, numparms, parms);   <<rv.pv>>25370000
        if > then                                              <<rv.pv>>25375000
        begin <<too many parameters>>                          <<rv.pv>>25380000
            cierr (vsdeftoomany, here, 0, class);              <<rv.pv>>25385000
            bad'return;                                        <<rv.pv>>25390000
        end;                                                   <<rv.pv>>25395000
        if numparms < 3 then                                   <<rv.pv>>25400000
        begin <<not enough parameters>>                        <<rv.pv>>25405000
            cierr (vsdeftoofew, here, 0, class);               <<rv.pv>>25410000
            bad'return;                                        <<rv.pv>>25415000
        end;                                                   <<rv.pv>>25420000
        pnum := pnum + 1; <<get past keyword>>                 <<rv.pv>>25425000
        hereinfo := parms (pnum);  <<get volume class name>>   <<rv.pv>>25430000
        tos := get'put'name (hereinfo, vcdef (gvcname),        <<rv.pv>>25435000
                             class, where);                    <<rv.pv>>25440000
        if <> then                                             <<rv.pv>>25445000
        begin <<illegal name>>                                 <<rv.pv>>25450000
            del;                                               <<rv.pv>>25455000
            bad'return;                                        <<rv.pv>>25460000
        end;                                                   <<rv.pv>>25465000
        if tos <> 1 then                                       <<rv.pv>>25470000
        begin <<missing :>>                                    <<rv.pv>>25475000
            @where' := where;                                  <<rv.pv>>25480000
            cierr (vsdefmisscolon, where', 0, class);          <<rv.pv>>25485000
            bad'return;                                        <<rv.pv>>25490000
        end;                                                   <<rv.pv>>25495000
        num'members := vsdef (gvsinfo).(0:4);                  <<rv.pv>>25500000
        pnum := pnum + 1; <<get past vol class name>>          <<rv.pv>>25505000
        <<start of loop to get and analyze members>>           <<rv.pv>>25510000
        do begin                                               <<rv.pv>>25515000
               volcnt := volcnt+1;                             <<rv.pv>>25520000
               hereinfo := parms (pnum);                       <<rv.pv>>25525000
               get'put'name (hereinfo, vcdef (gvcpname),       <<rv.pv>>25530000
                                    class, where);             <<rv.pv>>25535000
               if <> then <<illegal name>> bad'return;         <<rv.pv>>25540000
               tos := 1; <<start scan at 1st member entry>>    <<rv.pv>>25545000
               do begin                                        <<rv.pv>>25550000
                      found := bvsdef (s0*(gvsmembsz*2)) =     <<rv.pv>>25555000
                             bvcdef (gvcpname*2), (namesize*2);<<rv.pv>>25560000
                      tos := tos+1;                            <<rv.pv>>25565000
                  end until found or s0 > num'members;         <<rv.pv>>25570000
               if not found then                               <<rv.pv>>25575000
               begin <<vname specification unidentified>>      <<rv.pv>>25580000
                   del;                                        <<rv.pv>>25585000
                   @where' := where;                           <<rv.pv>>25590000
                   cierr (vsdefundfn, where');                 <<rv.pv>>25595000
                   bad'return;                                 <<rv.pv>>25600000
               end;                                            <<rv.pv>>25605000
               x := tos-1; <<position of member definition>>   <<rv.pv>>25610000
               mv := mv lor (logical (x) = 1);                 <<rv.pv>>25615000
               x := 16-x;  <<for setting vclass mask>>         <<rv.pv>>25620000
               tos := gvcinfo';                                <<rv.pv>>25625000
               assemble (tsbc 0, x);                           <<rv.pv>>25630000
               if <> then                                      <<rv.pv>>25635000
               begin <<duplicate member specification>>        <<rv.pv>>25640000
                   del;                                        <<rv.pv>>25645000
                   @where' := where;                           <<rv.pv>>25650000
                   cierr (vsdefdupmemb, where');               <<rv.pv>>25655000
                   bad'return;                                 <<rv.pv>>25660000
               end;                                            <<rv.pv>>25665000
               gvcinfo' := tos;                                <<rv.pv>>25670000
           end until stop or (pnum:=pnum+1) >= numparms;       <<rv.pv>>25675000
        if not stop then                                       <<rv.pv>>25680000
        begin                                                  <<rv.pv>>25685000
            if not mv then                                     <<rv.pv>>25690000
            begin <<master volume undefined>>                  <<rv.pv>>25695000
                cierr (vsdefundfnmastr);                       <<rv.pv>>25700000
                bad'return;                                    <<rv.pv>>25705000
            end;                                               <<rv.pv>>25710000
            gvcinfo'.(0:4) := volcnt;                          <<rv.pv>>25715000
            vcdef (gvcinfo) := gvcinfo';                       <<rv.pv>>25720000
        end;                                                   <<rv.pv>>25725000
    end;<<of cyclass>>                                         <<rv.pv>>25730000
logical procedure cymembers (hereinfo, vsdef,                  <<rv.pv>>25735000
                             disktypes, parmsp);               <<rv.pv>>25740000
    value   hereinfo;                                          <<rv.pv>>25745000
    double  hereinfo;                                          <<rv.pv>>25750000
    array   vsdef;                                             <<rv.pv>>25755000
    byte array disktypes, parmsp;                              <<rv.pv>>25760000
    option privileged, internal;                               <<rv.pv>>25765000
    begin                                                      <<rv.pv>>25770000
        entry cymembers';                                      <<rv.pv>>25775000
        byte pointer                                           <<rv.pv>>25780000
            where',                                            <<rv.pv>>25785000
            here = hereinfo,                                   <<rv.pv>>25790000
            string,                                            <<rv.pv>>25795000
            defn;                                              <<rv.pv>>25800000
        pointer                                                <<rv.pv>>25805000
            mv := 0;  <<master vol member temp position>>      <<rv.pv>>25810000
        double                                                 <<rv.pv>>25815000
                  <<  =      :      ,      cr >>               <<rv.pv>>25820000
            x1 := [8/%75, 8/%72, 8/%54, 8/%15] d;              <<rv.pv>>25825000
        logical                                                <<rv.pv>>25830000
            skipmv := false,                                   <<rv.pv>>25835000
            stop = cymembers,                                  <<rv.pv>>25840000
            parm1 = here+1;                                    <<rv.pv>>25845000
        equate                                                 <<rv.pv>>25850000
            cr = %15,                                          <<rv.pv>>25855000
            gvsmembsz = gvsinfo-gvsname+1;                     <<rv.pv>>25860000
        define                                                 <<rv.pv>>25865000
            bad'return = begin stop := true; return; end #,    <<rv.pv>>25870000
            where = @parmsp+(@here-@string) #,                 <<rv.pv>>25875000
            lngth = parm1.(0:8) #;                             << i.a >>25880000
        byte array                                             <<rv.pv>>25885000
            members' (0:7),                                    <<rv.pv>>25890000
            bvsdef (*) = vsdef,                                <<rv.pv>>25895000
            delims (*) = x1;                                   <<rv.pv>>25900000
        integer                                                <<rv.pv>>25905000
            members = members',                                <<rv.pv>>25910000
            volcnt := 0,                                       <<rv.pv>>25915000
            numparms,                                          <<rv.pv>>25920000
            pnum := 0;                                         <<rv.pv>>25925000
        double array                                           <<rv.pv>>25930000
            parms (0:vmax*2); <<includes keyword parameter>>   <<rv.pv>>25935000
                                                               <<rv.pv>>25940000
                                                               <<rv.pv>>25945000
        if false then                                          <<rv.pv>>25950000
    cymembers':                                                <<rv.pv>>25955000
         skipmv := true;                                       <<rv.pv>>25960000
        move members' := ("MEMBERS",0);                        <<rv.pv>>25965000
        tos := (lngth+2) & lsr (1);                            <<rv.pv>>25970000
        push (s);                                              <<rv.pv>>25975000
        @string := tos & lsl (1);                              <<rv.pv>>25980000
        assemble (adds 0);                                     <<rv.pv>>25985000
        move string := here, (lngth);                          <<rv.pv>>25990000
        @parmsp := @here;                                      <<rv.pv>>25995000
        string (lngth) := cr;                                  <<rv.pv>>26000000
        mycommand (string, delims, (vmax*2)+1,                 <<rv.pv>>26005000
                   numparms,parms);                            <<rv.pv>>26010000
        if > then                                              <<rv.pv>>26015000
        begin <<too many parameters>>                          <<rv.pv>>26020000
            cierr (vsdeftoomany, here, 0, members);            <<rv.pv>>26025000
            bad'return;                                        <<rv.pv>>26030000
        end;                                                   <<rv.pv>>26035000
        if numparms < 3 then                                   <<rv.pv>>26040000
        begin <<not enough parameters>>                        <<rv.pv>>26045000
            cierr (vsdeftoofew, here, 0, members);             <<rv.pv>>26050000
            bad'return;                                        <<rv.pv>>26055000
        end;                                                   <<rv.pv>>26060000
        pnum := pnum + 1; <<get past keyword>>                 <<rv.pv>>26065000
        <<start of loop to get and analyze members>>           <<rv.pv>>26070000
        do begin                                               <<rv.pv>>26075000
               volcnt := volcnt+1;                             <<rv.pv>>26080000
               hereinfo := parms (pnum);                       <<rv.pv>>26085000
               tos := get'put'name (hereinfo,                  <<rv.pv>>26090000
                    vsdef (volcnt*gvsmembsz), members, where); <<rv.pv>>26095000
               if <> then                                      <<rv.pv>>26100000
               begin <<illegal name>>                          <<rv.pv>>26105000
                   del;                                        <<rv.pv>>26110000
                   bad'return;                                 <<rv.pv>>26115000
               end;                                            <<rv.pv>>26120000
               if tos <> 1 then                                <<rv.pv>>26125000
               begin <<missing :>>                             <<rv.pv>>26130000
                   @where' := where;                           <<rv.pv>>26135000
                   cierr (vsdefmisscolon, where', 0, members); <<rv.pv>>26140000
                   bad'return;                                 <<rv.pv>>26145000
               end;                                            <<rv.pv>>26150000
               tos := 1; <<start scan at 1st member entry>>    <<rv.pv>>26155000
               while s0 < volcnt do                            <<rv.pv>>26160000
               begin                                           <<rv.pv>>26165000
                   if bvsdef (s0*(gvsmembsz*2)) =              <<rv.pv>>26170000
                    bvsdef (volcnt*(gvsmembsz*2)), (namesize*2)<<rv.pv>>26175000
                   then                                        <<rv.pv>>26180000
                   begin <<duplicate member definition>>       <<rv.pv>>26185000
                       del;                                    <<rv.pv>>26190000
                       @where' := where;                       <<rv.pv>>26195000
                       cierr (vsdefdupmembdef, where', 0, members);     26200000
                       bad'return;                             <<rv.pv>>26205000
                   end;                                        <<rv.pv>>26210000
                   tos := tos+1;                               <<rv.pv>>26215000
               end;                                            <<rv.pv>>26220000
               del;                                            <<rv.pv>>26225000
               if bvsdef (volcnt*(gvsmembsz*2)) =              <<rv.pv>>26230000
                  bvsdef (gvsname), (namesize*2) then          <<rv.pv>>26235000
                @mv := @vsdef (volcnt*gvsmembsz);              <<rv.pv>>26240000
               hereinfo := parms (pnum+1);                     <<rv.pv>>26245000
               tos := 0; <<return for search>>                 <<rv.pv>>26250000
               tos := hereinfo;                                <<rv.pv>>26255000
               tos := tos & lsr (8); <<length of parameter>>   <<rv.pv>>26260000
               if search (*, *, disktypes, defn) = 0 then      <<rv.pv>>26265000
               begin <<illegal disk type designator>>          <<rv.pv>>26270000
                   @where' := where;                           <<rv.pv>>26275000
                   cierr (vsdefundfntype, where', 0, members); <<rv.pv>>26280000
                   bad'return;                                 <<rv.pv>>26285000
               end;                                            <<rv.pv>>26290000
               vsdef ((volcnt*gvsmembsz)+gvsinfo).(0:8):= defn;<<rv.pv>>26295000
           end until stop or (pnum:=pnum+2) >= numparms;       <<rv.pv>>26300000
        if not stop then                                       <<rv.pv>>26305000
        begin                                                  <<rv.pv>>26310000
            if not skipmv then                                 <<rv.pv>>26315000
            begin                                              <<rv.pv>>26320000
                if @mv = 0 then                                <<rv.pv>>26325000
                begin <<master volume undefined>>              <<rv.pv>>26330000
                    cierr (vsdefundfnmastr);                   <<rv.pv>>26335000
                    bad'return;                                <<rv.pv>>26340000
                end;                                           <<rv.pv>>26345000
                if @mv <> @vsdef (gvsvolname) then             <<rv.pv>>26350000
                begin <<mv entry needs to go to 1st slot>>     <<rv.pv>>26355000
                    tos := mv (gvsinfo); <<save info word>>    <<rv.pv>>26360000
                    move mv := vsdef (gvsvolname), (gvsmembsz);<<rv.pv>>26365000
                    move vsdef (gvsvolname) :=                 <<rv.pv>>26370000
                         vsdef (gvsname), (namesize);          <<rv.pv>>26375000
                    vsdef (gvsvolinfo) := tos;                 <<rv.pv>>26380000
                end;                                           <<rv.pv>>26385000
            end;                                               <<rv.pv>>26390000
            tos := %177777d;                                   <<rv.pv>>26395000
            ds1 := ds1 & dlsl (volcnt);                        <<rv.pv>>26400000
            del;                                               <<rv.pv>>26405000
            vsdef (gvsinfo).(0:4) := volcnt;                   <<rv.pv>>26410000
            vsdef (x).(8:8) := tos; <<set mask>>               <<rv.pv>>26415000
        end;                                                   <<rv.pv>>26420000
    end;<<of cymembers>>                                       <<rv.pv>>26425000
procedure cxnewvset executorhead;                              <<rv.pv>>26430000
    option privileged, uncallable;                             <<rv.pv>>26435000
    begin                                                      <<rv.pv>>26440000
        double                                                 <<rv.pv>>26445000
            parm;                                              <<rv.pv>>26450000
        byte pointer                                           <<rv.pv>>26455000
            junkbp,                                            <<rv.pv>>26460000
            string = parm;                                     <<rv.pv>>26465000
        double pointer                                         <<rv.pv>>26470000
            junkdp;                                            <<rv.pv>>26475000
        integer                                                <<rv.pv>>26480000
            junk,                                              <<rv.pv>>26485000
            pnum,                                              <<rv.pv>>26490000
            parm1 = string+1,                                  <<rv.pv>>26495000
            x1 := [8/%73, 8/%15], <<; cr>>                     <<rv.pv>>26500000
            numparms;                                          <<rv.pv>>26505000
        logical                                                <<rv.pv>>26510000
            class := false,                                    <<rv.pv>>26515000
            stop := false;                                     <<rv.pv>>26520000
        integer array                                          <<rv.pv>>26525000
            account (0:namesize-1),                            <<rv.pv>>26530000
            group (0:namesize-1),                              <<rv.pv>>26535000
            vsdef (0:gvsdsize-1),                              <<rv.pv>>26540000
            vcdef (0:gvcdsize-1);                              <<rv.pv>>26545000
        double array                                           <<rv.pv>>26550000
            parms (0:2);                                       <<rv.pv>>26555000
        equate                                                 <<rv.pv>>26560000
            cr = %15,                                          <<rv.pv>>26565000
            keydictl = 17,                                     <<rv.pv>>26570000
        disktypesl = 109;                                      << 8820>>26575000
        define                                                 <<rv.pv>>26580000
            lngth = parm1.(0:8) #;                             << i.a >>26585000
        byte array                                             <<rv.pv>>26590000
            vset' (0:4),                                       <<rv.pv>>26595000
            baccount (*) = account,                            <<rv.pv>>26600000
            bgroup (*) = group,                                <<rv.pv>>26605000
            keydict (0:keydictl-1),                            <<rv.pv>>26610000
            disktypes (0:disktypesl-1),                        <<rv.pv>>26615000
            delims (*) = x1;                                   <<rv.pv>>26620000
        integer                                                <<rv.pv>>26625000
            vset = vset';                                      <<rv.pv>>26630000
        integer array                                          <<rv.pv>>26635000
            initvsdef (0:gvsinfo) = pb :=                      <<rv.pv>>26640000
                "        ",                                    <<rv.pv>>26645000
                0,0;                                           <<rv.pv>>26650000
        integer array                                          <<rv.pv>>26655000
            initvcdef (0:gvcunused-1) = pb :=                  <<rv.pv>>26660000
                "        ",                                    <<rv.pv>>26665000
                %100000,0,                                     <<rv.pv>>26670000
                "        ", "        ", "        ";            <<rv.pv>>26675000
        byte array                                             <<rv.pv>>26680000
            keydictx (0:keydictl-1) = pb :=                    <<rv.pv>>26685000
                9,7,"MEMBERS",                                 <<rv.pv>>26690000
                7,5,"CLASS",                                   <<rv.pv>>26695000
                0;                                             <<rv.pv>>26700000
        byte array                                             <<rv.pv>>26705000
    comment                                                    <<00263>>26710000
                                                               <<00263>>26715000
    pseudo subtypes for the different discs defined            <<00263>>26720000
    below where devloped as follows:                           <<00263>>26725000
                                                               <<00263>>26730000
    [pseudo subtype] = ([actual type] * 16) + [actual subtype] <<00263>>26735000
                                                               <<00263>>26740000
    ;                                                          <<00263>>26745000
                                                               <<00263>>26750000
            disktypesx (0:disktypesl-1) = pb :=                <<rv.pv>>26755000
                9,6,"HP7905",4,                                <<rv.pv>>26760000
                9,6,"HP7920",8,                                <<rv.pv>>26765000
                9,6,"HP7925",9,                                <<03.km>>26770000
                9,6,"HP7906",10,                               <<00263>>26775000
                9,6,"HP7902",32,                               <<00263>>26780000
                9,6,"HP9895",32,                               <<01850>>26785000
                9,6,"HP7911",49,                               <<06015>>26790000
                9,6,"HP7912",50,                               <<06015>>26795000
                9,6,"HP7914",52,                               <<06015>>26800000
                9,6,"HP7945",53,                               << 8820>>26805000
                9,6,"HP7933",56,                               <<06015>>26810000
                9,6,"HP7935",56,                               <<06015>>26815000
                0;                                             <<rv.pv>>26820000
                                                               <<rv.pv>>26825000
                                                               <<rv.pv>>26830000
        move vset' := ("VSET",0);                              <<rv.pv>>26835000
        vsdef := 0;                                            <<rv.pv>>26840000
        move vsdef (1) := vsdef, (gvsdsize-1);                 <<rv.pv>>26845000
        tos := vmax;                                           <<rv.pv>>26850000
        do begin                                               <<rv.pv>>26855000
               move vsdef (s0*(gvsinfo+1)) :=                  <<rv.pv>>26860000
                    initvsdef, (gvsinfo+1);                    <<rv.pv>>26865000
               tos := tos-1;                                   <<rv.pv>>26870000
           end until <;                                        <<rv.pv>>26875000
        del;                                                   <<rv.pv>>26880000
        vcdef := 0;                                            <<rv.pv>>26885000
        move vcdef (1) := vcdef, (gvcdsize-1);                 <<rv.pv>>26890000
        move vcdef := initvcdef, (gvcunused);                  <<rv.pv>>26895000
        mycommand (parmsp, delims, 3<<maxparms>>,              <<rv.pv>>26900000
                             numparms, parms);                 <<rv.pv>>26905000
        if > then                                              <<rv.pv>>26910000
        begin <<too many parameters>>                          <<rv.pv>>26915000
            cierr (errnum := vsdeftoomany, parmsp, 0, vset);   <<04790>>26920000
            return;                                            <<rv.pv>>26925000
        end;                                                   <<rv.pv>>26930000
        if numparms < 2 then                                   <<rv.pv>>26935000
        begin <<not enough parameters>>                        <<rv.pv>>26940000
            cierr (errnum := vsdeftoofew, parmsp, 0, vset);    <<04790>>26945000
            return;                                            <<rv.pv>>26950000
        end;                                                   <<rv.pv>>26955000
        parm := parms(0);  << point to newvset name >>         <<07278>>26960000
        tos := get'put'name (parms, vsdef (gvsname),           <<rv.pv>>26965000
                             vset, string);                    <<rv.pv>>26970000
        if <> then                                             <<rv.pv>>26975000
        begin <<illegal or ommitted name>>                     <<rv.pv>>26980000
            del;                                               <<rv.pv>>26985000
            return;                                            <<rv.pv>>26990000
        end;                                                   <<rv.pv>>26995000
        pnum := 1;  <<start after vs definition name>>         <<rv.pv>>27000000
        move keydict := keydictx, (keydictl);                  <<rv.pv>>27005000
        move disktypes := disktypesx, (disktypesl);            <<rv.pv>>27010000
    << the following section of code parses the parms >>       <<03513>>27015000
    << for "MEMBERS" and "CLASS" parms.               >>       <<03513>>27020000
        do begin                                               <<rv.pv>>27025000
               parm := parms (pnum); <<current parameter>>     <<rv.pv>>27030000
               tos := (lngth+2) & lsr (1);                     <<rv.pv>>27035000
               push (s);                                       <<rv.pv>>27040000
               @junkbp := tos & lsl (1);                       <<rv.pv>>27045000
               assemble (adds 0); <<room for temp parse>>      <<rv.pv>>27050000
               x1 := %036415; << = cr >>                       <<rv.pv>>27055000
               move junkbp := string, (lngth);                 <<rv.pv>>27060000
               junkbp (lngth) := cr;                           <<rv.pv>>27065000
               tos := 4;                                       <<rv.pv>>27070000
               push (s);                                       <<rv.pv>>27075000
               @junkdp := tos;                                 <<rv.pv>>27080000
               assemble (adds 0);                              <<rv.pv>>27085000
               mycommand (junkbp, delims, 2<<maxparms>>,       <<rv.pv>>27090000
                          junk, junkdp);                       <<rv.pv>>27095000
               if > then                                       <<rv.pv>>27100000
               begin <<too many parameters>>                   <<rv.pv>>27105000
                   cierr (errnum :=vsdeftoomany,string,0,vset);<<04790>>27110000
                   return;                                     <<rv.pv>>27115000
               end;                                            <<rv.pv>>27120000
               if junk < 2 then                                <<rv.pv>>27125000
               begin <<not enough parameters>>                 <<rv.pv>>27130000
                   cierr (errnum := vsdeftoofew,string,0,vset);<<04790>>27135000
                   return;                                     <<rv.pv>>27140000
               end;                                            <<rv.pv>>27145000
               tos := junkdp;                                  <<rv.pv>>27150000
               del;                                            <<rv.pv>>27155000
               @junkbp := tos;                                 <<rv.pv>>27160000
               tos := 0;  <<for return from search>>           <<rv.pv>>27165000
               tos := junkdp; <<1st pair of parm words>>       <<rv.pv>>27170000
               tos := tos & lsr (8); <<length of parameter>>   <<rv.pv>>27175000
               tos := search (*, *, keydict);                  <<rv.pv>>27180000
               if s0 = 0 then                                  <<rv.pv>>27185000
               begin <<illegal keyword>>                       <<rv.pv>>27190000
                   del;                                        <<rv.pv>>27195000
                   cierr (errnum := vsdefillegalkey, string);  <<04790>>27200000
                   return;                                     <<rv.pv>>27205000
               end;                                            <<rv.pv>>27210000
               tos := junkdp;                                  <<rv.pv>>27215000
               delb;                                           <<rv.pv>>27220000
               if tos.(11:5) <> 0 then                         <<rv.pv>>27225000
               begin <<keyword not followed by an = >>         <<rv.pv>>27230000
                   cierr (errnum := vsdefmissequal, string);   <<04790>>27235000
                   return;                                     <<rv.pv>>27240000
               end;                                            <<rv.pv>>27245000
               x := tos;                                       <<rv.pv>>27250000
               tos := ((lngth+2) & lsr (1)) + 4;               <<rv.pv>>27255000
               assemble (subs 0); <<cut back stack storage>>   <<rv.pv>>27260000
               case x of                                       <<rv.pv>>27265000
               begin                                           <<rv.pv>>27270000
                   ;  <<taken care of above>>                  <<rv.pv>>27275000
                   begin <<members>>                           <<rv.pv>>27280000
                       stop := cymembers (parm, vsdef,         <<rv.pv>>27285000
                                          disktypes, parmsp);  <<rv.pv>>27290000
                   end;                                        <<rv.pv>>27295000
                   begin <<class>>                             <<rv.pv>>27300000
                       stop := cyclass (parm, vsdef,           <<rv.pv>>27305000
                                        vcdef, parmsp);        <<rv.pv>>27310000
                       class := true;                          <<rv.pv>>27315000
                   end;                                        <<rv.pv>>27320000
               end;<<of case on keyword>>                      <<rv.pv>>27325000
           end until stop or (pnum:=pnum+1) >= numparms;       <<rv.pv>>27330000
        if not stop then                                       <<rv.pv>>27335000
        begin                                                  <<rv.pv>>27340000
            who (, , , ,bgroup, baccount);                     <<rv.pv>>27345000
            tos := 0;  tos.(endlevelf) := vsdeflevel;          <<rv.pv>>27350000
            tos := direcinsert (s0, 0d, account, group, vsdef, <<38.pv>>27355000
                                vsdef (gvslinkagew));          <<rv.pv>>27360000
            if <> then                                         <<rv.pv>>27365000
            begin                                              <<rv.pv>>27370000
                if s0 = 2 then suddendeath (505);              <<rv.pv>>27375000
                cydirerr' (*, %147000, errnum);                <<rv.pv>>27380000
            end else ddel;                                     <<rv.pv>>27385000
            if class then                                      <<rv.pv>>27390000
            begin                                              <<rv.pv>>27395000
                move vcdef (gvcpaname) := account, (namesize); <<rv.pv>>27400000
                move vcdef (gvcpgname) := group, (namesize);   <<rv.pv>>27405000
                move vcdef (gvcpvsname) :=                     <<rv.pv>>27410000
                     vsdef (gvsname), (namesize);              <<rv.pv>>27415000
                tos := direcinsert (s0, 0d, account, group,    <<38.pv>>27420000
                             vcdef, vcdef (gvclinkagew));      <<rv.pv>>27425000
                if <> then                                     <<rv.pv>>27430000
                begin                                          <<rv.pv>>27435000
                    tos := direcpurge (s2, 0d, account,        <<38.pv>>27440000
                                       group, vsdef);          <<rv.pv>>27445000
                    if <> then suddendeath (502);              <<rv.pv>>27450000
                    ddel;                                      <<rv.pv>>27455000
                    if s0 = 2 then suddendeath (503);          <<rv.pv>>27460000
                    cydirerr' (*, %147000, errnum);            <<rv.pv>>27465000
                    del;                                       <<rv.pv>>27470000
                end else assemble (ddel, del)                  <<rv.pv>>27475000
            end else del;                                      <<rv.pv>>27480000
        end;                                                   <<rv.pv>>27485000
    end;<<of cxnewvset>>                                       <<rv.pv>>27490000
integer procedure cyaltvs (element,level,parms,sirs);          <<rv.pv>>27495000
    value   level,parms,sirs;                                  <<rv.pv>>27500000
    integer array   element;                                   <<rv.pv>>27505000
    integer level,parms;                                       <<rv.pv>>27510000
    double  sirs;                                              <<rv.pv>>27515000
    option privileged, uncallable;                             <<04.ro>>27520000
    begin                                                      <<rv.pv>>27525000
        logical                                                <<rv.pv>>27530000
            dadirty = db+145;                                  <<38.pv>>27535000
        integer                                                <<rv.pv>>27540000
            vsvolcnt,                                          <<rv.pv>>27545000
            altvolcnt,                                         <<rv.pv>>27550000
            volcnt,                                            <<rv.pv>>27555000
            junk := 1; <<rel disp of 1st new member>>          <<rv.pv>>27560000
        integer array                                          <<rv.pv>>27565000
            vsdef (*);                                         <<rv.pv>>27570000
        byte array                                             <<rv.pv>>27575000
            bvsdef (*) = vsdef;                                <<rv.pv>>27580000
        define                                                 <<rv.pv>>27585000
            result = arrq0 (parms-1) #;                        <<rv.pv>>27590000
        equate                                                 <<rv.pv>>27595000
            gvsmembsz = gvsinfo-gvsname+1,                     <<rv.pv>>27600000
            dirdst = 20;                                       <<rv.pv>>27605000
                                                               <<rv.pv>>27610000
        cyaltvs := 5; <<sir not released, stop scan>>          <<rv.pv>>27615000
        parms := parms - deltaq;                               <<rv.pv>>27620000
        if level <> vsdeflevel then return;                    <<rv.pv>>27625000
        if element (gvclinkagew) >= 0 then                     <<rv.pv>>27630000
        begin <<set definition>>                               <<rv.pv>>27635000
            vsvolcnt := element (gvcinfo).(0:4);               <<rv.pv>>27640000
            altvolcnt := arrq0 (x+parms).(0:4);                <<rv.pv>>27645000
            if (volcnt := vsvolcnt + altvolcnt) > vmax then    <<rv.pv>>27650000
            begin                                              <<rv.pv>>27655000
                ddel;                                          <<rv.pv>>27660000
                result := altvsdvmax;                          <<rv.pv>>27665000
                return;                                        <<rv.pv>>27670000
            end;                                               <<rv.pv>>27675000
            exchangedb (0);                                    <<rv.pv>>27680000
            tos := gvsdsize;                                   <<rv.pv>>27685000
            @vsdef := @s0;                                     <<rv.pv>>27690000
            @bvsdef := @vsdef & lsl (1);                       <<rv.pv>>27695000
            assemble (adds 0);                                 <<rv.pv>>27700000
            tos := @vsdef;     <<d>>                           <<rv.pv>>27705000
            tos := dirdst;     <<c>>                           <<rv.pv>>27710000
            tos := @element;   <<b>>                           <<rv.pv>>27715000
            tos := gvsdsize;   <<a>>                           <<rv.pv>>27720000
            assemble (mfds); <<move to local store>>           <<rv.pv>>27725000
            do begin <<check and update set definition entry>> <<rv.pv>>27730000
                   vsvolcnt := vsvolcnt+1;                     <<rv.pv>>27735000
                   move vsdef (vsvolcnt*gvsmembsz) :=          <<rv.pv>>27740000
                        arrq0 (parms+(junk*gvsmembsz)),        <<rv.pv>>27745000
                        (gvsmembsz);                           <<rv.pv>>27750000
                   tos := 1; <<start scan at 1st member entry>><<rv.pv>>27755000
                   while s0 < vsvolcnt do                      <<rv.pv>>27760000
                   begin                                       <<rv.pv>>27765000
                       if bvsdef ((s0*gvsmembsz)*2) =          <<rv.pv>>27770000
                          bvsdef ((vsvolcnt*gvsmembsz)*2),     <<rv.pv>>27775000
                          (namesize*2) then                    <<rv.pv>>27780000
                       begin <<duplicate member definition>>   <<rv.pv>>27785000
                           del; <<scan control counter>>       <<rv.pv>>27790000
                           result := altvsddupmemb;            <<rv.pv>>27795000
                           exchangedb (dirdst);                <<rv.pv>>27800000
                           return;                             <<rv.pv>>27805000
                       end;                                    <<rv.pv>>27810000
                       tos := tos+1; <<check next one>>        <<rv.pv>>27815000
                   end;                                        <<rv.pv>>27820000
                   del; <<scan control counter>>               <<rv.pv>>27825000
                   junk := junk+1; <<next new member>>         <<rv.pv>>27830000
               end until vsvolcnt >= volcnt;                   <<rv.pv>>27835000
            tos := vsdef (gvsinfo).(8:8); <<old mask>>         <<rv.pv>>27840000
            tos := %100000;                                    <<rv.pv>>27845000
            s0 := s0 & asr (altvolcnt); <<mask expansion>>     <<rv.pv>>27850000
            ds1 := ds1 & dlsl (altvolcnt); <<expand mask>>     <<rv.pv>>27855000
            del; <<mask expansion>>                            <<rv.pv>>27860000
            s0.(0:4) := volcnt; <<complete gvsinfo>>           <<rv.pv>>27865000
            vsdef (gvsinfo) := tos;                            <<rv.pv>>27870000
            tos := dirdst;    <<d>>                            <<rv.pv>>27875000
            tos := @element;  <<c>>                            <<rv.pv>>27880000
            tos := @vsdef;    <<b>>                            <<rv.pv>>27885000
            tos := gvsdsize;  <<a>>                            <<rv.pv>>27890000
            assemble (mtds); <<update dds>>                    <<rv.pv>>27895000
            exchangedb (dirdst);                               <<rv.pv>>27900000
            dadirty := true;                                   <<rv.pv>>27905000
        end else result := altvsdnotavsd;                      <<rv.pv>>27910000
    end;<<of cyaltvs>>                                         <<rv.pv>>27915000
integer procedure cyaltvc (element,level,parms,sirs);          <<rv.pv>>27920000
    value   level,parms,sirs;                                  <<rv.pv>>27925000
    integer array   element;                                   <<rv.pv>>27930000
    integer level,parms;                                       <<rv.pv>>27935000
    double  sirs;                                              <<rv.pv>>27940000
    option privileged, uncallable;                             <<04.ro>>27945000
    begin                                                      <<rv.pv>>27950000
        logical                                                <<rv.pv>>27955000
            dadirty = db+145;                                  <<38.pv>>27960000
        integer                                                <<rv.pv>>27965000
            volcnt;                                            <<rv.pv>>27970000
        define                                                 <<rv.pv>>27975000
            result = arrq0 (parms-1) #;                        <<rv.pv>>27980000
                                                               <<rv.pv>>27985000
        cyaltvc := 5; <<sir not released, stop scan>>          <<rv.pv>>27990000
        parms := parms - deltaq;                               <<rv.pv>>27995000
        if level <> vsdeflevel then return;                    <<rv.pv>>28000000
        if element (gvclinkagew) < 0 then                      <<rv.pv>>28005000
        begin <<class definition>>                             <<rv.pv>>28010000
            tos := element (gvcinfo);                          <<rv.pv>>28015000
            tos := arrq0 (x+parms);                            <<rv.pv>>28020000
            volcnt := s0.(0:4) + s1.(0:4);                     <<rv.pv>>28025000
            if (ls0.(8:8) land ls1.(8:8)) <> 0 then            <<rv.pv>>28030000
            begin                                              <<rv.pv>>28035000
                ddel;                                          <<rv.pv>>28040000
                result := altvcsdupmemb;                       <<rv.pv>>28045000
                return;                                        <<rv.pv>>28050000
            end;                                               <<rv.pv>>28055000
            s0 := ls0.(8:8) lor ls1.(8:8);                     <<rv.pv>>28060000
            s0.(0:4) := volcnt;                                <<rv.pv>>28065000
            element (gvcinfo) := tos;                          <<rv.pv>>28070000
            del;                                               <<rv.pv>>28075000
            dadirty := true;                                   <<rv.pv>>28080000
        end else result := altvcsnotavcd;                      <<rv.pv>>28085000
    end;<<of cyaltvc>>                                         <<rv.pv>>28090000
procedure cxaltvset executorhead;                              <<rv.pv>>28095000
    option privileged, uncallable;                             <<rv.pv>>28100000
    begin                                                      <<rv.pv>>28105000
        logical array                                          <<rv.pv>>28110000
            commary (0:1+(gvsdsize-1)) = q,                    <<rv.pv>>28115000
            result (*) = commary,                              <<rv.pv>>28120000
            dsparms (*) = result (1),                          <<rv.pv>>28125000
            vcdef (*) = dsparms,                               <<rv.pv>>28130000
            vsdef' (*) = vcdef,                                <<rv.pv>>28135000
            vsdef (0:gvsdsize-1),                              <<rv.pv>>28140000
            account (0:namesize-1),                            <<rv.pv>>28145000
            group (0:namesize-1),                              <<rv.pv>>28150000
            vsname (0:namesize-1);                             <<rv.pv>>28155000
        double                                                 <<rv.pv>>28160000
            parm;                                              <<rv.pv>>28165000
        byte pointer                                           <<rv.pv>>28170000
            junkbp,                                            <<rv.pv>>28175000
            string = parm;                                     <<rv.pv>>28180000
        double pointer                                         <<rv.pv>>28185000
            junkdp;                                            <<rv.pv>>28190000
        integer                                                <<rv.pv>>28195000
            junk,                                              <<rv.pv>>28200000
            pnum := 0,                                         <<rv.pv>>28205000
            parm1 = string+1,                                  <<rv.pv>>28210000
            x1 := [8/";", 8/%15], <<; cr>>                     <<rv.pv>>28215000
            numparms;                                          <<rv.pv>>28220000
        logical                                                <<rv.pv>>28225000
            stop := false;                                     <<rv.pv>>28230000
        double array                                           <<rv.pv>>28235000
            parms (0:3);                                       <<rv.pv>>28240000
        equate                                                 <<rv.pv>>28245000
            gvsmembsz = gvsinfo-gvsname+1,                     <<rv.pv>>28250000
            cr = %15,                                          <<rv.pv>>28255000
            keydictl = 35,                                     <<rv.pv>>28260000
        disktypesl = 109;                                      << 8820>>28265000
        define                                                 <<rv.pv>>28270000
            lngth = parm1.(0:8) #;                             << i.a >>28275000
        byte array                                             <<rv.pv>>28280000
            altvset' (0:7),                                    <<rv.pv>>28285000
            keydict (0:keydictl-1),                            <<rv.pv>>28290000
            disktypes (0:disktypesl-1),                        <<rv.pv>>28295000
            delims (*) = x1;                                   <<rv.pv>>28300000
        integer                                                <<rv.pv>>28305000
            altvset = altvset';                                <<rv.pv>>28310000
        integer array                                          <<rv.pv>>28315000
            initvsdef (0:gvsinfo) = pb :=                      <<rv.pv>>28320000
                "        ",                                    <<rv.pv>>28325000
                0,0;                                           <<rv.pv>>28330000
        integer array                                          <<rv.pv>>28335000
            initvcdef (0:gvcunused-1) = pb :=                  <<rv.pv>>28340000
                "        ",                                    <<rv.pv>>28345000
                %100000,0,                                     <<rv.pv>>28350000
                "        ", "        ", "        ";            <<rv.pv>>28355000
        byte array                                             <<rv.pv>>28360000
            keydictx (0:keydictl-1) = pb :=                    <<rv.pv>>28365000
                13,11,"EXPANDCLASS",                           <<rv.pv>>28370000
                10,8,"ADDCLASS",                               <<rv.pv>>28375000
                11,9,"EXPANDSET",                              <<rv.pv>>28380000
                0;                                             <<rv.pv>>28385000
    comment                                                    <<00263>>28390000
                                                               <<00263>>28395000
    pseudo subtypes for the different discs defined            <<00263>>28400000
    below where devloped as follows:                           <<00263>>28405000
                                                               <<00263>>28410000
    [pseudo subtype] = ([actual type] * 16) + [actual subtype] <<00263>>28415000
                                                               <<00263>>28420000
    ;                                                          <<00263>>28425000
                                                               <<00263>>28430000
        byte array                                             <<rv.pv>>28435000
            disktypesx (0:disktypesl-1) = pb :=                <<rv.pv>>28440000
                9,6,"HP7905",4,                                <<rv.pv>>28445000
                9,6,"HP7920",8,                                <<rv.pv>>28450000
                9,6,"HP7925",9,                                <<03.km>>28455000
                9,6,"HP7906",10,                               <<00263>>28460000
                9,6,"HP7902",32,                               <<00263>>28465000
                9,6,"HP9895",32,                               <<06015>>28470000
                9,6,"HP7911",49,                               <<06015>>28475000
                9,6,"HP7912",50,                               <<06015>>28480000
                9,6,"HP7914",52,                               <<06015>>28485000
                9,6,"HP7945",53,                               << 8820>>28490000
                9,6,"HP7933",56,                               <<06015>>28495000
                9,6,"HP7935",56,                               <<06015>>28500000
                0;                                             <<rv.pv>>28505000
                                                               <<rv.pv>>28510000
                                                               <<rv.pv>>28515000
        move altvset' := ("ALTVSET",0);                        <<rv.pv>>28520000
        mycommand (parmsp, delims, 4<<maxparms>>,              <<rv.pv>>28525000
                             numparms, parms);                 <<rv.pv>>28530000
        if > then                                              <<rv.pv>>28535000
        begin <<too many parameters>>                          <<rv.pv>>28540000
            cierr (errnum := vsdeftoomany, parmsp, 0, altvset);<<04790>>28545000
            return;                                            <<rv.pv>>28550000
        end;                                                   <<rv.pv>>28555000
        if numparms < 2 then                                   <<rv.pv>>28560000
        begin <<not enough parameters>>                        <<rv.pv>>28565000
            cierr (errnum := vsdeftoofew, parmsp, 0, altvset); <<04790>>28570000
            return;                                            <<rv.pv>>28575000
        end;                                                   <<rv.pv>>28580000
        parm := parms (pnum);                                  <<rv.pv>>28585000
    << move string to vsname is what's done here >>            <<03513>>28590000
        tos := get'put'name (parms, vsname,                    <<rv.pv>>28595000
                             altvset, string);                 <<rv.pv>>28600000
        if <> then                                             <<rv.pv>>28605000
        begin <<illegal or ommitted name>>                     <<rv.pv>>28610000
            del;                                               <<rv.pv>>28615000
            return;                                            <<rv.pv>>28620000
        end;                                                   <<rv.pv>>28625000
        who (, , , , group,account);                           <<rv.pv>>28630000
        pnum := pnum + 1;  <<start after vs definition name>>  <<rv.pv>>28635000
    << initialize keydictx and disktypesx from pb  >>          <<03513>>28640000
    << relative array to db relative array.        >>          <<03513>>28645000
        move keydict := keydictx, (keydictl);                  <<rv.pv>>28650000
        move disktypes := disktypesx, (disktypesl);            <<rv.pv>>28655000
    << the following section of code parses the parms >>       <<03513>>28660000
    << for "ADDCLASS", "EXPANDCLASS", and "EXPANDSET".>>       <<03513>>28665000
        do begin                                               <<rv.pv>>28670000
               parm := parms (pnum); <<current parameter>>     <<rv.pv>>28675000
            << change to a word length  >>                     <<03513>>28680000
               tos := (lngth+2) & lsr (1);                     <<rv.pv>>28685000
               push (s);                                       <<rv.pv>>28690000
               @junkbp := tos & lsl (1);                       <<rv.pv>>28695000
               assemble (adds 0); <<room for temp parse>>      <<rv.pv>>28700000
               x1 := [8/"=", 8/cr];                            <<rv.pv>>28705000
               move junkbp := string, (lngth);                 <<rv.pv>>28710000
               junkbp (lngth) := cr;                           <<rv.pv>>28715000
               tos := 4;                                       <<rv.pv>>28720000
               push (s);                                       <<rv.pv>>28725000
               @junkdp := tos;                                 <<rv.pv>>28730000
               assemble (adds 0);                              <<rv.pv>>28735000
               mycommand (junkbp, delims, 2<<maxparms>>,       <<rv.pv>>28740000
                          junk, junkdp);                       <<rv.pv>>28745000
               if > then                                       <<rv.pv>>28750000
               begin <<too many parameters>>                   <<rv.pv>>28755000
                  cierr(errnum:=vsdeftoomany,string,0,altvset);<<04790>>28760000
                   return;                                     <<rv.pv>>28765000
               end;                                            <<rv.pv>>28770000
               if junk < 2 then                                <<rv.pv>>28775000
               begin <<not enough parameters>>                 <<rv.pv>>28780000
                   cierr(errnum:=vsdeftoofew,string,0,altvset);<<04790>>28785000
                   return;                                     <<rv.pv>>28790000
               end;                                            <<rv.pv>>28795000
               tos := junkdp;                                  <<rv.pv>>28800000
               del;                                            <<rv.pv>>28805000
               @junkbp := tos;                                 <<rv.pv>>28810000
               tos := 0;  <<for return from search>>           <<rv.pv>>28815000
               tos := junkdp; <<1st pair of parm words>>       <<rv.pv>>28820000
               tos := tos & lsr (8); <<length of parameter>>   <<rv.pv>>28825000
               tos := search (*, *, keydict);                  <<rv.pv>>28830000
            << entry number is returned to tos  >>             <<03513>>28835000
               if s0 = 0 then                                  <<rv.pv>>28840000
               begin <<illegal keyword>>                       <<rv.pv>>28845000
                   del;                                        <<rv.pv>>28850000
                   cierr (errnum := vsdefillegalkey, string);  <<04790>>28855000
                   return;                                     <<rv.pv>>28860000
               end;                                            <<rv.pv>>28865000
               tos := junkdp;                                  <<rv.pv>>28870000
               delb;                                           <<rv.pv>>28875000
               if tos.(11:5) <> 0 then                         <<rv.pv>>28880000
               begin <<keyword not followed by an = >>         <<rv.pv>>28885000
                   cierr (errnum := vsdefmissequal, string);   <<04790>>28890000
                   return;                                     <<rv.pv>>28895000
               end;                                            <<rv.pv>>28900000
               x := tos;                                       <<rv.pv>>28905000
            << x is entry value from keydict    >>             <<03513>>28910000
               tos := ((lngth+2) & lsr (1)) + 4;               <<rv.pv>>28915000
               assemble (subs 0); <<cut back stack storage>>   <<rv.pv>>28920000
               case x of  <<"KEYWORD">>                        <<rv.pv>>28925000
               begin                                           <<rv.pv>>28930000
                   ;  <<taken care of above>>                  <<rv.pv>>28935000
                   begin <<expandclass>>                       <<rv.pv>>28940000
                       tos := 0;  tos.(endlevelf) := vsdeflevel;        28945000
                       if (tos := direcfind (s0,0d,account,group,       28950000
                                           vsname,vsdef)) <> 0d then    28955000
                       begin                                   <<rv.pv>>28960000
                           if s0=2 and grouplevel<=s1<=accountlevel     28965000
                            then suddendeath (504);            <<rv.pv>>28970000
                           cydirerr' (*,%120000,errnum);       <<rv.pv>>28975000
                           del; <<type>>                       <<rv.pv>>28980000
                           stop := true;                       <<rv.pv>>28985000
                       end else                                <<rv.pv>>28990000
                       if integer(vsdef(gvslinkagew)) >= 0 then<<01.ro>>28995000
                        begin <<its a volume set def entry>>   <<rv.pv>>29000000
                            vcdef := 0;                        <<rv.pv>>29005000
                            move vcdef (1) := vcdef, (gvcdsize-1);      29010000
                            move vcdef := initvcdef, (gvcunused);       29015000
                            if not stop := cyclass' (parm,vsdef,vcdef,  29020000
                                                     parmsp) then       29025000
                            begin                                       29030000
                                assemble (cab); <<still set up>>        29035000
                                tos.(tolevelf) := vsdeflevel;           29040000
                                result := 0;                            29045000
                                tos := direcscan (*,0d,account,group,   29050000
                                           vcdef,cyaltvc,dsparms);      29055000
                                if <> then                              29060000
                                begin                                   29065000
                                    if s0=2 and                         29070000
                                       grouplevel<=s1<=accountlevel     29075000
                                     then suddendeath (505);            29080000
                                    cydirerr' (*,%120000,errnum);       29085000
                                    del; <<type>>                       29090000
                                    stop := true;                       29095000
                                end else                                29100000
                                begin                                   29105000
                                    ddel; del;                          29110000
                                    if stop := (result <> 0) then       29115000
                                  cierr(errnum:=result,string);<<04790>>29120000
                                end;                                    29125000
                            end; <<not stop>>                           29130000
                        end else                                        29135000
                        begin <<not a set definition>>                  29140000
                            stop := false;                              29145000
                           cierr(errnum:=altvsdnotavsd,parmsp);<<04790>>29150000
                        end;                                            29155000
                   end; <<expandclass>>                                 29160000
                   begin <<addclass>>                                   29165000
                       tos := 0;  tos.(endlevelf) := vsdeflevel;        29170000
                       if (tos := direcfind (s0,0d,account,group,       29175000
                                           vsname,vsdef)) <> 0d then    29180000
                       begin                                   <<rv.pv>>29185000
                           if s0=2 and grouplevel<=s1<=accountlevel     29190000
                            then suddendeath (504);            <<rv.pv>>29195000
                           cydirerr' (*,%120000,errnum);       <<rv.pv>>29200000
                           del; <<type>>                       <<rv.pv>>29205000
                           stop := true;                       <<rv.pv>>29210000
                       end else                                <<rv.pv>>29215000
                       if integer(vsdef(gvslinkagew)) >= 0 then<<01.ro>>29220000
                        begin <<its a volume set definition>>           29225000
                            vcdef := 0;                                 29230000
                            move vcdef (1) := vcdef, (gvcdsize-1);      29235000
                            move vcdef := initvcdef, (gvcunused);       29240000
                            if not stop := cyclass (parm, vsdef,        29245000
                                                    vcdef, parmsp) then 29250000
                            begin                                       29255000
                                move vcdef (gvcpaname) :=               29260000
                                     account , (namesize);              29265000
                                move vcdef (gvcpgname) :=               29270000
                                     group, (namesize);                 29275000
                                move vcdef (gvcpvsname) :=              29280000
                                     vsdef (gvsname), (namesize);       29285000
                                assemble (cab); <<still set up>>        29290000
                                tos.(tolevelf) := vsdeflevel;           29295000
                                tos:=direcinsert (*, 0d, account, group,29300000
                                          vcdef, vcdef (gvclinkagew));  29305000
                                if <> then                              29310000
                                begin                                   29315000
                                    if s0 = 2 then suddendeath (505);   29320000
                                    cydirerr' (*, %147000, errnum);     29325000
                                    del;                                29330000
                                end else assemble (ddel, del);          29335000
                            end;  <<not stop>>                          29340000
                        end else                                        29345000
                        begin <<not set definition entry>>              29350000
                            stop := true;                               29355000
                           cierr(errnum:=altvsdnotavsd,parmsp);<<04790>>29360000
                        end;                                            29365000
                   end; <<addclass>>                                    29370000
                   begin <<expandset>>                                  29375000
                       tos := vmax;                                     29380000
                       do begin                                         29385000
                              move vsdef' (s0*(gvsmembsz)) :=           29390000
                                   initvsdef, (gvsmembsz);              29395000
                              tos := tos-1;                             29400000
                          end until <;                                  29405000
                       del; <<loop control>>                            29410000
                       if not stop := cymembers' (parm,vsdef',          29415000
                                       disktypes,parmsp) then           29420000
                       begin                                            29425000
                           result := 0;                                 29430000
                           tos := 0;  tos.(tolevelf) := vsdeflevel;     29435000
                           tos.(endlevelf) := vsdeflevel;               29440000
                           tos := direcscan (s0,0d,account,group,       29445000
                                             vsname,cyaltvs,dsparms);   29450000
                           if <> then                                   29455000
                           begin                               <<rv.pv>>29460000
                               if s0 = 2 and                   <<rv.pv>>29465000
                                  grouplevel<=s1<=accountlevel <<rv.pv>>29470000
                                then suddendeath (505);        <<rv.pv>>29475000
                               cydirerr' (*,%120000,errnum);   <<rv.pv>>29480000
                               del; <<type>>                   <<rv.pv>>29485000
                               stop := true;                   <<rv.pv>>29490000
                           end else                            <<rv.pv>>29495000
                           begin                               <<rv.pv>>29500000
                               ddel; del;                      <<rv.pv>>29505000
                               if stop := (result <> 0) then   <<rv.pv>>29510000
                                cierr (errnum :=result,string);<<04790>>29515000
                           end;                                <<rv.pv>>29520000
                       end; <<not stop>>                       <<rv.pv>>29525000
                   end;  <<expandset>>                         <<rv.pv>>29530000
               end;<<of case on keyword>>                      <<rv.pv>>29535000
           end until stop or (pnum:=pnum+1) >= numparms;       <<rv.pv>>29540000
    end;<<of cxaltvset>>                                       <<rv.pv>>29545000
                                                               <<rv.pv>>29550000
$control segment=ciorgman                                      <<u.rao>>29555000
procedure cxnewacct executorhead;                                       29560000
   option privileged,uncallable;                                        29565000
begin                                                                   29570000
   integer           savesir;                                           29575000
   equate            dirsir            = 8;                             29580000
   logical array     vscomm (0:vscommsz-1);                    <<rv.pv>>29585000
   integer array     group (0:gsize-1),                        <<01.pv>>29590000
                     account (0:asize-1),                      <<01.pv>>29595000
                     user (0:usize-1); <<must follow acct>>    <<01.pv>>29600000
   double array      duser (*)         = user;                          29605000
   double array      dgroup1 (*)       = group (1);                     29610000
   double            initialgsec       := [5/16,5/6,5/6,5/6,5/16,5/6]d; 29615000
   byte array        bhvsaname (*)     = vscomm (vshaname),    <<rv.pv>>29620000
                     bhvsgname (*)     = vscomm (vshgname),    <<rv.pv>>29625000
                     bhvsvname (*)     = vscomm (vshvname);    <<rv.pv>>29630000
   equate                                                      <<rv.pv>>29635000
       condmount = 3,                                          <<rv.pv>>29640000
       conddismount = 3;                                       <<rv.pv>>29645000
   logical                                                     <<rv.pv>>29650000
       mounted := false,                                       <<00263>>29655000
       pvinfo,                                                 <<rv.pv>>29660000
       reqtype := condmount;                                   <<rv.pv>>29665000
   define                                                      <<rv.pv>>29670000
       mvtabx   = pvinfo.(4:4) #,                              <<rv.pv>>29675000
       vsspecified   = vscomm (vsmask).(0:1) #,                <<rv.pv>>29680000
       spanspecified = vscomm (vsmask).(1:1) #;                << i.a >>29685000
   subroutine relresources;                                    <<rv.pv>>29690000
       begin                                                   <<rv.pv>>29695000
           if not mounted then return;                         <<00263>>29700000
           reqtype := conddismount;                            <<rv.pv>>29705000
           dismount (bhvsvname, bhvsgname, bhvsaname, reqtype);<<rv.pv>>29710000
           if <> then                                          <<rv.pv>>29715000
           begin                                               <<rv.pv>>29720000
               <<reqtype contains error code. map to cierr>>   <<rv.pv>>29725000
               cierr (errnum);                                 <<rv.pv>>29730000
           end;                                                <<rv.pv>>29735000
       end;<<of relresources>>                                 <<rv.pv>>29740000
                                                                        29745000
<< >>                                                                   29750000
if cyorgcoms' (errnum,parmnum,parmsp,accountlevel,             <<rv.pv>>29755000
               account,vscomm) then                            <<rv.pv>>29760000
   begin  <<parm list parsed ok>>                              <<u.rao>>29765000
   savesir := getsir (dirsir);                                          29770000
   tos := 0; tos.(endlevelf) := accountlevel;                  <<01.pv>>29775000
   tos := direcinsert (s0, 0d, account, arrdb0, arrdb0,        <<38.pv>>29780000
                       account (agipntr));                     <<01.pv>>29785000
   if <> then << account insert failed >>                      <<01096>>29790000
         begin                                                 <<01096>>29795000
            relsir(dirsir,savesir);                            <<01187>>29800000
            go to doerr;                                       <<01096>>29805000
         end;                                                  <<01096>>29810000
   ddel; del;                                                  <<01.pv>>29815000
   move group := "PUB ";                                                29820000
   group (2) := "  ";                                                   29825000
   move group (3) := group (2), (6);                                    29830000
   move group (gdfscount) := account (adfscount), (12);        <<01.pv>>29835000
   dgroup1 (gsec/2) := initialgsec;                            <<01.pv>>29840000
   group (gcap) := account (acap+1);                           <<01.pv>>29845000
   group (glinkage) := 0;                                      <<01.pv>>29850000
   group (ghvsname) := "  ";                                   <<rv.pv>>29855000
   move group (ghvsname+1):=group (ghvsname),((namesize*3)-1); <<rv.pv>>29860000
   group (gspare) := group (gmountrefcntr) :=                  <<rv.pv>>29865000
                     group (gsavefipntr) := 0;                 <<rv.pv>>29870000
   tos := 0; tos.(endlevelf) := grouplevel;                    <<01.pv>>29875000
   tos := direcinsert (s0, 0d, account, group, arrdb0,         <<38.pv>>29880000
                       group (gfipntr));                       <<01.pv>>29885000
   if <> then goto purgea;                                              29890000
   ddel; del;                                                  <<01.pv>>29895000
   move user (ucap) := account (acap),(4);                     <<01.pv>>29900000
   user (upass) := "  ";                                       <<01.pv>>29905000
   move user(9) := user(8), (7);                                        29910000
   duser (uhgroup/2) := "PUB ";                                <<01.pv>>29915000
   user (ulogcount) := 0;                                      <<01.pv>>29920000
   user (umaxjob) := account (amaxjobw);                       <<01.pv>>29925000
   user (uspare) := 0;                                         <<01.pv>>29930000
   if vsspecified then                                         <<rv.pv>>29935000
   begin <<vs specified>>                                      <<rv.pv>>29940000
       if spanspecified then                                   <<rv.pv>>29945000
       begin <<span specified>>                                <<rv.pv>>29950000
           mount (bhvsvname, bhvsgname, bhvsaname,             <<rv.pv>>29955000
                  reqtype, 0<<gen>>, pvinfo);                  <<rv.pv>>29960000
           if < then                                           <<rv.pv>>29965000
           begin                                               <<rv.pv>>29970000
               <<translate error in reqtype to cierr>>         <<rv.pv>>29975000
               << cierr cannot be called at this point   >>    <<01315>>29980000
               << because in batch we abort. we have to  >>    <<01315>>29985000
               << release the dirsir and purge the acct. >>    <<01315>>29990000
               errnum := altgrpvsnotmntd;                      <<01315>>29995000
               go to purgea;                                   <<00263>>30000000
           end;                                                <<rv.pv>>30005000
           mounted := true;                                    <<00263>>30010000
       end <<will need to dismount later>>                     <<rv.pv>>30015000
       else                                                    <<rv.pv>>30020000
       begin <<span not optional>>                             <<rv.pv>>30025000
           cierr (errnum := -xxxacctprmnotopt);                <<04790>>30030000
       end;                                                    <<rv.pv>>30035000
   end;<<of vsspecified>>                                      <<rv.pv>>30040000
   tos := 0; tos.(endlevelf) := userlevel;                     <<01.pv>>30045000
   tos := direcinsert (s0, 0d, account, user, arrdb0,          <<38.pv>>30050000
                       user (ucap));                           <<01.pv>>30055000
   if <> then                                                           30060000
                                                                        30065000
purgea:                                                                 30070000
      begin                                                             30075000
      << we have the dirsir and we are just about  >>          <<01187>>30080000
      << to call direcpurge which aquires the fisir>>          <<01187>>30085000
      << this would result in a lockout,since fisir>>          <<01187>>30090000
      << has a lower logical rank than the dirsir. >>          <<01187>>30095000
      << in order to avoid this release the dirsir.>>          <<01187>>30100000
      relsir(dirsir,savesir);                                  <<01187>>30105000
      tos := 0; tos.(endlevelf) := accountlevel;               <<01.pv>>30110000
      tos := direcpurge (s0, 0d, account, arrdb0, arrdb0);     <<38.pv>>30115000
      << if purge does not suceed, there are two   >>          <<01187>>30120000
      << reasons: (1)another process purged it from>>          <<01187>>30125000
      << under us, or (2) because entry is in use. >>          <<01187>>30130000
      << if (2) then bad news, time to die.        >>          <<01187>>30135000
      if <> and s0 <> 2 then suddendeath(502);                 <<01187>>30140000
      ddel;  del;                                              <<01.pv>>30145000
      relresources;                                            <<rv.pv>>30150000
doerr:                                                                  30155000
      if errnum <> 0 then                                      <<01315>>30160000
         begin                                                 <<01315>>30165000
            cierr(errnum);                                     <<01315>>30170000
            return;                                            <<01315>>30175000
         end;                                                  <<01315>>30180000
      << directory problem defined by s-2, s-1, s-0 >>                  30185000
      if (s0 = 1) and (s2 <> %20) then suddendeath(503);                30190000
      cydirerr'(*,%147000,errnum);                             <<u.rao>>30195000
      end                                                      <<u.rao>>30200000
   else                                                        <<u.rao>>30205000
      begin                                                    <<rv.pv>>30210000
          ddel;                                                <<rv.pv>>30215000
          relsir (dirsir,savesir);                             <<rv.pv>>30220000
          if spanspecified then                                <<rv.pv>>30225000
          begin                                                <<rv.pv>>30230000
              tos.(endlevelf) := accountlevel;                 <<rv.pv>>30235000
              tos := direcinsert (s0,0d,account,arrdb0,arrdb0, <<rv.pv>>30240000
                                  account (agipntr),mvtabx);   <<rv.pv>>30245000
              if <> then                                       <<rv.pv>>30250000
              begin <<insert error on non-sysvs directory>>    <<rv.pv>>30255000
                  cydirerr' (*,%167000,errnum);                <<rv.pv>>30260000
                  del;                                         <<rv.pv>>30265000
                  cierr (errnum := -xxxacctspanfaild);         <<04790>>30270000
              end else assemble (ddel,del);                    <<rv.pv>>30275000
              relresources;                                    <<rv.pv>>30280000
          end <<of spanspecified>> else del;                   <<rv.pv>>30285000
      end;                                                     <<rv.pv>>30290000
   end;                                                        <<rv.pv>>30295000
end;   <<cxnewacct>>                                           <<u.rao>>30300000
procedure cxnewgroup executorhead;                                      30305000
   option privileged,uncallable;                                        30310000
begin                                                                   30315000
   logical array     vscomm (0:vscommsz-1);                    <<rv.pv>>30320000
   integer array     group (0:gsize-1);                        <<01.pv>>30325000
   integer array     account (0:asize-1);                      <<01.pv>>30330000
   logical array     lgroup (*)        = group;                         30335000
   logical array     laccount (*)      = account;                       30340000
   byte array        baccount (*)      = account,              <<rv.pv>>30345000
                     bhvsaname (*)     = vscomm (vshaname),    <<rv.pv>>30350000
                     bhvsgname (*)     = vscomm (vshgname),    <<rv.pv>>30355000
                     bhvsvname (*)     = vscomm (vshvname);    <<rv.pv>>30360000
   double array      dgroupx (*)       = group (gdfslimit),    <<01.pv>>30365000
                     daccountx (*)     = account (adfslimit);  <<01.pv>>30370000
   integer array     cap'denied(0:1);                          <<00879>>30375000
   equate                                                      <<rv.pv>>30380000
       condmount = 3,                                          <<rv.pv>>30385000
       conddismount = 3;                                       <<rv.pv>>30390000
   logical                                                     <<rv.pv>>30395000
       pvinfo,                                                 <<rv.pv>>30400000
       reqtype := condmount;                                   <<rv.pv>>30405000
   define                                                      <<rv.pv>>30410000
       mvtabx   = pvinfo.(4:4) #,                              <<rv.pv>>30415000
       vsspecified   = vscomm (vsmask).(0:1) #,                <<rv.pv>>30420000
        numnames = vscomm (vsmask).(14:2)#,                    <<04745>>30425000
       spanspecified = vscomm (vsmask).(1:1) #;                << i.a >>30430000
   subroutine relresources;                                    <<rv.pv>>30435000
       begin                                                   <<rv.pv>>30440000
           if not spanspecified then return;                   <<rv.pv>>30445000
           reqtype := conddismount;                            <<rv.pv>>30450000
           dismount (bhvsvname, bhvsgname, bhvsaname, reqtype);<<rv.pv>>30455000
           if <> then                                          <<rv.pv>>30460000
           begin                                               <<rv.pv>>30465000
               <<reqtype contains error code. map to cierr>>   <<rv.pv>>30470000
               cierr (errnum);                                 <<rv.pv>>30475000
           end;                                                <<rv.pv>>30480000
       end;<<of relresources>>                                 <<rv.pv>>30485000
                                                                        30490000
<< >>                                                                   30495000
<<                                                           >><<04745>>30500000
<< * fix information:                                        >><<04745>>30505000
<<                                                           >><<04745>>30510000
<<   :newgroup with vs= specified will not mark the group if >><<04745>>30515000
<<   a volset is not specified.                              >><<04745>>30520000
<<                                                           >><<04745>>30525000
if cyorgcoms' (errnum,parmnum,parmsp,grouplevel,               <<rv.pv>>30530000
               group,vscomm) then                              <<rv.pv>>30535000
   begin                                                       <<u.rao>>30540000
   <<the first major task is to validate any new file, cpu  >> <<u.rao>>30545000
   <<or connect limits to verify that they do not exceed    >> <<u.rao>>30550000
   <<the account limits.  to do this we use direcfind to get>> <<u.rao>>30555000
   <<the current account values.                            >> <<u.rao>>30560000
   <<first step is to set up for direcfind of account>>        <<u.rao>>30565000
   << do volume thing >>                                                30570000
   who (, , , , , baccount);                                            30575000
   tos := 0; tos.(endlevelf) := accountlevel;                  <<01.pv>>30580000
   if (direcfind (s0, 0d, account, arrdb0, arrdb0,             <<38.pv>>30585000
                  account)) <> 0d then                         <<01.pv>>30590000
   suddendeath(504);                                                    30595000
   del;                                                        <<01.pv>>30600000
   <<now check limits>>                                        <<u.rao>>30605000
   if daccountx(4) < dgroupx(4) then                          <<u.rao>> 30610000
      begin                                                    <<u.rao>>30615000
      if dgroupx(4) <> %17777777777d then  <<warn>>            <<u.rao>>30620000
         cierr(errnum := -altgrpcpulimits);                    <<04790>>30625000
      dgroupx(4) := daccountx(4);                              <<u.rao>>30630000
      end;                                                     <<u.rao>>30635000
   if daccountx(2) < dgroupx(2) then                          <<u.rao>> 30640000
      begin                                                    <<u.rao>>30645000
      if dgroupx(2) <> %17777777777d then  <<warn>>            <<u.rao>>30650000
         cierr(errnum := -altgrpconnectlm);                    <<04790>>30655000
      dgroupx(2) := daccountx(2);                              <<u.rao>>30660000
      end;                                                     <<u.rao>>30665000
   if daccountx < dgroupx then                                <<u.rao>> 30670000
      begin                                                    <<u.rao>>30675000
      if dgroupx <> %17777777777d then <<warn>>                <<u.rao>>30680000
         cierr(errnum := -altgrpfilelimit);                    <<04790>>30685000
      dgroupx := daccountx;                                    <<u.rao>>30690000
      end;                                                     <<u.rao>>30695000
   if (lgroup(gcap) lor laccount(acap+1)) <> laccount(acap+1) then      30700000
      begin  <<capabilities exceed accounts>>                  <<u.rao>>30705000
      cap'denied := 0; << 1st word of capabilities >>          <<00879>>30710000
      cap'denied(1) := lgroup(gcap) xor                        <<00879>>30715000
                       (lgroup(gcap) land laccount(acap+1));   <<00879>>30720000
      cap'err(-altgrpexcap,cap'denied);                        <<00879>>30725000
      lgroup(gcap) := lgroup(gcap) land laccount(acap+1);      <<00879>>30730000
      end;                                                     <<u.rao>>30735000
   if vsspecified then                                         <<rv.pv>>30740000
   begin <<vs specified>>                                      <<rv.pv>>30745000
       move group (ghvsaname):=vscomm (vshaname), (namesize*3);<<rv.pv>>30750000
       if spanspecified then                                   <<rv.pv>>30755000
       begin <<span specified>>                                <<rv.pv>>30760000
           mount (bhvsvname, bhvsgname, bhvsaname,             <<rv.pv>>30765000
                  reqtype, 0<<gen>>, pvinfo);                  <<rv.pv>>30770000
           if < then                                           <<rv.pv>>30775000
           begin                                               <<rv.pv>>30780000
               <<translate error in reqtype to cierr>>         <<rv.pv>>30785000
               cierr (errnum := altgrpvsnotmntd);              <<04790>>30790000
               return;                                         <<rv.pv>>30795000
           end;                                                <<rv.pv>>30800000
       end;<<will need to dismount later>>                     <<rv.pv>>30805000
        if numnames <> 0 then                                  <<04745>>30810000
           group (glinkage) := %100000;                        <<04745>>30815000
   end;<<of vsspecified>>                                      <<rv.pv>>30820000
   tos := 0; tos.(endlevelf) := grouplevel;                    <<01.pv>>30825000
   tos := direcinsert (s0, 0d, account, group, arrdb0,         <<38.pv>>30830000
                       group (gfipntr));                       <<01.pv>>30835000
   if <> then                                                           30840000
      begin                                                             30845000
      if s0 = 2 then suddendeath(505);                                  30850000
      cydirerr'(*,%147000,errnum);                             <<u.rao>>30855000
      del;                                                     <<rv.pv>>30860000
      relresources;                                            <<rv.pv>>30865000
      end else                                                 <<rv.pv>>30870000
      begin                                                    <<rv.pv>>30875000
          ddel;                                                <<rv.pv>>30880000
          if spanspecified then                                <<rv.pv>>30885000
          begin                                                <<rv.pv>>30890000
              group (glinkage) := 0;                           <<rv.pv>>30895000
              tos := direcinsert (s0,0d,account,group,arrdb0,  <<rv.pv>>30900000
                                  group (gfipntr),mvtabx);     <<rv.pv>>30905000
              if <> then                                       <<rv.pv>>30910000
              begin <<insert error on non-sysvs directory>>    <<rv.pv>>30915000
                  cydirerr' (*,%167000,errnum);                <<rv.pv>>30920000
                  del;                                         <<rv.pv>>30925000
                  cierr (errnum := -xxxgrpspanfaild)           <<04790>>30930000
              end else assemble (ddel,del);                    <<rv.pv>>30935000
              relresources;                                    <<rv.pv>>30940000
          end <<of spanspecified>> else del;                   <<rv.pv>>30945000
      end;                                                     <<rv.pv>>30950000
   end;                                                        <<u.rao>>30955000
end;   <<cxnewgroup>>                                          <<u.rao>>30960000
procedure  cxnewuser executorhead;                                      30965000
   option privileged,uncallable;                                        30970000
begin                                                                   30975000
   integer array     account (0:asize-1),                      <<01.pv>>30980000
                     user (0:usize-1);                         <<01.pv>>30985000
   logical array     luserx (*)        = user (ucap),          <<01.pv>>30990000
                     laccountx (*)     = account (acap);       <<01.pv>>30995000
   byte array        baccount (*)      = account;                       31000000
   integer array     cap'denied(0:1);                          <<00879>>31005000
                                                                        31010000
<< >>                                                                   31015000
if cyorgcoms'(errnum,parmnum,parmsp,userlevel,user) then       <<u.rao>>31020000
   begin  <<parameter list parsed ok>>                         <<u.rao>>31025000
   <<before insertion of a new user, check the requested>>     <<u.rao>>31030000
   <<user bounds against the account bounds>>                  <<u.rao>>31035000
   who (, , , , , baccount);                                            31040000
   tos := 0; tos.(endlevelf) := accountlevel;                  <<01.pv>>31045000
   if direcfind (s0, 0d, account, arrdb0, arrdb0, account)     <<38.pv>>31050000
                 <> 0d then                                    <<01.pv>>31055000
    suddendeath(504);                                                   31060000
   del;                                                        <<01.pv>>31065000
   <<check user capabilities against account capabilities>>    <<u.rao>>31070000
   if ((luserx lor laccountx) <> laccountx) or                 <<u.rao>>31075000
      ((luserx(1) lor laccountx(1)) <> laccountx(1)) then      <<u.rao>>31080000
         begin  <<force to account caps>>                      <<u.rao>>31085000
         cap'denied := luserx xor (luserx land laccountx);     <<00879>>31090000
         cap'denied(1) := luserx(1) xor                        <<00879>>31095000
                          (luserx(1) land laccountx(1));       <<00879>>31100000
         cap'err(-altusercaps,cap'denied);                     <<00879>>31105000
         luserx := luserx land laccountx; << intersection >>   <<00879>>31110000
         luserx(1) := luserx(1) land laccountx(1);             <<00879>>31115000
         end;                                                  <<u.rao>>31120000
   <<check local attributes>>                                  <<u.rao>>31125000
   if ((luserx(2) lor laccountx(2)) <> laccountx(2)) or        <<u.rao>>31130000
      ((luserx(3) lor laccountx(3)) <> laccountx(3)) then      <<u.rao>>31135000
         begin   <<local attributes don't match>>              <<u.rao>>31140000
         cierr(errnum := -altuserlattr);                       <<04790>>31145000
         luserx(2) := laccountx(2) land luserx(2);             <<01316>>31150000
         luserx(3) := laccountx(3) land luserx(3);             <<01316>>31155000
         end;                                                  <<u.rao>>31160000
   if user (umaxjob).(8:8) < account (amaxjobw).(8:8) then     <<01.pv>>31165000
      begin                                                    <<u.rao>>31170000
      cierr(errnum :=    -altumaxpri);                         <<04790>>31175000
      user(umaxjob).(8:8) := account(amaxjobw).(8:8);          <<u.rao>>31180000
      end;                                                     <<u.rao>>31185000
   tos := 0; tos.(endlevelf) := userlevel;                     <<01.pv>>31190000
   tos := direcinsert (s0, 0d, account, user,                  <<38.pv>>31195000
                       arrdb0, user (ucap));                   <<01.pv>>31200000
   if <> then                                                           31205000
      cydirerr' (*, %147000, errnum)                           <<u.rao>>31210000
   else ddel;                                                  <<01.pv>>31215000
   del;                                                        <<01.pv>>31220000
   end;                                                        <<u.rao>>31225000
end;   <<cxnewuser>>                                           <<u.rao>>31230000
$control segment=cialtorg                                      <<u.rao>>31235000
   integer procedure syslist (element, level, parms, sirs);             31240000
      value level, parms, sirs;                                         31245000
      array element;                                                    31250000
      integer level, parms;                                             31255000
      double sirs;                                                      31260000
   option privileged,uncallable;                                        31265000
begin                                                                   31270000
   integer array     pbuf (0:35)       = q,                             31275000
                     tbuf (*)          = pbuf(28);                      31280000
   equate finfosize=128;                                     <<01.02>>  31285000
   define p'ganame=     arrq0(parms+4) #,                      <<03.km>>31290000
          p'gname=      arrq0(parms+4) #,                      <<03.km>>31295000
          p'aname=      arrq0(parms+8) #,                      <<03.km>>31300000
          p'filenum=    arrq0(parms+18) #,                     <<04.km>>31305000
          p'glinkagew=  arrq0(parms+23) #,                     <<03.km>>31310000
          p'gotentry=   arrq0(parms+24) #,                     <<03.km>>31315000
          p'impmntdst=  arrq0(parms+25) #,                     <<03.km>>31320000
          p'impmnterr=  arrq0(parms+26) #,                     <<03.km>>31325000
          p'impmntname= arrq0(parms+27) #,                     <<03.km>>31330000
          p'acc'save'count = arrq0(parms+savebuffindex) #,     <<04178>>31335000
          p'acc'save = arrq0(parms+savebuffindex+1) #,         <<04178>>31340000
          p'grp'save'count=arrq0(parms+savebuffindex+asize+1)#,<<04178>>31345000
          p'grp'save = arrq0(parms+savebuffindex+asize+2) #;   <<04178>>31350000
   define pvgroup=    logical(p'glinkagew.(pvf)) #,            <<03.km>>31355000
          releasesir=                                          <<03.km>>31360000
            begin                                              <<03.km>>31365000
            tos:=sirs;                                         <<03.km>>31370000
            if <> then relsir(*,*) else ddel;                  <<03.km>>31375000
            end #,                                             <<04178>>31380000
          exit'if'break =                                      <<04178>>31385000
             if requestservice then                            <<04178>>31390000
                begin                                          <<04178>>31395000
                   rtn := 4;                                   <<04178>>31400000
                   go to exit1;                                <<04178>>31405000
                end #;                                         <<04178>>31410000
   integer pvinfo'error;                                       <<10.km>>31415000
  integer rtn; <<return value>>                                <<03.mm>>31420000
   equate nomount= 0;                                          <<03.km>>31425000
   integer pointer ppresult;                                  <<00.gen>>31430000
   integer array dds(*);                                     <<01.02>>  31435000
   integer array element'buff(*);                            <<01.02>>  31440000
   integer daxsize';                                         <<01.02>>  31445000
   integer           rem,                                               31450000
                     cnt,                                               31455000
                     daxsize           = db+146;               <<38.pv>>31460000
   byte array        bpbuf (*)         = pbuf,                          31465000
                     btbuf (*)         = tbuf;                          31470000
                                                                        31475000
                                                                        31480000
subroutine def'movefromdseg;                                  <<00.gen>>31485000
                                                              <<00.gen>>31490000
                                                              <<00.gen>>31495000
subroutine printline (elem, len);                                       31500000
   value len;                                                           31505000
   integer array elem;                                                  31510000
   integer len;                                                         31515000
begin                                                                   31520000
   move tbuf:=elem,(len);                                    <<01.02>>  31525000
   pbuf := "  ";                                                        31530000
   move pbuf (1) := pbuf, (27);                                         31535000
   move tbuf(len) := pbuf, (8-len);                                     31540000
   cnt := 0;                                                            31545000
   do begin                                                             31550000
      tos := 0;                                                         31555000
      tos := btbuf (cnt & lsl(1));                                      31560000
      if < then btbuf(x) := ".";                                        31565000
      tos := tos & lsl(8);                                              31570000
      tos := btbuf (x +1);                                              31575000
      if < then btbuf (x) := ".";                                       31580000
      tos := tos lor tos;                                               31585000
      ascii (*, 8, bpbuf (cnt *7));                                     31590000
      cnt := cnt +1;                                                    31595000
      end                                                               31600000
   until cnt = len;                                                     31605000
   fwrite(p'filenum,pbuf,36,0);                                <<04.km>>31610000
   if <> then go to stopexit;                                <<01.02>>  31615000
   end    <<printline>>;                                                31620000
                                                                        31625000
                                                                        31630000
subroutine printentry (elem, len);                                      31635000
   value len;                                                           31640000
   integer array elem;                                                  31645000
   integer len;                                                         31650000
begin                                                                   31655000
   rem := len;                                                          31660000
   while rem > 8 do                                                     31665000
      begin                                                             31670000
      printline (elem (len -rem), 8);                                   31675000
      rem := rem -8;                                                    31680000
      end;                                                              31685000
   if rem > 0 then printline (elem (len-rem), rem);                     31690000
   end    <<printentry>>;                                               31695000
logical subroutine at'name(level);                             <<03.mm>>31700000
  value level;                                                 <<03.mm>>31705000
  integer level;                                               <<03.mm>>31710000
begin                                                          <<03.mm>>31715000
  comment:                                                     <<03.mm>>31720000
    this subroutine returns true if the name at level          <<03.mm>>31725000
    'level' used for the directory search is a '@',            <<03.mm>>31730000
    otherwise it returns false.                                <<03.mm>>31735000
    ;                                                          <<03.mm>>31740000
  at'name:=false;  <<in case of error in call>>                <<03.mm>>31745000
  case level of                                                <<03.mm>>31750000
    begin                                                      <<03.mm>>31755000
    <<0>> at'name:=if d'fname.(0:8) = "@" then true else false;<<03.mm>>31760000
    <<1>> at'name:=if d'gname.(0:8) = "@" then true else false;<<03.mm>>31765000
    <<2>> at'name:=if d'aname.(0:8) = "@" then true else false;<<03.mm>>31770000
    <<3>> at'name:=if d'uname.(0:8) = "@" then true else false;<<03.mm>>31775000
    <<4>> at'name:=if d'vname.(0:8) = "@" then true else false;<<03.mm>>31780000
    end;                                                       <<03.mm>>31785000
end <<subroutine at'name>>;                                    <<03.mm>>31790000
                                                               <<03.mm>>31795000
                                                               <<03.mm>>31800000
                                                                        31805000
   if requestservice then                                               31810000
      begin                                                             31815000
      rtn:=5;                                                  <<03.mm>>31820000
      go to exit;                                                       31825000
      end;                                                              31830000
   parms := parms -integer(deltaq);                                     31835000
   daxsize':=daxsize;                                         <<00.gen>>31840000
   exchangedb(0);       <<db to stack>>                       <<00.gen>>31845000
   tos:=daxsize';                                             <<00.gen>>31850000
   @element'buff:=@s0;                                        <<00.gen>>31855000
   assemble(adds 0);                                          <<00.gen>>31860000
   movefromdseg(@element'buff,ddsdst,@element,daxsize');      <<00.gen>>31865000
                                                              <<00.gen>>31870000
   @ppresult:=@arrq0(parms+sysl'pprinx);                      <<00.gen>>31875000
   if logical(d'type.(allflag)) then                          <<00.gen>>31880000
   begin                                                      <<00.gen>>31885000
     case *level of begin                                     <<00.gen>>31890000
       tos:=dirmatch(g'fname,element'buff);                   <<00.gen>>31895000
       tos:=dirmatch(g'gname,element'buff);                   <<00.gen>>31900000
       tos:=dirmatch(g'aname,element'buff);                   <<00.gen>>31905000
       tos:=dirmatch(g'uname,element'buff);                   <<00.gen>>31910000
       tos:=dirmatch(g'vname,element'buff);                   <<00.gen>>31915000
     end;                                                     <<00.gen>>31920000
     if tos<>0 then                                           <<00.gen>>31925000
     begin                                                    <<00.gen>>31930000
       rtn:=if < then nextuncle'sir else nextbrother'sir;      <<03.mm>>31935000
       go exit1;                                              <<00.gen>>31940000
     end;                                                     <<00.gen>>31945000
   end;                                                       <<00.gen>>31950000
                                                              <<00.gen>>31955000
   if level = arrq0(parms+22).(tolevelf) then                  <<03.mm>>31960000
      begin                                                    <<03.mm>>31965000
      p'gotentry:=true;                                        <<03.mm>>31970000
      releasesir;                                              <<03.mm>>31975000
      rtn:=0;                                                  <<03.mm>>31980000
      tos := finfosize;                                        <<04178>>31985000
      @dds := @s0;                                             <<04178>>31990000
      assemble(adds 0);                                        <<04178>>31995000
      if p'acc'save'count <> 0 then << dump account entry >>   <<04178>>32000000
         begin                                                 <<04178>>32005000
            dds := "A ";                                       <<04178>>32010000
            move dds(1) := " =  ";                             <<04178>>32015000
            move dds(3) := p'aname,(4);                        <<04178>>32020000
            exit'if'break;                                     <<04178>>32025000
            fwrite(p'filenum,dds,-14,0);                       <<04178>>32030000
            if <> then go to stopexit;                         <<04178>>32035000
            printentry(p'acc'save,p'acc'save'count);           <<04178>>32040000
            p'acc'save'count := 0;                             <<04178>>32045000
         end;                                                  <<04178>>32050000
      if p'grp'save'count <> 0 then  << dump group entry >>    <<04178>>32055000
         begin                                                 <<04178>>32060000
            dds := "G ";                                       <<04178>>32065000
            move dds(1) := " =  ";                             <<04178>>32070000
            move dds(3) := p'gname,(4);                        <<04178>>32075000
            exit'if'break;                                     <<04178>>32080000
            fwrite(p'filenum,dds,-14,0);                       <<04178>>32085000
            if <> then go to stopexit;                         <<04178>>32090000
            printentry(p'grp'save,p'grp'save'count);           <<04178>>32095000
            p'grp'save'count := 0;                             <<04178>>32100000
         end;                                                  <<04178>>32105000
      case level of                                            <<04178>>32110000
         begin                                                 <<04178>>32115000
            tos := "F ";                                       <<04178>>32120000
            tos := "G ";                                       <<04178>>32125000
            tos := "A ";                                       <<04178>>32130000
            tos := "U ";                                       <<04178>>32135000
            tos := "VS";                                       <<04178>>32140000
         end;                                                  <<04178>>32145000
      dds := tos;                                              <<04178>>32150000
      move dds(1) := " =  ";                                   <<04178>>32155000
      move dds(3) := element'buff,(4);                         <<04178>>32160000
      exit'if'break;                                           <<04178>>32165000
      fwrite(p'filenum,dds,-14,0);                             <<04178>>32170000
      if <> then                                               <<04178>>32175000
stopexit:                                                      <<04178>>32180000
         begin                                                 <<04178>>32185000
            arrq0(parms + 1) := -1;                            <<04178>>32190000
            rtn := 4;                                          <<04178>>32195000
            go to exit1;                                       <<04178>>32200000
         end;                                                  <<04178>>32205000
      printentry(element'buff,daxsize');                       <<04178>>32210000
      if level = 0 then                                        <<04178>>32215000
         begin                                                 <<04178>>32220000
            tos := 0d;  << returun for attachio >>             <<04178>>32225000
            tos := lun(element'buff(4).(0:8),                  <<04178>>32230000
                       p'glinkagew.(mvtabxf));                 <<04178>>32235000
            tos := attachio(*,0,0,@dds,0,finfosize,            <<04178>>32240000
                            element'buff(4).(8:8),             <<04178>>32245000
                            element'buff(5),1);                <<04178>>32250000
            assemble(del);                                     <<04178>>32255000
            if tos.(13:3) <> 1 then                            <<04178>>32260000
               begin                                           <<04178>>32265000
                  cierr(listfflabioerr);                       <<04790>>32270000
                  rtn := 0;                                    <<04178>>32275000
                  go to okexit;                                <<04178>>32280000
               end;                                            <<04178>>32285000
            printentry(dds,finfosize);                         <<04178>>32290000
         end;                                                  <<04178>>32295000
      end                                                      <<03.mm>>32300000
   else                                                        <<03.mm>>32305000
      begin                                                    <<03.mm>>32310000
      if level=accountlevel then                               <<03.mm>>32315000
        begin                                                  <<03.mm>>32320000
        move p'aname:=element'buff,(4);                        <<03.mm>>32325000
        if at'name(level) then                                 <<03.mm>>32330000
          begin                                                <<03.mm>>32335000
          p'acc'save'count := daxsize';                        <<04178>>32340000
          move p'acc'save := element'buff,(daxsize');          <<04178>>32345000
          releasesir;                                          <<03.mm>>32350000
          rtn:=nextson;                                        <<03.mm>>32355000
          end                                                  <<03.mm>>32360000
        else rtn:=nextson'sir;                                 <<03.mm>>32365000
        end                                                    <<03.mm>>32370000
      else if arrq0(x).(tolevelf)<>filelevel then              <<03.mm>>32375000
        begin <<group level>>                                  <<03.mm>>32380000
        move p'gname:=element'buff,(4);                        <<03.mm>>32385000
        if at'name(level) then                                 <<03.mm>>32390000
          begin                                                <<03.mm>>32395000
          p'grp'save'count := daxsize';                        <<04178>>32400000
          move p'grp'save := element'buff,(daxsize');          <<04178>>32405000
          releasesir;                                          <<03.mm>>32410000
          rtn:=nextson;                                        <<03.mm>>32415000
          end                                                  <<03.mm>>32420000
        else rtn:=nextson'sir;                                 <<03.mm>>32425000
        end                                                    <<03.mm>>32430000
      else                                                     <<04.km>>32435000
        begin <<group level>>                                  <<04.km>>32440000
        if at'name(level) then                                 <<04178>>32445000
           begin                                               <<04178>>32450000
              p'grp'save'count := daxsize';                    <<04178>>32455000
              move p'grp'save := element'buff,(daxsize');      <<04178>>32460000
           end;                                                <<04178>>32465000
        p'glinkagew:=element'buff(glinkage);                   <<04.km>>32470000
        move p'gname:=element'buff,(4);                        <<04.km>>32475000
        releasesir;                                            <<04.km>>32480000
        if not pvgroup then rtn:=nextson                       <<03.mm>>32485000
        else if implicitmnt(p'gname,p'aname,p'impmntdst,       <<04.km>>32490000
                            pvinfo'error) then                 <<10.km>>32495000
          begin                                                <<04.km>>32500000
          p'glinkagew.(mvtabxf):=pvinfo'error.(pvmvtabxf);     <<10.km>>32505000
          rtn:=revisit;                                        <<03.mm>>32510000
          end                                                  <<04.km>>32515000
        else if pvinfo'error=nomount then                      <<10.km>>32520000
          begin                                                <<04.km>>32525000
          p'impmnterr:=pvinfo'error;                           <<10.km>>32530000
          rtn:=revisit;                <<dds used by "MOUNT">> <<03.mm>>32535000
          end                                                  <<04.km>>32540000
        else                                                   <<04.km>>32545000
          begin                                                <<04.km>>32550000
          p'impmnterr:=pvinfo'error;                           <<10.km>>32555000
          move p'impmntname:=p'ganame,(8);                     <<04.km>>32560000
          rtn:=abortscan;                                      <<03.mm>>32565000
          end;                                                 <<04.km>>32570000
        end <<group level>>;                                   <<04.km>>32575000
      end;                                                     <<04.km>>32580000
okexit:                                                                 32585000
exit1:                                                       <<01.02>>  32590000
   exchangedb(ddsdst);                                       <<01.02>>  32595000
exit:                                                                   32600000
   syslist:=rtn;                                               <<03.mm>>32605000
   end    <<syslist>>;                                                  32610000
integer procedure cyaltorg (element, level, parms, sirs);               32615000
   value level, parms, sirs;                                            32620000
   array element;                                                       32625000
   integer level, parms;                                                32630000
   double sirs;                                                         32635000
   option privileged,uncallable;                                        32640000
begin                                                                   32645000
   logical           dadirty           = db+145;               <<38.pv>>32650000
   integer                                                     <<rv.pv>>32655000
       altntryx,                                               <<rv.pv>>32660000
       xx;                                                     <<rv.pv>>32665000
   equate                                                      <<rv.pv>>32670000
       specmaskln' = specmaskln-1;                             <<rv.pv>>32675000
                                                                        32680000
                                                                        32685000
   parms := parms - deltaq;                                    <<rv.pv>>32690000
   altntryx := parms + specmaskln;                             <<rv.pv>>32695000
   if level < accountlevel then                                <<rv.pv>>32700000
      if arrq0 (parms).(11:2) = 3 then                         <<rv.pv>>32705000
         begin    <<limit specified>>                                   32710000
         xx := 9;                                              <<rv.pv>>32715000
         goto checkc;                                                   32720000
         end;                                                           32725000
   if = then                                                            32730000
      if arrq0 (parms+1).(0:2) = 3 then                        <<rv.pv>>32735000
         begin    <<new acct lim specified>>                            32740000
         xx := 14;                                             <<rv.pv>>32745000
checkc:  tos := element(xx);  tos := element(x:=x+1);          <<rv.pv>>32750000
         tos := arrq0 (xx+2+altntryx);  tos := arrq0 (x:=x+1); <<rv.pv>>32755000
         assemble (dcmp);                                               32760000
         if > then                                                      32765000
            begin                                                       32770000
            arrq0 (parms-1) := 1;  <<signal lim error>>                 32775000
            cyaltorg := 5;                                              32780000
            return;                                                     32785000
            end;                                                        32790000
         end;                                                           32795000
  <<max job pri is just a byte.  the other byte in the>>       <<02331>>32800000
  <<word is used for flags.  to avoid destroying those>>       <<02331>>32805000
  <<flags, we overlay left byte of the new word with the>>     <<02331>>32810000
  <<left byte of the existing word. note that this only >>     <<02331>>32815000
  <<works while the directory is locked.                >>     <<02331>>32820000
    if level = accountlevel or level=userlevel then            <<02331>>32825000
       case level of                                           <<02331>>32830000
          begin                                                <<02331>>32835000
          ; <<filelevel = 0 >>                                 <<02331>>32840000
          ; <<grouplevel = 1 >>                                <<02331>>32845000
          arrq0(altntryx+amaxjobw) :=                          <<02331>>32850000
              logical(arrq0(altntryx+amaxjobw)).(8:8) lor      <<02331>>32855000
              (element(amaxjobw) land %177400);                <<02331>>32860000
          arrq0(altntryx+umaxjob) :=                           <<02331>>32865000
              logical(arrq0(altntryx+umaxjob)).(8:8) lor       <<02331>>32870000
              (element(umaxjob) land %177400);                 <<02331>>32875000
          ; <<vsdeflevel = 4 >>                                <<02331>>32880000
          end;                                                 <<02331>>32885000
   tos := specmaskln';   <<set up loop limit>>                 <<rv.pv>>32890000
   do begin <<all mask words>>                                 <<rv.pv>>32895000
          tos := arrq0 (parms+(specmaskln'-s0)); <<mask word>> <<rv.pv>>32900000
          xx := (specmaskln'-s1) & lsl (4); <<word offset>>    <<rv.pv>>32905000
          assemble (test);                                     <<rv.pv>>32910000
          do begin <<each mask word>>                          <<rv.pv>>32915000
                 if < then element (xx) := arrq0 (xx+altntryx);<<rv.pv>>32920000
                 xx:=xx+1;  <<next word>>                      <<rv.pv>>32925000
                 tos := tos & lsl (1);                         <<rv.pv>>32930000
             end until =;                                      <<rv.pv>>32935000
          del;  <<mask word>>                                  <<rv.pv>>32940000
       end until (tos:=tos-1) < 0;                             <<rv.pv>>32945000
   del;  <<loop limit>>                                        <<rv.pv>>32950000
   <<return updated entry>>                                    <<rv.pv>>32955000
   case level of                                               <<rv.pv>>32960000
   begin                                                       <<rv.pv>>32965000
       ;                                                       <<rv.pv>>32970000
       xx := gsize-1;                                          <<rv.pv>>32975000
       xx := asize-1;                                          <<rv.pv>>32980000
       xx := usize-1;                                          <<rv.pv>>32985000
   end;                                                        <<rv.pv>>32990000
   do                                                          <<rv.pv>>32995000
    arrq0 (xx+altntryx) := element (xx)                        <<rv.pv>>33000000
   until (xx:=xx-1) < 0;                                       <<rv.pv>>33005000
   dadirty.(15:1) := true;                                     <<rv.pv>>33010000
   cyaltorg := 1;                                                       33015000
   end    <<cyaltorg>>;                                                 33020000
integer procedure cyloweralt( element, level, parms, sirs );   <<01320>>33025000
   value level, parms, sirs;                                   <<01320>>33030000
   logical array element;                                      <<01320>>33035000
   integer level, parms;                                       <<01320>>33040000
   double sirs;                                                <<01320>>33045000
   option privileged, uncallable;                              <<01320>>33050000
begin                                                          <<01320>>33055000
                                                               <<01320>>33060000
   << changes have been made to an account's capabilities  >>  <<01320>>33065000
   << and/or local attributes.  for those caps/attrs that  >>  <<01320>>33070000
   << have been deleted from account, remove them from the >>  <<01320>>33075000
   << groups/users in that account.                        >>  <<01320>>33080000
                                                               <<01320>>33085000
   logical                                                     <<01320>>33090000
      douser,            << visiting user or group?        >>  <<01320>>33095000
      extracaps,         << temp storage.                  >>  <<01450>>33100000
      dadirty = db+145;  << for marking changes to entry.  >>  <<01320>>33105000
                                                               <<01320>>33110000
   define                                                      <<01320>>33115000
      am'switched'ia'ba  =  arrq0(parms+5) #,                  <<01450>>33120000
                                                               <<01320>>33125000
                                                               <<01320>>33130000
      got'ia'or'ba  =  arrq0(parms+4) #;                       <<01450>>33135000
                                                               <<01450>>33140000
                                                               <<01450>>33145000
   parms := parms - deltaq;  << arrange pointers to parms  >>  <<01320>>33150000
   douser := if level = userlevel then true else false;        <<01320>>33155000
                                                               <<01320>>33160000
   if douser then                                              <<01320>>33165000
   begin            << change all caps/attrs of user.      >>  <<01320>>33170000
      element( ucap ) := element( ucap )                       <<01320>>33175000
                         land logical( arrq0( parms ) );       <<01320>>33180000
      element(ucap+1) := element(ucap+1)                       <<01320>>33185000
                         land logical( arrq0(parms+1) );       <<01320>>33190000
      element( ulattr ) := element( ulattr )                   <<01320>>33195000
                           land logical( arrq0(parms+2) );     <<01320>>33200000
      element(ulattr+1) := element(ulattr+1)                   <<01320>>33205000
                           land logical( arrq0(parms+3) );     <<01320>>33210000
      if element(ucap+1).(7:2) = 0 then  << no ia or ba.  >>   <<01450>>33215000
      begin                                                    <<01450>>33220000
                                                               <<01450>>33225000
                                                               <<01450>>33230000
         if element(ucap).(1:1) = 1 then << user was am.  >>   <<01450>>33235000
         begin                                                 <<01450>>33240000
                                                               <<01450>>33245000
            extracaps := 0;                                    <<01450>>33250000
            extracaps.(7:2) := logical(arrq0(parms+1)).(7:2);  <<01450>>33255000
            element(ucap+1)                                    <<01450>>33260000
               := element(ucap+1) lor extracaps;               <<01450>>33265000
                                                               <<01450>>33270000
            am'switched'ia'ba := integer( true );              <<01450>>33275000
                                                               <<01450>>33280000
         end                                                   <<01450>>33285000
         else   got'ia'or'ba := integer( false );              <<01450>>33290000
                                                               <<01450>>33295000
                                                               <<01450>>33300000
      end;                                                     <<01450>>33305000
                                                               <<01450>>33310000
                                                               <<01450>>33315000
                                                               <<01320>>33320000
   end                                                         <<01450>>33325000
   else   << change group's capabilities. >>                   <<01450>>33330000
   begin                                                       <<01450>>33335000
      element( gcap ) := element( gcap )                       <<01450>>33340000
                         land logical( arrq0(parms+1) );       <<01450>>33345000
      if element( gcap ).(7:2) = 0   << check for useless >>   <<01450>>33350000
         then got'ia'or'ba := integer( false ); << groups >>   <<01450>>33355000
   end;                                                        <<01450>>33360000
                                                               <<01450>>33365000
   dadirty := true;                                            <<01450>>33370000
   cyloweralt := 1;    << no sirs released, continue      >>   <<01450>>33375000
                                                               <<01450>>33380000
end;  << cyloweralt >>                                         <<01450>>33385000
                                                               <<01450>>33390000
                                                               <<01450>>33395000
procedure cxaltacct executorhead;                                       33400000
   option privileged,uncallable;                                        33405000
begin                                                                   33410000
                                                               <<01450>>33415000
   logical array     commary (0:vscommsz+1+specmaskln+(asize-1)) = q,   33420000
                     vscomm (*)        = commary,              <<rv.pv>>33425000
                     result (*)        = commary (vscommsz'),  <<rv.pv>>33430000
                     dsparms (*)       = result (1),           <<rv.pv>>33435000
                     account (*)       = dsparms (specmaskln); << i.a >>33440000
   byte array        bacct (*)         = account,              <<rv.pv>>33445000
                     bhvsaname (*)     = vscomm (vshaname),    <<rv.pv>>33450000
                     bhvsgname (*)     = vscomm (vshgname),    <<rv.pv>>33455000
                     bhvsvname (*)     = vscomm (vshvname);    <<rv.pv>>33460000
   equate                                                      <<rv.pv>>33465000
       condmount = 3,                                          <<rv.pv>>33470000
       conddismount = 3;                                       <<rv.pv>>33475000
   logical                                                     <<rv.pv>>33480000
       alll,                                                   <<01320>>33485000
       pvinfo,                                                 <<rv.pv>>33490000
       reqtype := condmount;                                   <<rv.pv>>33495000
   define                                                      <<rv.pv>>33500000
       got'ia'or'ba = caplaparms(4)  #,                        <<01320>>33505000
       am'switched'ia'ba = caplaparms(5)  #,                   <<01450>>33510000
       mvtabx   = pvinfo.(4:4) #,                              <<rv.pv>>33515000
       vsspecified   = vscomm (vsmask).(0:1) #,                <<rv.pv>>33520000
       spanspecified = vscomm (vsmask).(1:1) #,                <<rv.pv>>33525000
       altspecified  = vscomm (vsmask).(2:1) #;                << i.a >>33530000
                                                               <<01320>>33535000
   logical array                                               <<01320>>33540000
       caplaparms(0:4),                                        <<01320>>33545000
       all(*)   =   alll;                                      <<01320>>33550000
                                                               <<01320>>33555000
   subroutine relresources;                                    <<rv.pv>>33560000
       begin                                                   <<rv.pv>>33565000
           if not (spanspecified lor altspecified) then return;<<00086>>33570000
           reqtype := conddismount;                            <<rv.pv>>33575000
           dismount (bhvsvname, bhvsgname, bhvsaname, reqtype);<<rv.pv>>33580000
           if <> then                                          <<rv.pv>>33585000
           begin                                               <<rv.pv>>33590000
               <<reqtype contains error code. map to cierr>>   <<rv.pv>>33595000
               cierr (errnum);                                 <<rv.pv>>33600000
           end;                                                <<rv.pv>>33605000
       end;<<of relresources>>                                 <<rv.pv>>33610000
<< >>                                                                   33615000
result := 0;                                                   <<rv.pv>>33620000
if cyorgcoms' (errnum,parmnum,parmsp,accountlevel,account,     <<rv.pv>>33625000
               vscomm,dsparms) then                            <<rv.pv>>33630000
   begin                                                       <<u.rao>>33635000
   if bacct="SYS " and dsparms.(acap:2)=3 and                  <<u.rao>>33640000
         not account(acap).(0:1) then                          <<07.ro>>33645000
      begin <<attempt to remove sm cap from sys account>>      <<u.rao>>33650000
      cierr(errnum := -altacctsmcap);                          <<04790>>33655000
      account(acap).(0:1) := 1;  <<sm cap>>                    <<u.rao>>33660000
      end;                                                     <<u.rao>>33665000
   if vsspecified then                                         <<rv.pv>>33670000
       begin                                                   <<00086>>33675000
       if spanspecified or altspecified then                   <<00086>>33680000
       begin <<span specified>>                                <<rv.pv>>33685000
           mount (bhvsvname, bhvsgname, bhvsaname,             <<rv.pv>>33690000
                  reqtype, 0<<gen>>, pvinfo);                  <<rv.pv>>33695000
           if < then                                           <<rv.pv>>33700000
           begin                                               <<rv.pv>>33705000
               <<translate error in reqtype to cierr>>         <<rv.pv>>33710000
               cierr (errnum := altgrpvsnotmntd);              <<04790>>33715000
               return;                                         <<rv.pv>>33720000
           end;                                                <<rv.pv>>33725000
       end <<will need to dismount later>>                     <<rv.pv>>33730000
       else                                                    <<rv.pv>>33735000
       begin <<span not optional>>                             <<rv.pv>>33740000
           cierr (errnum := -xxxacctprmnotopt);                <<04790>>33745000
       end;                                                    <<rv.pv>>33750000
   end;<<of vsspecified>>                                      <<rv.pv>>33755000
   tos := 0;                                                   <<u.rao>>33760000
   tos.(tolevelf) := accountlevel;                             <<u.rao>>33765000
   tos.(endlevelf) := accountlevel;                            <<u.rao>>33770000
   tos := direcscan (s0,0d,account,arrdb0,arrdb0,cyaltorg,     <<00086>>33775000
             dsparms,if altspecified then mvtabx else 0);      <<00086>>33780000
   if <> then                                                  <<rv.pv>>33785000
   begin <<direcscan failed>>                                  <<rv.pv>>33790000
       cydirerr' (*,%120000,errnum);                           <<rv.pv>>33795000
       del;                                                    <<rv.pv>>33800000
   end                                                         <<rv.pv>>33805000
   else                                                        <<rv.pv>>33810000
   begin                                                       <<rv.pv>>33815000
       ddel;                                                   <<rv.pv>>33820000
       if result <> 0 then                                     <<rv.pv>>33825000
       begin                                                   <<rv.pv>>33830000
           del;                                                <<rv.pv>>33835000
           cierr (errnum := flimit'lt'used);                   <<rv.pv>>33840000
       end                                                     <<rv.pv>>33845000
       else                                                    <<rv.pv>>33850000
       begin                                                   <<01320>>33855000
                                                               <<01320>>33860000
                                                               <<01320>>33865000
       if dsparms.(6:4) <> 0   then                            <<01320>>33870000
       begin   << caps or local attributes have changed.  >>   <<01320>>33875000
               << "BUBBLE" changes down to user/groups.   >>   <<01320>>33880000
          caplaparms      := account( acap );                  <<01320>>33885000
          caplaparms(1)   := account(acap+1);                  <<01320>>33890000
          caplaparms(2)   := account( alattr );                <<01320>>33895000
          caplaparms(3)   := account(alattr+1);                <<01320>>33900000
          got'ia'or'ba    := true;                             <<01320>>33905000
          am'switched'ia'ba := false;                          <<01450>>33910000
          all := "@ ";                                         <<01320>>33915000
          tos := 0;                                            <<01320>>33920000
          tos.(tolevelf  ) := userlevel;                       <<01320>>33925000
          tos.(endlevelfx) := allusers;                        <<01320>>33930000
          tos := direcscan( s0, 0d, account, all, arrdb0,      <<01320>>33935000
                            cyloweralt, caplaparms,            <<01320>>33940000
                       if altspecified then mvtabx else 0 );   <<01320>>33945000
          if <> then                                           <<01320>>33950000
          begin                                                <<01320>>33955000
             cydirerr'( *, %120000, errnum );                  <<01320>>33960000
             del;                                              <<01320>>33965000
             relresources;                                     <<01320>>33970000
             return;                                           <<01320>>33975000
          end;                                                 <<01320>>33980000
          if am'switched'ia'ba                                 <<01450>>33985000
            then cierr( errnum := -am'switchedcaps );          <<01450>>33990000
          if not got'ia'or'ba                                  <<01450>>33995000
             then cierr( errnum := -dirugotnoiaba );           <<01320>>34000000
          ddel;                                                <<01320>>34005000
          tos.(tolevelf  ) := grouplevel;                      <<01320>>34010000
          tos.(endlevelfx) := allgroups;                       <<01320>>34015000
          got'ia'or'ba := true;                                <<01320>>34020000
          tos := direcscan( s0, 0d, account, all, arrdb0,      <<01320>>34025000
                            cyloweralt, caplaparms,            <<01320>>34030000
                       if altspecified then mvtabx else 0 );   <<01320>>34035000
          if <> then                                           <<01320>>34040000
          begin                                                <<01320>>34045000
             cydirerr'( *, %120000, errnum );                  <<01320>>34050000
             del;                                              <<01320>>34055000
             relresources;                                     <<01320>>34060000
             return;                                           <<01320>>34065000
          end;                                                 <<01320>>34070000
          if not got'ia'or'ba                                  <<01320>>34075000
             then cierr( errnum := -dirggotnoiaba );           <<01320>>34080000
          ddel;   del;                                         <<01320>>34085000
                                                               <<01320>>34090000
       end;  << "BUBBLING" changes down.  >>                   <<01320>>34095000
                                                               <<01320>>34100000
        if spanspecified then                                  <<rv.pv>>34105000
        begin                                                  <<rv.pv>>34110000
            account (adfscount) := 0;  account (x:=x+1) := 0;  <<rv.pv>>34115000
            account (acpucount) := 0;  account (x:=x+1) := 0;  <<rv.pv>>34120000
            account (acontimecount):=0; account (x:=x+1):=0;   <<rv.pv>>34125000
            tos.(tolevelf) := 0;                               <<rv.pv>>34130000
            tos := direcinsert (s0,0d,account,arrdb0,arrdb0,   <<38.pv>>34135000
                                account (agipntr),mvtabx);     <<rv.pv>>34140000
            if <> then                                         <<rv.pv>>34145000
            begin <<insert error on non-sysvs directory>>      <<rv.pv>>34150000
                cydirerr' (*,%167000,errnum);                  <<rv.pv>>34155000
                del;                                           <<rv.pv>>34160000
                cierr (errnum := -xxxacctspanfaild);           <<04790>>34165000
            end else assemble (ddel,del);                      <<rv.pv>>34170000
        end <<of spanspecified>> else del;                     <<rv.pv>>34175000
                                                               <<01320>>34180000
       end;   << result = 0 case.  >>                          <<01320>>34185000
                                                               <<01320>>34190000
   end;                                                        <<rv.pv>>34195000
   relresources;                                               <<00086>>34200000
   end;                                                        <<rv.pv>>34205000
end;   <<cxaltacct>>                                           <<u.rao>>34210000
procedure cxaltgroup executorhead;                                      34215000
   option privileged,uncallable;                                        34220000
begin                                                                   34225000
   logical array     commary (0:vscommsz+1+specmaskln+(gsize-1)) = q,   34230000
                     vscomm (*)        = commary,              <<rv.pv>>34235000
                     result (*)        = commary (vscommsz'),  <<rv.pv>>34240000
                     dsparms (*)       = result (1),           <<rv.pv>>34245000
                     ntry (0:gsize-1);                         <<rv.pv>>34250000
   integer array     group (*)         = dsparms (specmaskln), <<rv.pv>>34255000
                     account (0:asize-1);                      <<01.pv>>34260000
   byte array        baccount (*)      = account,              <<rv.pv>>34265000
                     bhvsaname (*)     = vscomm (vshaname),    <<rv.pv>>34270000
                     bhvsgname (*)     = vscomm (vshgname),    <<rv.pv>>34275000
                     bhvsvname (*)     = vscomm (vshvname);    <<rv.pv>>34280000
   logical array     lgroup (*)        = group,                         34285000
                     laccount (*)      = account;                       34290000
   double array      daccountx (*)     = account (adfslimit),  <<01.pv>>34295000
                     dgroupx (*)       = group (gdfslimit),    <<rv.pv>>34300000
                     dgdfscount (*)    = ntry (gdfscount);     <<rv.pv>>34305000
   logical           dsparms1          = dsparms +1;                    34310000
                                                               <<00879>>34315000
   integer array     cap'denied(0:1);                          <<00879>>34320000
   equate                                                      <<rv.pv>>34325000
       condmount = 3,                                          <<rv.pv>>34330000
       conddismount = 3;                                       <<rv.pv>>34335000
   logical                                                     <<rv.pv>>34340000
       glinkage',                                              <<rv.pv>>34345000
       pvinfo,                                                 <<rv.pv>>34350000
       reqtype := condmount;                                   <<rv.pv>>34355000
   define                                                      <<rv.pv>>34360000
       mvtabx   = pvinfo.(4:4) #,                              <<rv.pv>>34365000
       vsspecified   = vscomm (vsmask).(0:1) #,                <<rv.pv>>34370000
       spanspecified = vscomm (vsmask).(1:1) #,                <<rv.pv>>34375000
       altspecified  = vscomm (vsmask).(2:1) #,                <<00086>>34380000
       numnames      = vscomm (vsmask).(14:2) #;               <<rv.pv>>34385000
   subroutine relresources;                                    <<rv.pv>>34390000
       begin                                                   <<rv.pv>>34395000
           if not (spanspecified lor altspecified) then return;<<00086>>34400000
           reqtype := conddismount;                            <<rv.pv>>34405000
           dismount (bhvsvname, bhvsgname, bhvsaname, reqtype);<<rv.pv>>34410000
           if <> then                                          <<rv.pv>>34415000
           begin                                               <<rv.pv>>34420000
               <<reqtype contains error code. map to cierr>>   <<rv.pv>>34425000
               cierr (errnum);                                 <<rv.pv>>34430000
           end;                                                <<rv.pv>>34435000
       end;<<of relresources>>                                 <<rv.pv>>34440000
result := 0;                                                   <<rv.pv>>34445000
if cyorgcoms'(errnum,parmnum,parmsp,grouplevel,group,          <<u.rao>>34450000
              vscomm,dsparms) then  <<list parsed ok>>         <<rv.pv>>34455000
   begin                                                       <<u.rao>>34460000
   <<the first major task is to validate any new file, cpu  >> <<u.rao>>34465000
   <<or connect limits to verify that they do not exceed    >> <<u.rao>>34470000
   <<the account limits.  to do this we use direcfind to get>> <<u.rao>>34475000
   <<the current account values.  incidentally, the current >> <<u.rao>>34480000
   <<actual file limits are checked in cyaltorg, not here.  >> <<u.rao>>34485000
   <<first step is to set up for direcfind of account>>        <<u.rao>>34490000
   who(,,,,,baccount);  <<logon account>>                      <<u.rao>>34495000
   tos := 0; tos.(endlevelf) := accountlevel;                  <<u.rao>>34500000
   if direcfind(s0,0d,account,arrdb0,arrdb0,account) <> 0d then<<38.pv>>34505000
      suddendeath(504);  <<discrepancy between who & direcfind><<u.rao>>34510000
   del;  <<pop level word>>                                    <<u.rao>>34515000
   <<now check limits>>                                        <<u.rao>>34520000
   if dsparms1.(3:1) and (daccountx(4)<dgroupx(4)) then        <<u.rao>>34525000
      begin                                                    <<u.rao>>34530000
      cierr(errnum := -altgrpcpulimits);                       <<04790>>34535000
      dgroupx(4) := daccountx(4);                              <<u.rao>>34540000
      end;                                                     <<u.rao>>34545000
   if dsparms and (daccountx(2)<dgroupx(2)) then               <<u.rao>>34550000
      begin                                                    <<u.rao>>34555000
      cierr(errnum := -altgrpconnectlm);                       <<04790>>34560000
      dgroupx(2) := daccountx(2);                              <<u.rao>>34565000
      end;                                                     <<u.rao>>34570000
   if dsparms.(11:1) and (daccountx<dgroupx) then              <<u.rao>>34575000
      begin                                                    <<u.rao>>34580000
      cierr(errnum := -altgrpfilelimit);                       <<04790>>34585000
      dgroupx := daccountx;                                    <<u.rao>>34590000
      end;                                                     <<u.rao>>34595000
   if dsparms1.(7:1) and                                       <<u.rao>>34600000
         ((lgroup(gcap) lor laccount(acap+1)) <> laccount(acap+1)) then 34605000
      begin  <<capabilities exceed accounts>>                  <<u.rao>>34610000
      cap'denied := 0; << 1st word of capabilities >>          <<00879>>34615000
      cap'denied(1) := lgroup(gcap) xor                        <<00879>>34620000
                       (lgroup(gcap) land laccount(acap+1));   <<00879>>34625000
      cap'err(-altgrpexcap,cap'denied);                        <<00879>>34630000
      lgroup(gcap) := lgroup(gcap) land laccount(acap+1);      <<u.rao>>34635000
      end;                                                     <<u.rao>>34640000
   if vsspecified then                                         <<rv.pv>>34645000
   begin <<vs specified>>                                      <<rv.pv>>34650000
       if spanspecified or altspecified then                   <<00086>>34655000
       begin                                                   <<00086>>34660000
           mount (bhvsvname, bhvsgname, bhvsaname,             <<rv.pv>>34665000
                  reqtype, 0<<gen>>, pvinfo);                  <<rv.pv>>34670000
           if < then                                           <<rv.pv>>34675000
           begin                                               <<rv.pv>>34680000
               <<translate error in reqtype to cierr>>         <<rv.pv>>34685000
               cierr(errnum:=altgrpvsnotmntd);                 <<04791>>34690000
               return;                                         <<rv.pv>>34695000
           end;                                                <<rv.pv>>34700000
       end;<<will need to dismount later>>                     <<rv.pv>>34705000
       tos := 0;  tos.(endlevelf) := grouplevel;               <<rv.pv>>34710000
       if (tos := direcfind (s0,0d,account,group,              <<38.pv>>34715000
                             arrdb0,ntry)) <> 0d then          <<rv.pv>>34720000
       begin <<object group not found>>                        <<rv.pv>>34725000
           cydirerr' (*,%120000,errnum);                       <<rv.pv>>34730000
           del;                                                <<rv.pv>>34735000
           relresources;                                       <<rv.pv>>34740000
           return;                                             <<rv.pv>>34745000
       end;                                                    <<rv.pv>>34750000
       glinkage' := numnames <> 0  <<sets or resets pvf>>      <<00086>>34755000
                    land not altspecified;                     <<00086>>34760000
       if ntry (glinkage).(pvf) = pv then                      <<rv.pv>>34765000
        if ntry (gmountrefcntr) > 0 then                       <<rv.pv>>34770000
        begin <<currently bound to hvs>>                       <<rv.pv>>34775000
            <<cannot be done while bound to hvs>>              <<rv.pv>>34780000
            cierr(errnum:=altgrpbound);                        <<04791>>34785000
            relresources;                                      <<rv.pv>>34790000
            return;                                            <<rv.pv>>34795000
        end                                                    <<rv.pv>>34800000
        else                                                   <<rv.pv>>34805000
       else                                                    <<rv.pv>>34810000
        if glinkage' then <<assinging to a non-sysvs>>         <<rv.pv>>34815000
         if dgdfscount > 0d then                               <<rv.pv>>34820000
         begin <<cannot assign while file tree not null>>      <<rv.pv>>34825000
             cierr(errnum:=altgrpfdomain);                     <<04791>>34830000
             relresources;                                     <<rv.pv>>34835000
             return;                                           <<rv.pv>>34840000
         end;                                                  <<rv.pv>>34845000
       group (glinkage) := glinkage' land %100000;             <<rv.pv>>34850000
       move group (ghvsaname):=vscomm (vshaname), (namesize*3);<<rv.pv>>34855000
        if not altspecified then                                        34860000
        begin                                                           34865000
       tos := glinkage & lsr (4);                              <<rv.pv>>34870000
       tos := dsparms (s0);                                    <<rv.pv>>34875000
       x := glinkage land %17;                                 <<rv.pv>>34880000
       assemble (tsbc 0,x); <<set specmask for glinkage>>      <<rv.pv>>34885000
       assemble (xch,stax);                                    <<rv.pv>>34890000
       dsparms (x) := tos;                                     <<rv.pv>>34895000
        end;                                                            34900000
   end;<<of vsspecified>>                                      <<rv.pv>>34905000
   <<now actually attempt modification>>                       <<rv.pv>>34910000
   tos := 0;                                                   <<u.rao>>34915000
   tos.(tolevelf) := grouplevel;                               <<u.rao>>34920000
   tos.(endlevelf) := grouplevel;                              <<u.rao>>34925000
   tos := direcscan (s0,0d,account,group,arrdb0,cyaltorg,      <<00086>>34930000
             dsparms,if altspecified then mvtabx else 0);      <<00086>>34935000
   if <> then                                                  <<u.rao>>34940000
      begin  <<directory problem>>                             <<u.rao>>34945000
      if (ds1 = [16/2,16/2]d) and (not altspecified) then      <<00855>>34950000
         suddendeath(505);  << non-existent account >>         <<00855>>34955000
      cydirerr'(*,%120000,errnum);                             <<u.rao>>34960000
      del;                                                     <<rv.pv>>34965000
      end                                                      <<u.rao>>34970000
   else                                                        <<rv.pv>>34975000
   begin                                                       <<rv.pv>>34980000
       ddel; <<return from direcscan>>                         <<rv.pv>>34985000
       if result <> 0 then                                     <<rv.pv>>34990000
       begin                                                   <<rv.pv>>34995000
           del;                                                <<rv.pv>>35000000
           cierr (errnum := altgrpfileactul);                  <<rv.pv>>35005000
       end                                                     <<rv.pv>>35010000
       else                                                    <<rv.pv>>35015000
        if spanspecified then                                  <<rv.pv>>35020000
        begin                                                  <<rv.pv>>35025000
            group (gdfscount) := 0;  group (x:=x+1) := 0;      <<rv.pv>>35030000
            group (gcpucount) := 0;  group (x:=x+1) := 0;      <<00086>>35035000
            group (gcontimecount) := 0; group (x:=x+1) := 0;   <<rv.pv>>35040000
            group (glinkage) := 0;                             <<rv.pv>>35045000
            tos.(tolevelf) := 0;                               <<rv.pv>>35050000
            tos := direcinsert (s0,0d,account,group,arrdb0,    <<38.pv>>35055000
                                group (gfipntr),mvtabx);       <<rv.pv>>35060000
            if <> then                                         <<rv.pv>>35065000
            begin <<insert error on non-sysvs directory>>      <<rv.pv>>35070000
                cydirerr' (*,%167000,errnum);                  <<rv.pv>>35075000
                del;                                           <<rv.pv>>35080000
                cierr (errnum := -xxxgrpspanfaild)             <<04790>>35085000
            end else assemble (ddel,del);                      <<rv.pv>>35090000
        end <<of spanspecified>> else del;                     <<rv.pv>>35095000
   end;                                                        <<rv.pv>>35100000
   relresources;                                               <<00086>>35105000
   end;                                                        <<u.rao>>35110000
end;  <<cxaltgroup>>                                           <<u.rao>>35115000
procedure cxaltuser executorhead;                                       35120000
   option privileged,uncallable;                                        35125000
begin                                                                   35130000
   logical array     dsparms (0:(usize-1)+specmaskln) = q;     <<rv.pv>>35135000
   integer array     user (*)          = dsparms (specmaskln), <<rv.pv>>35140000
                     account (0:asize-1);                      <<01.pv>>35145000
   byte array        baccount (*)      = account;                       35150000
   byte array        buser (*)         = user,                          35155000
                     bme (0:7);                                         35160000
   double            cap;                                               35165000
   logical array     luserx (*)        = user (ucap),          <<01.pv>>35170000
                     laccountx (*)     = account (acap);       <<01.pv>>35175000
                                                               <<00879>>35180000
   integer array     cap'denied(0:1);                          <<00879>>35185000
                                                                        35190000
<< >>                                                                   35195000
if cyorgcoms' (errnum,parmnum,parmsp,userlevel,user,,dsparms) then      35200000
   begin  <<parameter list parsed ok>>                         <<u.rao>>35205000
   who ( , cap, , bme, , baccount);                                     35210000
   if dsparms.(4:2) <> 0 then                                  <<01319>>35215000
   begin     << changes to the user's capabilities.   >>       <<01319>>35220000
                                                               <<01319>>35225000
                                                               <<01319>>35230000
      if ( buser = "MANAGER " land baccount = "SYS " ) and     <<01319>>35235000
           luserx.(0:1) <> 1    then                           <<01319>>35240000
      begin  << attempt to remove "SM" from manager.sys.   >>  <<01319>>35245000
         cierr( errnum := altumgrsmcap );                      <<01319>>35250000
         return;                                               <<01319>>35255000
      end;                                                     <<01319>>35260000
                                                               <<01319>>35265000
      if bme = buser,(8)  and  luserx.(1:1) <> 1  then         <<01319>>35270000
      begin  << attempt to remove "AM" from caller.        >>  <<01319>>35275000
         cierr( errnum := altumgramcap );                      <<01319>>35280000
         return;                                               <<01319>>35285000
      end;                                                     <<01319>>35290000
                                                               <<01319>>35295000
   end;                                                        <<01319>>35300000
                                                               <<01319>>35305000
   tos := 0; tos.(endlevelf) := accountlevel;                  <<01.pv>>35310000
   if direcfind (s0, 0d, account, arrdb0, arrdb0,              <<38.pv>>35315000
                 account) <> 0d then                           <<01.pv>>35320000
   suddendeath(504);                                                    35325000
   del;                                                        <<01.pv>>35330000
   if dsparms.(4:1) then  <<ucap changed, check>>              <<u.rao>>35335000
      begin   <<against account cap>>                          <<u.rao>>35340000
      tos := luserx lor laccountx;                             <<u.rao>>35345000
      tos := luserx(1) lor laccountx(1);                       <<u.rao>>35350000
      tos := laccountx;                                        <<u.rao>>35355000
      tos := laccountx(1);                                     <<u.rao>>35360000
      assemble(dcmp);  <<compare 2 cap masks>>                 <<u.rao>>35365000
      if <> then   <<user given too high cap>>                 <<u.rao>>35370000
         begin  <<force to account caps>>                      <<u.rao>>35375000
         cap'denied := luserx xor (luserx land laccountx);     <<00879>>35380000
         cap'denied(1) := luserx(1) xor                        <<00879>>35385000
                          (luserx(1) land laccountx(1));       <<00879>>35390000
         cap'err(-altusercaps,cap'denied);                     <<00879>>35395000
         luserx := laccountx land luserx;  <<intersection>>    <<u.rao>>35400000
         luserx(1) := laccountx(1) land luserx(1);             <<u.rao>>35405000
         end                                                   <<u.rao>>35410000
      end;   <<check of user capabilities>>                    <<u.rao>>35415000
   if dsparms.(6:1) then <<user loc attr changed, check>>      <<u.rao>>35420000
      begin   <<against account loc attributes>>               <<u.rao>>35425000
      tos := luserx(2) lor laccountx(2);                       <<u.rao>>35430000
      tos := luserx(3) lor laccountx(3);                       <<u.rao>>35435000
      tos := laccountx(2);                                     <<u.rao>>35440000
      tos := laccountx(3);                                     <<u.rao>>35445000
      assemble(dcmp);                                          <<u.rao>>35450000
      if <> then  <<user loc attr exceeds account>>            <<u.rao>>35455000
         begin                                                 <<u.rao>>35460000
         cierr(errnum := -altuserlattr);                       <<04790>>35465000
         luserx(2) := laccountx(2) land luserx(2);             <<u.rao>>35470000
         luserx(3) := laccountx(3) land luserx(3);             <<u.rao>>35475000
         end                                                   <<u.rao>>35480000
      end;                                                     <<u.rao>>35485000
   if dsparms(1).(1:1) then                                             35490000
      if user (umaxjob).(8:8) < account (amaxjobw).(8:8) then  <<01.pv>>35495000
         begin                                                 <<u.rao>>35500000
         cierr(errnum := -altumaxpri);                         <<04790>>35505000
         user(umaxjob).(8:8) := account(amaxjobw).(8:8);       <<u.rao>>35510000
         end;                                                  <<u.rao>>35515000
   tos := 0;                                                   <<01.pv>>35520000
   tos.(tolevelf) := userlevel; tos.(endlevelf) := userlevel;  <<01.pv>>35525000
   tos := direcscan (s0, 0d, account, user, arrdb0,            <<38.pv>>35530000
                     cyaltorg, dsparms);                       <<01.pv>>35535000
   if <> then                                                           35540000
      begin                                                             35545000
      if ds1 = [16/2, 16/2]d then suddendeath(505);                     35550000
      cydirerr'(*,%120000,errnum);                             <<u.rao>>35555000
      end else ddel;                                           <<01.pv>>35560000
   del;                                                        <<01.pv>>35565000
   end;                                                        <<u.rao>>35570000
end;   <<cxaltuser>>                                           <<u.rao>>35575000
procedure cxlistacct executorhead;                             <<u.rao>>35580000
option privileged,uncallable;                                  <<u.rao>>35585000
begin                                                          <<u.rao>>35590000
entry cxlistgroup,                                             <<u.rao>>35595000
      cxlistuser;                                              <<07.km>>35600000
integer dl := commacr;                                         <<u.rao>>35605000
integer numparms,                                              <<04.km>>35610000
        fnum;                                                  <<04.km>>35615000
integer type := accountlevel;                                  <<u.rao>>35620000
integer array slparms(0:sysl'parmlen-1);                      <<00.gen>>35625000
integer array ppresult(*)=slparms(sysl'pprinx);               <<00.gen>>35630000
define p'filenum=  slparms(18) #,                              <<04.km>>35635000
       p'gotentry= slparms(24) #;                              <<03.km>>35640000
double array parms(0:2) = q;                                   <<u.rao>>35645000
byte pointer leaf = parms;                                     <<u.rao>>35650000
byte leafnamelen = parms+1;                                    <<u.rao>>35655000
byte pointer listfile = parms+2;                               <<u.rao>>35660000
byte listfilelen = parms+3;                                    <<u.rao>>35665000
byte pointer extraparm = parms+4;                              <<u.rao>>35670000
array datebuf(0:13);  <<for time stamp if required>>           <<02.ro>>35675000
integer dev := 0;  <<device type if listfile specified>>       <<03.ro>>35680000
byte pointer delim;                                           <<00.gen>>35685000
array qarray(*) = q + 0;                                       <<06585>>35690000
integer pcbglobloc;                                            <<06585>>35695000
pointer ucapptr;                                               <<06585>>35700000
$include inclcap              ;                                <<06585>>35705000
                                                               <<u.rao>>35710000
subroutine listfserr;  <<handles file system errors>>          <<u.rao>>35715000
begin                                                          <<u.rao>>35720000
ferror'(fnum,parmnum);                                         <<00582>>35725000
cierr(errnum := listffserr,,%10000,parmnum);                   <<u.rao>>35730000
fclose(fnum,0,0);                                              <<00582>>35735000
assemble(exit 3);  <<bail out>>                                <<u.rao>>35740000
end;                                                           <<u.rao>>35745000
                                                               <<u.rao>>35750000
   goto start;  <<newacct entry>>                              <<u.rao>>35755000
                                                               <<u.rao>>35760000
cxlistgroup:                                                   <<u.rao>>35765000
   type := grouplevel;                                         <<u.rao>>35770000
   goto start;                                                 <<u.rao>>35775000
                                                               <<u.rao>>35780000
cxlistuser:                                                    <<u.rao>>35785000
   type := userlevel;                                          <<u.rao>>35790000
   goto start;                                                 <<u.rao>>35795000
                                                               <<u.rao>>35800000
   type := vsdeflevel;                                         <<u.rao>>35805000
   goto start;                                                 <<u.rao>>35810000
                                                               <<u.rao>>35815000
start:                                                         <<u.rao>>35820000
                                                               <<u.rao>>35825000
mycommand(parmsp,dl,3,numparms,parms);                         <<u.rao>>35830000
parmnum := 1;                                                  <<u.rao>>35835000
if not produceparms(type,parmsp,ppresult,delim,errnum)        <<00.gen>>35840000
   then return;                                               <<00.gen>>35845000
if numparms > 0 then                                           <<u.rao>>35850000
   begin  <<check out parms>>                                  <<u.rao>>35855000
   if @delim < integer(leafnamelen)+@leaf then                <<00.gen>>35860000
      begin  <<extraneous stuff in leaf name>>                 <<u.rao>>35865000
      tos := errnum := listacctextran;                         <<u.rao>>35870000
      tos := @delim;                                          <<00.gen>>35875000
      cierr(*,*);                                              <<u.rao>>35880000
      return;                                                  <<u.rao>>35885000
      end;                                                     <<u.rao>>35890000
   if leafnamelen > 0 then  <<some name specified>>            <<u.rao>>35895000
      begin  <<check for sm capability>>                       <<u.rao>>35900000
      pxglobal;                                                <<06585>>35905000
      @ucapptr := @pxg'userattributes;                         <<06585>>35910000
      if ucapsm <> 1 then                                      <<06585>>35915000
         if checkhomeacct(ppresult) >= 3 then                  <<u.rao>>35920000
            begin                                              <<u.rao>>35925000
            if = then errnum := listacctnotat                  <<u.rao>>35930000
                 else errnum := listacctsmlogon;               <<u.rao>>35935000
            cierr(errnum, leaf);                               <<u.rao>>35940000
            return                                             <<u.rao>>35945000
            end;                                               <<u.rao>>35950000
      end;                                                     <<u.rao>>35955000
   if numparms > 1 then  <<check for list file>>               <<u.rao>>35960000
      if listfilelen = 0 then                                  <<u.rao>>35965000
         begin                                                 <<u.rao>>35970000
         parmnum := 2;                                         <<u.rao>>35975000
         cierr(errnum := listacctxpctlst, listfile);           <<u.rao>>35980000
         return                                                <<u.rao>>35985000
         end;                                                  <<u.rao>>35990000
   if numparms > 2 then                                        <<u.rao>>35995000
      begin  <<too many parameters>>                           <<u.rao>>36000000
      parmnum := 3;                                            <<u.rao>>36005000
      cierr(errnum := listacct2mp, extraparm);                 <<u.rao>>36010000
      return                                                   <<u.rao>>36015000
      end;                                                     <<u.rao>>36020000
   end;  <<parse of parameters>>                               <<u.rao>>36025000
if type = accountlevel then  <<check for proper default>>      <<04.ro>>36030000
   begin                                                       <<04.ro>>36035000
   pxglobal;                                                   <<06585>>36040000
   @ucapptr := @pxg'userattributes;                            <<06585>>36045000
   if not ucapsm then << reduce default to logon acct >>       <<06585>>36050000
      if d'aname = "@ " then                                   <<04.ro>>36055000
         begin  <<replace with account name>>                  <<05.ro>>36060000
         who(,,,,,d'aname);                                    <<05.ro>>36065000
         who(,,,,,g'aname);                                    <<05.ro>>36070000
         end;                                                  <<05.ro>>36075000
   end;                                                        <<05.ro>>36080000
<<now open list file>>                                         <<u.rao>>36085000
if numparms = 2 then  <<listfile name present>>                <<u.rao>>36090000
   begin                                                       <<03.ro>>36095000
   fnum := fopen(listfile, %504, %102, 36);                    <<04.km>>36100000
   if carry then listfserr;                                    <<03.ro>>36105000
   fgetinfo(fnum,,,,,dev);  <<get device type info>>           <<04.km>>36110000
   if carry then listfserr;                                    <<03.ro>>36115000
   end                                                         <<03.ro>>36120000
else                                                           <<u.rao>>36125000
   fnum := 2;  <<default of $stdlist (but no open)>>           <<04.km>>36130000
<<if not interactive or user supplied a list file, >>          <<02.ro>>36135000
<<time stamp the output of the procedure>>                     <<02.ro>>36140000
pxglobal;                                                      <<06585>>36145000
if pxg'interactive <> 1 and numparms <> 2 or                   <<06585>>36150000
   numparms = 2 and dev.(8:8) >= 8 <<not disc>> then           <<03.ro>>36155000
   begin                                                       <<02.ro>>36160000
   date'line(datebuf);                                         <<02.ro>>36165000
   fwrite(fnum, datebuf, -27, %60);                            <<04.km>>36170000
   end;                                                        <<02.ro>>36175000
                                                               <<02.ro>>36180000
slparms(1) := 0;                                               <<u.rao>>36185000
slparms (22) := d'type;                                       <<00.gen>>36190000
slparms (23) := 0;         <<glinkage initialization>>         <<rv.pv>>36195000
slparms(savebuffindex) := 0;  << see syslist >>                <<04178>>36200000
slparms(savebuffindex + asize + 1) := 0;                       <<04178>>36205000
p'gotentry:=false;                                             <<03.km>>36210000
p'filenum:=fnum;                                               <<04.km>>36215000
tos := 0d;                                                     <<38.pv>>36220000
tos := d'type;                                                <<00.gen>>36225000
tos := d'inx1.(mvtabxf);               <<linkage>>            <<05.gen>>36230000
tos := d'inx2;                         <<indexp>>             <<05.gen>>36235000
tos := direcscan (*,*,d'aname,d'gname,d'fname,                <<00.gen>>36240000
                  syslist,slparms);                           <<00.gen>>36245000
if <> then                                                     <<u.rao>>36250000
   begin  <<directory problem>>                                <<u.rao>>36255000
   if fnum<>2 then  <<not $stdlist, close file>>               <<04.km>>36260000
      begin                                                    <<u.rao>>36265000
      fclose(fnum, 0, 0);                                      <<04.km>>36270000
      if carry then                                            <<u.rao>>36275000
         listfserr;                                            <<u.rao>>36280000
      end;                                                     <<u.rao>>36285000
   cydirerr'(*, %120000, errnum);                              <<u.rao>>36290000
   end                                                         <<u.rao>>36295000
else                                                           <<u.rao>>36300000
   begin  <<went fine, let's get out of here>>                 <<u.rao>>36305000
   if slparms(1)<0 then listfserr;                             <<04.km>>36310000
   if not logical(p'gotentry) then                             <<03.km>>36315000
      begin                                                    <<03.km>>36320000
      cierr(errnum := -noxxxlisted-type);                      <<04790>>36325000
             <<xparent to programmatic call for upward compat>><<03.km>>36330000
      end;                                                     <<03.km>>36335000
   if fnum<>2 then   <<not $stdlist, close list file>>         <<04.km>>36340000
      begin                                                    <<u.rao>>36345000
      fclose(fnum, 1, 0);                                      <<04.km>>36350000
      if carry then                                            <<u.rao>>36355000
         listfserr;                                            <<u.rao>>36360000
      end;                                                     <<u.rao>>36365000
   end                                                         <<u.rao>>36370000
end;  <<cxlistacct/listuser/listgroup/listvsd>>                <<rv.pv>>36375000
$control segment=ciorgman                                      <<u.rao>>36380000
                                                               <<00256>>36385000
                                                               <<00256>>36390000
procedure releasecomrecs(level,btarget);                       <<00256>>36395000
value level;                                                   <<00256>>36400000
integer level;                                                 <<00256>>36405000
byte array btarget;                                            <<00256>>36410000
option uncallable;                                             <<00256>>36415000
   begin                                                       <<00256>>36420000
   comment                                                     <<00256>>36425000
      this procedure returns records in command.pub.sys        <<00256>>36430000
      to the free list. if level = userlevel, the records      <<00256>>36435000
      for this user will be released unless he is trying       <<00256>>36440000
      to purge himself. if level = acctlevel, all entries      <<00256>>36445000
      for this account will be released.                       <<00256>>36450000
      ;                                                        <<00256>>36455000
                                                               <<04792>>36460000
<< note:  the caller is made critical while command.pub.sys  >><<04792>>36465000
<< is locked.  this prevents a breakjob from hanging up      >><<04792>>36470000
<< users logging on or doing setcatalogs.                    >><<04792>>36475000
                                                               <<04792>>36480000
   equate                                                      <<00256>>36485000
      comrecsize   = 20,                                       <<00256>>36490000
      comrecsizem1 = comrecsize -1,                            <<00256>>36495000
      comlink      = 0,                                        <<00256>>36500000
      eoffound     = 5;                                        <<00256>>36505000
   array rec(0:comrecsizem1);                                  <<00256>>36510000
   byte array                                                  <<00256>>36515000
      buser(0:7),                                              <<00256>>36520000
      bacct(0:7);                                              <<00256>>36525000
   logical                                                     <<00256>>36530000
      oldcrit,                                                 <<04792>>36535000
      unlockok,                                                <<04792>>36540000
      comfilelocked,                                           <<00256>>36545000
      comfileopen,                                             <<00256>>36550000
      moreentries;                                             <<00256>>36555000
   integer                                                     <<00256>>36560000
      comfn,                                                   <<00256>>36565000
      errno,                                                   <<00256>>36570000
      headrec := 0,                                            <<00884>>36575000
      err;                                                     <<00256>>36580000
                                                               <<00256>>36585000
   subroutine error(errno);                                    <<00256>>36590000
   value errno; integer errno;                                 <<00256>>36595000
      begin                                                    <<00256>>36600000
      fcheck(comfn,err);                                       <<00256>>36605000
      genmsg(fserrormsgset,err);                               <<00256>>36610000
      genmsg(cierrmsgset,errno);                               <<00256>>36615000
      end;  << error >>                                        <<00256>>36620000
                                                               <<00256>>36625000
   subroutine opencomfile;                                     <<00256>>36630000
      begin                                                    <<00256>>36635000
      move rec := "COMMAND.PUB.SYS ";                          <<00256>>36640000
      comfn := fopen(rec,1,%346);  <<old,shr,lock,exec>>       <<00256>>36645000
      if <> then                                               <<00256>>36650000
         begin                                                 <<00256>>36655000
         error(comopenfail);                                   <<00256>>36660000
         go outl;                                              <<00256>>36665000
         end                                                   <<00256>>36670000
      else comfileopen:=true;                                  <<00256>>36675000
      end;  << opencomfile >>                                  <<00256>>36680000
                                                               <<00256>>36685000
   subroutine closecomfile;                                    <<00256>>36690000
      begin                                                    <<00256>>36695000
      fclose(comfn,0,0);                                       <<00256>>36700000
      end;  << closecomfile >>                                 <<00256>>36705000
                                                               <<00256>>36710000
   subroutine lockcomfile;                                     <<00256>>36715000
      begin                                                    <<00256>>36720000
      oldcrit := setcritical;                                  <<04792>>36725000
      flock(comfn,true);  <<unconditional>>                    <<00256>>36730000
      if <> then                                               <<00256>>36735000
         begin                                                 <<00256>>36740000
         error(comlockfail);                                   <<00256>>36745000
         go outl;                                              <<00256>>36750000
         end                                                   <<00256>>36755000
      else comfilelocked := true;                              <<00256>>36760000
      end;  << lockcomfile >>                                  <<00256>>36765000
                                                               <<00256>>36770000
   subroutine unlockcomfile;                                   <<00256>>36775000
      begin                                                    <<00256>>36780000
      funlock(comfn);                                          <<00256>>36785000
      if <> then unlockok := false                             <<04792>>36790000
            else unlockok := true;                             <<04792>>36795000
      resetcritical( oldcrit );                                <<04792>>36800000
      if not unlockok then                                     <<04792>>36805000
         begin                                                 <<00256>>36810000
         error(comunlockfail);                                 <<00256>>36815000
         go out;                                               <<00256>>36820000
         end;                                                  <<00256>>36825000
      end;  << unlockcomfile >>                                <<00256>>36830000
                                                               <<00256>>36835000
   subroutine releaserecs;                                     <<00256>>36840000
      begin                                                    <<00256>>36845000
      << this subroutine returns all records held by a user >> <<00256>>36850000
      << in command.pub.sys to the free list. >>               <<00256>>36855000
                                                               <<00256>>36860000
      if comfn <> 0 then                                       <<00256>>36865000
         do begin                                              <<00256>>36870000
            freaddir(comfn,rec,comrecsize,double(headrec));    <<00256>>36875000
            if <> then error (comreadfail);                    <<00256>>36880000
            relcomrec(comfn,headrec,errno);                    <<00256>>36885000
            comfilelocked := false;  << relcomrec unlocks it >><<00256>>36890000
            if errno <> 0 then error(errno);                   <<00256>>36895000
            headrec := rec(comlink);                           <<00256>>36900000
            end                                                <<00256>>36905000
         until headrec = 0;                                    <<00256>>36910000
      end;  << releaserecs >>                                  <<00256>>36915000
                                                               <<00256>>36920000
   <<  releasecomrecs  main  body  >>                          <<00256>>36925000
                                                               <<00256>>36930000
   comfileopen:=comfilelocked:=false;                          <<00256>>36935000
                                                               <<00256>>36940000
   if level = accountlevel then                                <<00256>>36945000
      begin                                                    <<00256>>36950000
      opencomfile;                                             <<00256>>36955000
      moreentries := true;                                     <<00256>>36960000
      headrec := 0;                                            <<00256>>36965000
      do begin                                                 <<00256>>36970000
         lockcomfile;                                          <<00256>>36975000
         headrec := headrec + 1;  << move record ptr to next >><<00256>>36980000
         searchcomfile(comfn,,btarget,headrec,,errno);         <<00884>>36985000
         if errno = 0 then                                     <<00256>>36990000
            releaserecs     << return records to free list >>  <<00256>>36995000
         else                                                  <<00256>>37000000
         if errno = eoffound then                              <<00256>>37005000
            moreentries :=false                                <<00256>>37010000
         else                                                  <<00256>>37015000
            error(errno);                                      <<00256>>37020000
         end                                                   <<00256>>37025000
      until not moreentries;                                   <<00256>>37030000
      end                                                      <<00256>>37035000
                                                               <<00256>>37040000
   else                                                        <<00256>>37045000
   if level = userlevel then                                   <<00256>>37050000
      begin                                                    <<00256>>37055000
      who(,,,buser,,bacct);                                    <<00256>>37060000
      if buser <> btarget,(8) then                             <<00256>>37065000
         begin                                                 <<00256>>37070000
         opencomfile;                                          <<00256>>37075000
         lockcomfile;                                          <<00256>>37080000
         searchcomfile(comfn,btarget,bacct,headrec,,errno);    <<00884>>37085000
         if errno = 0 then                                     <<00256>>37090000
            releaserecs                                        <<00256>>37095000
         else                                                  <<00256>>37100000
         if errno <> eoffound then                             <<00256>>37105000
            error(errno);                                      <<00256>>37110000
         end;                                                  <<00256>>37115000
      end;                                                     <<00256>>37120000
                                                               <<00256>>37125000
   outl:   <<  exit for errors  >>                             <<00256>>37130000
   if comfilelocked then unlockcomfile;                        <<00256>>37135000
   out:    <<  exit for unlock fail >>                         <<00256>>37140000
   if comfileopen then closecomfile;                           <<00256>>37145000
                                                               <<00256>>37150000
   end;  << releasecomrecs >>                                  <<00256>>37155000
                                                               <<00256>>37160000
procedure cxpurgeacct executorhead;                            <<00256>>37165000
option privileged,uncallable;                                  <<u.rao>>37170000
begin                                                          <<u.rao>>37175000
entry cxpurgeuser,                                             <<u.rao>>37180000
      cxpurgegroup,                                            <<rv.pv>>37185000
      cxpurgevset;                                             <<rv.pv>>37190000
                                                               <<u.rao>>37195000
<<variables for the parse>>                                    <<u.rao>>37200000
double dl := [8/";", 8/"=", 8/",", 8/%15] d;                   <<rv.pv>>37205000
double array parms (0:3) = q;                                  <<rv.pv>>37210000
byte save'byte;                                                <<01034>>37215000
byte pointer parm;   <<points to start of current parameter>>  <<rv.pv>>37220000
integer                                                        <<rv.pv>>37225000
    nextdelim,  <<holds dl index of next delimiter>>           <<rv.pv>>37230000
    parmlen,    <<length of current parameter>>                <<rv.pv>>37235000
    parmptr = parm;                                            <<rv.pv>>37240000
byte pointer extraparm = parms+6;                              <<rv.pv>>37245000
integer numparms;                                              <<u.rao>>37250000
logical embededspecial;                                        <<u.rao>>37255000
                                                               <<u.rao>>37260000
<<variables for the purge>>                                    <<u.rao>>37265000
integer type := accountlevel;  <<type of purge>>               <<u.rao>>37270000
logical interactive;  <<used for verification message>>        <<u.rao>>37275000
double reply;                                                  <<u.rao>>37280000
byte array breply(*) = reply;                                  <<u.rao>>37285000
integer array target(0:3);                                     <<u.rao>>37290000
byte array btarget(*)=target;                                  <<u.rao>>37295000
integer array account(0:3);                                    <<u.rao>>37300000
byte array baccount(*) = account;                              <<u.rao>>37305000
integer array group (0:3);                                     <<rv.pv>>37310000
byte array bgroup (*) = group;                                 <<rv.pv>>37315000
integer errorbase := fanamebase;                               <<u.rao>>37320000
<<declarations for vs processing>>                             <<rv.pv>>37325000
define purgestatus= s0.(6:2) #;                                <<07.km>>37330000
integer s0= s-0;                                               <<07.km>>37335000
equate                <<indexes in the dl array>>              <<rv.pv>>37340000
    condmount = 3,                                             <<rv.pv>>37345000
    conddismount = 3,                                          <<rv.pv>>37350000
    semicolon = 0,                                             <<rv.pv>>37355000
    equals    = 1;                                             << i.a >>37360000
logical                                                        <<rv.pv>>37365000
    mounted := false,                                          <<rv.pv>>37370000
    reqtype := condmount,                                      <<rv.pv>>37375000
    pvinfo := 0;                                               <<rv.pv>>37380000
define                                                         <<rv.pv>>37385000
       mvtabx   = pvinfo.(4:4) #;                              << i.a >>37390000
array                                                          <<rv.pv>>37395000
    vsrefname (0:(namesize*3)-1),                              <<rv.pv>>37400000
    vsvname (*) = vsrefname,                                   <<rv.pv>>37405000
    vsgname (*) = vsvname (namesize),                          <<rv.pv>>37410000
    vsaname (*) = vsgname (namesize);                          <<rv.pv>>37415000
                                                               <<rv.pv>>37420000
subroutine next;                                               <<rv.pv>>37425000
    <<this subroutine simply decomposes the data returned by>> <<rv.pv>>37430000
    <<mycommand into individual items for the next parameter>> <<rv.pv>>37435000
    begin                                                      <<rv.pv>>37440000
        tos := parms (parmnum);                                <<rv.pv>>37445000
embededspecial := s0.(10:1);  <<embedded special bit from mycom<<u.rao>>37450000
        nextdelim := s0.(11:5);                                <<rv.pv>>37455000
        parmlen := tos & lsr (8);                              <<rv.pv>>37460000
        parmptr := tos;                                        <<rv.pv>>37465000
        parmnum := parmnum + 1;                                <<rv.pv>>37470000
    end;  <<subroutine next>>                                  <<rv.pv>>37475000
                                                               <<u.rao>>37480000
goto start;  <<purgeaccount stuff already initialized>>        <<u.rao>>37485000
                                                               <<u.rao>>37490000
cxpurgegroup:                                                  <<u.rao>>37495000
   type := grouplevel;                                         <<u.rao>>37500000
   errorbase := fgnamebase;                                    <<u.rao>>37505000
   go to start;                                                <<u.rao>>37510000
                                                               <<u.rao>>37515000
cxpurgeuser:                                                   <<u.rao>>37520000
   type := userlevel;                                          <<u.rao>>37525000
   errorbase := usernamebase;                                  <<u.rao>>37530000
   go to start;                                                <<rv.pv>>37535000
cxpurgevset:                                                   <<rv.pv>>37540000
   type := vsdeflevel;                                         <<rv.pv>>37545000
   errorbase := vsdnamebase;                                   <<rv.pv>>37550000
                                                               <<u.rao>>37555000
start:                                                         <<u.rao>>37560000
                                                               <<u.rao>>37565000
mycommand (parmsp,dl,4,numparms,parms);                        <<rv.pv>>37570000
parmnum := 0;                                                  <<rv.pv>>37575000
next;                                                          <<rv.pv>>37580000
if type > userlevel and numparms > 1 or numparms > 3 then      <<rv.pv>>37585000
   begin                                                       <<u.rao>>37590000
   parmnum := 2;                                               <<u.rao>>37595000
   cierr(errnum := purgegroup2mp-1+type, extraparm);           <<u.rao>>37600000
   end                                                         <<u.rao>>37605000
else if numparms < 1 then <<requires at least one parm>>       <<rv.pv>>37610000
   cierr(errnum := errorbase+2, parmsp(1))                     <<u.rao>>37615000
else if integer (parmlen) > 8 then                             <<rv.pv>>37620000
   cierr(errnum := errorbase+3, parm)                          <<rv.pv>>37625000
else if parm <> alpha then  <<name starts with nonalpha>>      <<rv.pv>>37630000
   cierr (errnum := errorbase+1, parm)                         <<rv.pv>>37635000
else if embededspecial then                                    <<u.rao>>37640000
   cierr(errnum := errorbase+5, parm)                          <<u.rao>>37645000
else                                                           <<u.rao>>37650000
   begin                                                       <<u.rao>>37655000
   target := "  ";                                             <<u.rao>>37660000
   move target(1) := target,(3);                               <<u.rao>>37665000
   account := "  ";                                            <<u.rao>>37670000
   move account(1) := account,(3);                             <<u.rao>>37675000
   move btarget := parm, (integer (parmlen));                  <<rv.pv>>37680000
   who (interactive,,,,bgroup,baccount);                       <<rv.pv>>37685000
   if interactive then                                         <<u.rao>>37690000
      do begin  <<verify purge>>                               <<u.rao>>37695000
         reply := "NO  ";                                      <<u.rao>>37700000
            save'byte := parm(integer(parmlen));               <<01034>>37705000
         parm(integer(parmlen)) := 0; <<stopper for genmsg>>   <<00832>>37710000
         genmsg(cigeneralmsgset,purgegroupq-1+type,            <<u.rao>>37715000
            0,parmptr,,,,,,,,,%100000);                        <<rv.pv>>37720000
            parm(integer(parmlen)) := save'byte;<<put it back>><<01034>>37725000
         read(reply,-4);                                       <<u.rao>>37730000
         if <> then << eof or io error on $stdin >>            <<00832>>37735000
            begin   << abort purge >>                          <<00832>>37740000
            if < then cierr(errnum := errstdinio);             <<04790>>37745000
            return;                                            <<00832>>37750000
            end;                                               <<00832>>37755000
         move breply := breply while as;                       <<u.rao>>37760000
         if reply = "NO  " then return;                        <<u.rao>>37765000
         if reply <> "YES " then cierr(-invldresp);            <<u.rao>>37770000
         end until reply = "YES ";                             <<u.rao>>37775000
                                                               <<u.rao>>37780000
   if numparms > 1 then                                        <<rv.pv>>37785000
   begin <<vs parameter sequence>>                             <<rv.pv>>37790000
       if nextdelim <> semicolon then                          <<rv.pv>>37795000
       begin                                                   <<rv.pv>>37800000
           cierr (errnum := orgcomxpctkeywd,parm (1));         <<rv.pv>>37805000
           return;                                             <<rv.pv>>37810000
       end;                                                    <<rv.pv>>37815000
       next;                                                   <<rv.pv>>37820000
       if parm = "VS" and parmlen = 2 then else                <<rv.pv>>37825000
       begin                                                   <<rv.pv>>37830000
           cierr (errnum := orgcomxpctkeywd,parm);             <<rv.pv>>37835000
           return;                                             <<rv.pv>>37840000
       end;                                                    <<rv.pv>>37845000
       if nextdelim <> equals then                             <<rv.pv>>37850000
       begin                                                   <<rv.pv>>37855000
           cierr (errnum := orgcomxpctequals,parm (1));        <<rv.pv>>37860000
           return;                                             <<rv.pv>>37865000
       end;                                                    <<rv.pv>>37870000
       vsrefname := "  ";                                      <<rv.pv>>37875000
       move vsrefname (1) := vsrefname, ((namesize*3)-1);      <<rv.pv>>37880000
       move vsvname := "@   "; <<set up default>>              <<rv.pv>>37885000
       next;                                                   <<rv.pv>>37890000
       tos := check'n'movename (parm,parmlen,vsrefname,4,3);   <<rv.pv>>37895000
       if <> then                                              <<rv.pv>>37900000
       begin                                                   <<rv.pv>>37905000
           cierr (errnum := tos+vcsrefbase,parm);              <<rv.pv>>37910000
           return;                                             <<rv.pv>>37915000
       end;                                                    <<rv.pv>>37920000
       case tos of                                             <<rv.pv>>37925000
       begin                                                   <<rv.pv>>37930000
           who (,,,,vsgname,vsaname); <<0 names supplied>>     <<rv.pv>>37935000
           who (,,,,vsgname,vsaname); <<1 name supplied>>      <<rv.pv>>37940000
           who (,,,,,vsaname);        <<2 names supplied>>     <<rv.pv>>37945000
           ;                          <<all names supplied>>   <<rv.pv>>37950000
       end;                                                    <<rv.pv>>37955000
       mount (vsvname,vsgname,vsaname,reqtype,0<<gen>>,pvinfo);<<rv.pv>>37960000
       if < then                                               <<rv.pv>>37965000
       begin                                                   <<rv.pv>>37970000
           cierr (errnum := altgrpvsnotmntd);                  <<rv.pv>>37975000
           return;                                             <<rv.pv>>37980000
       end;                                                    <<rv.pv>>37985000
       mounted := true;                                        <<rv.pv>>37990000
   end;<<of vs sequence>>                                      <<rv.pv>>37995000
   <<now do purge>>                                            <<u.rao>>38000000
   tos := 0d;   <<result space for direcpurge>>                <<u.rao>>38005000
   tos := 0;  tos.(endlevelf) := type;  <<kind of purge>>      <<u.rao>>38010000
   tos := 0d;  <<null index>>                                  <<38.pv>>38015000
   if type = accountlevel then                                 <<u.rao>>38020000
      begin                                                    <<u.rao>>38025000
      tos := @target;                                          <<u.rao>>38030000
      tos := 0;  <<group name is null>>                        <<u.rao>>38035000
      tos := 0;  <<third name is null>>                        <<rv.pv>>38040000
      end                                                      <<u.rao>>38045000
   else                                                        <<u.rao>>38050000
    if type = grouplevel or type = userlevel then              <<rv.pv>>38055000
      begin  <<get logon account too>>                         <<u.rao>>38060000
      tos := @account;                                         <<u.rao>>38065000
      tos := @target; <<group name>>                           <<rv.pv>>38070000
      tos := 0;       <<third name is null>>                   <<rv.pv>>38075000
      end                                                      <<rv.pv>>38080000
    else                                                       <<rv.pv>>38085000
    begin <<type is vsdeflevel or vslistlevel>>                <<rv.pv>>38090000
        tos := @account;                                       <<rv.pv>>38095000
        tos := @group;                                         <<rv.pv>>38100000
        tos := @target;                                        <<rv.pv>>38105000
    end;                                                       <<rv.pv>>38110000
   tos := direcpurge (*,*,*,*,*,mvtabx);                       <<rv.pv>>38115000
                                                               <<07.km>>38120000
   push(status);                                               <<07.km>>38125000
                                                               <<00256>>38130000
   if mounted then                                             <<rv.pv>>38135000
   begin                                                       <<rv.pv>>38140000
       reqtype := conddismount;                                <<rv.pv>>38145000
       dismount (vsvname,vsgname,vsaname,reqtype);             <<rv.pv>>38150000
       if <> and purgestatus=cce then                          <<07.km>>38155000
       begin                                                   <<rv.pv>>38160000
           cierr (errnum := 0<<dismount problem>>);            <<rv.pv>>38165000
           return;                                             <<rv.pv>>38170000
       end;                                                    <<rv.pv>>38175000
   end;<<of mounted>>                                          <<rv.pv>>38180000
   set(status);                                                <<07.km>>38185000
                                                               <<07.km>>38190000
<< if purge suceeded then take out command.pub.sys records >>  <<01096>>38195000
                                                               <<01096>>38200000
if <> then cydirerr'(*,%120400,errnum)                         <<01096>>38205000
else                                                           <<01096>>38210000
   releasecomrecs(type,btarget);                               <<01096>>38215000
   end;                                                        <<u.rao>>38220000
end;  <<cxpurgeacct, cxpurgegroup, cxpurgeuser>>               <<u.rao>>38225000
$control segment=cisysmgr                                      <<u.rao>>38230000
integer procedure rcreport (element, level, parms, sirinfo);            38235000
   value level, parms, sirinfo;                                << ... >>38240000
   array element;                                              << ... >>38245000
   integer level;                                                       38250000
   integer parms;                                                       38255000
   double sirinfo;                                                      38260000
   option privileged, uncallable;                                       38265000
begin                                                                   38270000
   define p'gotentry= arrq0(parms+3) #;                        <<04.km>>38275000
   array arrs11(*)= s-11,                                     <<00.gen>>38280000
         arrs16(*)= s-16;                                     <<00.gen>>38285000
   double array      delement (*)      = element;                       38290000
   define            filenum           = arrq0 (parms) #,               38295000
                     writesize         = arrqp1 (parms) #,              38300000
                     complcode         = arrqp2 (parms) #,              38305000
                     binaryoutput      = writesize = 17 #;              38310000
   integer pointer   info;                                              38315000
   integer pointer ppresult;                                  <<00.gen>>38320000
   double pointer    dinfo2;                                            38325000
   integer pointer   buf;                                               38330000
   byte pointer      bbuf,                                              38335000
                     bbuf2,                                             38340000
                     tbbuf;                                             38345000
                                                              <<00.gen>>38350000
                                                              <<00.gen>>38355000
subroutine def'movefromdseg;                                  <<00.gen>>38360000
                                                              <<00.gen>>38365000
                                                                        38370000
   if requestservice then                                               38375000
      begin                                                             38380000
      rcreport:=5;                                                      38385000
      return;                                                           38390000
      end;                                                              38395000
   parms := parms -integer(deltaq);                                     38400000
   tos := level;                                                        38405000
   tos := delement;                                                     38410000
   tos := delement (1);                                                 38415000
   exchangedb(0);                                             <<00.gen>>38420000
   assemble(adds 12);                                         <<00.gen>>38425000
   @info:=@arrs16;                                            <<00.gen>>38430000
   @dinfo2:=@arrs11;                                          <<00.gen>>38435000
   movefromdseg(@dinfo2,ddsdst,                               <<00.gen>>38440000
                @element+(if level=1 then 9 else 14),12);     <<00.gen>>38445000
   tos := sirinfo;                                             <<03.km>>38450000
   if <> then relsir (*, *) else ddel;                         <<03.km>>38455000
                                                              <<00.gen>>38460000
   @ppresult:=@arrq0(parms+rcr'pprinx);                       <<00.gen>>38465000
   if logical(d'type.(allflag)) then                          <<00.gen>>38470000
   begin                                                      <<00.gen>>38475000
     case *level of begin                                     <<00.gen>>38480000
       tos:=-1;                        <<shouldn't happen>>    <<03.km>>38485000
       tos:=dirmatch(g'gname,info(1));                        <<06.gen>>38490000
       tos:=dirmatch(g'aname,info(1));                        <<06.gen>>38495000
       tos:=-1;                        <<shouldn't happen>>    <<03.km>>38500000
       tos:=-1;                        <<shouldn't happen>>    <<03.km>>38505000
     end;                                                     <<00.gen>>38510000
     if tos<>0 then                                           <<00.gen>>38515000
     begin                                                    <<00.gen>>38520000
       rcreport:=if < then nextuncle else nextbrother;         <<03.km>>38525000
       exchangedb(ddsdst);                                    <<00.gen>>38530000
       return;                                                <<00.gen>>38535000
     end;                                                     <<00.gen>>38540000
   end;                                                       <<00.gen>>38545000
                                                              <<00.gen>>38550000
   if binaryoutput then                                                 38555000
      tos := @info                                                      38560000
   else                                                                 38565000
      begin                                                             38570000
      tos := 44;                                                        38575000
      @tbbuf := (@bbuf2 := (@bbuf := (@buf := @s0) &lsl(1)) +21) +45;   38580000
      assemble (adds 0);                                                38585000
      buf := "  ";                                                      38590000
      move buf (1) := buf, (32);                                        38595000
      tos := @buf;                                                      38600000
      if level = 1 then                                                 38605000
         begin                                                          38610000
         bbuf (3) := "/";                                               38615000
         tos := tos +2;                                                 38620000
         end;                                                           38625000
      move * := info (1), (4);                                          38630000
      x := 5;                                                           38635000
      do begin                                                          38640000
         tos := @bbuf2 + (x *9);                                        38645000
         tos := @tbbuf;                                                 38650000
         tos := dascii (dinfo2 (x), 10, bps0);                          38655000
         if s0 > 8 then                                                 38660000
            begin                                                       38665000
            assemble (ddel);                                            38670000
            tos := tos -2;                                              38675000
            move * := "**";                                             38680000
            end                                                         38685000
         else                                                           38690000
            begin                                                       38695000
            s2 := s2 - s0;                                              38700000
            move * := *, (tos);                                         38705000
            end;                                                        38710000
         x := x -1;                                                     38715000
         end                                                            38720000
      until <;                                                          38725000
      tos := @buf;                                                      38730000
      end;                                                              38735000
   if level=grouplevel then p'gotentry:=true;                  <<03.km>>38740000
   tos := filenum;                                                      38745000
                                                               <<00506>>38750000
   assemble (xch);                                                      38755000
   fwrite (*, *, writesize, 0);                                         38760000
   if <> then                                                  <<02365>>38765000
      begin                                                             38770000
      complcode := 1;                                                   38775000
      rcreport := 4;                                                    38780000
      end;                                                              38785000
   exchangedb (ddsdst);                                                 38790000
   end    <<rcreport>>;                                                 38795000
integer procedure checkhomeacct(ppresult);                     <<u.rao>>38800000
integer array ppresult;                                        <<u.rao>>38805000
option privileged, uncallable;                                 <<u.rao>>38810000
begin                                                          <<u.rao>>38815000
<<this procedure checks the parameters of ppresult to verify>> <<u.rao>>38820000
<<that the user has specified his logon account.            >> <<u.rao>>38825000
<<it is used to verify that an account manager is not       >> <<u.rao>>38830000
<<attempting to access an account outside his own, a        >> <<u.rao>>38835000
<<capability restricted to system managers.                 >> <<u.rao>>38840000
<<the procedure returns:                                    >> <<u.rao>>38845000
<<     0 => no errors                                       >> <<u.rao>>38850000
<<     3 => user specified "@" accounts                     >> <<u.rao>>38855000
<<     4 => user specified non-logon account                >> <<u.rao>>38860000
                                                               <<u.rao>>38865000
byte array loacct(0:7);                                        <<u.rao>>38870000
byte array bppresult(*)=ppresult;                             <<00.gen>>38875000
                                                              <<00.gen>>38880000
                                                              <<00.gen>>38885000
checkhomeacct := 0;                                            <<u.rao>>38890000
if d'type.(endlevelfx) = allaccts then                        <<00.gen>>38895000
   checkhomeacct := 3                                          <<u.rao>>38900000
else if d'aname <> "  " then  <<non-null account name>>       <<00.gen>>38905000
   begin                                                       <<u.rao>>38910000
   who(,,,,,loacct);                                           <<u.rao>>38915000
   if d'baname<>loacct,(8) then checkhomeacct:=4;             <<00.gen>>38920000
   end                                                         <<u.rao>>38925000
end;                                                           <<u.rao>>38930000
integer procedure checkhomegroup(ppresult);                    <<u.rao>>38935000
integer array ppresult;                                        <<u.rao>>38940000
option privileged, uncallable;                                 <<u.rao>>38945000
begin                                                          <<u.rao>>38950000
<<this procedure checks the parameters of ppresult to >>       <<u.rao>>38955000
<<verify that the user has specified his logon group  >>       <<u.rao>>38960000
<<the procedure returns:                              >>       <<u.rao>>38965000
<<         0 => no errors detected                    >>       <<u.rao>>38970000
<<         1 => user specified "@" groups             >>       <<u.rao>>38975000
<<         2 => user specified non-logon group        >>       <<u.rao>>38980000
<<         3 => user specified "@" accounts           >>       <<u.rao>>38985000
<<         4 => user specified non-logon account      >>       <<u.rao>>38990000
byte array logrp(0:7);                                         <<u.rao>>38995000
byte array bppresult(*)=ppresult;                             <<00.gen>>39000000
                                                              <<00.gen>>39005000
                                                              <<00.gen>>39010000
checkhomegroup := 0;                                           <<u.rao>>39015000
if d'type.(endlevelfx) = allgroups then                       <<00.gen>>39020000
   checkhomegroup := 1                                         <<u.rao>>39025000
else if d'gname <> "  " then                                  <<00.gen>>39030000
   begin                                                       <<u.rao>>39035000
   who(,,,,logrp);                                             <<u.rao>>39040000
   if d'bgname<>logrp,(8) then                                <<00.gen>>39045000
      checkhomegroup := 2                                      <<u.rao>>39050000
   else                                                        <<u.rao>>39055000
      checkhomegroup := checkhomeacct(ppresult);               <<u.rao>>39060000
   end                                                         <<u.rao>>39065000
end;                                                           <<u.rao>>39070000
procedure cxreport executorhead;                               <<u.rao>>39075000
option privileged,uncallable;                                  <<u.rao>>39080000
begin                                                          <<u.rao>>39085000
$include inclcap              ;                                <<06585>>39090000
byte pointer delim;                                           <<00.gen>>39095000
double dl := [8/";", 8/"=", 8/",", 8/%15] d;                   <<00086>>39100000
integer numparms;  <<returned by mycommand>>                   <<u.rao>>39105000
integer array recipparms(0:rcr'parmlen-1);                    <<00.gen>>39110000
integer array ppresult(*)=recipparms(rcr'pprinx);             <<00.gen>>39115000
define fnum =      recipparms #,                              <<00.gen>>39120000
       writesize = recipparms(1) #,                           <<00.gen>>39125000
       complcode = recipparms(2) #,                            <<03.km>>39130000
       p'gotentry= recipparms(3) #;                            <<03.km>>39135000
double array parms (0:4) = q;                                  <<00129>>39140000
byte pointer parm;   <<points to start of current parameter>>  <<00086>>39145000
define reportstatus= s0.(6:2) #;                               <<00086>>39150000
integer s0= s-0;                                               <<00086>>39155000
integer                                                        <<00086>>39160000
    nextdelim,  <<holds dl index of next delimiter>>           <<00086>>39165000
    parmlen,    <<length of current parameter>>                <<00086>>39170000
    parmptr = parm;                                            <<00086>>39175000
byte pointer leaf = parm;                                      <<00129>>39180000
integer leafnamelen = parmlen;                                 <<00129>>39185000
byte pointer listfile := 0;                                    <<00129>>39190000
integer listfilelen = parmlen;                                 <<00129>>39195000
byte pointer extraparm = parms+8;                              <<00129>>39200000
logical foptions;                                              <<u.rao>>39205000
integer closeoption := 0;                                     <<01067>> 39210000
equate newfile        = 0,                                     <<01067>>39215000
       temp'domain    = 2,                                     <<01067>>39220000
       cur'domain     = 0;                                     <<01067>>39225000
array datebuf(0:13);   <<for time stamp, if required>>         <<02.ro>>39230000
integer dev := 0;  <<device type of listfile>>                 <<03.ro>>39235000
array qarray(*) = q + 0;                                       <<06585>>39240000
integer pcbglobloc;                                            <<06585>>39245000
pointer ucapptr;                                               <<06585>>39250000
<<declarations for vs processing>>                             <<00086>>39255000
equate                <<indexes in the dl array>>              <<00086>>39260000
    condmount = 3,                                             <<00086>>39265000
    conddismount = 3,                                          <<00086>>39270000
    semicolon = 0,                                             <<00086>>39275000
    equals    = 1,                                             <<00086>>39280000
    comma     = 2;                                             << i.a >>39285000
logical                                                        <<00086>>39290000
    mounted := false,                                          <<00086>>39295000
    reqtype := condmount,                                      <<00086>>39300000
    pvinfo := 0;                                               <<00086>>39305000
define                                                         <<00086>>39310000
       mvtabx   = pvinfo.(4:4) #;                              << i.a >>39315000
array                                                          <<00086>>39320000
    vsrefname (0:(namesize*3)-1),                              <<00086>>39325000
    vsvname (*) = vsrefname,                                   <<00086>>39330000
    vsgname (*) = vsvname (namesize),                          <<00086>>39335000
    vsaname (*) = vsgname (namesize);                          <<00086>>39340000
                                                               <<00086>>39345000
subroutine next;                                               <<00086>>39350000
    <<this subroutine simply decomposes the data returned by>> <<00086>>39355000
    <<mycommand into individual items for the next parameter>> <<00086>>39360000
    begin                                                      <<00086>>39365000
        tos := parms (parmnum);                                <<00086>>39370000
        nextdelim := s0.(11:5);                                <<00086>>39375000
        parmlen := tos & lsr (8);                              <<00086>>39380000
        parmptr := tos;                                        <<00086>>39385000
        parmnum := parmnum + 1;                                <<00086>>39390000
    end;  <<subroutine next>>                                  <<00086>>39395000
                                                               <<00086>>39400000
                                                               <<u.rao>>39405000
subroutine listfserr;                                          <<u.rao>>39410000
<<manages list file i/o error>>                                <<u.rao>>39415000
begin                                                          <<u.rao>>39420000
ferror'(fnum,parmnum);                                         <<u.rao>>39425000
cierr(errnum := listffserr,,%10000,parmnum);                   <<u.rao>>39430000
assemble(exit 3);                                              <<u.rao>>39435000
end;                                                           <<u.rao>>39440000
                                                               <<u.rao>>39445000
mycommand (parmsp,dl,4,numparms,parms);                        <<00129>>39450000
parmnum := 0;                                                  <<00129>>39455000
next;                                                          <<00129>>39460000
if not produceparms(1,parmsp,ppresult,delim,errnum)            <<01.km>>39465000
   then return;                                               <<00.gen>>39470000
if numparms>0 and @delim<@leaf(leafnamelen) then               <<01.km>>39475000
   begin                                                       <<01.km>>39480000
   tos := errnum := reportextranleaf;                          <<01.km>>39485000
   tos := @delim;                                              <<01.km>>39490000
   cierr(*,*);                                                 <<01.km>>39495000
   return;                                                     <<01.km>>39500000
   end;                                                        <<01.km>>39505000
                                                               <<01.km>>39510000
if numparms=0 or leafnamelen=0 then                            <<01.km>>39515000
   begin                                                       <<01.km>>39520000
   comment:                                                    <<01.km>>39525000
     no group designator:  "PRODUCEPARMS" set default to       <<01.km>>39530000
     "@.LAN".  this is fine for acct mgr.  for standard        <<01.km>>39535000
     user we want "LGN.LAN".  for sm we want "@.@";            <<01.km>>39540000
                                                               <<01.km>>39545000
   pxglobal;                                                   <<06585>>39550000
   @ucapptr := @pxg'userattributes;                            <<06585>>39555000
   if ucapam <> 1 and ucapsm <> 1 then << std user >>          <<06585>>39560000
      begin                                                    <<01.km>>39565000
      getdirinfo(0,2,ppresult);                                <<01.km>>39570000
      d'type.(endlevelfx):=grouplevel;                         <<01.km>>39575000
      end                                                      <<01.km>>39580000
   else if ucapsm = 1 then  << sys mgr >>                      <<06585>>39585000
      begin                                                    <<01.km>>39590000
      move d'aname:="@       ";                                <<01.km>>39595000
      move g'aname:="@       ";                                <<01.km>>39600000
      d'type.(endlevelfx):=allaccts;                           <<01.km>>39605000
      end;                                                     <<01.km>>39610000
   end                                                         <<01.km>>39615000
else                                                           <<01.km>>39620000
   begin                               <<check caps>>          <<01.km>>39625000
   pxglobal;                                                   <<06585>>39630000
   @ucapptr := @pxg'userattributes;                            <<06585>>39635000
   if ucapam <> 1 and ucapsm <> 1 then << plain user >>        <<06585>>39640000
      begin                                                    <<u.rao>>39645000
      x:=checkhomegroup(ppresult)-1;                           <<01.km>>39650000
      if >= then                                               <<u.rao>>39655000
         begin  <<found error condition>>                      <<u.rao>>39660000
         case x of                                             <<01.km>>39665000
            begin                                              <<u.rao>>39670000
            tos := reportnotamat;                              <<u.rao>>39675000
            tos := reportnotamlogon;                           <<u.rao>>39680000
            tos := reportnotsmat;                              <<u.rao>>39685000
            tos := reportnotsmlogon;                           <<u.rao>>39690000
            end;                                               <<u.rao>>39695000
         errnum := tos;                                        <<u.rao>>39700000
         cierr(errnum, leaf);                                  <<u.rao>>39705000
         return                                                <<u.rao>>39710000
         end;                                                  <<u.rao>>39715000
      end                                                      <<u.rao>>39720000
   else if ucapam=1 and ucapsm = 0 and   << am and not sm >>   <<06585>>39725000
        checkhomeacct(ppresult)>=3 then                        <<06585>>39730000
      begin                            <<wrong acct for am>>   <<01.km>>39735000
      if = then errnum := reportnotsmat                        <<u.rao>>39740000
           else errnum := reportnotsmlogon;                    <<u.rao>>39745000
      cierr(errnum, leaf);                                     <<u.rao>>39750000
      return                                                   <<u.rao>>39755000
      end;                                                     <<u.rao>>39760000
   end;  <<validation of leaf name access>>                    <<u.rao>>39765000
if numparms > 1 then                                           <<00129>>39770000
begin                                                          <<00129>>39775000
    if nextdelim = comma then                                  <<00129>>39780000
    begin                                                      <<00129>>39785000
        next;                                                  <<00129>>39790000
        if listfilelen = 0 then                                <<00129>>39795000
        begin  <<missing list file name>>                      <<00129>>39800000
            parmnum := 2;                                      <<00129>>39805000
            cierr(errnum := reportexpectlist, listfile);       <<00129>>39810000
            return;                                            <<00129>>39815000
        end;                                                   <<00129>>39820000
        @listfile := @parm;                                    <<00129>>39825000
    end else numparms := 3; <<fake>>                           <<00129>>39830000
    if numparms > 2 then                                       <<00129>>39835000
    begin <<vs parameter sequence>>                            <<00129>>39840000
        if nextdelim <> semicolon then                         <<00129>>39845000
        begin                                                  <<00129>>39850000
            cierr (errnum := orgcomxpctkeywd,parm (1));        <<00129>>39855000
            return;                                            <<00129>>39860000
        end;                                                   <<00129>>39865000
        next;                                                  <<00129>>39870000
        if parm = "VS" and parmlen = 2 then else               <<00129>>39875000
        begin                                                  <<00129>>39880000
            cierr (errnum := orgcomxpctkeywd,parm);            <<00129>>39885000
            return;                                            <<00129>>39890000
        end;                                                   <<00129>>39895000
        if nextdelim <> equals then                            <<00129>>39900000
        begin                                                  <<00129>>39905000
            cierr (errnum := orgcomxpctequals,parm (1));       <<00129>>39910000
            return;                                            <<00129>>39915000
        end;                                                   <<00129>>39920000
        vsrefname := "  ";                                     <<00129>>39925000
        move vsrefname (1) := vsrefname, ((namesize*3)-1);     <<00129>>39930000
        move vsvname := "@   "; <<set up default>>             <<00129>>39935000
        next;                                                  <<00129>>39940000
        tos := check'n'movename (parm,parmlen,vsrefname,4,3);  <<00129>>39945000
        if <> then                                             <<00129>>39950000
        begin                                                  <<00129>>39955000
            cierr (errnum := tos+vcsrefbase,parm);             <<00129>>39960000
            return;                                            <<00129>>39965000
        end;                                                   <<00129>>39970000
        case tos of                                            <<00129>>39975000
        begin                                                  <<00129>>39980000
            who (,,,,vsgname,vsaname);<<0 names supplied>>     <<00129>>39985000
            who (,,,,vsgname,vsaname);<<1 name supplied>>      <<00129>>39990000
            who (,,,,,vsaname);       <<2 names supplied>>     <<00129>>39995000
            ;                         <<all names supplied>    <<00129>>40000000
        end;                                                   <<00129>>40005000
        mount (vsvname,vsgname,vsaname,reqtype,                <<00129>>40010000
               -1<<gen>>,pvinfo);                              <<00129>>40015000
        if < then                                              <<00129>>40020000
        begin                                                  <<00129>>40025000
            cierr (errnum := altgrpvsnotmntd);                 <<00129>>40030000
            return;                                            <<00129>>40035000
        end;                                                   <<00129>>40040000
        mounted := true;                                       <<00129>>40045000
    end;<<of vs sequence>>                                     <<00129>>40050000
    if numparms > 4 then                                       <<00129>>40055000
    begin  <<too many parameters>>                             <<00129>>40060000
        parmnum := 5;                                          <<00129>>40065000
        cierr (errnum := report2mp, extraparm);                <<00129>>40070000
        return;                                                <<00129>>40075000
    end;                                                       <<00129>>40080000
end;                                                           <<00129>>40085000
                                                               <<01.km>>40090000
d'type.(hitflag):=1;                                           <<01.km>>40095000
d'type.(startlevelf):=0;                                       <<01.km>>40100000
                                                               <<u.rao>>40105000
<<now open list file, get relevant info, put out header>>      <<u.rao>>40110000
if @listfile <> 0 then  <<listfile present>>                   <<00129>>40115000
   begin  <<must open a real file>>                            <<u.rao>>40120000
   fnum := fopen(listfile,%2504,%101);                         <<01067>>40125000
   if carry then listfserr;  <<open failed>>                   <<u.rao>>40130000
   end                                                         <<u.rao>>40135000
else                                                           <<u.rao>>40140000
   fnum := 2;                                                  <<u.rao>>40145000
fgetinfo(fnum,,foptions,,,dev);                                <<03.ro>>40150000
if carry then listfserr;                                       <<u.rao>>40155000
closeoption.(13:3) := if foptions.(14:2) = newfile then        <<01067>>40160000
                      temp'domain else cur'domain;             <<01067>>40165000
if foptions.(13:1) then  <<ascii file>>                        <<u.rao>>40170000
   begin                                                       <<u.rao>>40175000
   <<if not interactive or if to list file then time stamp>>   <<02.ro>>40180000
   pxglobal;                                                   <<06585>>40185000
   tos := pxg'interactive;                                     <<06585>>40190000
   if not tos  <<not interactive>> and @listfile = 0 or        <<00129>>40195000
      @listfile <> 0 and dev.(8:8) >= 8 <<not disc>> then      <<00129>>40200000
      begin                                                    <<02.ro>>40205000
      date'line(datebuf);                                      <<02.ro>>40210000
      fwrite(fnum, datebuf, -27, %60);                         <<02.ro>>40215000
      end;                                                     <<02.ro>>40220000
   genmsg(cigeneralmsgset,reportline1,,,,,,,-fnum);            <<u.rao>>40225000
   genmsg(cigeneralmsgset,reportline2,,,,,,,-fnum);            <<u.rao>>40230000
   writesize := 33;                                            <<u.rao>>40235000
   end                                                         <<u.rao>>40240000
else writesize := 17;  <<binary>>                              <<u.rao>>40245000
complcode := 0;                                                <<u.rao>>40250000
p'gotentry:=false;                                             <<03.km>>40255000
tos := direcscan(d'type,0d,d'aname,d'gname,arrdb0,            <<00.gen>>40260000
                 rcreport,recipparms,mvtabx);                  <<00086>>40265000
push (status);                                                 <<00086>>40270000
if mounted then                                                <<00086>>40275000
begin                                                          <<00086>>40280000
    reqtype := conddismount;                                   <<00086>>40285000
    dismount (vsvname,vsgname,vsaname,reqtype);                <<00086>>40290000
    if <> and reportstatus = cce then                          <<00086>>40295000
    begin                                                      <<00086>>40300000
        cierr (errnum := 0<<dismount problem>>);               <<00086>>40305000
        return;                                                <<00086>>40310000
    end;                                                       <<00086>>40315000
end;<<of mounted>>                                             <<00086>>40320000
set (status);                                                  <<00086>>40325000
if <> then                                                     <<u.rao>>40330000
   begin                                                       <<u.rao>>40335000
   if fnum <> 2 then                                           <<u.rao>>40340000
      fclose(fnum, 0, 0);                                      <<u.rao>>40345000
   cydirerr'(*,%120000,errnum);                                <<u.rao>>40350000
   return;                                                     <<u.rao>>40355000
   end;                                                        <<u.rao>>40360000
if complcode <> 0 then listfserr;                              <<u.rao>>40365000
if not logical(p'gotentry) then cierr(errnum := -nogrpslisted);<<04790>>40370000
             <<xparent to programmatic call for upward compat>><<04.km>>40375000
if fnum <> 2 then                                              <<u.rao>>40380000
   begin  <<close real file>>                                  <<u.rao>>40385000
   fclose(fnum,closeoption,0);                                 <<01067>>40390000
   if carry then listfserr;                                    <<u.rao>>40395000
   end;                                                        <<u.rao>>40400000
parmnum := 0;                                                  <<u.rao>>40405000
end;  <<cxreport>>                                             <<u.rao>>40410000
$control segment=cialtorg                                      <<u.rao>>40415000
integer procedure rcresetacct (element,level,parms,sirinfo);            40420000
   value level,parms,sirinfo;                                           40425000
   integer level, parms;                                                40430000
   array element;                                                       40435000
   double sirinfo;                                                      40440000
   option uncallable;                                                   40445000
begin                                                                   40450000
   logical array     larrq0(*)         =q-0;                            40455000
   define            flags             = larrq0 (parms) #;              40460000
   logical           dadirty           =db+145;                <<38.pv>>40465000
   parms := parms -integer(deltaq);                                     40470000
   tos := @element + (if level =2 then 18 else 13);                     40475000
   if flags & lsr(1) then                                               40480000
      dps0 := 0d;                                                       40485000
   tos:=tos+4;                                                          40490000
   if flags then                                                        40495000
      dps0 := 0d;                                                       40500000
   dadirty := true;                                                     40505000
   rcresetacct := 1;                                                    40510000
   end  << rcresetacct>>;                                               40515000
procedure cxresetacct executorhead;                                     40520000
   option privileged, uncallable;                                       40525000
begin                                                                   40530000
   <<type word: field lengths>>                                <<01.pv>>40535000
   equate                                                      <<01.pv>>40540000
      hitx   = 1,                                              <<01.pv>>40545000
      tox    = 3,                                              <<01.pv>>40550000
      allx   = 1,                                              <<01.pv>>40555000
      endx   = 3,                                              <<01.pv>>40560000
      startx = 3;                                              <<01.pv>>40565000
   integer           type              := [hitx/true,          <<01.pv>>40570000
                                           tox/grouplevel,     <<01.pv>>40575000
                                           allx/true,          <<01.pv>>40580000
                                           endx/accountlevel,  <<01.pv>>40585000
                                           startx/false];      <<01.pv>>40590000
logical flags := 3;  <<init to both cpu and connect>>          <<u.rao>>40595000
double array parms(0:2) = q;                                   <<u.rao>>40600000
byte pointer acct = parms;                                     <<u.rao>>40605000
byte acctnamelen = parms+1;                                    <<u.rao>>40610000
byte pointer cpuconnect = parms+2;                             <<u.rao>>40615000
byte cpuconnectlen = parms+3;                                  <<u.rao>>40620000
byte pointer extraparm = parms+4;                              <<u.rao>>40625000
logical dl := commacr;                                         <<u.rao>>40630000
integer numparms;                                              <<u.rao>>40635000
array lacct(0:4);                                              <<u.rao>>40640000
                                                               <<u.rao>>40645000
lacct := "  ";                                                 <<u.rao>>40650000
move lacct(1) := lacct,(4);                                    <<u.rao>>40655000
mycommand(parmsp,dl,3,numparms,parms);                         <<u.rao>>40660000
if numparms > 0 then                                           <<u.rao>>40665000
   begin                                                       <<u.rao>>40670000
   if integer(acctnamelen) > 0 then                            <<u.rao>>40675000
      begin   <<account name present>>                         <<u.rao>>40680000
      if acct <> "@" then                                      <<u.rao>>40685000
         begin  <<specific account desired>>                   <<u.rao>>40690000
         type.(endlevelf) := grouplevel;                       <<u.rao>>40695000
         if acctnamelen > 8 then                               <<u.rao>>40700000
            begin                                              <<u.rao>>40705000
            parmnum := 1;                                      <<u.rao>>40710000
            cierr(errnum := acctnametoolong, acct);            <<u.rao>>40715000
            return                                             <<u.rao>>40720000
            end;                                               <<u.rao>>40725000
         if acct <> alpha then                                 <<u.rao>>40730000
            begin                                              <<u.rao>>40735000
            parmnum := 1;                                      <<u.rao>>40740000
            cierr(errnum := acctexpectalpha, acct);            <<u.rao>>40745000
            return;                                            <<u.rao>>40750000
            end;                                               <<u.rao>>40755000
         tos := @lacct&lsl(1);                                 <<u.rao>>40760000
         move * := acct,(integer(acctnamelen));                <<u.rao>>40765000
         end                                                   <<u.rao>>40770000
      else   <<acct is "@">>                                   <<u.rao>>40775000
         if acctnamelen > 1 then                               <<u.rao>>40780000
            begin                                              <<u.rao>>40785000
            parmnum := 1;                                      <<u.rao>>40790000
            cierr(errnum := resacctjustat, acct(1));           <<u.rao>>40795000
            return                                             <<u.rao>>40800000
            end;                                               <<u.rao>>40805000
      end;                                                     <<u.rao>>40810000
   if numparms > 1 then  <<cpu or connect>>                    <<u.rao>>40815000
      begin                                                    <<u.rao>>40820000
      if (integer(cpuconnectlen) = 3)  and                     <<u.rao>>40825000
            (cpuconnect = "CPU") then                          <<u.rao>>40830000
         flags := 2                                            <<u.rao>>40835000
      else if (cpuconnectlen = 7) and                          <<u.rao>>40840000
            (cpuconnect = "CONNECT") then                      <<u.rao>>40845000
         flags := 1                                            <<u.rao>>40850000
      else  <<???>>                                            <<u.rao>>40855000
         begin                                                 <<u.rao>>40860000
         parmnum := 2;                                         <<u.rao>>40865000
         cierr(errnum := resacctexpect, cpuconnect);           <<u.rao>>40870000
         return                                                <<u.rao>>40875000
         end;                                                  <<u.rao>>40880000
      if numparms > 2 then   <<too many parms>>                <<u.rao>>40885000
         begin                                                 <<u.rao>>40890000
         parmnum := 3;                                         <<u.rao>>40895000
         cierr(errnum := resacct2mp, extraparm);               <<u.rao>>40900000
         return                                                <<u.rao>>40905000
         end;                                                  <<u.rao>>40910000
      end;                                                     <<u.rao>>40915000
   end;  <<all parms now parsed and verified>>                 <<u.rao>>40920000
tos := direcscan (type,0d,lacct,arrdb0,arrdb0,                 <<38.pv>>40925000
                  rcresetacct,flags);                          <<38.pv>>40930000
if <> then cydirerr'(*,%120000,errnum);                        <<u.rao>>40935000
end;                                                           <<u.rao>>40940000
$page       "ERROR HANLDERS AND MISC ROUTINES"                          40945000
$control segment=main                                                   40950000
end.                                                                    40955000
