$CONTROL USLINIT,CODE,MAP                                      <<01549>>00010000
<<COMMAND INTERPRETER - MODULE 51>>                            <<01549>>00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$THIRTY                                                                 00028000
$TITLE "IMS"                                                            00030000
<<*************************************************************<<U.RAO>>00032000
<<*****************  Command Interpreter IMS  *****************<<U.RAO>>00034000
<<*************************************************************<<U.RAO>>00036000
<<                                                             <<U.RAO>>00038000
<<*************************************************************<<U.RAO>>00040000
<<************************  OVERVIEW  *************************<<U.RAO>>00042000
<<*************************************************************<<U.RAO>>00044000
<<                                                             <<U.RAO>>00046000
<<WHO:                                                         <<U.RAO>>00048000
<<   Larry Birenbaum designed the basic structures of the      <<U.RAO>>00050000
<<Command Interpreter for VERSION A of MPE.  Work was begun in <<U.RAO>>00052000
<<1970 or 1971.                                                <<U.RAO>>00054000
<<   Bob Olson substantially redesigned the parsers of the     <<U.RAO>>00056000
<<Command Interpreter for VERSION B of MPE II.  Work was begun <<U.RAO>>00058000
<<in November 1976 and completed in late 1977.  The basic      <<U.RAO>>00060000
<<algorithms for executing the commands remained essentially   <<U.RAO>>00062000
<<the same even though the parsers were rewritten.  Several    <<U.RAO>>00064000
<<new commands were added at this time, as were User Defined   <<U.RAO>>00066000
<<Commands.                                                    <<U.RAO>>00068000
<<   Other people who have added commands or modified existing <<U.RAO>>00070000
<<commands for MPE IIB are Ron Hoyt and Bob Vannucci (Private  <<U.RAO>>00072000
<<Volumes, including modification of the accounting commands   <<U.RAO>>00074000
<<and STORE/RESTORE), Neal Mack (Transaction Logging user      <<U.RAO>>00076000
<<commands), Mike Philben (revision of DS commands), Ed Basart <<U.RAO>>00078000
<<(revision of HELLO, JOB, and DATA and the addition of User   <<U.RAO>>00080000
<<Defined Commands), and Bob Gerstmeyer (CLINE command).       <<U.RAO>>00082000
<<                                                             <<U.RAO>>00084000
<<WHERE:                                                       <<U.RAO>>00086000
<<   Pieces of the Command Interpreter are scattered all over  <<U.RAO>>00088000
<<the system.  This module contains the bulk of the executors. <<U.RAO>>00090000
<<The spooling commands (SHOWJOB, SHOWOUT, STREAM, and SHOWIN) <<U.RAO>>00092000
<<may be found in the SPOOLCOMS module.  The DS commands       <<U.RAO>>00094000
<<(RFA, DSLINE, REMOTE) will be found in the DS code.  STORE   <<U.RAO>>00096000
<<and RESTORE have a module of their own.  The bulk of the work<<U.RAO>>00098000
<<for User Defined Commands is done in a module called UDC.    <<U.RAO>>00100000
<<HELP resides in module HELPUSER.  JOB, HELLO and DATA are    <<U.RAO>>00102000
<<parsed by code in module NURSERY.  In general, it is better  <<U.RAO>>00104000
<<to put the executors in the same module as the routines which<<U.RAO>>00106000
<<do the work.  This will reduce confusion and simplify        <<U.RAO>>00108000
<<maintenance.  There is no inherent benefit to accumulating   <<U.RAO>>00110000
<<executors in common segments, assuming that there is         <<U.RAO>>00112000
<<non-trivial work to do.                                      <<U.RAO>>00114000
<<                                                             <<U.RAO>>00116000
<<WHY:                                                         <<U.RAO>>00118000
<<   The purpose served by the Command Interpreter is to       <<U.RAO>>00120000
<<provide the user access to the operating system functions    <<U.RAO>>00122000
<<without requiring him/her to go through the irritation of    <<U.RAO>>00124000
<<writing a program to do so.  There are three primary function<<U.RAO>>00126000
<<provided by the commands.  Most important is the ability to  <<U.RAO>>00128000
<<execute programs, evidenced by the RUN command and the variou<<U.RAO>>00130000
<<compiler commands.  Second is the ability to manage one's    <<U.RAO>>00132000
<<resources, such as files.  Finally there are a large number o<<U.RAO>>00134000
<<utility functions, primarily for status checking.  When a new<<U.RAO>>00136000
<<capability is added to the system, the user should be given  <<U.RAO>>00138000
<<commands which allow him to manipulate the capability and to <<U.RAO>>00140000
<<determine the status of the new resource created by the      <<U.RAO>>00142000
<<capability.                                                  <<U.RAO>>00144000
<<                                                             <<U.RAO>>00146000
$PAGE                                                                   00148000
<<*************************************************************<<U.RAO>>00150000
<<****************  ADDING A COMMAND TO THE CI  ***************<<U.RAO>>00152000
<<*************************************************************<<U.RAO>>00154000
<<                                                             <<U.RAO>>00156000
<<Step 1:  Designing the command.                              <<U.RAO>>00158000
<<   A reasonable and parseable command syntax is one of the   <<U.RAO>>00160000
<<important parts of designing a good command.  Your goal is   <<U.RAO>>00162000
<<to minimize user irritation when using the command.  Always  <<U.RAO>>00164000
<<remember that for most users the problem for which they are  <<U.RAO>>00166000
<<using a computer is probably solved within an application    <<U.RAO>>00168000
<<program of some sort and the Command Interpreter in general  <<U.RAO>>00170000
<<and your command in particular are necessary annoyances.     <<U.RAO>>00172000
<<You must strive to limit that annoyance to the unavoidable.  <<U.RAO>>00174000
<<   Unfortunately, there are a wide variety of ways in which  <<U.RAO>>00176000
<<you can annoy people.  Some of the solutions are mutually    <<U.RAO>>00178000
<<incompatible.  The following is a list of the issues you     <<U.RAO>>00180000
<<should consider.                                             <<U.RAO>>00182000
<<   1)  Verbose versus terse command names                    <<U.RAO>>00184000
<<       In general it is desireable to have command names     <<U.RAO>>00186000
<<       which accurately reflect the function of the          <<U.RAO>>00188000
<<       command.  The tradeoff is that verbose command        <<U.RAO>>00190000
<<       names which describe the command are easier to        <<U.RAO>>00192000
<<       pick out in documentation whereas terse names are     <<U.RAO>>00194000
<<       easier to type.  Thus the deciding factor should      <<U.RAO>>00196000
<<       be how often the user will use the command.  A        <<U.RAO>>00198000
<<       side consideration is that the use of archaic         <<U.RAO>>00200000
<<       English or bizarre abbreviations will work a          <<U.RAO>>00202000
<<       hardship on our users who are not native English      <<U.RAO>>00204000
<<       speakers.                                             <<U.RAO>>00206000
<<   2)  Keyword versus positional parameters                  <<U.RAO>>00208000
<<       Positional parameters can be dangerous, especially    <<U.RAO>>00210000
<<       when the parameters can be similar data types.        <<U.RAO>>00212000
<<       For example, a positional string of numbers can       <<U.RAO>>00214000
<<       result in erroneous operation due to the accidental   <<U.RAO>>00216000
<<       omission of a delimiter.  Keyworded parameters        <<U.RAO>>00218000
<<       can be very verbose, especially on complex commands.  <<U.RAO>>00220000
<<       They can also work a hardship when a user uses a      <<U.RAO>>00222000
<<       particular command heavily, since it drastically      <<U.RAO>>00224000
<<       enlarges the amount of typing.  This last objection   <<U.RAO>>00226000
<<       can be gotten around through the agency of User       <<U.RAO>>00228000
<<       Defined Commands.  Another major objection to         <<U.RAO>>00230000
<<       keywords is that it requires several different        <<U.RAO>>00232000
<<       delimiters, often leading to typing errors and        <<U.RAO>>00234000
<<       mental confusion.                                     <<U.RAO>>00236000
<<   3)  Delimiters & other special characters                 <<U.RAO>>00238000
<<       The typical delimiters in commands are commas to      <<U.RAO>>00240000
<<       separate positional parameters and semicolons to      <<U.RAO>>00242000
<<       separate keywords.  The file command shows this       <<U.RAO>>00244000
<<       in full generality.  Periods are sometimes            <<U.RAO>>00246000
<<       terminators (as in the LABEL option on the FILE       <<U.RAO>>00248000
<<       command) and sometimes separators, as in the logon    <<U.RAO>>00250000
<<       user ID and file names.  Blanks are tough to deal     <<U.RAO>>00252000
<<       with and should be avoided as delimiters.             <<U.RAO>>00254000
<<       Non-printing characters should be avoided at all      <<U.RAO>>00256000
<<       costs.  All commands will be terminated with a        <<U.RAO>>00258000
<<       carriage return when passed to the command parser.    <<U.RAO>>00260000
<<   4)  Hardware/software peculiarities                       <<U.RAO>>00262000
<<       Too frequently the command syntax reflects some       <<U.RAO>>00264000
<<       strange and unpleasant aspect of the mechanism        <<U.RAO>>00266000
<<       underlying the command.  We should not require the    <<U.RAO>>00268000
<<       user to be cognizant of our design problems.  To      <<U.RAO>>00270000
<<       do so violates the principle of lowering the          <<U.RAO>>00272000
<<       annoyance factor.                                     <<U.RAO>>00274000
<<   5)  Extensibility                                         <<U.RAO>>00276000
<<       No matter how well your command does its job, one     <<U.RAO>>00278000
<<       of these days someone will want to modify or          <<U.RAO>>00280000
<<       extend it.  In particular, one should be careful      <<U.RAO>>00282000
<<       about the use of delimiters in ways other than the    <<U.RAO>>00284000
<<       "traditional" way.  For example, periods, commas,     <<U.RAO>>00286000
<<       semicolons and others have fairly standardized        <<U.RAO>>00288000
<<       meanings, and to use them in a different way reduces  <<U.RAO>>00290000
<<       the options of your successor to extend your command. <<U.RAO>>00292000
<<       Another related issue is that listing formats should  <<U.RAO>>00294000
<<       be extensible.                                        <<U.RAO>>00296000
<<   6)  Defaults                                              <<U.RAO>>00298000
<<       Defaults are vital, dangerous and difficult to choose.<<U.RAO>>00300000
<<       The design goal is that the command should be simple  <<U.RAO>>00302000
<<       for simple minded users.  This implies restraint in   <<U.RAO>>00304000
<<       the use of defaults which vary depending on some other<<U.RAO>>00306000
<<       parameter to the command.  Too smart defaults can be  <<U.RAO>>00308000
<<       just as bad as no defaults, since many users will     <<U.RAO>>00310000
<<       use the command defensively to avoid surprises from   <<U.RAO>>00312000
<<       the default mechanism.  Good luck.                    <<U.RAO>>00314000
<<   7)  Ambiguity                                             <<U.RAO>>00316000
<<       Careful design will avoid the need for lookahead to   <<U.RAO>>00318000
<<       resolve abiguous situations.  Lookahead should be     <<U.RAO>>00320000
<<       avoided if at all possible, as it results in          <<U.RAO>>00322000
<<       much code with complicated data structures.           <<U.RAO>>00324000
<<   8)  Computerese                                           <<U.RAO>>00326000
<<       Keywords should be couched in English, not computerese<<U.RAO>>00328000
<<                                                             <<U.RAO>>00330000
<<In summary, the user of your command will probably not be a  <<U.RAO>>00332000
<<computer professional and probably will be annoyed at the nee<<U.RAO>>00334000
<<to use your command at all.  Simplicity, understandability an<<U.RAO>>00336000
<<regularity are the keys to good command syntax.              <<U.RAO>>00338000
<<                                                             <<U.RAO>>00340000
<<Step 2: Code the Executor.                                   <<U.RAO>>00342000
<<   For the most part this is quite straightforward.  Most of <<U.RAO>>00344000
<<the existing executors can be used as models.  There are a fe<<U.RAO>>00346000
<<good concepts to keep in mind, however.                      <<U.RAO>>00348000
<<   Generating good error messages is just as important as    <<U.RAO>>00350000
<<executing the command.  The whole error message issue is deal<<U.RAO>>00352000
<<with below.                                                  <<U.RAO>>00354000
<<   The code of the command should be easily extensible.  This<<U.RAO>>00356000
<<implies the use of a simple parsing scheme with very obvious <<U.RAO>>00358000
<<techniques.  Probably more often than any other part of the  <<U.RAO>>00360000
<<system, the CI is modified by people who have no proprietary <<U.RAO>>00362000
<<interest in it.  In the interests of reliability and         <<U.RAO>>00364000
<<maintainability, it is desireable to start with as clean code<<U.RAO>>00366000
<<as possible.  Unfortunately, no universal parsing scheme has <<U.RAO>>00368000
<<yet been developed for the CI.                               <<U.RAO>>00370000
<<   A trap to avoid is called the "parse a little, execute a  <<U.RAO>>00372000
<<little" syndrome.  It results in the need to back out of a   <<U.RAO>>00374000
<<situation when an error is detected further down stream.  A  <<U.RAO>>00376000
<<secondary problem is that it tends to result in the          <<U.RAO>>00378000
<<partial destruction of the context of the error.  A command  <<U.RAO>>00380000
<<should be parsed completely before being executed at all.    <<U.RAO>>00382000
<<   Don't worry about having particularly efficient code.  The<<U.RAO>>00384000
<<CI's execution time is trivial compared to the time it takes <<U.RAO>>00386000
<<for the user to recover from a poorly designed error message <<U.RAO>>00388000
<<or even from a poorly designed syntax.  The customer always  <<U.RAO>>00390000
<<comes first.                                                 <<U.RAO>>00392000
<<   The use of global storage is discouraged.  Most important <<U.RAO>>00394000
<<is the fact that there are some performance consequences     <<U.RAO>>00396000
<<related to the need to constantly enlarge the CI's stack.    <<U.RAO>>00398000
<<If you find you do need global storage, be sure to initialize<<U.RAO>>00400000
<<it in procedure COMMANDINTERP, as the CI is procreated and   <<U.RAO>>00402000
<<thus has no global initialization capability.  Be careful    <<U.RAO>>00404000
<<about where you put new globals.  Certain other modules such <<U.RAO>>00406000
<<as UDC know about the CI global space.                       <<U.RAO>>00408000
<<   In general, the execution part of the command should simpl<<U.RAO>>00410000
<<be a call to the appropriate user callable intrinsic.  The   <<U.RAO>>00412000
<<CI usually should not provide the user any special services  <<U.RAO>>00414000
<<that are not available programmatically.  In this way we avoi<<U.RAO>>00416000
<<such undesireable situations as users getting their accountin<<U.RAO>>00418000
<<information through a call to the REPORT command and setting <<U.RAO>>00420000
<<up their files through a call to the FILE command through the<<U.RAO>>00422000
<<COMMAND intrinsic.  See the SETJCW command for an example of <<U.RAO>>00424000
<<this.                                                        <<U.RAO>>00426000
<<   EXCHANGEDB is to be avoided if at all possible, even if   <<U.RAO>>00428000
<<you have to do data segment moves iteratively.  The speed cos<<U.RAO>>00430000
<<is nothing compared to the cost of the crash which is        <<U.RAO>>00432000
<<inevitable when doing split stack operations.  All of the CI <<U.RAO>>00434000
<<utility routines assume no split stack operation.            <<U.RAO>>00436000
<<   Similarly there is rarely any valid reason for accessing  <<U.RAO>>00438000
<<system primitives directly from the CI.  The CI should be a  <<U.RAO>>00440000
<<very high level module.  It rarely has any business rooting  <<U.RAO>>00442000
<<around in some system table.  This principle unfortunately ha<<U.RAO>>00444000
<<been rather imperfectly adhered to.                          <<U.RAO>>00446000
<<   These almost random thoughts about writing executors hardl<<U.RAO>>00448000
<<provide a good framework for writing code.  Cursory          <<U.RAO>>00450000
<<examination of some of the executors currently in the module <<U.RAO>>00452000
<<probably will give you a better idea of the tricks of the    <<U.RAO>>00454000
<<trade.  A few ideas stand out.                               <<U.RAO>>00456000
<<                                                             <<U.RAO>>00458000
<<      Code assuming someone else will be changing it.        <<U.RAO>>00460000
<<                                                             <<U.RAO>>00462000
<<      Code for good error messages, not speed.               <<U.RAO>>00464000
<<                                                             <<U.RAO>>00466000
<<      It is far better to detect a problem at the            <<U.RAO>>00468000
<<      time the command is put in than when it is             <<U.RAO>>00470000
<<      executed.  That is, at parse time as opposed           <<U.RAO>>00472000
<<      to execution time.                                     <<U.RAO>>00474000
<<                                                             <<U.RAO>>00476000
<<      Cleverness will get you in trouble, usually for        <<U.RAO>>00478000
<<      no good reason.                                        <<U.RAO>>00480000
<<                                                             <<U.RAO>>00482000
<<Step 3:  Add the command to the Command Interpreter.         <<U.RAO>>00484000
<<   Other than physically adding the executor to the system,  <<U.RAO>>00486000
<<the only task is to add the command name to the list in      <<U.RAO>>00488000
<<procedure COMSEARCH.  This procedure is called for each      <<U.RAO>>00490000
<<command to determine if it is one of the ones known to the   <<U.RAO>>00492000
<<system.  The mechanics of this process are described in that <<U.RAO>>00494000
<<procedure.  If the executor is physically outside the CI     <<U.RAO>>00496000
<<module, don't forget to add the OPTION EXTERNAL declaration. <<U.RAO>>00498000
<<Congratulations.  Now all you need to do is make sure it     <<U.RAO>>00500000
<<works.                                                       <<U.RAO>>00502000
<<                                                             <<U.RAO>>00504000
$PAGE                                                                   00506000
<<*************************************************************<<U.RAO>>00508000
<<**************  ERROR MESSAGES FROM THE CI  **************** <<U.RAO>>00510000
<<*************************************************************<<U.RAO>>00512000
<<                                                             <<U.RAO>>00514000
<<Philosophical aspects:                                       <<U.RAO>>00516000
<<     The essential goal of an error message from the CI is to<<U.RAO>>00518000
<<help the user quickly recover from his problem.  In general, <<U.RAO>>00520000
<<a good error message should indicate:                        <<U.RAO>>00522000
<<    1)  What the CI did not like.  On syntax errors this     <<U.RAO>>00524000
<<        typically is done with a caret underneath where the  <<U.RAO>>00526000
<<        problem was detected.  If the caret isn't sufficient <<U.RAO>>00528000
<<        to identify the problem then some of the text of the <<U.RAO>>00530000
<<        message should further elaborate.  On semantic errors<<U.RAO>>00532000
<<        this usually is done with the text of the message.   <<U.RAO>>00534000
<<    2)  How to recover.  This usually will take the form of  <<U.RAO>>00536000
<<        telling the user what the valid input might be.  For <<U.RAO>>00538000
<<        example, on an invalid record type in the :FILE      <<U.RAO>>00540000
<<        command, the CI will put out a message something like<<U.RAO>>00542000
<<        EXPECTED RECORD TYPE TO BE F, V OR U.                <<U.RAO>>00544000
<<        This serves to identify to the user very quickly what<<U.RAO>>00546000
<<        the valid syntax is and thus how to get on with his  <<U.RAO>>00548000
<<        business.  Sometimes it is hard to figure out what th<<U.RAO>>00550000
<<        user had in mind.  For example, it isn't really      <<U.RAO>>00552000
<<        possible to second guess the user on an unknown      <<U.RAO>>00554000
<<        command name.  In these relatively rare cases, it is <<U.RAO>>00556000
<<        sufficient to tell the user just what was wrong.     <<U.RAO>>00558000
<<        In general, if it is a syntax error of any sort, it  <<U.RAO>>00560000
<<        is possible to give a good error message outlining   <<U.RAO>>00562000
<<        what was expected.  A cop-out on this is really      <<U.RAO>>00564000
<<        sloppy workmanship.                                  <<U.RAO>>00566000
<<    3)  In many cases it is desireable to tell the user what <<U.RAO>>00568000
<<        was done about the error.  This is particularly true <<U.RAO>>00570000
<<        in the case of warnings, where the user may be left  <<U.RAO>>00572000
<<        wondering whether some default was taken.  For exampl<<U.RAO>>00574000
<<        in the accounting structure commands we ignore many  <<U.RAO>>00576000
<<        errors.  In each case it is necessary to tell the use<<U.RAO>>00578000
<<        what default we took so that he can then do an ALTxxx<<U.RAO>>00580000
<<        to fix up the particular error, if necessary.  Of    <<U.RAO>>00582000
<<        course, in each case we try to pick a reasonable     <<U.RAO>>00584000
<<        default so that he doesn't have to do any recovery.  <<U.RAO>>00586000
<<                                                             <<U.RAO>>00588000
<<In any case, messages should be very specific.  Given the    <<U.RAO>>00590000
<<very simple mechanism for generating error and warning       <<U.RAO>>00592000
<<messages, there is no acceptable excuse for generic messages.<<U.RAO>>00594000
<<Examples:                                                    <<U.RAO>>00596000
<<   "INVALID NUMBER" is unacceptable.  Such messages should be<<U.RAO>>00598000
<<of the form "EXPECTED <item> TO BE BETWEEN <n1> AND <n2>."   <<U.RAO>>00600000
<<This message should be used only once in the CI.             <<U.RAO>>00602000
<<   "UNKNOWN KEYWORD" is unacceptable.  The proper form is    <<U.RAO>>00604000
<<"EXPECTED ONE OF <item1>, <item2>....".                      <<U.RAO>>00606000
<<   In general, "<item>", "<n1>" and so forth should not be   <<U.RAO>>00608000
<<passed to CIERR as parameters but rather be embedded as part <<U.RAO>>00610000
<<of the error message.  The reason for this is that you will  <<U.RAO>>00612000
<<need to give a fuller description of the error in the Error  <<U.RAO>>00614000
<<Messages part of the MPE manual.  It is awkward at best and  <<U.RAO>>00616000
<<embarrassing at worst to have to tell the manual writer "Well<<U.RAO>>00618000
<<it could be this, or it could be that, or even this third    <<U.RAO>>00620000
<<thing."  The one exception is where truly dynamic information<<U.RAO>>00622000
<<is involved.  Examples might include configuration data and  <<U.RAO>>00624000
<<user supplied information like file names.>>                 <<U.RAO>>00626000
<<   In most cases, redundantly specified parameters should    <<U.RAO>>00628000
<<result not in a fatal error but in a warning.  If a value is <<U.RAO>>00630000
<<associated with the redundant keyword then the message should<<U.RAO>>00632000
<<specify that the last value found was used.                  <<U.RAO>>00634000
<<   Similarly unacceptable messages are                       <<U.RAO>>00636000
<<   "INSUFFICIENT PARAMETERS" - what is missing?              <<U.RAO>>00638000
<<   "INSUFFICIENT CAPABILITY" should say what capability is   <<U.RAO>>00640000
<<missing.                                                     <<U.RAO>>00642000
<<   "INSUFFICIENT RESOURCES" should say what resources are    <<U.RAO>>00644000
<<lacking.                                                     <<U.RAO>>00646000
<<And so forth for all messages.                               <<U.RAO>>00648000
<<                                                             <<U.RAO>>00650000
<<Mechanical aspects of adding error messages:                 <<U.RAO>>00652000
<<                                                             <<U.RAO>>00654000
<<1)  Numbering                                                <<U.RAO>>00656000
<<    The number chosen for a message is largely irrelevant.  I<<U.RAO>>00658000
<<    is nice, however, if it is near the other messages       <<U.RAO>>00660000
<<    associated with the same command.  Be sure to declare it <<U.RAO>>00662000
<<    as an equate in the CI globals (or SPOOLCOMS or whatever)<<U.RAO>>00664000
<<    Note that the message should be tagged as to whether it i<<U.RAO>>00666000
<<    a CIERR or CIWARN or whatever.  Put it in message set 2. <<U.RAO>>00668000
<<2)  Generation                                               <<U.RAO>>00670000
<<    There is a procedure called CIERR which is responsible fo<<U.RAO>>00672000
<<    processing related to the handling of errors.  In        <<U.RAO>>00674000
<<    particular this procedure decides whether to print the   <<U.RAO>>00676000
<<    message, abort the job, and other related cleanup        <<U.RAO>>00678000
<<    problems.  Note that it always returns to the caller if  <<U.RAO>>00680000
<<    the job is not aborted.  It is the responsibility of the <<U.RAO>>00682000
<<    caller to assure that the job is clean enough to be      <<U.RAO>>00684000
<<    aborted at the time of the call.  CIERR cannot be called <<U.RAO>>00686000
<<    in split stack mode.  See the listing of CIERR for the   <<U.RAO>>00688000
<<    details of the call.                                     <<U.RAO>>00690000
<<3)  Errors detected by other parts of the system.            <<U.RAO>>00692000
<<    Errors such as file system errors, loader errors, DS     <<U.RAO>>00694000
<<    runtime errors and private volume errors are really of   <<U.RAO>>00696000
<<    little meaning in the context of the CI.  Accordingly,   <<U.RAO>>00698000
<<    when such errors are detected, several messages may be   <<U.RAO>>00700000
<<    displayed.  This is done through the agency of routines  <<U.RAO>>00702000
<<    like FERROR', CYDIRERR', LOADERROR, and CREATEERROR.     <<U.RAO>>00704000
<<    The development of such routines is encouraged whenever  <<U.RAO>>00706000
<<    message sets outside the CI error message set is         <<U.RAO>>00708000
<<    involved.  When such a message is output, the CI should  <<U.RAO>>00710000
<<    also print a message translating the error into the      <<U.RAO>>00712000
<<    context of the command which failed.  For example, when  <<U.RAO>>00714000
<<    a purge fails for an unusual reason, we print the file   <<U.RAO>>00716000
<<    system error message as well as a message saying that the<<U.RAO>>00718000
<<    purge was not done.                                      <<U.RAO>>00720000
<<4)  General purpose parsing routines                         <<U.RAO>>00722000
<<    Some parses, such as file names, are done so often that  <<U.RAO>>00724000
<<    generalized routines exist.  Usually these will be found <<U.RAO>>00726000
<<    in the neighborhood of the error handling routines.      <<U.RAO>>00728000
<<5)  Programmatically callable commands                       <<U.RAO>>00730000
<<    For errors in programmatically callable commands you must<<U.RAO>>00732000
<<    also return the error number to the caller of the COMMAND<<U.RAO>>00734000
<<    intrinsic.  This is done by returning the number through <<U.RAO>>00736000
<<    the ERRNUM parameter to all executors.  Also it is       <<U.RAO>>00738000
<<    required that you return the parameter number in the     <<U.RAO>>00740000
<<    PARMNUM parameter.  Parameter number is roughly defined  <<U.RAO>>00742000
<<    as one for each entity such as a keyword or value past   <<U.RAO>>00744000
<<    the command name.  In other words, 1 is the first        <<U.RAO>>00746000
<<    parameter past the command name, 2 might be the value to <<U.RAO>>00748000
<<    be associated with the keyword which was parameter 1.    <<U.RAO>>00750000
<<                                                             <<U.RAO>>00752000
<<   Error message generation is one of the most important     <<U.RAO>>00754000
<<tasks to be performed by the Command Interpreter.  The best  <<U.RAO>>00756000
<<error messages are generated when the coder tries to envision<<U.RAO>>00758000
<<the user's perception of the error.  For example, in many    <<U.RAO>>00760000
<<cases it seems to the user that it was obvious what he meant <<U.RAO>>00762000
<<even though it was not expressed in correct form.  This      <<U.RAO>>00764000
<<includes redundantly specified keywords like NOCCTL in the   <<U.RAO>>00766000
<<file command.  The user does not think highly of a command   <<U.RAO>>00768000
<<parser which gives him an error message on something like tha<<U.RAO>>00770000
<<which is obviously non-fatal.  The key to success with error <<U.RAO>>00772000
<<messages is to identify errors in the user's frame of        <<U.RAO>>00774000
<<reference, not the system programmer's.                      <<U.RAO>>00776000
<<                                                             <<U.RAO>>00778000
$PAGE "PATCH MENMONICS & EXPLANATIONS"                         <<04660>>00780000
<<Handle new STORE, which is a program not a procedure.     >> <<04660>>00782000
$TITLE "GLOBAL DECLARATIONS"                                            00784000
$PAGE "GLOBAL DECLARATIONS"                                             00786000
$CONTROL MAIN=COMMAND'INTERP                                   <<06.EB>>00788000
BEGIN                                                                   00790000
      <<MISCELLANEOUS DECLARATIONS >>                                   00792000
      INTEGER                                                           00794000
      DELTAQ=Q-0,                                                       00796000
      S0=S-0,                                                           00798000
      S1=S-1,                                                           00800000
      S2=S-2,                                                           00802000
      S3=S-3,                                                           00804000
      S4=S-4,                                                           00806000
      S5=S-5,                                                           00808000
      S15=S-15,                                                         00810000
      XREG = X,                                                         00812000
      X=X;                                                              00814000
                                                                        00816000
      LOGICAL                                                           00818000
      LS0=S-0,                                                          00820000
      LS1=S-1,                                                          00822000
      LS2=S-2,                                                          00824000
      STATUS=Q-1;                                                       00826000
                                                                        00828000
      DOUBLE                                                            00830000
      DS0=S-0,                                                          00832000
      DS1=S-1,                                                          00834000
      DS2=S-2,                                                          00836000
      DS3=S-3,                                                          00838000
      DS13=S-13,                                                        00840000
      DS15=S-15;                                                        00842000
                                                                        00844000
      BYTE POINTER                                                      00846000
      BPS0=S-0,                                                         00848000
      BPS1=S-1;                                                         00850000
                                                                        00852000
      INTEGER POINTER                                                   00854000
      PS0=S-0,                                                          00856000
      LPDT =08;   <<LPDT TABLE POINTER>>                       <<U.RAO>>00858000
                                                                        00860000
      DOUBLE POINTER                                                    00862000
      DPS0=S-0,                                                         00864000
      DPS1 = S-1;                                              <<U.RAO>>00866000
                                                                        00868000
      ARRAY DBARRAY(*)=DB+0;                                            00870000
      INTEGER ARRAY ARRDB0(*)=DB+0;                                     00872000
      INTEGER ARRAY ARRDB2(*)=DB+2;                                     00874000
      INTEGER ARRAY ARRDB3(*)=DB+3;                                     00876000
      INTEGER ARRAY ARRDB5(*)=DB+5;                                     00878000
      INTEGER ARRAY ARRDB6(*)=DB+6;                                     00880000
      INTEGER ARRAY ARRQ0(*)=Q-0;                                       00882000
      INTEGER ARRAY ARRQP1(*)=Q+1;                                      00884000
      INTEGER ARRAY ARRQP2(*)=Q+2;                                      00886000
      INTEGER ARRAY ARRS0(*)=S-0;                                       00888000
      INTEGER ARRAY ARRS1(*)=S-1;                                       00890000
      INTEGER ARRAY ARRS7(*)=S-7;                                       00892000
      INTEGER ARRAY ARRS16(*)=S-16;                                     00894000
EQUATE BCOMMANDBUFLEN=270,   <<COMMAND BUFFER LENGTH IN BYTES>><<U.RAO>>00896000
       WCOMMANDBUFLEN=(BCOMMANDBUFLEN+1)/2,  <<AND IN WORDS>>  <<00606>>00898000
       MAXNUMLINES=29, <<MAX NUMBER OF CONTINUATION LINES+1>>  <<01032>>00900000
       MAXCOMMANDLEN= BCOMMANDBUFLEN-2; <<MAX ALLOWED LEN COM>><<00606>>00902000
BYTE ARRAY BCOMIMAGE(@)=DB+0;   <<BYTE POINTER TO COMMAND IMAGE<<U.RAO>>00904000
ARRAY WCOMIMAGE(*)=DB+1; <<ACTUAL START OF COMMAND IMAGE BUFFER<<U.RAO>>00906000
INTEGER ARRAY LINELENSTACK(*)=WCOMIMAGE(WCOMMANDBUFLEN);       <<U.RAO>>00908000
   <<USED TO KEEP TRACK OF INPUT RECORD LENGTHS FOR PRINTCARET<<U.RAO>> 00910000
INTEGER NEXTMSG=LINELENSTACK+30;                               <<U.RAO>>00912000
INTEGER NUMBER'BLANKS = NEXTMSG + 1; << for DS prompt >>       <<04170>>00914000
ARRAY UDCSPACE(*) = NUMBER'BLANKS + 1;                         <<04170>>00916000
<< Note that the User Defined Command module, UDC, is >>       <<U.RAO>>00918000
<< sensitive to the DB offset in the CI stack of the  >>       <<U.RAO>>00920000
<< following variables.  If you move these, check UDC too.>>   <<U.RAO>>00922000
LOGICAL                                                        <<00.EB>>00924000
   UDC0 = UDCSPACE,                                            <<00.EB>>00926000
   UDC1 = UDC0 +1,                                             <<00.EB>>00928000
   UDC2 = UDC1 +1,                                             <<00.EB>>00930000
   UDC3 = UDC2 +1,                                             <<00.EB>>00932000
   UDC4 = UDC3 +1;                                             <<00.EB>>00934000
INTEGER IFNESTING = UDC4+1;  <<CURRENT IF NESTING LEVEL>>      <<U.RAO>>00936000
LOGICAL IFSKIP = IFNESTING+1;  <<CURRENT IF FLUSH FLAG>>       <<U.RAO>>00938000
LOGICAL ELSESEEN = IFSKIP+1;  <<SEEN AN ELSE AT THIS IF LEVEL>><<U.RAO>>00940000
LOGICAL CIFLAGS = ELSESEEN+1;  <<USED FOR VARIOUS FLAGS>>      <<U.RAO>>00942000
DEFINE SEQUENCED = CIFLAGS.(13:1)#;                            <<01.RO>>00944000
DOUBLE CONTINUSTATESTK = CIFLAGS+1;  <<WHEN WE ENTER A NEW UDC><<08.RO>>00946000
   <<LEVEL, THIS IS SHIFTED TO PRESERVE THE CONTINUE STATE AT>><<08.RO>>00948000
   <<THE OLD LEVEL FOR EVENTUAL RESTORATION.>>                 <<08.RO>>00950000
LOGICAL CSTACK = CONTINUSTATESTK+1;  <<JUST A DUMMY TO ALLOW A><<08.RO>>00952000
   <<BIT EXTRACT ON THE LOW ORDER 2 BITS OF CONTINUSTATESTK>>  <<08.RO>>00954000
DEFINE CONTINUESTATE = CSTACK.(14:2)#;                         <<08.RO>>00956000
   <<0 => NO :CONTINUE, 1 => JUST SEEN, 2 => IN EFFECT >>      <<08.RO>>00958000
INTEGER PENDINGCOMLEN = CONTINUSTATESTK + 2;                   <<08.RO>>00960000
   << PENDINGCOMLEN <> 0 =>  COMMAND ALREADY READ IN.  THIS>>  <<08.RO>>00962000
   << IS ITS LENGTH.  >>                                       <<08.RO>>00964000
BYTE ARRAY BLASTCOMIMAGE(@) = PENDINGCOMLEN+1; <<LAST COMMAND>><<U.RAO>>00966000
ARRAY LASTCOMIMAGE(*) =BLASTCOMIMAGE+1;                        <<U.RAO>>00968000
                                                                        00970000
   << UDC GLOBAL DEFINITIONS >>                                <<09.EB>>00972000
                                                               <<09.EB>>00974000
<< UDC0: UDCDSTN                                   >>          <<09.EB>>00976000
<< UDC1: OLDS                                      >>          <<09.EB>>00978000
<< UDC2: DEFINED BELOW                             >>          <<00884>>00980000
<< UDC3: Holds flags indicating current UDC options>>          <<00617>>00982000
<< UDC4: DEFINED BELOW                             >>          <<09.EB>>00984000
                                                               <<00884>>00986000
<< UDC2 BIT DEFINITIONS >>                                     <<00884>>00988000
DEFINE                                                         <<00884>>00990000
   FLUSHUDC    = (0:1) #;                                      <<00884>>00992000
                                                               <<09.EB>>00994000
<< UDC3 BIT DEFINTIONS. THESE MUST BE THE SAME AS THE >>       <<00617>>00996000
<< DEFINITIONS FOR THE OPTIONS IN THE UDC DIRECTORY.  >>       <<00617>>00998000
DEFINE                                                         <<00617>>01000000
   OPTLIST     = (0:1) #,                                      <<00617>>01002000
   OPTLOGON    = (1:1) #,                                      <<00617>>01004000
   OPTNOHELP   = (2:1) #,                                      <<00617>>01006000
   OPTNOBREAK  = (3:1) #;                                      <<00617>>01008000
                                                               <<00617>>01010000
DEFINE    << UDC4 BIT DEFINITIONS >>                           <<09.EB>>01012000
   UDCFATALCIERR   = ( 0:1) #,                                 <<09.EB>>01014000
   EXITBREAK       = ( 1:1) #,                                 <<09.EB>>01016000
   BREAKDETECTED   = ( 2:1) #,                                 <<09.EB>>01018000
   UDCNOPRINT      = ( 3:1) #,                                 <<01361>>01020000
   IMAGEADJUST     = ( 4:1) #,                                 <<09.EB>>01022000
   NESTLEVEL       = (10:6) #;                                 <<08.RO>>01024000
                                                               <<09.EB>>01026000
      <<EQUATES USED THROUGHOUT>>                                       01028000
                                                                        01030000
      EQUATE                                                            01032000
      << SERIES 33 CPU NUMBER RETURNED FROM 'THISCPU' >>       <<00492>>01034000
      SERIES33CPU = 2,                                         <<00492>>01036000
      <<CONDITION CODES>>                                               01038000
      CCE=2,                                                            01040000
      CCL=1,                                                            01042000
      CCG=0,                                                            01044000
      <<CI MESSAGE SET NUMBERS>>                               <<U.RAO>>01046000
      CIERRMSGSET=2,                                           <<U.RAO>>01048000
      CIGENERALMSGSET=7,                                       <<U.RAO>>01050000
      FSERRORMSGSET = 8,                                       <<U.RAO>>01052000
      LOADERRMSGSET = 9,                                       <<U.RAO>>01054000
      CREATEERRMSGSET = 10,                                    <<U.RAO>>01056000
      PVERRMSGSET = 15,                                        <<RH.PV>>01058000
      INTRNLERRSET = 27,  << System internal error. >>         <<04193>>01060000
   <<EQUATES FOR GENERAL MESSAGES (NOT ERROR MESSAGES)>>       <<U.RAO>>01062000
   OPWARN=9,         <<OPERATOR WARNING MESSAGE #>>            <<00552>>01064000
   JOBPRIVAL       = 1,                                        <<U.RAO>>01066000
   JOBFLUSHED      = 2,                                        <<U.RAO>>01068000
   TELLFROM        = 3,                                        <<U.RAO>>01070000
   REPORTLINE1     =   4,  <<REPORT HEADER>>                   <<U.RAO>>01072000
   REPORTLINE2     =   5,  <<REPORT HEADER>>                   <<U.RAO>>01074000
ENDOFFILEMSG    =  9,  <<END OF FILE DETECTED>>                <<00527>>01076000
   TELLNOTACCEPT   =  25,   <<! NOT ACCEPTING MESSAGES>>       <<U.RAO>>01078000
   ABORTQ          =  26,   <<ABORT?>>                         <<U.RAO>>01080000
   PURGEGROUPQ     =  30,  <<PURGE GROUP ?>>                   <<RV.PV>>01082000
   PURGEACCTQ      =  31,  <<PURGE ACCT ?>>                    <<RV.PV>>01084000
   PURGEUSERQ      =  32,  <<PURGE USER ?>>                    <<RV.PV>>01086000
   PURGEVSDQ       =  33,  <<PURGE VOLUME SET DEFINITION ?>>   <<RV.PV>>01088000
   PURGEVSLQ       =  34,  <<PURGE VOLUME SET LIST ELEMENT ?>> <<RV.PV>>01090000
   ENDOFPROG       = 50,  <<END OF PROGRAM MESSAGE>>           <<U.RAO>>01092000
   << END OF PREPARE = 51, >>                                  <<U.RAO>>01094000
   << END OF SUBSYSTEM = 52, >>                                <<U.RAO>>01096000
   << END OF COMPILE = 53, >>                                  <<U.RAO>>01098000
   << END OF REMOTE PROGRAM = 54>>                             <<U.RAO>>01100000
   SHOWJCWMSG      = 55,  << <jcw> = <value> >>                <<U.RAO>>01102000
   <<JCW = WARN, MSG 56>>                                      <<U.RAO>>01104000
   <<JCW = FATAL, MSG 57>>                                     <<U.RAO>>01106000
   <<JCW = SYSTEM, MSG 58>>                                    <<U.RAO>>01108000
   <<DS MESSAGE, MSG 59>>                                      <<U.RAO>>01110000
   <<DS MESSAGE, MSG 60>>                                      <<U.RAO>>01112000
   SHOWME1BRK      = 61,                                       <<U.RAO>>01114000
   SHOWME2         =  62,                                      <<U.RAO>>01116000
   SHOWME3         =  63,                                      <<U.RAO>>01118000
   SHOWME4         =  64,                                      <<U.RAO>>01120000
   SHOWME5         =  65,                                      <<U.RAO>>01122000
   SHOWME1NOBRK    = 70,                                       <<U.RAO>>01124000
   SHOWME6         = 71,                                       <<U.RAO>>01126000
   CONDITION'TRUE  = 40,                                       <<00849>>01128000
   CONDITION'FALSE = 41,                                       <<00849>>01130000
   RESUME'EXEC     = 42,                                       <<00849>>01132000
   IGNORE'COMM     = 43,                                       <<00849>>01134000
   SHOWME33        = 72,                                       <<00492>>01136000
   SHOWME55        = 74,                                       <<01403>>01138000
      <<ERROR EQUATES REFER TO C.I. ERROR NUMBER>>                      01140000
                                                                        01142000
                                                                        01144000
                                                                        01146000
      <<COMMAND RELATED ERRORS>>                                        01148000
      ERRNOTPROGRAMAT = 12,  <<DISALLOWED PROGRAMMATICALLY>>   <<U.RAO>>01150000
   ERRMISSINGCR    = 13,  << NO CR AT END OF COMMAND IMAGE >>  <<00257>>01152000
   PARAMTOOBIG     =  14,  <<PARAMETER EXCEEDS 255 CHARS>>     <<01709>>01154000
   NOSTACKSPACE    =  15,  << NOT ENOUGH STACK FOR COMMAND >>  <<01895>>01156000
   <<FILE AND BUILD COMMANDS>>                                 <<U.RAO>>01158000
   BLD2MP          = 200  ,  <<MORE THAN 30 PARMS TO BUILD>>   <<U.RAO>>01160000
   BLDREQFILENAME  = 201  ,  <<NAME IS REQUIRED PARM>>         <<U.RAO>>01162000
   FILEFCODEDEFALT = 202  ,  <<FILE CODE MISSING - 0 DEFAULT>> <<U.RAO>>01164000
   FILE2MP         = 203  ,  <<MORE THAN 30 PARMS TO BUILD>>   <<U.RAO>>01166000
   FILEREQFDESIG   = 204  ,  <<REQUIRES FORMAL DESIGNATOR>>    <<U.RAO>>01168000
   FILEFDSGNOBACK  = 205  ,  <<FDESIG MAY NOT BE BACKREF>>     <<U.RAO>>01170000
   FILEFDSGNOSYS   = 206  ,  <<FDESIG MAY NOT BE SYSDEF FILE>> <<U.RAO>>01172000
   FILEREQSOMEPARM = 207  ,  <<NEEDS AT LEAST 2 PARMS>>        <<U.RAO>>01174000
   FILEADESIGBR2MP = 208  ,  <<BACK REF MAY NOT HAVE PARMS>>   <<U.RAO>>01176000
   FILEBREFMISADES = 209  ,  <<UNABLE TO FIND BACK REF'D FILE>><<U.RAO>>01178000
   FILEADESNULL2MP = 210  ,  <<$NULL ADES CANNOT HAVE PARMS>>  <<U.RAO>>01180000
   FILEDOMAINSYSDF = 211  ,  <<CANNOT SPEC FILE DOMAIN>>       <<U.RAO>>01182000
   FILEXPCTDOMAIN  = 212  ,  <<EXPECTED A FILE DOMAIN>>        <<U.RAO>>01184000
   FILEINVLDDOMAIN = 213  ,  <<UNKNOWN DOMAIN TYPE>>           <<U.RAO>>01186000
   FILEXSTRTPARMCR = 214  ,  <<EXPECTED START OF PARMS>>       <<U.RAO>>01188000
   FILEEXTRANDELIM = 215  ,  <<EXTRANEOUS PARM DELIMITER>>     <<U.RAO>>01190000
   FILECONTXTBLD   = 216  ,  <<NOT APPROPRIATE FOR BUILD>>     <<U.RAO>>01192000
   FILECONTXTSYSDF = 217  ,  <<NOT APPROPRIATE FOR SYSDEF FILE><<U.RAO>>01194000
   FILECONTXTOLD   = 218  ,  <<NOT APPROPRIATE FOR OLD FILE>>  <<U.RAO>>01196000
   FILECONTXTNEW   = 219  ,  <<NOT APPROPRIATE FOR NEW FILE>>  <<U.RAO>>01198000
   FILEUNKNOWNKEY  = 220  ,  <<UNKNOWN KEYWORD FOR COMMAND>>   <<U.RAO>>01200000
   FILENOCCTLCCTL  = 221  ,  <<CCTL OVERRIDES NOCCTL>>         <<U.RAO>>01202000
   FILECCTLNOCCTL  = 222  ,  <<NOCCTL OVERRIDES CCTL>>         <<U.RAO>>01204000
   FILEDELTEMP     = 223  ,  <<TEMP OVERRIDES DEL>>            <<U.RAO>>01206000
   FILESAVETEMP    = 224  ,  <<TEMP OVERRIDES SAVE>>           <<U.RAO>>01208000
   FILEDELSAVE     = 225  ,  <<SAVE OVERRIDES DEL>>            <<U.RAO>>01210000
   FILETEMPSAVE    = 226  ,  <<SAVE OVERRIDES TEMP>>           <<U.RAO>>01212000
   FILETEMPDEL     = 227  ,  <<DEL OVERRIDES TEMP>>            <<U.RAO>>01214000
   FILESAVEDEL     = 228  ,  <<DEL OVERRIDES SAVE>>            <<U.RAO>>01216000
   FILEEXCLSHARE   = 229  ,  <<SHR OVERRIDES EXCLUSIVE>>       <<U.RAO>>01218000
   FILEEARSHARE    = 230  ,  <<SHARE OVERRIDES EXCLUSIVE READ>><<U.RAO>>01220000
   FILEEXCLEAR     = 231  ,  <<EAR OVERRIDES EXC>>             <<U.RAO>>01222000
   FILESHAREEAR    = 232  ,  <<EAR OVERRIDES SHARE>>           <<U.RAO>>01224000
   FILEEAREXCL     = 233  ,  <<EXC OVERRIDES EAR>>             <<U.RAO>>01226000
   FILESHAREEXCL   = 234  ,  <<EXC OVERRIDES SHARE>>           <<U.RAO>>01228000
   FILEBUFNOBUF    = 235  ,  <<NOBUF OVERRIDES BUF>>           <<U.RAO>>01230000
   FILENOMRMR      = 236  ,  <<MR OVERRIDES NOMR>>             <<U.RAO>>01232000
   FILEMRNOMR      = 237  ,  <<NOMR OVERRIDES MR>>             <<U.RAO>>01234000
   FILENOMULTIMULTI= 238  ,  <<MULTI OVERRIDES NOMULTI>>       <<U.RAO>>01236000
   FILEMULTINOMULTI= 239  ,  <<NOMULTI OVERRIDES MULTI>>       <<U.RAO>>01238000
   FILENOWAITWAIT  = 240 ,  <<WAIT OVERRIDES NOWAIT>>          <<U.RAO>>01240000
   FILEWAITNOWAIT  = 241 ,  <<NOWAIT OVERRIDES WAIT>>          <<U.RAO>>01242000
   FILENOXPCTSPARM = 242 ,  <<NO SUBPARMS FOR THIS KEY>>       <<U.RAO>>01244000
   FILEREQEQSIGN   = 243 ,  <<EXPECTED EQUALS SIGN>>           <<U.RAO>>01246000
   FILEACCESSREDND = 244 ,  <<ACCESS REDUNDANTLY SPECIFIED>>   <<U.RAO>>01248000
   FILEACCREQVALUE = 245 ,  <<ACCESS TYPE REQUIRED>>           <<U.RAO>>01250000
   FILEACCINVALID  = 246 ,  <<UNKNOWN ACCESS TYPE>>            <<U.RAO>>01252000
   FILEACCXTRNPARM = 247 ,  <<EXTRANEOUS PARM TO ACCESS>>      <<U.RAO>>01254000
   FILENOBUFBUF    = 248 ,  <<BUF OVERRIDES NOBUF>>            <<U.RAO>>01256000
   FILEBUFOVERRIDE = 249 ,  <<BUF OVERRIDES PREVIOUS BUF>>     <<U.RAO>>01258000
   FILEINVLDBUFNUM = 250 ,  <<INVALID NUMBER OF BUFFERS>>      <<U.RAO>>01260000
   FILEBUFXTRANDEL = 251 ,  <<EXTRANEOUS PARM TO BUF>>         <<U.RAO>>01262000
   FILEFCODEREDUND = 252 ,  <<FILE CODE OVERRIDES PREVIOUS>>   <<U.RAO>>01264000
   FILEUNKFCODE    = 253 ,  <<UNKNOWN FILE CODE>>              <<U.RAO>>01266000
   FILEFCODEVALUE  = 254 ,  <<FILE CODE MUST BE A POSITIVE INT><<U.RAO>>01268000
   FILECODEXTRNDEL = 255 ,  <<EXTRANEOUS PARM TO CODE>>        <<U.RAO>>01270000
   FILEDEVOVERRIDE = 256 ,  <<OVERRIDES PREVIOUS DEV>>         <<U.RAO>>01272000
   FILESYSDEFDEV   = 257 ,  <<SYSDEF FILE DEV FORCED>>         <<U.RAO>>01274000
   FILEXPCTPOUNDSN = 258 ,  <<UNKNOWN SPECIAL CHAR IN DEV NAME><<U.RAO>>01276000
   FILEDSNAME2LONG = 259 ,  <<DS NAME > 8 CHARACTERS>>         <<U.RAO>>01278000
   FILEDEVNAME2LNG = 260 ,  <<DEVICE NAME > 8 CHARACTERS>>     <<U.RAO>>01280000
   FILEOUTPRINOT   = 261 ,  <<OUTPRI LEGAL ONLY FOR OUTPUT FILES>>      01282000
   FILEOUTPRIINVLD = 262 ,  <<UNACCEPTABLE OUTPRI>>            <<U.RAO>>01284000
   FILENUMCOPINVLD = 263 ,  <<UNACCEPTABLE NUMBER OF COPIES>>  <<U.RAO>>01286000
   FILEDEVXPARMS   = 264 ,  <<UNKNOWN SUBPARAMETER>>           <<U.RAO>>01288000
   FILEDISCOVERIDE = 265 ,  <<OVERRIDE PREVIOUS DISC PARM>>    <<U.RAO>>01290000
   FILEFILESIZE    = 266 ,  <<ILLEGAL NUMBER OF RECORDS>>      <<U.RAO>>01292000
   FILEEXTENTSPROB = 267 ,  <<ILLEGAL NUMBER OF EXTENTS>>      <<U.RAO>>01294000
   FILEINITALLOCBD = 268 ,  <<UNACCEPTABLE INIT ALLOCATION>>   <<U.RAO>>01296000
   FILEDISCXPARMS  = 269 ,  <<UNKNOWN DISC SUBPARAMETER>>      <<U.RAO>>01298000
   FILERECOVERRIDE = 270 ,  <<OVERRIDE PREVIOUS REC =  >>      <<U.RAO>>01300000
   FILEBADRECSIZE  = 271 ,  <<DISALLOW RECSIZE OF 0>>          <<U.RAO>>01302000
   FILEBADBLOCKING = 272 ,  <<ILLEGAL BLOCK FACTOR>>           <<U.RAO>>01304000
   FILEUNKRECFMT   = 273 ,  <<UNKNOWN RECORD FORMAT>>          <<U.RAO>>01306000
   FILEASCIIINVALD = 274 ,  <<NEITHER ASCII NOR BINARY>>       <<U.RAO>>01308000
   FILERECXTRANPRM = 275 ,  <<UNKNOWN PARM TO REC PARM>>       <<U.RAO>>01310000
   FEQTABFULLXPLCT = 276 ,  <<FILE EQUATE TABLE FULL>>         <<U.RAO>>01312000
   BLDDOMAINNOT    = 277 ,  <<DOMAIN NOT ALLOWED ON BUILD>>    <<U.RAO>>01314000
   BLDNOTADES      = 278 ,  <<ACTUAL DESIGNATOR NOT ALLOWED ON BUILD>>  01316000
   BLDFAILED       = 279 ,  <<BUILD OF FILE FAILED>>           <<U.RAO>>01318000
   FILEXPINVMONTH  = 280 ,  <<BAD NO. FOR MONTH>>              <<U.RAO>>01320000
   FILEXPNOSLASHMD = 281 ,  <<NO SLASH BETWEEN MONTH & DAY>>   <<U.RAO>>01322000
   FILEXPINVDAY    = 282 ,  <<INVALID NO. FOR DAY OF MONTH>>   <<U.RAO>>01324000
   FILEXPDAYZERO   = 283 ,  <<00 FOR MONTH, NOT FOR DAY>>      <<U.RAO>>01326000
   FILEXPNOSLASHDY = 284 ,  <<NO SLASH BETWEEN DAY & YEAR>>    <<U.RAO>>01328000
   FILEXPNONZERO   = 285 ,  <<IF MONTH, DAY = 00, NOT YEAR>>   <<U.RAO>>01330000
   FILEXPXTRNDATA  = 286 ,  <<EXTRANEOUS PARM TO EXP DATE>>    <<U.RAO>>01332000
   FILEREDUNDLABEL = 287 ,  <<LABEL REDUNDANTLY SPECIFIED>>    <<U.RAO>>01334000
   FILEVOLID2LONG  = 288 ,  <<VOLID > 6 CHARACTERS>>           <<U.RAO>>01336000
   FILEVOLIDSPECAL = 289 ,  <<EMBEDDED SPECIAL IN VOLID>>      <<U.RAO>>01338000
   FILEINVVOLTYPE  = 290 ,  <<BAD VOLUME TYPE>>                <<U.RAO>>01340000
   FILEXPINVSEQ    = 291 ,  <<INVALID SEQUENCE FIELD>>         <<U.RAO>>01342000
   FILEXTRNLABEL   = 292 ,  <<EXTRANEOUS PARM TO LABEL>>       <<U.RAO>>01344000
   FILEFORMOVERRID = 293 ,  <<REDUNDANTLY SPECIFIED FORMS MSG>><<U.RAO>>01346000
   FILEFMSNOPERIOD = 294 ,  <<NO PERIOD ON FORMS MESSAGE>>     <<U.RAO>>01348000
   FILEFMSTOOLONG  = 295 ,  <<TRUNCATED TO 49 CHARACTERS>>     <<U.RAO>>01350000
   FILELABELNOLABEL= 296 ,  <<LABEL OVERRIDEN BY NOLABEL>>     <<U.RAO>>01352000
   FILENOLOCKLOCK  = 297 ,  <<NOLOCK OVERRIDES LOCK>>          <<U.RAO>>01354000
   FILELOCKNOLOCK  = 298 ,  <<LOCK OVERRIDES NOLOCK>>          <<U.RAO>>01356000
   BLDUNKNOWNKEY   = 299 ,  <<UNKNOWN KEYWORD TO BUILD>>       <<U.RAO>>01358000
   BLDNOSYSFILES   = 300,  <<ONLY $NEWPASS TO :BUILD>>         <<U.RAO>>01360000
   FILEINVALDEVNAME= 301,  <<INVALID DEV NAME>>                <<00579>>01362000
   FILENORIO'RIO   = 302,  <<"NORIO" CONVERTED TO "RIO">>      <<00634>>01364000
   FILERIO'NORIO   = 303,  <<"RIO" CONVERTED TO "NORIO">>      <<00634>>01366000
   CIRCULARFEQ     = 304,  <<CIRCULAR FILE EQUATIONS>>         <<00834>>01368000
   FILEADESSYS     = 305,  <<ENVIRONMENT NOT SYSFILE>>         <<01549>>01370000
   FILEENVOVERRIDE = 306,  <<OVERRIDE PREVIOUS ENV PARAMETER>> <<01549>>01372000
   FILEENVXPARMS   = 307,  <<ENV HAS NO SUBPARAMETERS>>        <<01549>>01374000
   FILEOUTQOVERRIDE= 308,  <<OVERRIDE PREVIOUS OUTQ PARM>>     <<01549>>01376000
   OUTQNAMEALPHNUM = 309,  <<OUTQ NAME NOT ALPHANUMERIC>>      <<01549>>01378000
   OUTQNAME2LNG    = 310,  <<OUTQ NAME > 8 CHARACTERS>>        <<01549>>01380000
   OUTQNAMENOTALPH = 311,  <<OUTQ NAME BEGINS WITH ALPHA>>     <<01549>>01382000
   FILEOUTQXPARMS  = 312,  <<OUTQ HAS NO SUBPARAMETERS>>       <<01549>>01384000
   FILESHARESEMI   = 313,  <<SEMI OVERRIDES SHR>>              <<01549>>01386000
   FILEEXCLSEMI    = 314,  <<SEMI OVERRIDES EXC>>              <<01549>>01388000
   FILENOCOPYCOPY  = 315,  <<COPY OVERRIDES NOCOPY>>           <<01549>>01390000
   FILECOPYNOCOPY  = 316,  <<NOCOPY OVERRIDES COPY>>           <<01549>>01392000
   FILENOMULTGMULT = 317,  <<GMULTI OVERRIDES NOMULTI>>        <<01549>>01394000
   FILEMULTIGMULTI = 318,  <<GMULTI OVERRIDES MULTI>>          <<01549>>01396000
   FILEGMULTIMULTI = 319,  <<MULTI OVERRIDES GMULTI>>          <<01549>>01398000
   FILEGMULTNOMULT = 320,  <<NOMULTI OVERRIDES GMULTI>>        <<01549>>01400000
   FILERIOSTD      = 321,  <<STD OVERRIDES RIO>>               <<01549>>01402000
   FILEMSGSTD      = 322,  <<STD OVERRIDES MSG>>               <<01549>>01404000
   FILECIRSTD      = 323,  <<STD OVERRIDES CIR>>               <<01549>>01406000
   FILESTDRIO      = 324,  <<RIO OVERRIDES STD>>               <<01549>>01408000
   FILEMSGRIO      = 325,  <<RIO OVERRIDES MSG>>               <<01549>>01410000
   FILECIRRIO      = 326,  <<RIO OVERRIDES CIR>>               <<01549>>01412000
   FILESTDMSG      = 327,  <<MSG OVERRIDES STD>>               <<01549>>01414000
   FILERIOMSG      = 328,  <<MSG OVERRIDES RIO>>               <<01549>>01416000
   FILECIRMSG      = 329,  <<MSG OVERRIDES CIR>>               <<01549>>01418000
   FILESTDCIR      = 330,  <<CIR OVERRIDES STD>>               <<01549>>01420000
   FILERIOCIR      = 331,  <<CIR OVERRIDES RIO>>               <<01549>>01422000
   FILEMSGCIR      = 332,  <<CIR OVERRIDES MSG>>               <<01549>>01424000
   FILECONTENV     = 333,  <<BACK REF. FILE CONTAINS ENV.>>    <<02554>>01426000
   FILEDENSOVERRID = 334,  <<OVERRIDE PREVIOUS DENS PARM>>     <<02569>>01428000
   FILEDENSXPARM   = 335,  <<EXTRANEOUS PARM TO DENS>>         <<02569>>01430000
   FILEDENSINVAL   = 336,  <<DENS PARM NOT VALID>>             <<02569>>01432000
   FILEMISSQUOTE   = 337,  << MISSING QUOTE ON VOLID >>        <<02663>>01434000
   FILENONPRINTCHAR= 338,  << VOLID HAS NON PRINT CHARS >>     <<02663>>01436000
   FILECOMMASEMINOK= 339,  << VOLID CAN'T HAVE COMMA,SEMI >>   <<02663>>01438000
   FILEVOLEXTRAN   = 340,  << VOLID HAS EXTRA INFO >>          <<02663>>01440000
   FILEVIRTUALDEV  = 342,  << virtual device not allowed >>    <<04171>>01442000
   FILEINVLDCLASPEC= 343,  << invalid device class >>          <<04171>>01444000
   FILEUNKNOWNDEV  = 344,  << unknown device class >>          <<04171>>01446000
   FILEDONTKNOWLDEV= 345,  << unknown logical device >>        <<04171>>01448000
                                                                        01450000
<< SECURE COMMAND>>                                            <<U.RAO>>01452000
   LWDMISMATCH     = 350,  <<LOCK WORD MISMATCH>>              <<U.RAO>>01454000
   NOTCREATOR      = 351,  <<NOT CREATOR OF FILE>>             <<U.RAO>>01456000
   FNOTFOUND       = 352, <<FILE NOT FOUND>>                   <<U.RAO>>01458000
   DISCIOERR       = 353, <<DISC IO ERROR WHEN ACCESSING FILE L<<U.RAO>>01460000
   SECURE2MP       = 354, <<ONLY FILE NAME ALLOWED>>           <<U.RAO>>01462000
   SECURENOTENUF   = 355, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>01464000
   GETFLABOPEN     = 356,  <<OPEN FAILED IN GETFLABEL>>        <<04.RO>>01466000
<< RESET AND CRESET COMMANDS>>                                 <<U.RAO>>01468000
   RESETPARMERR    = 360,                                      <<U.RAO>>01470000
   CRESETPARMERR   = 361,                                      <<U.RAO>>01472000
   FEQNOTFOUND     = 362, <<FILE EQUATE NOT FOUND>>            <<U.RAO>>01474000
<< RENAME COMMAND>>                                            <<U.RAO>>01476000
   RENAME2MP       = 370,                                      <<U.RAO>>01478000
   RENAMEEXPECTTEMP= 371,                                      <<U.RAO>>01480000
   RENAMEOLDFFSERR = 372,  <<RENAME OLD FILE ERROR>>           <<U.RAO>>01482000
   RENAMEFAILED    = 373,  <<CALL TO FRENAME FAILED>>          <<U.RAO>>01484000
   RENAMECLSFAILED = 374,  <<CLOSE OF RENAMED FILE FAILED>>    <<U.RAO>>01486000
   RENAMEREQOLDNAME= 375  ,  <<EXPECTED OLD FILE NAME>>        <<U.RAO>>01488000
   RENAMEREQNEWNAME= 376  ,  <<EXPECTED NEW FILE NAME>>        <<U.RAO>>01490000
<< PURGE COMMAND>>                                             <<U.RAO>>01492000
   PURGE2MP        = 380,                                      <<U.RAO>>01494000
   PURGEREQFNAME   = 381,                                      <<U.RAO>>01496000
   PURGEEXPECTTEMP = 382,                                      <<U.RAO>>01498000
   PURGEFNOTFOUND  = 383,                                      <<U.RAO>>01500000
   PURGEFOPENFAILD = 384,  <<OPEN OF FILE TO BE PURGED FAILED>><<U.RAO>>01502000
   PURGECLOSEFAILD = 385,  <<UNABLE TO PURGE FILE>>            <<U.RAO>>01504000
   PURGESEMICOLON  = 386  ,  <<FOUND ";", EXPECTED ",">>       <<U.RAO>>01506000
<< SAVE COMMAND >>                                             <<U.RAO>>01508000
   SAVE2MP         = 390,                                      <<U.RAO>>01510000
   SAVEREQFNAME    = 391,                                      <<U.RAO>>01512000
   SAVEEXPECTOLDPASS=392,                                      <<U.RAO>>01514000
   SAVEOPENOLDPASS = 393,  <<UNABLE TO OPEN $OLDPASS>>         <<U.RAO>>01516000
   SAVECLOSOLDPASS = 394,  <<UNABLE TO CLOSE $OLDPASS>>        <<U.RAO>>01518000
   SAVETEMPOPEN    = 395,  <<UNABLE TO OPEN TEMP FILE>>        <<U.RAO>>01520000
   SAVETEMPCLOSE   = 396,  <<UNABLE TO SAVE TEMP FILE>>        <<U.RAO>>01522000
   SAVESEMICOLON   = 397  ,  <<FOUND ";", EXPECTED ",">>       <<U.RAO>>01524000
<< RELEASE COMMAND >>                                          <<U.RAO>>01526000
   RELEASE2MP      = 400, <<ONLY FILE NAME ALLOWED>>           <<U.RAO>>01528000
   RELEASENOTENUF  = 401, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>01530000
<< ALTSEC COMMAND >>                                           <<U.RAO>>01532000
   ALTSECNOTENUF   = 410, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>01534000
   ALTSEC2MP       = 411, <<EXTRANEOUS DATA ON ALTSEC COMMAND>><<U.RAO>>01536000
<< LISTF COMMAND >>                                            <<U.RAO>>01538000
   LISTFBADLEVEL    = 420, <<BAD LEVEL # IN LISTF>>            <<U.RAO>>01540000
   LISTFSMCAP       = 422, <<NEED SM CAPABILITY>>              <<U.RAO>>01542000
   LISTFAMCAP       = 423, <<NEED AM CAPABILITY>>              <<U.RAO>>01544000
   LISTFEXPECTFILE  = 424, <<EXPECTED FILE NAME>>              <<U.RAO>>01546000
   LISTFFSERR       = 425, <<LISTF FILE SYS ERROR>>            <<U.RAO>>01548000
   LISTFEXTRANEOUS = 426,  <<UNIDENTIFIED FILESET NAME>>       <<U.RAO>>01550000
   LISTF2MP        = 427,  <<2 MANY PARMS TO LISTF>>           <<U.RAO>>01552000
   LISTFFLABIOERR  = 428,  <<IO ERROR READING FILE LABEL>>     <<U.RAO>>01554000
   LISTFHVSNOTMTD  = 429,  <<HOME VOLUME SET NOT MOUNTED>>     <<RV.PV>>01556000
   LISTFSTOPPED    = 430,                                      <<03.KM>>01558000
   NOXXXLISTED     = 431,                                      <<03.KM>>01560000
   NOFILESLISTED   = NOXXXLISTED,                              <<03.KM>>01562000
   NOGRPSLISTED    = 432,                                      <<03.KM>>01564000
   NOACCTSLISTED   = 433,                                      <<03.KM>>01566000
   NOUSERSLISTED   = 434,                                      <<03.KM>>01568000
   NOVSDSLISTED    = 435,                                      <<03.KM>>01570000
<< FILE ACCESS MASK ERRORS (PROCEDURE FORMACCESS, MOSTLY)>>    <<U.RAO>>01572000
   ACCESSEXPECTLPAREN= 500, <<EXPECTED LEADING "(">>           <<U.RAO>>01574000
   ACCESSEXPECTRPAREN=501,<<EXPECTED TRAILING ")">>            <<U.RAO>>01576000
   ACCESSUNKNOWNFMODE=502,<<EXPECTED FILE ACCESS MODE TYPE>>   <<U.RAO>>01578000
   ACCESSUNKNOWNGMODE=503,<<DITTO FOR GROUP>>                  <<U.RAO>>01580000
   ACCESSUNKNOWNAMODE=504,<<DITTO FOR ACCOUNT>>                <<U.RAO>>01582000
   ACCESSFSNOTPERMIT=505, <<SAVE NOT PERMITTED FOR FILE>>      <<U.RAO>>01584000
   ACCESSASNOTPERMIT=506, <<SAVE NOT PERMITTED FOR ACCOUNT>>   <<U.RAO>>01586000
   ACCESSEXPECTCOLON=507, << (X:XX), DIDN'T FIND COLON>>       <<U.RAO>>01588000
   ACCESSUNKNOWNFUSER=508,<<UNKNOWN FILE USER TYPE>>           <<U.RAO>>01590000
   ACCESSUNKNOWNGUSER=509,<<UNKNOWN GROUP USER TYPE>>          <<U.RAO>>01592000
   ACCESSUNKNOWNAUSER=510,<<UNKNOWN ACCOUNT USER TYPE>>        <<U.RAO>>01594000
   ACCESSCRNOTPERMIT=511, <<CREATOR NOT PERMITTED IN GROUP>>   <<U.RAO>>01596000
   ACCESSUSNOTPERMIT=512, <<NOT PERMITTED AT ACCOUNT LEVEL>>   <<U.RAO>>01598000
   ACCESSRREDUND   = 513, <<READ REDUNDANTLY SPECIFIED>>       <<U.RAO>>01600000
   ACCESSAREDUND   = 514, <<APPEND REDUNDANTLY SPECIFIED>>     <<U.RAO>>01602000
   ACCESSWREDUND   = 515, <<WRITE  "               "   >>      <<U.RAO>>01604000
   ACCESSLREDUND   = 516, <<LOCK      "            "   >>      <<U.RAO>>01606000
   ACCESSXREDUND   = 517, <<EXECUTE   "            "   >>      <<U.RAO>>01608000
   ACCESSSREDUND   = 518, <<SAVE      "            "   >>      <<U.RAO>>01610000
   ACCESSREDUNDMODE= 519, <<REDUNDANT IN THIS LIST>>           <<U.RAO>>01612000
<< FILE NAME ERRORS>>                                          <<U.RAO>>01614000
   FILEEXPECTALPHA = 530  ,                                    <<U.RAO>>01616000
   FFNAMEBASE=FILEEXPECTALPHA-1,                               <<U.RAO>>01618000
   FILENAMEMISSING = 531  ,                                    <<U.RAO>>01620000
   FILENAMETOOLONG = 532  ,                                    <<U.RAO>>01622000
   FILENOEMBEDSPEC = 534  ,  <<EMBEDDED SPECIAL IN FILE NAME>> <<U.RAO>>01624000
   FILEMISSINGDELIM= 535,                                     <<00.GEN>>01626000
   FILENOGENNAME   = 536,                                     <<00.GEN>>01628000
<< GROUP NAME ERRORS >>                                        <<U.RAO>>01630000
   GRPEXPECTALPHA  = 540  ,                                    <<U.RAO>>01632000
   FGNAMEBASE=GRPEXPECTALPHA-1,                                <<U.RAO>>01634000
   GRPNAMEMISSING  = 541  ,                                    <<U.RAO>>01636000
   GRPNAMETOOLONG  = 542  ,                                    <<U.RAO>>01638000
   GRPEXPECTNAMENOTAT = 543,                                   <<U.RAO>>01640000
   GRPNOEMBEDSPEC  = 544  ,  <<EMBEDDED SPECIAL IN GROUP NAME>><<U.RAO>>01642000
   GRPMISSINGDELIM = 545,                                     <<00.GEN>>01644000
   GRPNOGENNAME    = 546,                                     <<00.GEN>>01646000
<< ACCOUNT NAME ERRORS >>                                      <<U.RAO>>01648000
   ACCTEXPECTALPHA = 550  ,                                    <<U.RAO>>01650000
   FANAMEBASE=ACCTEXPECTALPHA-1,                               <<U.RAO>>01652000
   ACCTNAMEMISSING = 551  ,                                    <<U.RAO>>01654000
   ACCTNAMETOOLONG = 552  ,                                    <<U.RAO>>01656000
   ACCTEXPECTNAMENOTAT= 553,                                   <<U.RAO>>01658000
   ACCTNOEMBEDSPEC = 554  ,  <<EMBEDDED SPECIAL IN ACCT NAME>> <<U.RAO>>01660000
   ACCTMISSINGDELIM= 555,                                     <<00.GEN>>01662000
   ACCTNOGENNAME   = 556,                                     <<00.GEN>>01664000
<< LOCKWORD NAME ERRORS >>                                     <<U.RAO>>01666000
   LWDEXPECTALPHA  = 560  ,                                    <<U.RAO>>01668000
   FLWORDBASE=LWDEXPECTALPHA-1,                                <<U.RAO>>01670000
   LWDNAMEMISSING  = 561  ,                                    <<U.RAO>>01672000
   LWDNAMETOOLONG  = 562  ,                                    <<U.RAO>>01674000
   LWDEXPECTNAMENOTAT= 563,                                    <<U.RAO>>01676000
   LWDNOEMBEDSPEC  = 564  ,  <<EMBEDDED SPECIAL IN LOCK WORD>> <<U.RAO>>01678000
   LWDMISSINGDELIM = 565,                                     <<00.GEN>>01680000
   LWDNOGENNAME    = 566,                                     <<00.GEN>>01682000
   LWDNOFILE       = 569,                                     <<00.GEN>>01684000
<< VOLUME SET DEFINITION NAME ERRORS >>                        <<U.RAO>>01686000
   VSDEXPECTALPHA  = 570  ,                                    <<U.RAO>>01688000
   VSDNAMEBASE     = VSDEXPECTALPHA-1,                         <<U.RAO>>01690000
   VSDNAMEMISSING  = 571  ,                                    <<U.RAO>>01692000
   VSDNAMETOOLONG  = 572  ,                                    <<U.RAO>>01694000
   VSDEXPECTNAMENOTAT =573,                                    <<U.RAO>>01696000
   VSDNOEMBEDSPEC  = 574  ,  <<EMBEDDED SPECIAL IN VSD>>       <<U.RAO>>01698000
   VSDMISSINGDELIM = 575,                                     <<00.GEN>>01700000
   VSDNOGENNAME    = 576,                                     <<00.GEN>>01702000
   VSDNOLOCKWORD   = 579,                                     <<00.GEN>>01704000
<< MISCELLANEOUS NAMING ERRORS >>                              <<U.RAO>>01706000
   UNKNOWNSYSDEF   = 580  ,                                    <<U.RAO>>01708000
   EXPECTPERIOD    = 581  ,                                    <<U.RAO>>01710000
   XPCTPERIODSLASH = 582  ,                                    <<U.RAO>>01712000
   EXTRANEOUSADESG = 583  ,                                    <<U.RAO>>01714000
   EXPECTDELIMITER = 586, <<EXPECTED DELIMITER AFTER NAME>>    <<U.RAO>>01716000
<< USER NAME ERRORS >>                                         <<U.RAO>>01718000
   USEREXPECTALPHA = 590,                                      <<U.RAO>>01720000
   USERNAMEBASE    = USEREXPECTALPHA-1,                        <<U.RAO>>01722000
   USERNAMEMISSING = 591,                                      <<U.RAO>>01724000
   USERNAMETOOLONG = 592,                                      <<U.RAO>>01726000
   USEREXPECTNAMENOTAT = 593,                                  <<U.RAO>>01728000
   USERMISSINGDELIM= 595,                                     <<00.GEN>>01730000
   USERNOGENNAME   = 596,                                     <<00.GEN>>01732000
<< PREPRUN, PREP, RUN COMMANDS >>                              <<U.RAO>>01734000
   ERRNOPROGF      = 600  ,  <<NO PROGRAM FILE SPECIFIED>>     <<U.RAO>>01736000
   ERRNOUSLF       = 601  ,  <<NO USL FILE SPECIFIED>>         <<U.RAO>>01738000
   ERRNOPORUF      = 602  ,  <<NEITHER SPECIFIED>>             <<U.RAO>>01740000
   ERRNOPREPTARGET = 603  ,  <<NO PROGRAM FILE SPECIFIED>>     <<U.RAO>>01742000
   CMAXPCTSEMIORCR = 604  ,  <<FOUND COMMA, NEEDED ; OR CR>>   <<U.RAO>>01744000
   EQXPCTSEMIORCR  = 605  ,  <<FOUND =, NEEDED ; OR CR>>       <<U.RAO>>01746000
   EXTRNDELIMIGNRD = 606  ,  <<IGNORED EXTRANEOUS DELIMITER>>  <<U.RAO>>01748000
   CONTXTRUNNOTPRP = 607  ,  <<ALLOWED IN RUN, NOT PREP>>      <<U.RAO>>01750000
   CONTXTPRPNOTRUN = 608  ,  <<ALLOWED IN PREP, NOT RUN>>      <<U.RAO>>01752000
   UNKNOWNKEYPREP  = 609  ,                                    <<U.RAO>>01754000
   UNKNOWNKEYRUN   = 610  ,                                    <<U.RAO>>01756000
   UNKNOWNKEYPRPRN = 611  ,                                    <<U.RAO>>01758000
   REQEQUALSIGN    = 612  ,  <<NEED EQUALS SIGN>>              <<U.RAO>>01760000
   INVALIDLIB      = 613  ,  <<NEED ONE OF S,P, OR G>>         <<U.RAO>>01762000
   INVALIDMAXDATA  = 614  ,                                    <<U.RAO>>01764000
   INVALIDPARM     = 615  ,                                    <<U.RAO>>01766000
   INVALIDSTAKSIZE = 616  ,                                    <<U.RAO>>01768000
   INVALIDDLSIZE   = 617  ,                                    <<U.RAO>>01770000
   MISSINGCAP      = 618  ,  <<A SYNTAX PROBLEM WITH CAPABILITY<<U.RAO>>01772000
   UNKNOWNCAP      = 619  ,  <<NOT RECOGNIZED CAPABILITY>>     <<U.RAO>>01774000
   WARNDUPLKEY     = 620  ,  <<A WARNING ONLY>>                <<U.RAO>>01776000
   SEGMENTERERROR  = 621  ,  <<SEGMENTER RETURN TO CXPREPRUN>> <<U.RAO>>01778000
   NOSUCHPROGFILE  = 622  ,  <<THE CREATE FAILED.>>            <<U.RAO>>01780000
   DEFVAL          = 623,  <<DEFAULT MAXDATA TAKEN>>           <<U.RAO>>01782000
   PRPRNNOCREATE   = 624,  <<UNABLE TO CREATE PROGRAM>>        <<U.RAO>>01784000
   PRPRNNOLOAD     = 625,  <<UNABLE TO LOAD PROGRAM>>          <<U.RAO>>01786000
   INVALIDPROGFILE = 626,   <<INVALID PROGRAM FILE>>           <<U.RAO>>01788000
   ERRENTRYTOOBIG  = 627,  <<ENTRY POINT NAME > 15 CHAR LONG>> <<U.RAO>>01790000
   INVALIDPATCH    = 628,                                      <<00629>>01792000
   OUTOFPCBS       = 629,  <<NO PCB, ETC. FOR CREATEPROCESS>>  <<01200>>01794000
   INVALIDPROG     = 630,  <<INVALID PROGRAM FILE>>            <<01200>>01796000
   BADENTRYPT      = 631,  <<UNKNOWN ENTRY POINT>>             <<01200>>01798000
   DFLTSTACK       = 632,  <<DEFAULT STACKSIZE USED>>          <<01200>>01800000
   DFLTDL          = 633,  <<DEFAULT DLSIZE USED>>             <<01200>>01802000
   DFLTMAXD        = 634,  <<DEFAULT MAXDATA USED>>            <<01200>>01804000
   DLRNDED         = 635,  <<DLSIZE ROUNDED TO 128 WRD MULT>>  <<01200>>01806000
   CONFMAXD        = 636,  <<CONFIGURATION MAXDATA USED>>      <<01200>>01808000
   STKRNDEDUP      = 637,  <<STACK SPACE SET TO CONF MAXDATA>> <<01200>>01810000
   STACKTOOBIG     = 638,  <<STACK SPACE > CONF MAXDATA>>      <<01200>>01812000
<< OTHER SUBSYSTEM ERRORS (BASIC, SPL, RJE, ETC. >>            <<U.RAO>>01814000
   ERR2MPLISTONLY  = 640,                                      <<U.RAO>>01816000
   SUBSNOTFOUND    = 641,                                      <<U.RAO>>01818000
   SUBS2MP         = 642,                                      <<U.RAO>>01820000
   COMPFAILEDNOPRP = 643,                                      <<U.RAO>>01822000
   PREPFAILEDNORUN = 644,                                      <<U.RAO>>01824000
   DUMPFILENOTOPT  = 645,                                      <<U.RAO>>01826000
   DUMPFILENOTBACKREF = 646,                                   <<U.RAO>>01828000
   DSSUBSNOTFOUND  = 647,  <<DS NOT FOUND>>                    <<U.RAO>>01830000
   BASICCREATEERR  = 648,  <<UNABLE TO CREATE BASIC INTERP.>>  <<U.RAO>>01832000
   BASICLOADERR    = 649,  <<UNABLE TO LOAD BASIC INTERPRETER>><<U.RAO>>01834000
   SUBSYSCREATEERR = 650,  <<UNABLE TO CREATE SUBSYSTEM>>      <<U.RAO>>01836000
   SUBSYSLOADERR   = 651,  <<UNABLE TO LOAD SUBSYSTEM>>        <<U.RAO>>01838000
   COMPILERCREATE  = 652,  <<UNABLE TO CREATE COMPILER>>       <<U.RAO>>01840000
   COMPILERLOAD    = 653,  <<UNABLE TO LOAD COMPILER>>         <<U.RAO>>01842000
   COMPILEDCREATE  = 654,  <<UNABLE TO CREATE USER PROG>>      <<U.RAO>>01844000
   COMPILEDLOAD    = 655,   <<UNABLE TO LOAD USER PROG>>       <<U.RAO>>01846000
   FEQTABFULL      = 656,  <<FILE EQUATE TABLE FULL>>          <<U.RAO>>01848000
   TOOMANYFEQBREF  = 657,  <<TOO MANY BACK REF'S>>             <<U.RAO>>01850000
   APLTERM         = 658,  <<ERROR TRYING TO USE APL TERM>>    <<U.RAO>>01852000
   APLXPCTJUSTWS   = 659,  <<TOO MANY PARMS TO APL COMMAND>>   <<02.RO>>01854000
   SUBSNOTCREATE   = 660,  <<CREATEPROCESS FAILED ON SUBSYS.>> <<01452>>01856000
   INFOOVERIDE     = 661,  <<MULTIPLE INFO PARMS >>            <<02844>>01858000
   UNKNWNKWRD      = 662,  << UNKNOWN KEYWORD >>               <<02844>>01860000
<< ADDITIONAL ERRORS FOR :RUN COMMAND >>                       <<01200>>01862000
   INVALIDSTDIN    = 680,  <<INCORRECT STDIN SPECIFICATION>>   <<01200>>01864000
   INVALIDSTDLIST  = 681,  <<INCORRECT STDLIST SPECIFICATION>> <<01200>>01866000
   EXPCTQUOTE      = 682,  <<EXPECTED ' OR " TO START STRING>> <<01200>>01868000
   EXPCTCLOSEQUOTE = 683,  <<EXPECTED ' OR " TO END STRING>>   <<01200>>01870000
   BADSTDIN        = 684,  <<COULN'T OPEN $STDIN FOR :RUN>>    <<01200>>01872000
   BADSTDLIST      = 685,  <<COULN'T OPEN $STDLIST FOR :RUN>>  <<01200>>01874000
   OTHERCREATERR   = 686,  << GENERAL CREATEPROC. ERROR >>     <<01452>>01876000
                           << TO TRAP INTERNAL PROBLEMS.>>     <<01452>>01878000
   XPCTSEMIORCR    = 687,  <<EXPECTED ; OR CR>>                <<01709>>01880000
   STRINGTOOBIG    = 688,  <<INFO STRING > 255 CHARS>>         <<01709>>01882000
   INVALIDSYSDEFFL = 689, <<INVALID SYSTEM DEFINED FILE >>     <<02324>>01884000
   IMPIABA         = 690,                                      <<02369>>01886000
   BOTHFPMAPNOFPMAP= 691, <<BOTH FPMAP/NOFPMAP SPECIFIED>>     <<04103>>01888000
<<ORGANIZATIONAL MANAGEMENT COMMAND ERROR MESSAGES>>           <<U.RAO>>01890000
<< RESETACCT COMMAND >>                                        <<U.RAO>>01892000
   RESACCTJUSTAT   = 700,   <<EXPECTED JUST "@">>              <<U.RAO>>01894000
   RESACCTEXPECT   = 701,   <<EXPECTED CPU OR CONNECT>>        <<U.RAO>>01896000
   RESACCT2MP      = 702,                                      <<U.RAO>>01898000
<< REPORT COMMAND >>                                           <<U.RAO>>01900000
   REPORTNOTAMAT   = 705,   <<SAID "@", IS NOT AM>>            <<U.RAO>>01902000
   REPORTNOTAMLOGON= 706,   <<NOT LOGON GROUP>>                <<U.RAO>>01904000
   REPORTNOTSMAT   = 707,   <<WANTS ALL ACCTS, NOT SM>>        <<U.RAO>>01906000
   REPORTNOTSMLOGON= 708,   <<WANTS OTHER ACCT, NOT SM>>       <<U.RAO>>01908000
   REPORTEXPECTLIST= 709,   <<EXPECTED LIST FILE NAME>>        <<U.RAO>>01910000
   REPORT2MP       = 710,                                      <<U.RAO>>01912000
   REPORTEXTRANLEAF= 711,  <<EXTRANEOUS DATA IN LEAF NAME>>    <<RV.PV>>01914000
<< PURGEACCT, PURGEGROUP, PURGEUSER, PURGEVSD COMMANDS >>      <<U.RAO>>01916000
   PURGEGROUP2MP   = 715,                                      <<U.RAO>>01918000
   PURGEACCT2MP    = 716,                                      <<U.RAO>>01920000
   PURGEUSER2MP    = 717,                                      <<U.RAO>>01922000
   PURGEVSD2MP     = 718,                                      <<RV.PV>>01924000
   PURGEVSL2MP     = 719,                                      <<RV.PV>>01926000
<< LISTACCT, LISTGROUP, LISTUSER, LISTVSD COMMANDS >>          <<U.RAO>>01928000
   LISTACCTEXTRAN  = 723,  <<UNIDENTIFIABLE GARBAGE IN NAME>>  <<RV.PV>>01930000
   LISTACCTNOTAT   = 724,  <<NOT SM, CAN'T LOOK OUTSIDE ACCT>> <<RV.PV>>01932000
   LISTACCTSMLOGON = 725,  <<NOT SM, CAN'T LOOK OUTSIDE ACCT>> <<RV.PV>>01934000
   LISTACCTXPCTLST = 726,  <<EXPECTED LIST FILE>>              <<RV.PV>>01936000
   LISTACCT2MP     = 727,                                      <<RV.PV>>01938000
<< NEWACCT, NEWGROUP, NEWUSER, ALTACCT, ALTUSER, ALTGROUP >>   <<U.RAO>>01940000
   ALTACCT2MP      = 730,  <<MAX OF 71 PARAMETERS>>            <<RV.PV>>01942000
   ALTGROUP2MP     = 731,  <<DITTO>>                           <<RV.PV>>01944000
   ALTUSER2MP      = 732,                                      <<RV.PV>>01946000
   NEWACCT2MP      = 733,                                      <<RV.PV>>01948000
   NEWGROUP2MP     = 734,                                      <<RV.PV>>01950000
   NEWUSER2MP      = 735,                                      <<RV.PV>>01952000
   NEWACCTXPCTCMA  = 736,  <<EXPECT COMMA BEFORE MGR NAME>>    <<RV.PV>>01954000
   ORGCOMNOKEY     = 737,  <<EXPECTED KEYWORD>>                <<RV.PV>>01956000
   ORGCOMXPCTEQUALS= 738,  <<EXPECTED = AFTER KEYWORD>>        <<RV.PV>>01958000
   ORGCOMUNKNONKEY = 739,  <<UNKNOWN KEYWORD>>                 <<RV.PV>>01960000
   ORGCOMXPCTKEYWD = 740,  <<UNIDENTIFIABLE KEYWORD>>          <<RV.PV>>01962000
   ORGCOMUNOTACCESS= 741,  <<NOT APPROPRIATE FOR USER>>        <<RV.PV>>01964000
   ORGCOMACCESSRDND= 742,  <<ACCESS REDUNDANTLY SPECIFIED>>    <<RV.PV>>01966000
   ORGCOMUNKSUBQ   = 743,  <<UNIDENTIFIED SUBQ NAME>>          <<RV.PV>>01968000
   ORGCOMRDNDMAXPRI= 744,  <<MAXPRI REDUNDANTLY SPECIFIED>>    <<RV.PV>>01970000
   ORGCOMGNOTMAXPRI= 745,  <<NOT APPROPRIATE FOR GROUP>>       <<RV.PV>>01972000
   ORGCOMRDNDCAPKY = 746,  <<REDUNDANT CAPABILITY LIST>>       <<RV.PV>>01974000
   ORGCOMISSINGCAP = 747,  <<NO CAPABILITY SPECIFIED - IGNORED><<RV.PV>>01976000
   ORGCOMUNKCAP    = 748,  <<UNKNOWN CAPABILITY TYPE>>         <<RV.PV>>01978000
   ORGCOMCAPCONTXT = 749,  <<NOT ALLOWED CAP FOR GROUP>>       <<RV.PV>>01980000
   ORGCOMREDUNDCAP = 750,  <<REDUNDANTLY SPECIFIED CAPABILITY>><<RV.PV>>01982000
   ORGCOMFORCAIABA = 751,  <<FORCED IA & BA ON ACCOUNT>>       <<RV.PV>>01984000
   ORGCOMFORCUIABA = 752,  <<FORCED IA & BA ON USER>>          <<RV.PV>>01986000
   ORGCOMGLOCATTR  = 753,  <<INAPPROPRIATE FOR GROUPS>>        <<RV.PV>>01988000
   ORGCOMMGRMISING = 754,  <<REQUIRED MANAGER NAME MISSING>>   <<U.RAO>>01990000
   ORGCOMMGRNOTA   = 755,  <<MGR NAME MUST START WITH ALPHA>>  <<U.RAO>>01992000
   ORGCOMMGRTOOLNG = 756,  <<MUST BE LESS THAN 8 CHARACTERS>>  <<U.RAO>>01994000
   MGRNAMEBASE = ORGCOMMGRMISING-1,                            <<RV.PV>>01996000
   ORGCOMMGREMSPEC = 758,  <<EMBEDDED SPECIAL CHAR.>>          <<U.RAO>>01998000
   ORGCOMPASSNOTA  = 760,  <<PASSWORD MUST START WITH ALPHA>>  <<RV.PV>>02000000
   PASSWORDBASE    = ORGCOMPASSNOTA-1,                         <<RV.PV>>02002000
   ORGCOMRDNDPASS  = 761,  <<PASSWORD REDUNDANTLY DEFINED>>    <<RV.PV>>02004000
   ORGCOMPASTOOLNG = 762,  <<PASSWORD MUST BE LESS THAN 8 CHAR><<RV.PV>>02006000
   ORGCOMUHOMEGRP  = 765,  <<ONLY APPROPRIATE FOR USER>>       <<RV.PV>>02008000
   ORGCOMPASSSPECL = 766,  <<EMBEDDED SPECIAL IN PASSWORD>>    <<U.RAO>>02010000
   ORGCOMFUNOTDBL  = 767,  <<INAPPROPRIATE FOR USER>>          <<RV.PV>>02012000
   ORGCOMFILESBASE = ORGCOMFUNOTDBL,                           <<RV.PV>>02014000
   ORGCOMFINVALID  = 768,  <<BAD DOUBLE INTEGER>>              <<RV.PV>>02016000
   ORGCOMFDBLNEG   = 769,  <<CANNOT BE NEGATIVE NUMBER>>       <<RV.PV>>02018000
   ORGCOMFREDUNDNT = 770,  <<FILES REDUNDANTLY SPECIFIED>>     <<RV.PV>>02020000
   ORGCOMUNOTVS    = 771,  <<INAPPROPRIATE FOR USER>>          <<00580>>02022000
   ORGCOMCPUNOTDBL = 773,  <<CPU INAPPROPRIATE FOR USER>>      <<RV.PV>>02024000
   ORGCOMCPUBASE   = ORGCOMCPUNOTDBL,                          <<RV.PV>>02026000
   ORGCOMCPINVALID = 774,  <<BAD CPU DOUBLE INTEGER>>          <<RV.PV>>02028000
   ORGCOMCPUDBLNEG = 775,  <<CANNOT BE NEGATIVE NUMBER>>       <<RV.PV>>02030000
   ORGCOMCPURDNDNT = 776,  <<CPU REDUNDANTLY SPECIFIED>>       <<RV.PV>>02032000
   DIRUGOTNOIABA   = 777,  << USER WITHOUT IA, BA >>           <<01320>>02034000
   DIRGGOTNOIABA   = 778,  << GROUP WITHOUT IA,BA >>           <<01320>>02036000
   ORGCOMCONNOTDBL = 779,  <<CONNECT INAPPROPRIATE FOR USER>>  <<RV.PV>>02038000
   ORGCOMCONNECTBS = ORGCOMCONNOTDBL,                          <<RV.PV>>02040000
   ORGCOMCNINVALID = 780,  <<BAD CONNECT DOUBLE INTEGER>>      <<RV.PV>>02042000
   ORGCOMCONDBLNEG = 781,  <<CANNOT BE NEGATIVE NUMBER>>       <<RV.PV>>02044000
   ORGCOMCONRDNDNT = 782,  <<CONNECT REDUNDANTLY SPECIFIED>>   <<RV.PV>>02046000
   ALTUMGRSMCAP    = 784,  <<REMOVED SM CAP FROM HIMSELF>>     <<00539>>02048000
   ALTACCTSMCAP    = 785,  <<OVERRIDE ON REMOVAL OF SYS SM CAP><<RV.PV>>02050000
   FLIMIT'LT'USED  = 786,  <<REQUEST LESS THAN ACTUAL>>        <<RV.PV>>02052000
   ALTGRPCPULIMITS = 787,  <<EXCEEDS ACCOUNT LIMIT>>           <<RV.PV>>02054000
   ALTGRPCONNECTLM = 788,  <<EXCEEDS ACCOUNT LIMIT>>           <<RV.PV>>02056000
   ALTGRPFILELIMIT = 789,  <<EXCEEDS ACCOUNT LIMIT>>           <<RV.PV>>02058000
   ALTGRPEXCAP     = 790,  <<EXCEEDS ACCOUNT CAPABILITES>>     <<RV.PV>>02060000
   ALTGRPFILEACTUL = 791,  <<LIMIT LESS THAN ACTUAL>>          <<RV.PV>>02062000
   ALTUMGRAMCAP    = 792,  <<REMOVED AM CAP FROM SELF>>        <<RV.PV>>02064000
   ALTUMAXPRI      = 793,  <<EXCEEDS ACCOUNT MAXPRI>>          <<RV.PV>>02066000
   ALTUSERCAPS     = 794,  <<EXCEEDS ACCOUNT CAPABILITIES>>    <<RV.PV>>02068000
   ALTUSERLATTR    = 795,  <<EXCEEDS ACCOUNT LOCATTR>>         <<RV.PV>>02070000
   ORGCOMRDNDGROUP = 796,  <<REDUNDANTLY SPECIFIED HOME GROUP>><<U.RAO>>02072000
   ORGCOMRDNDLATTR = 797,  <<REDUNDANTLY SPECIFIED LOCATTR>>   <<U.RAO>>02074000
   ORGCOMINVLDLATR = 798,  <<INVALID INTEGER>>                 <<U.RAO>>02076000
   ORGCOMUNKGCAP   = 799,  <<INVALID GROUP CAPABILITY>>        <<07.RO>>02078000
   AM'SWITCHEDCAPS = 800,  << ALTACCT REMOVED IA/BA FROM AM>>  <<01450>>02080000
                                                                        02082000
   VSDEFSPECHAR    = 850,  <<CONTAINS SPEC CHAR(S)>>           <<RV.PV>>02084000
   VSDEFNOTALPHA   = 851,  <<FIRST CHAAR MUST BE ALPHA>>       <<RV.PV>>02086000
   VSDEFTOOLONG    = 852,  <<NAME GTR THAN 8 CHARS>>           <<RV.PV>>02088000
   VSDEFMISSNAME   = 853,  <<NAME MISSING>>                    <<RV.PV>>02090000
   VSDEFTOOMANY    = 854,  <<TOO MANY PARMS>>                  <<RV.PV>>02092000
   VSDEFTOOFEW     = 855,  <<TOO FEW PARMS>>                   <<RV.PV>>02094000
   VSDEFMISSCOLON  = 856,  <<MISSING COLON IN DEFINITION>>     <<RV.PV>>02096000
   VSDEFDUPMEMBDEF = 857,  <<DUP MEMBER DEFINITION>>           <<RV.PV>>02098000
   VSDEFUNDFNTYPE  = 858,  <<UNDEFINED DISK TYPE DESIGNATOR>>  <<RV.PV>>02100000
   VSDEFUNDFNMASTR = 859,  <<MASTER VOL UNDEFINED>>            <<RV.PV>>02102000
   VSDEFILLEGALKEY = 860,  <<ILLEGAL KEYWORD>>                 <<RV.PV>>02104000
   VSDEFMISSEQUAL  = 861,  <<MISSING EQUAL AFTER KEYWORD>>     <<RV.PV>>02106000
   VSDEFUNDFN      = 862,  <<VOLUME NAME UNIDENTIFIED>>        <<RV.PV>>02108000
   VSDEFDUPMEMB    = 863,  <<DUP CLASS MEMBER SPEC>>           <<RV.PV>>02110000
   <<864-863 ARE IN CATALOG -- WHO USES THEM??>>               <<03.KM>>02112000
   VSDNOVOLSET     = 869,  <<CLASS W/O PARENT SET>>            <<03.KM>>02114000
<< ERRORS ON $STDIN >>                                         <<U.RAO>>02116000
   ERRSTDINEOF    =  900,     <<EOF ON $STDIN>>                <<U.RAO>>02118000
   ERRSTDINIO     =  901,     <<I/O ERROR ON $STDIN>>          <<U.RAO>>02120000
<< DIRECTORY PROBLEMS >>                                       <<U.RAO>>02122000
   DIRIOERR        = 905,                                      <<U.RAO>>02124000
   DIRDUPLNAME     = 906,  <<DUPLICATE NAME>>                  <<U.RAO>>02126000
   DIRNOSUCHFILE   = 907,  <<NON-EXISTENT NAME>>               <<U.RAO>>02128000
   DIRNOSUCHGROUP  = 908,  <<NON-EXISTENT GROUP>>              <<U.RAO>>02130000
   DIRNOSUCHACCT   = 909,  <<NO SUCH ACCOUNT>>                 <<U.RAO>>02132000
   DIRNOSUCHUSER   = 910,  <<NON-EXISTENT USER>>               <<U.RAO>>02134000
   DIRNOSUCHVSD    = 911,  <<NON-EXISTENT VSD>>                <<U.RAO>>02136000
   DIRNOSUCHVSL    = 912,  <<NON-EXISTENT VSL>>                <<U.RAO>>02138000
   DIRNOSAVEGROUP  = 913,  <<NO GROUP SAVE ACCESS>>            <<U.RAO>>02140000
   DIRNOSAVEACCT   = 914,  <<NO ACCT SAVE ACCESS>>             <<U.RAO>>02142000
   DIROVERFLOW     = 915,  <<DIRECTORY OUT OF SPACE>>          <<U.RAO>>02144000
   DIRINUSE        = 916,  <<SOMETHING IN USE, CAN'T BE PURGED><<U.RAO>>02146000
   DIRGRPFSPACE    = 917,  <<WOULD EXCEED GROUP FILE SPACE>>   <<U.RAO>>02148000
   DIRACCTFSPACE   = 918,  <<WOULD EXCEED ACCOUNT FILE SPACE>> <<U.RAO>>02150000
<< ERRORS ON $STDLIST >>                                       <<U.RAO>>02152000
   ERRSTDLISTEOF  =  950,     <<EOF ON $STDLIST>>              <<U.RAO>>02154000
   ERRSTDLISTIO   =  951,     <<I/O ERROR ON $STDLIST>>        <<U.RAO>>02156000
<< CAPABILITY ERRORS >>                                        <<U.RAO>>02158000
   CAPREQ'OP'      = 955,  <<REQUIRES OP CAPABILITY>>          <<U.RAO>>02160000
   CAPREQ'SM'      = 956,  <<REQUIRES SM CAPABILITY>>          <<U.RAO>>02162000
   CAPREQ'AM'      = 957,  <<REQUIRES AM CAPABILITY>>          <<U.RAO>>02164000
   CAPREQSMORAM    = 958,  <<REQUIRES SM OR AM CAPABILITY>>    <<U.RAO>>02166000
   CAPREQ'CS'      = 959,  <<REQUIRES CS CAPABILITY>>          <<U.RAO>>02168000
   CAPREQUVORCV    = 960,  <<REQUIRES UV OR CV CAPABILITY>>    <<U.RAO>>02170000
   CAPREQ'CV'      = 961,  <<REQUIRES CV CAPABILITY>>          <<U.RAO>>02172000
   CAPREQ'PM'      = 962,  <<REQUIRES PM CAPABILITY>>          <<U.RAO>>02174000
   CAPREQ'IA'      = 963,  <<REQUIRES IA CAPABILITY>>          <<U.RAO>>02176000
   CAPREQ'BA'      = 964,  <<REQUIRES BA CAPABILITY>>          <<U.RAO>>02178000
   CAPREQ'SF'      = 965,  <<REQUIRES SF CAPABILITY>>          <<U.RAO>>02180000
   CAPREQ'LG'      = 966,  <<REQUIRES LOGGING CAPABILITY>>     <<00506>>02182000
   CAPREQSMOROP    = 967,  <<REQUIRES SM OR OP CAPABILITY>>    <<01724>>02184000
   ERRUNDEF        = 975, <<UNKNOWN COMMAND>>                  <<U.RAO>>02186000
   ERRABTERM       = 976, <<ABNORMAL PROGRAM TERMINATION>>     <<U.RAO>>02188000
   NOTINSESSION    = 977, <<NOT ALLOWED IN SESSION>>           <<U.RAO>>02190000
   NOTINJOB        = 978, <<NOT ALLOWED IN A JOB>>             <<U.RAO>>02192000
   NOTINUDC        = 979, <<NOT ALLOWED FROM WITHIN A UDC>>    <<01455>>02194000
   COMMAND'GT'BUFFER=980, <<COMMAND > 268 CHARACTERS>>         <<00287>>02196000
   NOCOLON         = 981, <<COMMAND LACKS LEADING COLON>>      <<U.RAO>>02198000
   BADSEQUENCEORDR = 982, <<COMMAND SEQNUM NOT NUMERIC OR BLANK<<01.RO>>02200000
   BADSEQUENCENUM  = 983, <<COMMAND SEQNUM OUT OF SEQUENCE>>   <<01.RO>>02202000
   REQFORMALFDESIG = 984,                                      <<U.RAO>>02204000
   INVLDRESP       = 985, <<EXPECT "YES" OR "NO">>             <<U.RAO>>02206000
   NOTINBREAK      = 986, <<NOT ALLOWED IN BREAK>>             <<U.RAO>>02208000
   NOTYETIMPLEMENTED=987,                                      <<U.RAO>>02210000
   COMTOOMANYLINES = 988,  <<COMMAND HAS > 28 CONTINUATIONS>>  <<U.RAO>>02212000
   PGMABORT        = 989,  <<PROGRAM ABORTED BY USER>>         <<U.RAO>>02214000
   BRKINVLDRESP    = 990,  <<EXPECT "YES" OR "NO">>            <<U.RAO>>02216000
   NOABORTPARMS    = 991, << DISALLOW PARAMETERS WITH ABORT>>  <<01308>>02218000
<< 1000'S RESERVED FOR STORE/RESTORE >>                        <<U.RAO>>02220000
   STORE'FAILED    = 1090, << STORE FAILED >>                  <<04660>>02222000
<< 1100'S RESERVED FOR PRIVATE VOLUMES MESSAGES >>             <<U.RAO>>02224000
   VCSREFNOTALPHA  = 1100, <<MUST START WITH ALPHA>>           <<RV.PV>>02226000
   VCSREFBASE      = VCSREFNOTALPHA,                           <<RV.PV>>02228000
   VCSREFSPECHAR   = 1101, <<CONTAINS SPEC CHAR(S)>>           <<RV.PV>>02230000
   VCSREFTOOLONG   = 1102, <<NAME GTR THAN 8 CHARS>>           <<RV.PV>>02232000
   ORGCOMRDNDVS    = 1103, <<REDUNDANTLY SPECIFIED VS PARM>>   <<RV.PV>>02234000
   ORGCOMSPANCNTXT = 1104, <<SPAN KEYWORD OUT OF CONTEXT>>     <<RV.PV>>02236000
   ALTGRPREFNOTFND = 1105, <<VOL SET/CLASS REF NO FOUND>>      <<RV.PV>>02238000
   ALTGRPBOUND     = 1106, <<CURRENT HVS IS BOUND>>            <<RV.PV>>02240000
   ALTGRPFDOMAIN   = 1107, <<GROUP FILE DOMAIN NOT EMPTY>>     <<RV.PV>>02242000
   ALTGRPVSNOTMNTD = 1108, <<VOL SET NOT PREVIOUSLY MOUNTED>>  <<RV.PV>>02244000
   XXXGRPSPANFAILD = 1109, <<SPAN OPERATION FAILED>>           <<RV.PV>>02246000
   LISTVBADINT      = 1110, <<BAD LEVEL # IN LISTV>>           <<RH.PV>>02248000
   LISTVINTOVFL     = 1111, <<OUT OF BOUNDS>>                  <<RH.PV>>02250000
   LISTVSMCAP       = 1112, <<NEED SM CAPABILITY>>             <<RH.PV>>02252000
   LISTVAMCAP       = 1113, <<NEED AM CAPABILITY>>             <<RH.PV>>02254000
   LISTVEXPECTFILE  = 1114, <<EXPECTED FILE NAME>>             <<RH.PV>>02256000
   LISTVFSERR       = 1115, <<LISTV FILE SYS ERROR>>           <<RH.PV>>02258000
   LISTVEXTRANEOUS  = 1116, <<UNIDENTIFIED FILESET NAME>>      <<RH.PV>>02260000
   LISTV2MP         = 1117,  <<2 MANY PARMS TO LISTV>>         <<RH.PV>>02262000
   ALTVSDVMAX       = 1118, <<MAX ALLOWABLE (8) MEMBERS>>      <<RV.PV>>02264000
   ALTVXXBASE       = ALTVSDVMAX,                             <<RV.PV>> 02266000
   ALTVSDDUPMEMB    = 1119, <<DUP SET MEMBER SPECIFIED>>       <<RV.PV>>02268000
   ALTVCSDUPMEMB    = 1120, <<DUP CLASS MEMBER SPECIFIED>>     <<RV.PV>>02270000
   ALTVSDNOTAVSD    = 1121, <<SPECIFIED VSNAME NOT SET DEF>>   <<RV.PV>>02272000
   ALTVCSNOTAVCD    = 1122, <<SPECIFIED VCNAME NOT CLASS DEF>> <<RV.PV>>02274000
   XXXACCTSPANFAILD= 1123, <<SPAN OPERATION FAILED>>           <<RV.PV>>02276000
   XXXACCTPRMNOTOPT= 1125, <<SPAN PARAMETER NOT OPTIONAL>>     <<RV.PV>>02278000
   <<1126-1135 RESERVED FOR IMPLICITMNT ERRORS>>               <<03.KM>>02280000
   IM'MNTERR       = 1126,   <<MOUNT ERROR RECORDED IN DST>>   <<03.KM>>02282000
   IM'NODST        = 1127,   <<OUT OF DST'S>>                  <<03.KM>>02284000
   IM'NOVDS        = 1128,   <<OUT OF VIRTUAL MEM FOR DST>>    <<03.KM>>02286000
   IM'NOSPACE      = 1129,   <<OUT OF SPACE IN DST>>           <<03.KM>>02288000
   IM'SYSERR       = 1130,   <<UNKNOWN ERROR USING DST>>       <<03.KM>>02290000
<< 1200'S RESERVED FOR USER LOGGING >>                         <<U.RAO>>02292000
<< 1300'S RESERVED FOR DS >>                                   <<U.RAO>>02294000
<< 1400'S RESERVED FOR STARTDEVICE (HELLO, JOB, DATA)>>        <<U.RAO>>02296000
<< 1500 - 1529 RESERVED FOR SHOWJOB >>                         <<U.RAO>>02298000
<< 1530 - 1579 RESERVED FOR SHOWIN AND SHOWOUT >>              <<U.RAO>>02300000
<< 1580 - 1589 RESERVED FOR SHOWDEV >>                         <<U.RAO>>02302000
<< 1590 - 1609 RESERVED FOR STREAM >>                          <<U.RAO>>02304000
<< TELL COMMAND >>                                             <<U.RAO>>02306000
   TELLINVJNUM     = 1610, <<INVALID JOB NUMBER>>              <<U.RAO>>02308000
   TELLINVSNUM     = 1611, <<INVALID SESSION NUMBER>>          <<U.RAO>>02310000
   TELLXPCTJORS    = 1612, <<EXPECT "J" OR "S">>               <<U.RAO>>02312000
   TELLXPCTJSORAT  = 1613, <<EXPECT "@J" OR "@S" OR "@">>      <<U.RAO>>02314000
   TELLJXPCTJUSTAT = 1614, <<JOB NAME CAN'T BE "@XX">>         <<U.RAO>>02316000
   TELLJNAME2LONG  = 1615, <<NAME > 8 CHARACTERS>>             <<U.RAO>>02318000
   TELLJXPCTALPHA  = 1616, <<JOB NAME MUST START WITH ALPHA>>  <<U.RAO>>02320000
   TELLXPCTPERIOD  = 1617, <<EXPECTED "." BETWEEN USER&ACCT>>  <<U.RAO>>02322000
   TELLJOBIDMISSIN = 1618, <<MISSING JOBID>>                   <<U.RAO>>02324000
   TELLNOSUCHJOBS  = 1619, <<NO MATCH ON JOBID>>               <<U.RAO>>02326000
   TELLSENDONLYTARGET                                          <<01652>>02328000
                   = 1620,  << ONLY TARGET IS SENDER >>        <<01652>>02330000
   TELLJOBINVALID  = 1627,     << TELL TO JOB INVALID>>        <<04208>>02332000
<< TELLOP COMMAND >>                                           <<U.RAO>>02334000
   TELLOPMSGPROBLEM= 1626,<<PROBLEM WITH GENMSG>>              <<U.RAO>>02336000
<< PTAPE COMMAND >>                                            <<U.RAO>>02338000
   PTAPE2MP        = 1630, <<PTAPE MORE THAN 1 PARAMETER>>     <<U.RAO>>02340000
   PTAPENOFILE     = 1631, <<NO TARGET FILE WAS SPECIFIED>>    <<U.RAO>>02342000
   PTAPEOPENFAILED = 1632, <<UNABLE TO OPEN DISC FILE>>        <<U.RAO>>02344000
   PTAPEFSERR      = 1633, <<READ ERROR ON PAPER TAPE>>        <<U.RAO>>02346000
   PTAPETOFSERR    = 1634, <<WRITE ERROR ON DISC FILE>>        <<U.RAO>>02348000
   PTAPECLOSEERR   = 1635, <<UNABLE TO CLOSE DISC FILE>>       <<U.RAO>>02350000
   PTAPETERMFILE   = 1636, <<TERMINAL IO ERROR>>               <<U.RAO>>02352000
<< SPEED COMMAND >>                                            <<U.RAO>>02354000
   SPEED2MP        = 1640, <<MORE THAN 2 PARAMETERS FOR SPEED>><<U.RAO>>02356000
   SPEEDNOTENUF    = 1641, <<NEITHER INPUT NOR OUTPUT SPEEDS>> <<U.RAO>>02358000
   ERRINSPEED      = 1642,<<ILLEGAL INPUT SPEED>>              <<U.RAO>>02360000
   ERROUTSPEED     = 1643,<<ILLEGAL OUTPUT SPEED>>             <<U.RAO>>02362000
   NOTVER          = 1644,<<SPEED CHANGE NOT VERIFIED>>        <<U.RAO>>02364000
   SPEEDINEQUALOUT = 1645,  <<WARN. IN = OUT. SERIES 33>>      <<0306>> 02366000
   SPEEDNOTEQUAL   = 1646,  <<IN MUST EQUAL OUT. SERIES 33>>   <<0306>> 02368000
<< ALLOCATE AND DEALLOCATE COMMANDS >>                         <<U.RAO>>02370000
   ALLOC2MP        = 1650, <<DE/ALLOCATE MORE THAN 2 PARAMETERS<<U.RAO>>02372000
   ALLOCNOTENUF    = 1651, <<NO PARMS TO [DE]ALLOCATE>>        <<U.RAO>>02374000
   PROCNOTALL      = 1652,<<PROCEDURE NOT ALLOCATED>>          <<U.RAO>>02376000
   PROCALLOC       = 1653,<<PROCEDURE ALREADY ALLOCATED>>      <<U.RAO>>02378000
   PROGNOTALL      = 1654,<<PROGRAM NOT ALLOCATED>>            <<U.RAO>>02380000
   PROGALLOC       = 1655,<<PROGRAM ALREADY ALLOCATED>>        <<U.RAO>>02382000
   ALLOCXPROGPROC  = 1656,  <<EXPECT "PROGRAM","PROCEDURE">>   <<U.RAO>>02384000
   ALLOCNOBACKREF  = 1657, <<NO BACK REF FOR ALLOCATE>>        <<08.RO>>02386000
   ALLOCNOSYSDEF   = 1658, <<DISALLOW SYSDEF FILE FOR ALLOC>>  <<08.RO>>02388000
<< QUANTUM COMMAND >>                                          <<U.RAO>>02390000
   QUANTUM2MP      = 1660, <<MORE THAN 4 PARMS TO QUANTUM>>    <<U.RAO>>02392000
   QUANTUMNOTENUF  = 1661, <<NO PARMS TO QUANTUM>>             <<U.RAO>>02394000
   QUANTUMPRIBNDS  = 1662, <<NOT(150<=PRIORITY<=250)>>         <<U.RAO>>02396000
   QUANTUMTIME     = 1663, <<NOT(1<=QUANTUM SIZE<=65535>>      <<U.RAO>>02398000
   QUANTUM'NOMO    = 1664, <<QUANTUM REPLACED BY TUNE.>>       <<01724>>02400000
<< ALLOCATE AND DEALLOCATE  (CONT.) >>                         <<00833>>02402000
   NODEALOCPROC    = 1666, <<UNABLE TO DEALLOCATE PROCEDURE>>  <<00833>>02404000
   NOALOCPROC      = 1667, <<UNABLE TO ALLOCATE PROCEDURE>>    <<00833>>02406000
   NODEALOCPROG    = 1668, <<UNABLE TO DEALLOCATE PROGRAM>>    <<00833>>02408000
   NOALOCPROG      = 1669, <<UNABLE TO ALLOCATE PROGRAM>>      <<00833>>02410000
<< SHOWQ COMMAND >>                                            <<U.RAO>>02412000
   WARNXPARMSIGNORED=1670, <<COMMAND HAS NO PARMS, PARMS IGNORE<<U.RAO>>02414000
<< SETMSG COMMAND >>                                           <<U.RAO>>02416000
   SETMSGPARMPROB  = 1675, <<MISSING OR UNKNOWN PARM>>         <<U.RAO>>02418000
   SETMSGEXTRAPARM = 1676, <<TOO MANY PARMS TO SETMSG>>        <<U.RAO>>02420000
<< SETDUMP COMMAND >>                                          <<U.RAO>>02422000
   SETDUMPUNKNOWN  = 1680, <<UNKNOWN OPTION TO SETDUMP>>       <<U.RAO>>02424000
   SETDUMP2MP      = 1681, <<MORE THAN 4 PARMS TO SETDUMP>>    <<U.RAO>>02426000
<< EOD COMMAND >>                                              <<U.RAO>>02428000
      BADLOGONSTRING = 1684,  << BAD HELLO/JOB/DATA >>         <<02329>>02430000
   IGNORED         = 1685,<<:EOD IGNORED>>                     <<U.RAO>>02432000
<< RESUME COMMAND >>                                           <<U.RAO>>02434000
   ONLYINBREAK     = 1686,<<ONLY ALLOWED IN BREAK>>            <<U.RAO>>02436000
<< GETRIN AND FREERIN COMMANDS >>                              <<U.RAO>>02438000
   GETRINNOPASS    = 1690, <<NO RIN PASSWORD SUPPLIED>>        <<U.RAO>>02440000
   FREERINNORIN    = 1691, <<NO RIN NUMBER TO FREERIN>>        <<U.RAO>>02442000
   RINTABFULL      = 1692, <<RIN TABLE FULL>>                  <<U.RAO>>02444000
   RINNOTAL        = 1693, <<RIN NOT ALLOCATED, CAN'T BE FREED><<U.RAO>>02446000
   RININUSE        = 1694, <<RIN IN USE, CAN'T DEALLOCATE>>    <<U.RAO>>02448000
   RININVINT       = 1695, <<BAD INTEGER AS RIN NUMBER>>       <<U.RAO>>02450000
   RINPASS2LONG    = 1696, << PASSWORD LONGER THEN 8 CHARS>>   <<02367>>02452000
   RINPASSSPECHAR  = 1697, << " " CONTAINS SPECIAL CHARS  >>   <<02367>>02454000
   RINPASSTALPHA   = 1698, << MUST START W. ALPHA CHAR. >>     <<02367>>02456000
<< JOBPRI COMMAND >>                                           <<U.RAO>>02458000
   JOBPRI2MP       = 1700, <<MORE THAN TWO PARMS>>             <<U.RAO>>02460000
   JOBPRIUNKNOWNQ  = 1701, <<NOT ONE OF CS,DS,ES,0>>           <<U.RAO>>02462000
   JOBPRIWARNNOT0  = 1702, <<0 NOT ALLOWED, FORCED TO CS>>     <<U.RAO>>02464000
   JOBPRIDEFCSMAXDS= 1703,                                     <<U.RAO>>02466000
   JOBPRIDEFCSMAXES= 1704,                                     <<U.RAO>>02468000
   JOBPRIDEFDSMAXES= 1705,                                     <<U.RAO>>02470000
<< SETJCW COMMAND >>                                           <<U.RAO>>02472000
   SETJCWNONAME    = 1710, <<JCW NAME NOT FOUND>>              <<U.RAO>>02474000
   SETJCWNOVALUE   = 1711, <<VALUE NOT PRESENT>>               <<U.RAO>>02476000
   SETJCWNUM2LARGE = 1712, <<EXCEEDS 65535>>                   <<U.RAO>>02478000
   SETJCWINVOCTDGT = 1713, <<FOUND 8 OR 9>>                    <<U.RAO>>02480000
   SETJCWOKVAL2BIG = 1714, <<MAX OK IS 65535>>                 <<U.RAO>>02482000
   SETJCWWARNVAL   = 1715, <<MAX WARN IS 49151>>               <<U.RAO>>02484000
   SETJCWFATALVAL  = 1716, <<MAX FATAL IS 32767>>              <<U.RAO>>02486000
   SETJCWSYSTEMVAL = 1717, <<MAX SYSTEM IS 16383>>             <<U.RAO>>02488000
   SETJCWNAME2LONG = 1718, <<NAME > 255 CHAR.>>                <<U.RAO>>02490000
   SETJCWNAMENOALP = 1719, <<NO LEADING ALPHA>>                <<U.RAO>>02492000
   SETJCWNOSUCHJCW = 1720, <<VALUE JCW DOES NOT EXIST>>        <<U.RAO>>02494000
   SETJCW2MP       = 1721, <<EXTRANEOUS PARM TO SETJCW>>       <<U.RAO>>02496000
   JCWTABOVERFLOW  = 1722, <<JDT OVERFLOW>>                    <<U.RAO>>02498000
   SETJCWFATINUDC  = 1723, << UDC MAY FLUSH. >>                <<01893>>02500000
   SETJCWFATINJOB  = 1724, << JOB MAY FLUSH. >>                <<01893>>02502000
   SETJCWUNKNOWN   = 1725, << EXTRANEOUS CHAR >>               <<04646>>02504000
<< SHOWJCW COMMAND >>                                          <<U.RAO>>02506000
   SHOWJCW2MP      = 1730, <<EXTRANEOUS PARM TO SHOWJCW>>      <<U.RAO>>02508000
   SHOWJCWNOSCHJCW = 1731, <<JCW NAMED NOT FOUND>>             <<U.RAO>>02510000
<< IF, ELSE, ENDIF COMMANDS >>                                 <<U.RAO>>02512000
   IFXPCTRELATION  = 1735, <<REST OF RELATIONAL MISSING>>      <<U.RAO>>02514000
   IFXPCTRELOP     = 1736, <<EXPECTED RELATIONAL OPERATOR>>    <<U.RAO>>02516000
   IFNOSUCHJCW     = 1737, <<JCW UNDEFINED>>                   <<U.RAO>>02518000
   IFXPCTJCWVAL    = 1738, <<EXPECTED A SECOND JCW>>           <<U.RAO>>02520000
   IFXPCTCLOSPAREN = 1739, <<EXPECTED A MATCHING ")">>         <<U.RAO>>02522000
   IFNOPARMS       = 1740, <<NO PARMS TO IF COMMAND>>          <<U.RAO>>02524000
   IFNOTHEN        = 1741, <<NO THEN FOUND>>                   <<U.RAO>>02526000
   IFEXTRANEOUS    = 1742, <<EXTRANEOUS PARMS TO IF>>          <<U.RAO>>02528000
   IFNESTINGTOOGREAT=1743, <<GT 15 LEVELS OF IF'S>>            <<U.RAO>>02530000
   ELSE2MP         = 1744, <<ELSE HAS NO PARMS>>               <<U.RAO>>02532000
   ELSEUNPAIRED    = 1745, <<UNPAIRED ELSE FOUND>>             <<U.RAO>>02534000
   ENDIF2MP        = 1746, <<ENDIF HAS NO PARMS>>              <<U.RAO>>02536000
   ENDIFUNPAIRED   = 1747, <<UNPAIRED IF FOUND>>               <<U.RAO>>02538000
   ELSE2MANYELSES  = 1748, <<REDUNDANT IF FOUND>>              <<U.RAO>>02540000
   IFS'NEQ'ENDIFS  = 1749, <<IFS <> ENDIFS WHEN EXITING BREAK>><<00835>>02542000
<< REDO COMMAND >>                                             <<U.RAO>>02544000
   REDOITOOLONG    = 1755, <<EXCEEDS MAX BUF LENGTH>>          <<U.RAO>>02546000
   REDODELGARBAGE  = 1756, <<GARBAGE IN DELETE FIELD>>         <<U.RAO>>02548000
<< CLINE COMMAND >>                                            <<U.RAO>>02550000
   ERRCTABFULL     = 1760, <<CLINE EQUATION TABLE FULL>>       <<U.RAO>>02552000
   ERRCNOTFOUND    = 1761, <<BACK CLINE RE. NOT FOUND>>        <<U.RAO>>02554000
   ERR2MCREF       = 1762, <<TOO MANY BACK CLINE REFS.>>       <<U.RAO>>02556000
   ERRCLINEDESIG   = 1763, <<INVALID CLINE DESIGNATOR>>        <<U.RAO>>02558000
   ERRLNOTFOUND    = 1764, <<CLINE EQUATION NOT FOUND>>        <<U.RAO>>02560000
   CLN'NO'NAME     = 1765, <<NAME  MISSING>>                   <<U.RAO>>02562000
   CLNMBEDSPECIALS = 1766, <<EMBEDDED SPECIALS IN PROPER NAME>><<U.RAO>>02564000
   CLNLEADINGNUM   = 1767, <<NAME MAY NOT BEGIN WITH NUMERIC>> <<U.RAO>>02566000
   CLNNAME2LONG    = 1768, <<NAME > 8 CHAR LONG>>              <<U.RAO>>02568000
   CLNXPCTEQSIGN   = 1769, <<EXPECTED EQUALS SIGN>>            <<U.RAO>>02570000
   CLNKEYVALNOTOPT = 1770, <<VALUE NOT OPTIONAL>>              <<U.RAO>>02572000
   CLNSYNERR       = 1771, <<SYNTAX ERROR IN LINE SPECIFICATION<<U.RAO>>02574000
   CLNBADINT       = 1772, <<BINARY FAILED ON INTEGER>>        <<U.RAO>>02576000
   CLNBNDSERR0'377 = 1773, <<OUT OF RANGE>>                    <<U.RAO>>02578000
   CLNXPCTCOLON    = 1774, <<EXPECTED A COLON HERE>>           <<U.RAO>>02580000
   CLNXPCTKEY      = 1775, <<EXPECTED A KEYWORD>>              <<U.RAO>>02582000
   CLNDEV2LONG     = 1776, <<DEVICE NAME > 8 CHAR LONG>>       <<U.RAO>>02584000
   CLNDUPKEY       = 1777, <<REDUNDANT KEYWORD>>               <<U.RAO>>02586000
   CLNBNDSERR0'63  = 1778, <<INT OUT OF RANGE>>                <<U.RAO>>02588000
   CLNBNDSERR0'15  = 1779, <<INT OUT OF RANGE>>                <<U.RAO>>02590000
   CLNDRIVERNAM2LN = 1780, <<DRIVER NAME > 8 CHAR LONG>>       <<U.RAO>>02592000
   CLNBNDSERR0'127 = 1781, <<INT OUT OF RANGE>>                <<U.RAO>>02594000
   CLNREQLINE      = 1782, <<REQUIRES AT LEAST A LINE NAME>>   <<U.RAO>>02596000
   CLNREQADESIG    = 1783, <<REQUIRES ACTUAL LINE DESIGNATOR>> <<U.RAO>>02598000
   CLNBREF2MP      = 1784, <<BACK REF WITH PARMS ILLEGAL>>     <<U.RAO>>02600000
<< HELP MESSAGES >>                                            <<01.EB>>02602000
   HELPOFFSET      =1751, << HELP RETURNS 50-60 >>             <<01.EB>>02604000
   OPENCATFAIL     = 1800,                                     <<01.EB>>02606000
   HELPTERMINATED  = 1801,                                     <<01.EB>>02608000
   CATERR'         = HELPOFFSET +51, <<1802>>                  <<06.EB>>02610000
   NOUSERLABEL'    = HELPOFFSET +52, <<1803>>                  <<06.EB>>02612000
   NOHELPDIR'      = HELPOFFSET +53, <<1804>>                  <<06.EB>>02614000
   USERLABELERR'   = HELPOFFSET +54, <<1805>>                  <<06.EB>>02616000
   OPENSTDINERR'   = HELPOFFSET +55, <<1806>>                  <<06.EB>>02618000
   READERR'        = HELPOFFSET +56, <<1807>>                  <<06.EB>>02620000
   LISTERR'        = HELPOFFSET +57, <<1808>>                  <<06.EB>>02622000
<< 1900 - 1999 RESERVED FOR USER DEFINED COMMANDS (UDC) >>     <<09.EB>>02624000
<< 3000-4000 ARE RESERVED FOR OPERATOR COMMANDS>>              <<00552>>02626000
                                                               <<00552>>02628000
OPCOMNOTALLOW=3000,      <<OPERATOR COMMAND IS NOT ALLOWED>>   <<00552>>02630000
   SPECIALCOM=3800,         <<ONLY RECALL,REPLY & RESUME ALLOWE<<00594>>02632000
   UDCSTACKOVRFLOW   = 1907,  <<STACK OVERFLOW WHILE>>         <<08.RO>>02634000
      <<PROCESSING USER DEFINED COMMANDS - TOO DEEPLY NESTED.>><<08.RO>>02636000
   COMOPENFAIL     = 1910, << ERROR OPENING COMMAND FILE >>    <<00256>>02638000
   COMEOF          = 1911, << EOF IN COMMAND.PUB.SYS     >>    <<00256>>02640000
   COMLOCKFAIL     = 1912, << ERROR LOCKING COMMAND FILE >>    <<00256>>02642000
   COMUNLOCKFAIL   = 1913, << ERROR UNLOCKING COMMAND FILE >>  <<00256>>02644000
   COMREADFAIL     = 1914, << ERROR READING COMMAND FILE >>    <<00256>>02646000
   COMWRITEFAIL    = 1915, << ERROR WRITING COMMAND FILE >>    <<00256>>02648000
<< IML/3000 ERROR MESSAGES >>                                  <<02845>>02650000
   TOOMANYPARMS    = 3820, << TOO MANY PARMS FOR IML CMND >>   <<02845>>02652000
   EXPECTSEMIC     = 3821, << EXPECT SEMICOLON DELIM >>        <<02845>>02654000
   UNKNOWNKEY      = 3822, << INVALID KEYWORD >>               <<02845>>02656000
   REDNDENH        = 3823, << ENHANCE REDUNDANTLY SPECD. >>    <<02845>>02658000
   EXPCTEQUAL      = 3824, << EXPECTED EQUAL AS DELMITER >>    <<02845>>02660000
   ILLVALENH       = 3825, << ILLEGAL VALUE FOR ENHANCE >>     <<02845>>02662000
   REDNDFMT        = 3826, << FORMAT REDUNDANTLY SPECD. >>     <<02845>>02664000
   ILLVALFMT       = 3827, << ILLEGAL VALUE FOR FORMAT >>      <<02845>>02666000
   REDNDPRI        = 3828, << PRI. REDUNDANTLY SPECD. >>       <<02845>>02668000
   ILLVALPRI       = 3829, << ILLEGAL VALUE FOR PRI. >>        <<02845>>02670000
                                                               <<04193>>02672000
<< System Internal Errors.  Alternatives to SUDDENDEATH. >>    <<04193>>02674000
   COPYSCREEN         = 1,   << Request to send in screen. >>  <<04193>>02676000
   STATUS'AND'P       = 2,   << Reports caller's stack parms. ><<04193>>02678000
   PRINTCARETERR      = 101, << PRINTCARET bounds error. >>    <<04193>>02680000
                                                               <<04193>>02682000
                                                               <<03.EB>>02684000
      <<FILE SYSTEM DEFINITIONS >>                                      02686000
                                                                        02688000
      FLSECURE=22,                                                      02690000
      FLSECMATRIX=10,                                                   02692000
                                                                        02694000
      <<DST ENTRIES USED THROUGHOUT>>                                   02696000
                                                                        02698000
      DDSDST=20,                                                        02700000
      JMATDST=25,                                                       02702000
                                                               <<00851>>02704000
      <<Definitions for finding the PLABEL for SHOWCOM>>                02706000
                                                                        02708000
      SYSDB=%1000,                                                      02710000
      PLAB'SHOWCOM=%133,                                                02712000
      << FCONTROL DEFINITIONS >>                               <<00851>>02714000
                                                               <<00851>>02716000
      TIMEOUT      = 4,                                        <<00851>>02718000
      DISABLEBREAK = 14,                                       <<00851>>02720000
      ENABLEBREAK  = 15,                                       <<00851>>02722000
       DSBTIMER = 20, << FCONTROL INPUT TIMER DISABLE >>       <<01033>>02724000
                                                                        02726000
     <<TABLE LENGTHS USED THROUGHOUT>>                                  02728000
                                                                        02730000
     JMATLEN=26,                                                        02732000
                                                                        02734000
      <<SIRS USED THROUGHOUT>>                                          02736000
                                                                        02738000
     FILESIR=37,                                                        02740000
                                                                        02742000
      <<WORDS/FLAGS>>                                                   02744000
                                                                        02746000
   JMATTIMESTAMP   = 19,  <<OFFSET IN JMAT ENTRY OF TIME STAMP><<U.RAO>>02748000
JMATSEQUENCE = 24,  <<OFFSET IN JMAT TO SEQUENCED BIT>>        <<01.RO>>02750000
   JITCPUTIME      = 50,  <<DOUBLE IN JIT FO JOB CPU TIME>>    <<U.RAO>>02752000
JITASSPTR=5,         <<ASSOCIATE TABLE HEADER ENTRY>>          <<00552>>02754000
JITALLOW=40,         <<ALLOW TABLE >>                          <<00552>>02756000
JITALLOW'L=3,        <<ALLOW TABLE LENGTH>>                    <<00552>>02758000
      COLDLOADID=%1075,                                                 02760000
      LINFO=%1167,                                                      02762000
      FLAGX=%1176,                                                      02764000
      LOGFILENO=%1205,                                                  02766000
      LOGFILESIZE=%1203,                                                02768000
      LOGPROCESS=%1150,                                                 02770000
      WELCOMEDST = %1277,                                               02772000
      MAXQUEUE=%1333,                                                   02774000
      DEFAULTQUEUE=%1334,                                               02776000
   SYSUDCFLAG=%1376,      <<SYSTEM LEVEL UDC FLAG>>            <<00416>>02778000
   SYSVERSION      = %1116,  <<MPE VERSION LETTER>>            <<U.RAO>>02780000
   SYSUPDATE       = %1114,  <<MPE UPDATE LEVEL (ASCII)>>      <<U.RAO>>02782000
   SYSFIX          = %1115,  <<MPE FIX LEVEL>>                 <<U.RAO>>02784000
      PXGWATTRIBUTE = 2 ,                                               02786000
      PXFWBREAK = 32 ,                                                  02788000
      PXFWQINIT=3,   <<OFFSET IN PCBX OF QINIT VALUE>>         <<U.RAO>>02790000
      PXFCPUTIME   = 24,   <<OFFSET TO CPUTIME DOUBLE>>        <<U.RAO>>02792000
      PXFUDC       = 22,   <<UDC FLAG>>                        <<U.RAO>>02794000
      PXGWFLAGS = 6,                                                    02796000
      PXGWJMATX=3,                                                      02798000
      PXGWJDT = 5,                                                      02800000
      PXGWJIT = 6,                                                      02802000
      PXGWJOBIN = 3 ,                                                   02804000
      CPCB = 4,                                                         02806000
      PCBB = 3,                                                         02808000
      PCBSIZE = 16,                                                     02810000
      PCBJSMAIN=2,  <<JOB/SESSION MAIN PROCESS TYPE IN PCB>>   <<U.RAO>>02812000
      PXFWRESOURCE = 5,                                                 02814000
      PXGWJOBLIST = 4;                                                  02816000
                                                                        02818000
      <<DEFINES USED THROUGHOUT>>                                       02820000
                                                                        02822000
      <<CODE DEFINITIONS>>                                              02824000
                                                                        02826000
      DEFINE                                                            02828000
      DISABLE=ASSEMBLE(SED 0)#,                                         02830000
      ENABLE=ASSEMBLE(SED 1)#,                                          02832000
      DUPLICATE = ASSEMBLE (DUP)#,                                      02834000
      CC = STATUS . (6:2)#,                                             02836000
      LBPARMDECS=ARRAY LPARM (*) = PARMS;                               02838000
                 BYTE ARRAY BPARM (*) = PARMS #,                        02840000
      NEXTLINE=ASSEMBLE (ZERO,DZRO);                           <<01881>>02842000
               PRINT (*, *, *)#,                               <<01881>>02844000
                                                               <<01709>>02846000
      PCBNUM = ((ABSOLUTE(CPCB)-ABSOLUTE(PCBB))/PCBSIZE)#,              02848000
      PCB09=ABSOLUTE(ABSOLUTE(CPCB)+9)#,  <<WORD 9 OF CURRENT P<<U.RAO>>02850000
      PCBPTYPE=(6:3)#,  <<PROCESS TYPE FIELD IN PCB09>>        <<U.RAO>>02852000
      SETXPXGLOB=PUSH (DL);                                             02854000
                 X := TOS -PS0 (-1)#,                                   02856000
      SETXPXFIXED=PUSH(DL);                                             02858000
                  X := TOS - PS0(-2) #,                                 02860000
      SETJIT=PUSH(DL);                                                  02862000
             TOS:=ARRDB6(TOS-PS0(-1)).(6:10)#,                          02864000
<<        DEF'MOVEFROMDSEG          >>                         <<U.RAO>>02866000
<< To use, declare SUBROUTINE DEF'MOVEFROMDSEG >>              <<U.RAO>>02868000
   DEF'MOVEFROMDSEG =                                          <<U.RAO>>02870000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                  <<U.RAO>>02872000
         VALUE TARGET,DSTN,OFFSET,COUNT;                       <<U.RAO>>02874000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                     <<U.RAO>>02876000
      BEGIN                                                    <<U.RAO>>02878000
         X := TOS; << SAVE RETURN ADDRESS >>                   <<U.RAO>>02880000
         ASSEMBLE(MFDS 0);                                     <<U.RAO>>02882000
         TOS := X; << RESTORE RETURN ADDRESS >>                <<U.RAO>>02884000
      END #,                                                   <<U.RAO>>02886000
                                                               <<U.RAO>>02888000
<<        DEF'MOVETODSEG            >>                         <<U.RAO>>02890000
<< To use, declare SUBROUTINE DEF'MOVETODSEG >>                <<U.RAO>>02892000
   DEF'MOVETODSEG =                                            <<U.RAO>>02894000
      MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                    <<U.RAO>>02896000
         VALUE DSTN,OFFSET,SOURCE,COUNT;                       <<U.RAO>>02898000
         LOGICAL DSTN,OFFSET,SOURCE,COUNT;                     <<U.RAO>>02900000
      BEGIN                                                    <<U.RAO>>02902000
         X := TOS;                                             <<U.RAO>>02904000
         ASSEMBLE(MTDS 0);                                     <<U.RAO>>02906000
         TOS := X;                                             <<U.RAO>>02908000
      END #,                                                   <<U.RAO>>02910000
                                                               <<U.RAO>>02912000
                                                                        02914000
      << FIELDS/FLAGS>>                                                 02916000
                                                                        02918000
      PXGFJOBTYPE = 2:2 #,                                              02920000
      PXGFDUP  = 4:1 #,                                                 02922000
      PXGFINTER = 5:1 #,                                                02924000
                                                                        02926000
<<TEST FOR INTERACTIVE USER.  LEAVES TRUE ON TOS IF>>          <<02.RO>>02928000
<<USER WAS INTERACTIVE.  GETS IT FROM PXGLOB>>                 <<02.RO>>02930000
                                                               <<02.RO>>02932000
INTERACTIVETEST =   SETXPXGLOB+PXGWFLAGS;                      <<02.RO>>02934000
                    TOS := ARRDB0(X).(PXGFINTER)#,             <<02.RO>>02936000
                                                               <<02.RO>>02938000
<<DELIMITER ARRAY DECLARATIONS>>                               <<U.RAO>>02940000
                                                               <<U.RAO>>02942000
COMMACR = [8/",",8/%15]#,                                      <<U.RAO>>02944000
SEMICR  = [8/";",8/%15]#,                                      <<U.RAO>>02946000
COMMASEMICR = [8/",",8/";",8/%15,8/0]D#,                       <<U.RAO>>02948000
                                                               <<U.RAO>>02950000
      <<EXECUTOR PROCEDURE HEADING>>                                    02952000
                                                                        02954000
      EXECUTORHEAD =                                                    02956000
      (PARMSP,ERRNUM,PARMNUM);                                          02958000
      BYTE ARRAY PARMSP;                                                02960000
      INTEGER ERRNUM,PARMNUM #,                                         02962000
                                                                        02964000
      SMCAP = LOGICAL(ARRDB2(X).(0:1))#,                       <<U.RAO>>02966000
      AMCAP = LOGICAL(ARRDB2(X).(1:1))#,                       <<U.RAO>>02968000
      ALCAP = LOGICAL(ARRDB2(X).(2:1))#,                       <<U.RAO>>02970000
      GLCAP = LOGICAL(ARRDB2(X).(3:1))#,                       <<U.RAO>>02972000
      DICAP = LOGICAL(ARRDB2(X).(4:1))#,                       <<U.RAO>>02974000
      OPCAP = LOGICAL(ARRDB2(X).(5:1))#;                       <<U.RAO>>02976000
                                                                        02978000
                                                              <<00.GEN>>02980000
                                                              <<00.GEN>>02982000
<<  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>>02984000
                                                              <<00.GEN>>02986000
DEFINE D'INX=      DPPRESULT #,        <<"PPRESULT" FMT>>     <<00.GEN>>02988000
       D'INX1=     PPRESULT #,                                <<00.GEN>>02990000
       D'INX2=     PPRESULT(1) #,                             <<04.GEN>>02992000
       D'TYPE=     PPRESULT(2) #,                             <<00.GEN>>02994000
       D'FNAME=    PPRESULT(3) #,                             <<00.GEN>>02996000
       D'VNAME=    PPRESULT(3) #,                             <<00.GEN>>02998000
       D'GNAME=    PPRESULT(7) #,                             <<00.GEN>>03000000
       D'UNAME=    PPRESULT(7) #,                             <<00.GEN>>03002000
       D'ANAME=    PPRESULT(11) #,                            <<00.GEN>>03004000
       D'LOCKWORD= PPRESULT(15) #,                            <<00.GEN>>03006000
       G'FNAME=    PPRESULT(19) #,                            <<00.GEN>>03008000
       G'VNAME=    PPRESULT(19) #,                            <<00.GEN>>03010000
       G'GNAME=    PPRESULT(23) #,                            <<00.GEN>>03012000
       G'UNAME=    PPRESULT(23) #,                            <<00.GEN>>03014000
       G'ANAME=    PPRESULT(27) #,                            <<00.GEN>>03016000
       D'BFNAME=    BPPRESULT(6) #,                           <<00.GEN>>03018000
       D'BVNAME=    BPPRESULT(6) #,                           <<00.GEN>>03020000
       D'BGNAME=    BPPRESULT(14) #,                          <<00.GEN>>03022000
       D'BUNAME=    BPPRESULT(14) #,                          <<00.GEN>>03024000
       D'BANAME=    BPPRESULT(22) #,                          <<00.GEN>>03026000
       D'BLOCKWORD= BPPRESULT(30) #,                          <<00.GEN>>03028000
       G'BFNAME=    BPPRESULT(38) #,                          <<00.GEN>>03030000
       G'BVNAME=    BPPRESULT(38) #,                          <<00.GEN>>03032000
       G'BGNAME=    BPPRESULT(46) #,                          <<00.GEN>>03034000
       G'BUNAME=    BPPRESULT(46) #,                          <<00.GEN>>03036000
       G'BANAME=    BPPRESULT(54) #;                          <<00.GEN>>03038000
                                                              <<00.GEN>>03040000
  <<LENGTH OF "DIRECSCAN" RECIP PARAMETER  >>                 <<00.GEN>>03042000
  <<AND OFFSET THEREIN TO "PPRESULT" AT END>>                 <<00.GEN>>03044000
  <<OF PARAMETER TO FACILITATE EXTENSIONS  >>                 <<00.GEN>>03046000
                                                              <<00.GEN>>03048000
                                                               <<01.PV>>03052000
                                                               <<01.PV>>03054000
<<  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>>03056000
EQUATE                                                         <<01.PV>>03058000
   NAMESIZE        = 4,                  <<UNPACKED REP>>      <<01.PV>>03060000
                   <<ENTRY EQUATES>>                           <<01.PV>>03062000
                                                               <<01.PV>>03064000
                                                               <<01.PV>>03066000
<< ACCOUNT ENTRY >>                                            <<01.PV>>03068000
   ANAME           = 0,                  <<NAME>>              <<01.PV>>03070000
   AGIPNTR         = ANAME+NAMESIZE,     <<GROUP INDEX PNTR>>  <<01.PV>>03072000
   AUIPNTR         = AGIPNTR+1,          <<USER INDEX PNTR>>   <<01.PV>>03074000
   ACAP            = AUIPNTR+1,          <<CAPABILITY>>        <<01.PV>>03076000
   ALATTR          = ACAP+2,                                   <<01.PV>>03078000
   APASS           = ALATTR+2,                                 <<01.PV>>03080000
   ADFSCOUNT       = APASS+NAMESIZE,     <<DISC FILE SPACE>>   <<01.PV>>03082000
   ADFSCOUNTD      = ADFSCOUNT /2,                             <<01.PV>>03084000
   ADFSLIMIT       = ADFSCOUNT+2,                              <<01.PV>>03086000
   ADFSLIMITD      = ADFSLIMIT /2,                             <<01.PV>>03088000
   ACPUCOUNT       = ADFSLIMIT+2,        <<CPU TIME>>          <<01.PV>>03090000
   ACPUCOUNTD      = ACPUCOUNT /2,                             <<01.PV>>03092000
   ACPULIMIT       = ACPUCOUNT+2,                              <<01.PV>>03094000
   ACPULIMITD      = ACPULIMIT /2,                             <<01.PV>>03096000
   ACONTIMECOUNT   = ACPULIMIT+2,        <<CONNECT TIME>>      <<01.PV>>03098000
   ACONTIMECOUNTD  = ACONTIMECOUNT /2,                         <<01.PV>>03100000
   ACONTIMELIMIT   = ACONTIMECOUNT+2,                          <<01.PV>>03102000
   ACONTIMELIMITD  = ACONTIMELIMIT /2,                         <<01.PV>>03104000
   ASECW           = ACONTIMELIMIT+2,                          <<01.PV>>03106000
   APURGEFLAGW     = ASECW,                                    <<01.PV>>03108000
   AMAXJOBW        = ASECW+1,            <<MAX. JOB PRIORITY>> <<01.PV>>03110000
   ASPARE1         = AMAXJOBW+1,                               <<RV.PV>>03112000
   ASPARE2         = ASPARE1 +1,                               <<RV.PV>>03114000
   ASIZE           = ASPARE2 +1,                               <<RV.PV>>03116000
                                                               <<01.PV>>03118000
<<GROUP ENTRY>>                                                <<01.PV>>03120000
   GNAME           = 0,                  <<NAME>>              <<01.PV>>03122000
   GFIPNTR         = GNAME+NAMESIZE,     <<FILE INDEX>>        <<01.PV>>03124000
   GPASS           = GFIPNTR+1,          <<PASSWORD>>          <<01.PV>>03126000
   GDFSCOUNT       = GPASS+NAMESIZE,     <<DISC FILE SPACE>>   <<01.PV>>03128000
   GDFSLIMIT       = GDFSCOUNT+2,                              <<01.PV>>03130000
   GCPUCOUNT       = GDFSLIMIT+2,        <<CPU TIME>>          <<01.PV>>03132000
   GCPULIMIT       = GCPUCOUNT+2,                              <<01.PV>>03134000
   GCONTIMECOUNT   = GCPULIMIT+2,                              <<01.PV>>03136000
   GCONTIMELIMIT   = GCONTIMECOUNT+2,                          <<01.PV>>03138000
   GSEC            = GCONTIMELIMIT+2,                          <<01.PV>>03140000
   GPURGEFLAGW     = GSEC,                                     <<01.PV>>03142000
   GCAP            = GSEC +2,                                  <<01.PV>>03144000
   GLINKAGE        = GCAP+1,                                   <<01.PV>>03146000
   GVSDIPNTR       = GLINKAGE+1,         <<VS DEF INDEX PNTR>> <<01.PV>>03148000
   GHVSNAME        = GVSDIPNTR+1,        <<HOME VS NAME>>      <<01.PV>>03150000
   GHVSANAME       = GHVSNAME,           << "   "  ACCT NAME>> <<01.PV>>03152000
   GHVSGNAME       = GHVSANAME+NAMESIZE, << "   "  GRP  NAME>> <<01.PV>>03154000
   GHVSVSNAME      = GHVSGNAME+NAMESIZE, << "   "  VS   NAME>> <<01.PV>>03156000
   GSAVEFIPNTR     = GHVSVSNAME+NAMESIZE,                      <<13.PV>>03158000
   GMOUNTREFCNTR   = GSAVEFIPNTR+1,                            <<13.PV>>03160000
   GSPARE          = GMOUNTREFCNTR+1,                          <<13.PV>>03162000
   GSIZE           = GSPARE +1;                                <<01.PV>>03164000
<<GLINKAGE DEFINITIONS>>                                       <<01.PV>>03166000
DEFINE                                                         <<01.PV>>03168000
   PVF             = 0:1 #,                                    <<01.PV>>03170000
   MVTABXF         = 8:8 #;                                    <<01.PV>>03172000
DEFINE                                                         <<10.KM>>03174000
   PVMVTABXF= 4:4 #;                   <<PVINFO FIELD>>        <<10.KM>>03176000
EQUATE                                                         <<01.PV>>03178000
   PV              = 1,                                        <<01.PV>>03180000
   VMAX            = 8,                  <<VOL MEMBERSHIP MAX>><<01.PV>>03182000
                                                               <<01.PV>>03184000
<<FILE ENTRY >>                                                <<01.PV>>03186000
   FNAME           = 0,                  <<NAME>>              <<01.PV>>03188000
   FVOLPNTRW       = FNAME+NAMESIZE,     <<VOLUME TABLE PTR>>  <<01.PV>>03190000
   FLABELPNTRW     = FVOLPNTRW,          <<FILE LABEL POINTER>><<01.PV>>03192000
   FSIZE           = FLABELPNTRW+2,                            <<01.PV>>03194000
                                                               <<01.PV>>03196000
<<USER ENTRY>>                                                 <<01.PV>>03198000
   UNAME           = 0,                  <<NAME>>              <<01.PV>>03200000
   UCAP            = UNAME+NAMESIZE,     <<CAPABILITY>>        <<01.PV>>03202000
   ULATTR          = UCAP+2,                                   <<01.PV>>03204000
   UPASS           = ULATTR+2,                                 <<01.PV>>03206000
   UHGROUP         = UPASS+NAMESIZE,     <<HOME GROUP>>        <<01.PV>>03208000
   ULOGCOUNT       = UHGROUP+NAMESIZE,   <<# OF USERS LOGGED>> <<01.PV>>03210000
   UMAXJOB         = ULOGCOUNT+1,                              <<01.PV>>03212000
   UPURGEFLAGW     = UMAXJOB,                                  <<01.PV>>03214000
   USPARE          = UMAXJOB +1,                               <<01.PV>>03216000
   USIZE           = USPARE +1,                                <<01.PV>>03218000
                                                               <<01.PV>>03220000
<<VOLUME SET DEFINITION ENTRY>>                                <<01.PV>>03222000
   GVSNAME         = 0,                  <<VOLUME SET NAME>>   <<01.PV>>03224000
   GVSLINKAGEW     = GVSNAME+NAMESIZE,   <<MVTAB LINKAGE>>     <<01.PV>>03226000
   GVSINFO         = GVSLINKAGEW+1,      <<DEFINITION INFO>>   <<01.PV>>03228000
   GVSMEMBERS      = GVSINFO+1,          <<VMAX MEMBERS>>      <<01.PV>>03230000
                                         <<MEMBER INFO>>       <<01.PV>>03232000
                                         <<VMAX MEMBERS>>      <<01.PV>>03234000
   GVSVOLNAME      = GVSMEMBERS,         <<MEMBER NAME>>       <<01.PV>>03236000
   GVSVOLFLAGS     = GVSVOLNAME+NAMESIZE,<<MEMBER STAT FLAGS>> <<01.PV>>03238000
   GVSVOLINFO      = GVSVOLFLAGS+1,      <<MEMBER ATTRIBS>>    <<01.PV>>03240000
   GVSDREFCNT      = (GVSINFO-GVSNAME+1)*(VMAX+1),             <<RV.PV>>03242000
   GVSDSPARE2      = GVSDREFCNT+1,                             <<RV.PV>>03244000
   GVSDSIZE        = GVSDSPARE2+1,                             <<RV.PV>>03246000
                                                               <<01.PV>>03248000
<<VOLUME CLASS DEFINITION ENTRY>>                              <<01.PV>>03250000
   GVCNAME        = 0,                   <<VOLUME CLASS NAME>> <<01.PV>>03252000
   GVCLINKAGEW     = GVCNAME+NAMESIZE,                         <<01.PV>>03254000
   GVCINFO         = GVCLINKAGEW+1,      <<DEFINITION INFO>>   <<01.PV>>03256000
   GVCPNAME        = GVCINFO+1,          <<PARENT DEF  NAME>>  <<01.PV>>03258000
   GVCPANAME       = GVCPNAME,           <<  "    ACCT   " >>  <<01.PV>>03260000
   GVCPGNAME       = GVCPANAME+NAMESIZE, <<  "    GRP    " >>  <<01.PV>>03262000
   GVCPVSNAME      = GVCPGNAME+NAMESIZE, <<  "    VS     " >>  <<01.PV>>03264000
   GVCUNUSED       = GVCPVSNAME+NAMESIZE,                      <<01.PV>>03266000
   GVCDSIZE        = GVSDSIZE,                                 <<01.PV>>03268000
                                                               <<01.PV>>03270000
   MAXENTRYSIZE    = GVSDSIZE,                                 <<01.PV>>03272000
                                                               <<01.PV>>03274000
<<ENTRY TYPES>>                                                <<01.PV>>03276000
   FILELEVEL       = 0,                                        <<01.PV>>03278000
   GROUPLEVEL      = 1,                                        <<01.PV>>03280000
   ACCOUNTLEVEL    = 2,                                        <<01.PV>>03282000
   USERLEVEL       = 3,                                        <<01.PV>>03284000
   VSDEFLEVEL      = 4;                                        <<RV.PV>>03286000
                                                               <<01.PV>>03288000
<<DIRECTORY SEARCH TYPE WORD DEFINITIONS>>                     <<01.PV>>03290000
DEFINE                                                         <<01.PV>>03292000
   STARTLEVELF     = 13:3 #,                                   <<01.PV>>03294000
   ENDLEVELF       = 10:3 #,                                   <<01.PV>>03296000
   ALLFLAG         =  9:1 #,                                   <<01.PV>>03298000
   ENDLEVELFX      =  9:4 #,                                   <<01.PV>>03300000
   TOLEVELF        =  6:3 #,                                   <<01.PV>>03302000
   HITFLAG         =  5:1 #;                                   <<01.PV>>03304000
EQUATE                                                         <<01.PV>>03306000
   ALLXXX          = %(2)1000,                                 <<04.PV>>03308000
   ALLACCTS        = ALLXXX + ACCOUNTLEVEL,                    <<04.PV>>03310000
   ALLGROUPS       = ALLXXX + GROUPLEVEL,                      <<04.PV>>03312000
   ALLUSERS        = ALLXXX + USERLEVEL,                       <<04.PV>>03314000
   ALLFILES        = ALLXXX + FILELEVEL;                       <<04.PV>>03316000
EQUATE                                                         <<04178>>03318000
   PPR'LEN         = 31 +    << "ppresult" size >>             <<04178>>03320000
                     ASIZE+1+<< account entry size >>          <<04178>>03322000
                     GSIZE+1,<< group entry size   >>          <<04178>>03324000
   SYSL'PARMLEN    = 35 + PPR'LEN,<< "syslist" parm >>         <<04178>>03326000
   SYSL'PPRINX     = SYSL'PARMLEN - PPR'LEN,                   <<04178>>03328000
   RCR'PARMLEN     = 4 + PPR'LEN, << "rcreport" parm >>        <<04178>>03330000
   RCR'PPRINX      = RCR'PARMLEN - PPR'LEN,                    <<04178>>03332000
   SAVEBUFFINDEX = SYSL'PPRINX + 31;                           <<04178>>03334000
                                                               <<03.KM>>03336000
<<DIRECTORY SEARCH STATES (RETURNED BY RECIP)>>                <<03.KM>>03338000
EQUATE GOTSIR=          1,                                     <<03.KM>>03340000
       NEXTSON=         0,                                     <<03.KM>>03342000
       NEXTBROTHER=     2,                                     <<03.KM>>03344000
       NEXTUNCLE=       NEXTBROTHER,   <<NOT IMPLEMENTED>>     <<03.KM>>03346000
       REVISIT=         %100000,                               <<03.KM>>03348000
       ABORTSCAN=       4,                                     <<03.KM>>03350000
       NEXTSON'SIR=     NEXTSON+GOTSIR,                        <<03.KM>>03352000
       NEXTBROTHER'SIR= NEXTBROTHER+GOTSIR,                    <<03.KM>>03354000
       NEXTUNCLE'SIR=   NEXTUNCLE+GOTSIR,                      <<03.KM>>03356000
       ABORTSCAN'SIR=   ABORTSCAN+GOTSIR,                      <<03.KM>>03358000
       REVISIT'SIR=     REVISIT+GOTSIR;                        <<03.KM>>03360000
                                                               <<01.PV>>03362000
<< ORGANIZATIONAL COMMANDS :NEWXXX, :ALTXXX COMMUNICATION >>   <<RV.PV>>03364000
EQUATE                                                         <<RV.PV>>03366000
    VSSPECIFIED   = %100000,                                   <<RV.PV>>03368000
    SPANSPECIFIED = %040000,                                   <<RV.PV>>03370000
    ALTSPECIFIED  = %020000,                                   <<00086>>03372000
    VSMASK        = 0,                                         <<RV.PV>>03374000
    VSHANAME      = VSMASK+1,                                  <<RV.PV>>03376000
    VSHGNAME      = VSHANAME+NAMESIZE,                         <<RV.PV>>03378000
    VSHVNAME      = VSHGNAME+NAMESIZE,                         <<RV.PV>>03380000
    VSCOMMSZ'     = VSHVNAME+NAMESIZE,                         <<RV.PV>>03382000
    VSCOMMSZ      = VSCOMMSZ'+1,                               <<RV.PV>>03384000
    SPECMASKLN    = 3;                                         <<RV.PV>>03386000
$PAGE   "EXTERNAL DECLARATIONS"                                         03388000
<<                                                                      03390000
   EXTERNAL MPE INTRINSICS                                              03392000
                           >>                                           03394000
   PROCEDURE DATE'LINE(STRING);                                <<0U.EB>>03396000
      BYTE ARRAY STRING; OPTION EXTERNAL;                      <<0U.EB>>03398000
                                                               <<0U.EB>>03400000
INTRINSIC LOADPROC,ZSIZE;                                      <<03.EB>>03402000
                                                               <<00.EB>>03404000
INTRINSIC SETJCW,GETJCW,FCONTROL;                              <<00851>>03406000
   LOGICAL PROCEDURE BINARY (STRING, LENGTH);                           03408000
   VALUE LENGTH;                                                        03410000
   BYTE ARRAY STRING;                                                   03412000
   INTEGER LENGTH;                                                      03414000
   OPTION EXTERNAL;                                                     03416000
                                                                        03418000
   INTEGER PROCEDURE EXCHANGEDB(DSTNO);                                 03420000
   VALUE DSTNO;                                                         03422000
   INTEGER DSTNO;                                                       03424000
   OPTION EXTERNAL;                                                     03426000
                                                                        03428000
   DOUBLE PROCEDURE DBINARY(STRING,LENGTH);                             03430000
   VALUE LENGTH;                                                        03432000
   BYTE ARRAY STRING;  INTEGER LENGTH;                                  03434000
   OPTION EXTERNAL;                                                     03436000
                                                                        03438000
   INTEGER PROCEDURE ASCII (WORD, BASE, STRING);                        03440000
   VALUE WORD, BASE;                                                    03442000
   LOGICAL WORD;                                                        03444000
   INTEGER BASE;                                                        03446000
   BYTE ARRAY STRING;                                                   03448000
   OPTION EXTERNAL;                                                     03450000
                                                                        03452000
   INTEGER PROCEDURE DASCII(WORD,BASE,STRING);                          03454000
   VALUE WORD,BASE;                                                     03456000
   DOUBLE WORD;                                                         03458000
   INTEGER BASE;                                                        03460000
   BYTE ARRAY STRING;                                                   03462000
   OPTION EXTERNAL;                                                     03464000
                                                                        03466000
   INTEGER PROCEDURE READ (STRING, EXPECTEDL);                          03468000
   VALUE EXPECTEDL;                                                     03470000
   ARRAY STRING;                                                        03472000
   INTEGER EXPECTEDL;                                                   03474000
   OPTION EXTERNAL;                                                     03476000
                                                                        03478000
   PROCEDURE PRINT (STRING, LENGTH, TYPE);                              03480000
   VALUE LENGTH, TYPE;                                                  03482000
   ARRAY STRING;                                                        03484000
   INTEGER LENGTH;                                                      03486000
   LOGICAL TYPE;                                                        03488000
   OPTION EXTERNAL;                                                     03490000
                                                                        03492000
   INTEGER PROCEDURE SEARCH (TARGET, LENGTH, DICT, DEFN);               03494000
   VALUE LENGTH;                                                        03496000
   BYTE ARRAY TARGET, DICT;                                             03498000
   INTEGER LENGTH;                                                      03500000
   BYTE POINTER DEFN;                                                   03502000
   OPTION EXTERNAL, VARIABLE;                                           03504000
                                                               <<01.01>>03506000
PROCEDURE CLEAN'MESSAGE(MSG,LEN);                              <<01.01>>03508000
VALUE LEN;                                                     <<01.01>>03510000
INTEGER LEN;                                                   <<01.01>>03512000
BYTE ARRAY MSG;                                                <<U.RAO>>03514000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<01.01>>03516000
                                                                        03518000
   PROCEDURE DEBUG;                                                     03520000
   OPTION EXTERNAL;                                                     03522000
                                                                        03524000
   INTEGER PROCEDURE MYCOMMAND                                          03526000
   (COMIMAGE,DELIMS,MAXPARMS,NUMPARMS,PARMS,DICT,DEFN);                 03528000
   VALUE MAXPARMS;                                                      03530000
   BYTE ARRAY COMIMAGE,DELIMS,DICT;                                     03532000
   INTEGER MAXPARMS, NUMPARMS;                                          03534000
   DOUBLE ARRAY PARMS;                                                  03536000
   BYTE POINTER DEFN;                                                   03538000
   OPTION VARIABLE,EXTERNAL;                                            03540000
                                                                        03542000
   PROCEDURE WHO(MODE,CAP,LATTR,USERN,GROUPN,ACCTN,HOMEN,TERMNUM);      03544000
   LOGICAL MODE;                                                        03546000
   DOUBLE CAP,LATTR;                                                    03548000
   BYTE ARRAY USERN,GROUPN,ACCTN,HOMEN;                                 03550000
   LOGICAL TERMNUM;                                                     03552000
   OPTION VARIABLE,EXTERNAL;                                            03554000
                                                                        03556000
   LOGICAL PROCEDURE PARSE'DENSITY(PARM,PARMLEN,DEN'VALUE);    <<02569>>03558000
   VALUE PARMLEN;                                              <<02569>>03560000
   INTEGER DEN'VALUE,PARMLEN;                                  <<02569>>03562000
   BYTE ARRAY PARM;                                            <<02569>>03564000
   OPTION EXTERNAL;                                            <<02569>>03566000
                                                               <<02569>>03568000
   INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS, AOPTIONS, RECSIZE, 03570000
   DEVICE, FORMMSG, RECMODE, BLOCKFACTOR, NUMBUFFERS, FILESIZE,         03572000
   NUMEXTENTS, INITALLOC, FILECODE);                                    03574000
   VALUE FOPTIONS, AOPTIONS, RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, 03576000
   FILESIZE, NUMEXTENTS, INITALLOC, FILECODE;                           03578000
   BYTE ARRAY FILEDESIGNATOR,  DEVICE, FORMMSG;                         03580000
   LOGICAL FOPTIONS, AOPTIONS;                                          03582000
   INTEGER RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, NUMEXTENTS,       03584000
   INITALLOC, FILECODE;                                                 03586000
   DOUBLE FILESIZE;                                                     03588000
   OPTION VARIABLE, EXTERNAL;                                           03590000
                                                               <<00098>>03592000
   INTEGER PROCEDURE MUSTOPEN                                  <<00098>>03594000
     (FNAME,FOPS,AOPS,RECSIZE,DEV,FORMMSG,NUMLABS,BLKFACT,     <<00098>>03596000
      NUMBUFS,FSIZE,NUMEXTS,INITEXTS,FCODE);                   <<00098>>03598000
     VALUE FOPS,AOPS,RECSIZE,NUMLABS,BLKFACT,NUMBUFS,FSIZE,    <<00098>>03600000
           NUMEXTS,INITEXTS,FCODE;                             <<00098>>03602000
     BYTE ARRAY FNAME,DEV,FORMMSG;                             <<00098>>03604000
     LOGICAL FOPS,AOPS;                                        <<00098>>03606000
     INTEGER RECSIZE,NUMLABS,BLKFACT,NUMBUFS,NUMEXTS,INITEXTS, <<00098>>03608000
             FCODE;                                            <<00098>>03610000
     DOUBLE FSIZE; OPTION VARIABLE,EXTERNAL;                   <<00098>>03612000
                                                               <<00200>>03614000
   INTEGER PROCEDURE DFOPEN                                    <<00200>>03616000
     (FNAME,FOPS,AOPS,RECSIZE,DEV,FORMMSG,NUMLABS,BLKFACT,     <<00200>>03618000
      NUMBUFS,FSIZE,NUMEXTS,INITEXTS,FCODE);                   <<00200>>03620000
     VALUE FOPS,AOPS,RECSIZE,NUMLABS,BLKFACT,NUMBUFS,FSIZE,    <<00200>>03622000
           NUMEXTS,INITEXTS,FCODE;                             <<00200>>03624000
     BYTE ARRAY FNAME,DEV,FORMMSG;                             <<00200>>03626000
     LOGICAL FOPS,AOPS;                                        <<00200>>03628000
     INTEGER RECSIZE,NUMLABS,BLKFACT,NUMBUFS,NUMEXTS,INITEXTS, <<00200>>03630000
             FCODE;                                            <<00200>>03632000
     DOUBLE FSIZE; OPTION VARIABLE,EXTERNAL;                   <<00200>>03634000
                                                                        03636000
   PROCEDURE FCLOSE (FILENUM, DISPOSITION, SECCODE);                    03638000
   VALUE FILENUM, DISPOSITION, SECCODE;                                 03640000
   INTEGER FILENUM, DISPOSITION, SECCODE;                               03642000
   OPTION EXTERNAL;                                                     03644000
                                                                        03646000
   INTEGER PROCEDURE FREAD (FNUM, BUF, COUNT);                          03648000
      VALUE FNUM, COUNT;                                                03650000
      INTEGER FNUM, COUNT;                                              03652000
      ARRAY BUF;                                                        03654000
      OPTION EXTERNAL;                                                  03656000
                                                                        03658000
   PROCEDURE FWRITE(FNUM,TARGET,COUNT,CONT);                            03660000
   VALUE FNUM,COUNT,CONT;                                               03662000
   INTEGER FNUM,COUNT,CONT;                                             03664000
   ARRAY TARGET;                                                        03666000
   OPTION EXTERNAL;                                                     03668000
                                                                        03670000
   PROCEDURE FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);             03672000
   VALUE FILENUM;                                                       03674000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              03676000
   DOUBLE BLKNUM;                                                       03678000
   OPTION VARIABLE,EXTERNAL;                                            03680000
                                                                        03682000
   PROCEDURE FGETINFO                                                   03684000
   (FNUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,DEVTYPE,LDNUM,HDADDR,       03686000
    FILECODE,RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,BLKSIZE,EXTSIZE,       03688000
    NUMEXTENTS,USERLABELS,CREATORID,LABADDR);                           03690000
   VALUE FNUM;                                                          03692000
   INTEGER FNUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,USERLABELS; 03694000
   BYTE ARRAY FILENAME,CREATORID;                                       03696000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      03698000
   DOUBLE RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,LABADDR;                  03700000
   OPTION VARIABLE,EXTERNAL;                                            03702000
                                                                        03704000
   PROCEDURE FBREAK;                                                    03706000
   OPTION EXTERNAL;                                                     03708000
                                                                        03710000
   PROCEDURE FRESETEOF;                                                 03712000
   OPTION EXTERNAL;                                                     03714000
                                                                        03716000
   PROCEDURE FUNBREAK(DONOTREADFLAG);                                   03718000
   VALUE DONOTREADFLAG;                                                 03720000
   LOGICAL DONOTREADFLAG;                                               03722000
   OPTION EXTERNAL;                                                     03724000
                                                                        03726000
INTEGER PROCEDURE FLABIO (LDEV,ADDR,FUNC,FLAB);                         03728000
    VALUE   LDEV,FUNC,ADDR;                                             03730000
    INTEGER LDEV,FUNC;                                                  03732000
    LOGICAL ARRAY FLAB;                                                 03734000
    DOUBLE ADDR;                                                        03736000
    OPTION EXTERNAL;                                                    03738000
                                                                        03740000
   DOUBLE PROCEDURE DIRECINSERT (TYPE, LINKAGE'INDEXP, AN,     <<38.PV>>03742000
                                 GUN, FN, E, MVTABX);          <<38.PV>>03744000
   VALUE TYPE, LINKAGE'INDEXP, MVTABX;                         <<38.PV>>03746000
   INTEGER TYPE, MVTABX;                                       <<38.PV>>03748000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>03750000
   ARRAY AN, GUN, FN;                                                   03752000
   ARRAY E;                                                             03754000
   OPTION EXTERNAL, VARIABLE;                                  <<12.PV>>03756000
                                                                        03758000
   DOUBLE PROCEDURE DIRECPURGE (T, LINKAGE'INDEXP, AN,         <<38.PV>>03760000
                                GUN, FN, MVTABX);              <<38.PV>>03762000
   VALUE T, LINKAGE'INDEXP, MVTABX;                            <<38.PV>>03764000
   INTEGER T, MVTABX;                                          <<38.PV>>03766000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>03768000
   ARRAY AN, GUN, FN;                                                   03770000
   OPTION EXTERNAL, VARIABLE;                                  <<21.PV>>03772000
                                                                        03774000
   DOUBLE PROCEDURE SUBQUEUE (N, C);                                    03776000
   VALUE N, C;                                                          03778000
   INTEGER N, C;                                                        03780000
   OPTION EXTERNAL;                                                     03782000
                                                                        03784000
   PROCEDURE FRENAME(FILENUM,FNAME);                                    03786000
   VALUE FILENUM;                                                       03788000
   INTEGER FILENUM;                                                     03790000
   BYTE ARRAY FNAME;                                                    03792000
   OPTION EXTERNAL;                                                     03794000
                                                                        03796000
   PROCEDURE SEGMENTER                                                  03798000
   (PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6,           <<00629>>03800000
    STR1,STR2,FNAME1,FNAME2);                                  <<00629>>03802000
   VALUE COMMAND,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;                <<00629>>03804000
   INTEGER PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;    <<00629>>03806000
   BYTE ARRAY STR1,STR2,FNAME1,FNAME2;                                  03808000
   OPTION VARIABLE, EXTERNAL;                                           03810000
                                                                        03812000
   PROCEDURE CREATEPROCESS (ERROR,PIN,PROGNAME,OPTNUMS,OPTS);  <<01200>>03814000
   INTEGER ERROR,PIN;                                          <<01200>>03816000
   BYTE ARRAY PROGNAME;                                        <<01200>>03818000
   INTEGER ARRAY OPTNUMS;                                      <<01200>>03820000
   LOGICAL ARRAY OPTS;                                         <<01200>>03822000
   OPTION VARIABLE, EXTERNAL;                                  <<01200>>03824000
                                                               <<01200>>03826000
   PROCEDURE CREATE(PROGNAME,ENTRYNAME,PIN,PARM,FLAGS,                  03828000
   STACK,DL,MAXDATA,PRI,RANK);                                          03830000
   VALUE PARM,STACK,DL,PRI,FLAGS,MAXDATA,RANK;                          03832000
   LOGICAL PIN,PARM,FLAGS,PRI;                                          03834000
   INTEGER STACK,DL,MAXDATA,RANK;                                       03836000
   BYTE ARRAY PROGNAME, ENTRYNAME;                                      03838000
   OPTION EXTERNAL, VARIABLE;                                           03840000
                                                                        03842000
   PROCEDURE AWAKE(PCBPT,N,WTFLG);                                      03844000
   VALUE PCBPT,N,WTFLG;                                                 03846000
   INTEGER PCBPT,N,WTFLG;                                               03848000
   OPTION EXTERNAL;                                                     03850000
                                                               <<02318>>03852000
LOGICAL PROCEDURE SETCRITICAL;                                 <<02318>>03854000
OPTION EXTERNAL;                                               <<02318>>03856000
                                                                        03858000
   PROCEDURE RESETCRITICAL(PARM);                                       03860000
   VALUE PARM; LOGICAL PARM;                                            03862000
   OPTION EXTERNAL;                                                     03864000
                                                                        03866000
   LOGICAL PROCEDURE CALENDAR;                                          03868000
   OPTION EXTERNAL;                                                     03870000
                                                                        03872000
   DOUBLE PROCEDURE CLOCK;                                              03874000
   OPTION EXTERNAL;                                                     03876000
                                                                        03878000
   PROCEDURE TERMINATE;                                                 03880000
   OPTION EXTERNAL;                                                     03882000
                                                                        03884000
PROCEDURE FINDJCW(JCW, JCWVALUE, ERROR);                       <<U.RAO>>03886000
BYTE ARRAY JCW;                                                <<U.RAO>>03888000
LOGICAL JCWVALUE;                                              <<01461>>03890000
INTEGER ERROR;                                                 <<01461>>03892000
OPTION EXTERNAL;                                               <<U.RAO>>03894000
                                                               <<U.RAO>>03896000
PROCEDURE PUTJCW(JCW, JCWVALUE, ERROR);                        <<U.RAO>>03898000
BYTE ARRAY JCW;                                                <<U.RAO>>03900000
LOGICAL JCWVALUE;                                              <<01461>>03902000
INTEGER ERROR;                                                 <<01461>>03904000
OPTION EXTERNAL;                                               <<U.RAO>>03906000
                                                               <<U.RAO>>03908000
   LOGICAL PROCEDURE GETSIR (N);                                        03910000
   VALUE N;                                                             03912000
   LOGICAL N;                                                           03914000
   OPTION EXTERNAL;                                                     03916000
                                                                        03918000
   PROCEDURE RELSIR (N,T);                                              03920000
   VALUE N, T;                                                          03922000
   LOGICAL N, T;                                                        03924000
   OPTION EXTERNAL;                                                     03926000
                                                                        03928000
   DOUBLE PROCEDURE DIRECFIND (TYPE,LINKAGE'INDEXP,ANAME,      <<38.PV>>03930000
                               GUNAME,FNAME,ENRY);             <<38.PV>>03932000
   VALUE TYPE,LINKAGE'INDEXP;                                  <<38.PV>>03934000
   INTEGER TYPE;                                               <<38.PV>>03936000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>03938000
   ARRAY ANAME,GUNAME,FNAME,ENRY;                                       03940000
   OPTION EXTERNAL;                                                     03942000
                                                                        03944000
   DOUBLE PROCEDURE DIRECSCAN (TYPE,LINKAGE'INDEXP,ANAME,      <<38.PV>>03946000
                               GUNAME,FNAME,RECIP,LDN,MVTABX); <<38.PV>>03948000
   VALUE TYPE,LINKAGE'INDEXP,MVTABX;                           <<38.PV>>03950000
   INTEGER TYPE,MVTABX;                                        <<38.PV>>03952000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>03954000
   ARRAY ANAME,GUNAME,FNAME,LDN;                                        03956000
   INTEGER PROCEDURE RECIP;                                             03958000
   OPTION EXTERNAL,VARIABLE;                                   <<35.PV>>03960000
                                                                        03962000
   INTEGER PROCEDURE ADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO);                03964000
   VALUE SIZE,TNO;                                                      03966000
   INTEGER SIZE,TNO;                                                    03968000
   BYTE ARRAY N1,N2,N3;                                                 03970000
   INTEGER ARRAY INFO;                                                  03972000
   OPTION EXTERNAL;                                                     03974000
                                                                        03976000
   INTEGER PROCEDURE XADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO,XN1,XN2,XN3);   03978000
   VALUE SIZE,TNO;                                                      03980000
   INTEGER SIZE,TNO;                                                    03982000
   BYTE ARRAY N1,N2,N3,XN1,XN2,XN3;                                     03984000
   INTEGER ARRAY INFO;                                                  03986000
   OPTION EXTERNAL;                                                     03988000
                                                                        03990000
   INTEGER PROCEDURE XREMJTENTRY(N1,N2,N3,TNO);                         03992000
   VALUE TNO;                                                           03994000
   INTEGER TNO;                                                         03996000
   BYTE ARRAY N1,N2,N3;                                                 03998000
   OPTION EXTERNAL;                                                     04000000
                                                                        04002000
   LOGICAL PROCEDURE LOCKJIR;                                           04004000
   OPTION EXTERNAL;                                                     04006000
                                                                        04008000
   PROCEDURE UNLOCKJIR (A);                                             04010000
   VALUE A;                                                             04012000
   INTEGER A;                                                           04014000
   OPTION EXTERNAL;                                                     04016000
                                                                        04018000
   PROCEDURE PTAPE(TF,DF);                                              04020000
   VALUE TF,DF;                                                         04022000
   INTEGER TF,DF;                                                       04024000
   OPTION EXTERNAL;                                                     04026000
                                                                        04028000
   DOUBLE PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);04030000
   VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     04032000
   INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                   04034000
   OPTION EXTERNAL;                                                     04036000
                                                                        04038000
   INTEGER PROCEDURE ALLOCATEPROC(NAM);                                 04040000
   BYTE ARRAY NAM;                                                      04042000
   OPTION EXTERNAL;                                                     04044000
                                                                        04046000
   INTEGER PROCEDURE ALLOCATEPROG(NAM);                                 04048000
   BYTE ARRAY NAM;                                                      04050000
   OPTION EXTERNAL;                                                     04052000
                                                                        04054000
   INTEGER PROCEDURE DEALLOCATEPROC(NAM);                               04056000
   BYTE ARRAY NAM;                                                      04058000
   OPTION EXTERNAL;                                                     04060000
                                                                        04062000
   INTEGER PROCEDURE DEALLOCATEPROG(NAM);                               04064000
   BYTE ARRAY NAM;                                                      04066000
   OPTION EXTERNAL;                                                     04068000
                                                                        04070000
   INTEGER PROCEDURE ALLORIN(RCODE,UNAM,PASS);                          04072000
   VALUE RCODE;                                                         04074000
   INTEGER RCODE;                                                       04076000
   ARRAY UNAM,PASS;                                                     04078000
   OPTION VARIABLE,EXTERNAL;                                            04080000
                                                                        04082000
   PROCEDURE DEALLORIN(RIN,UNAM);                                       04084000
   VALUE RIN;                                                           04086000
   INTEGER RIN;                                                         04088000
   ARRAY UNAM;                                                          04090000
   OPTION VARIABLE,EXTERNAL;                                            04092000
                                                                        04094000
   PROCEDURE QUANTUM(TS,TP,NP,CP);                                      04096000
   VALUE TS,TP,NP,CP;                                                   04098000
   LOGICAL TS;                                                          04100000
   INTEGER TP,NP,CP;                                                    04102000
   OPTION EXTERNAL;                                                     04104000
                                                                        04106000
   PROCEDURE SHOWMQ;                                                    04108000
   OPTION EXTERNAL;                                                     04110000
                                                                        04112000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<0U.EB>>04114000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>04116000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<0U.EB>>04118000
      DST,IOTYPE;                                              <<0U.EB>>04120000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<0U.EB>>04122000
      DST,IOTYPE;                                              <<0U.EB>>04124000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>04126000
                                                               <<U.RAO>>04128000
LOGICAL PROCEDURE PARSEJOBID(JOBID, RESULT);                   <<U.RAO>>04130000
BYTE ARRAY JOBID;                                              <<U.RAO>>04132000
INTEGER ARRAY RESULT;                                          <<U.RAO>>04134000
OPTION EXTERNAL;                                               <<U.RAO>>04136000
                                                               <<U.RAO>>04138000
LOGICAL PROCEDURE SCANJMAT(NEXTINDEX, JOBID, RESULT);          <<U.RAO>>04140000
INTEGER NEXTINDEX;                                             <<U.RAO>>04142000
INTEGER ARRAY JOBID;                                           <<U.RAO>>04144000
INTEGER ARRAY RESULT;                                          <<U.RAO>>04146000
OPTION EXTERNAL;                                               <<U.RAO>>04148000
                                                                        04150000
   INTEGER PROCEDURE ERRORGET(L);                                       04152000
   VALUE L;                                                             04154000
   INTEGER L;                                                           04156000
   OPTION EXTERNAL;                                                     04158000
                                                                        04160000
   PROCEDURE ERRORON;                                                   04162000
   OPTION EXTERNAL;                                                     04164000
                                                                        04166000
   PROCEDURE ABORTPROG;                                                 04168000
   OPTION EXTERNAL;                                                     04170000
                                                                        04172000
   PROCEDURE ERROREXIT(INTRINEXIT,ERRBYTES,PARAM);                      04174000
   VALUE INTRINEXIT,ERRBYTES,PARAM;                                     04176000
   LOGICAL INTRINEXIT,ERRBYTES,PARAM;                                   04178000
   OPTION EXTERNAL;                                                     04180000
                                                                        04182000
   DOUBLE PROCEDURE CHEK(INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK);          04184000
   VALUE INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK;                           04186000
   LOGICAL INTRIN,FLAGS,OPTVMASK;                                       04188000
   DOUBLE PARMS,CAPMASK;                                                04190000
   OPTION VARIABLE,EXTERNAL;                                            04192000
                                                               <<02.EB>>04194000
INTEGER PROCEDURE FORMNAME(TYPE,TARGET,BA1,BA2,BA3,BA4);       <<02.EB>>04196000
   VALUE TYPE; INTEGER TYPE;                                   <<02.EB>>04198000
   BYTE ARRAY TARGET,BA1,BA2,BA3,BA4; OPTION EXTERNAL;         <<02.EB>>04200000
                                                               <<02.EB>>04202000
PROCEDURE INITJSMP(EXPCODE); INTEGER EXPCODE;                  <<02.EB>>04204000
   OPTION EXTERNAL;                                            <<02.EB>>04206000
                                                                        04208000
PROCEDURE FMTDATE(CALENDAR',CLOCK',USERID);                    <<U.RAO>>04210000
VALUE CALENDAR', CLOCK';                                       <<U.RAO>>04212000
LOGICAL CALENDAR';                                             <<U.RAO>>04214000
DOUBLE CLOCK';                                                 <<U.RAO>>04216000
BYTE ARRAY USERID;                                             <<U.RAO>>04218000
OPTION EXTERNAL;                                               <<U.RAO>>04220000
                                                               <<U.RAO>>04222000
   LOGICAL PROCEDURE FREPLY (MES, LEN);                                 04224000
   VALUE LEN;                                                           04226000
   INTEGER LEN;                                                         04228000
   BYTE ARRAY MES;                                                      04230000
   OPTION EXTERNAL;                                                     04232000
                                                                        04234000
   PROCEDURE SUDDENDEATH(ERRORNUMBER);                                  04236000
   VALUE ERRORNUMBER;                                                   04238000
   INTEGER ERRORNUMBER;                                                 04240000
   OPTION EXTERNAL;                                                     04242000
                                                                        04244000
PROCEDURE CTRANSLATE(CODE,INSTRING,OUTSTRING,STRINGLENGTH,TABLE);       04246000
   VALUE CODE,STRINGLENGTH;                                             04248000
   INTEGER CODE,STRINGLENGTH;                                           04250000
   BYTE ARRAY INSTRING,OUTSTRING,TABLE;                                 04252000
   OPTION VARIABLE,EXTERNAL;                                            04254000
                                                                        04256000
   PROCEDURE CXRESTORE                                                  04258000
   EXECUTORHEAD;                                                        04260000
   OPTION EXTERNAL;                                                     04262000
                                                               <<04660>>04264000
   PROCEDURE CXSTORENEW EXECUTORHEAD;                          <<04660>>04266000
            OPTION EXTERNAL;                                   <<04660>>04268000
                                                                        04270000
   PROCEDURE CXSTORE                                                    04272000
   EXECUTORHEAD;                                                        04274000
   OPTION EXTERNAL;                                                     04276000
                                                                        04278000
PROCEDURE CXSHOWALLOW EXECUTORHEAD;                            <<00894>>04280000
OPTION EXTERNAL;                                               <<00894>>04282000
                                                               <<00894>>04284000
   PROCEDURE CXSHOWJOB EXECUTORHEAD;                                    04286000
   OPTION EXTERNAL;                                                     04288000
                                                                        04290000
   PROCEDURE CXSHOWIN EXECUTORHEAD;                                     04292000
   OPTION EXTERNAL;                                                     04294000
                                                                        04296000
   PROCEDURE CXSHOWOUT EXECUTORHEAD;                                    04298000
   OPTION EXTERNAL;                                                     04300000
                                                                        04302000
   PROCEDURE CXSHOWDEV EXECUTORHEAD;                                    04304000
   OPTION EXTERNAL;                                                     04306000
                                                                        04308000
   PROCEDURE CXSTREAM EXECUTORHEAD;                                     04310000
   OPTION EXTERNAL;                                                     04312000
   PROCEDURE CXDSLINE EXECUTORHEAD;                            <<DS0.0>>04314000
   OPTION EXTERNAL;                                            <<DS0.0>>04316000
                                                               <<DS0.0>>04318000
   PROCEDURE CXREMOTE EXECUTORHEAD;                            <<DS0.0>>04320000
   OPTION EXTERNAL;                                            <<DS0.0>>04322000
                                                               <<DS0.0>>04324000
   PROCEDURE CXRFA EXECUTORHEAD;                               <<DS0.0>>04326000
   OPTION EXTERNAL;                                            <<DS0.0>>04328000
                                                               <<DS0.0>>04330000
   LOGICAL PROCEDURE DSBREAK(TYPE,PIN);                        <<DS.06>>04332000
   VALUE   TYPE,PIN;                                           <<DS.06>>04334000
   INTEGER TYPE,PIN;                                           <<DS.06>>04336000
   OPTION EXTERNAL;                                            <<DS.06>>04338000
LOGICAL PROCEDURE CILOGTABLE(CODE,JMATP,CNTWORD,COMMAND);    <<A00.04>> 04340000
   VALUE CODE,JMATP;                                          <<A00.04>>04342000
   INTEGER CODE,JMATP,CNTWORD;                                <<A00.04>>04344000
   INTEGER ARRAY COMMAND;                                     <<A00.04>>04346000
   OPTION EXTERNAL;                                           <<A00.04>>04348000
                                                               <<RH.PV>>04350000
INTEGER PROCEDURE GETDEVINFO(DEVICE,DEVINFO);                  <<00579>>04352000
   BYTE ARRAY DEVICE;                                          <<00579>>04354000
   INTEGER ARRAY DEVINFO;                                      <<00579>>04356000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<00579>>04358000
                                                               <<00579>>04360000
INTEGER PROCEDURE GET'DSDEVICE( LDEV );                        <<02848>>04362000
   VALUE   LDEV;                                               <<02848>>04364000
   INTEGER LDEV;                                               <<02848>>04366000
   OPTION  PRIVILEGED, UNCALLABLE, EXTERNAL;                   <<02848>>04368000
                                                               <<02848>>04370000
PROCEDURE MOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,GEN,           <<00211>>04372000
                 PVINFO,SOME'OTHER'PIN);                       <<00211>>04374000
   VALUE GEN,SOME'OTHER'PIN;                                   <<00211>>04376000
   INTEGER REQTYPE,GEN,PVINFO,SOME'OTHER'PIN;                  <<00211>>04378000
   BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                          <<RH.PV>>04380000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>04382000
                                                               <<RH.PV>>04384000
PROCEDURE DISMOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,            <<00211>>04386000
                    MVTABX,SOME'OTHER'PIN);                    <<00211>>04388000
   VALUE MVTABX,SOME'OTHER'PIN;                                <<00211>>04390000
   INTEGER REQTYPE,MVTABX,SOME'OTHER'PIN;                      <<00211>>04392000
   BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                          <<RH.PV>>04394000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>04396000
                                                               <<RH.PV>>04398000
INTEGER PROCEDURE LUN (VTABINX,MVTABX);                        <<RV.PV>>04400000
    VALUE   VTABINX,MVTABX;                                    <<RV.PV>>04402000
    INTEGER VTABINX,MVTABX;                                    <<RV.PV>>04404000
    OPTION EXTERNAL;                                           <<RV.PV>>04406000
                                                               <<RV.PV>>04408000
PROCEDURE CHECKDISC(LDN,STAT);                                 <<RH.PV>>04410000
   VALUE LDN;                                                  <<RH.PV>>04412000
   INTEGER LDN;                                                <<RH.PV>>04414000
   LOGICAL STAT;                                               <<RH.PV>>04416000
   OPTION EXTERNAL;                                            <<RH.PV>>04418000
                                                               <<RH.PV>>04420000
DOUBLE PROCEDURE VTABINDEX(VID,VSID,LDN,GEN);                  <<RH.PV>>04422000
   VALUE LDN;                                                  <<RH.PV>>04424000
   INTEGER LDN,GEN;                                            <<RH.PV>>04426000
   BYTE ARRAY VID,VSID;                                        <<RH.PV>>04428000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>04430000
                                                               <<RH.PV>>04432000
INTEGER PROCEDURE VSUSERCOM(REQTYPE,NUMPARMS,VSNAME);          <<RH.PV>>04434000
   VALUE REQTYPE,NUMPARMS;                                     <<RH.PV>>04436000
   INTEGER REQTYPE,NUMPARMS;                                   <<RH.PV>>04438000
   BYTE ARRAY VSNAME;                                          <<RH.PV>>04440000
   OPTION EXTERNAL;                                            <<RH.PV>>04442000
                                                               <<RH.PV>>04444000
INTEGER PROCEDURE DSTATCOM(REQTYPE,LDEV);                      <<RH.PV>>04446000
   VALUE REQTYPE,LDEV;                                         <<RH.PV>>04448000
   INTEGER REQTYPE,LDEV;                                       <<RH.PV>>04450000
   OPTION EXTERNAL;                                            <<RH.PV>>04452000
                                                               <<RH.PV>>04454000
PROCEDURE INITUDC( SHOW, COMFN );                              <<03737>>04456000
   VALUE    SHOW, COMFN;                                       <<03737>>04458000
   LOGICAL  SHOW;                                              <<03737>>04460000
   INTEGER  COMFN;                                             <<03737>>04462000
   OPTION   VARIABLE, EXTERNAL;                                <<03737>>04464000
                                                               <<06.EB>>04466000
LOGICAL PROCEDURE UDC(COMIMAGE,OFFSET);                        <<06.EB>>04468000
   VALUE OFFSET; INTEGER OFFSET;                               <<06.EB>>04470000
   BYTE ARRAY COMIMAGE; OPTION EXTERNAL;                       <<06.EB>>04472000
                                                               <<06.EB>>04474000
PROCEDURE QUALIFYFILENAME(OLDFNAME,NEWFNAME);                  <<03.EB>>04476000
   BYTE ARRAY OLDFNAME,NEWFNAME; OPTION EXTERNAL;              <<03.EB>>04478000
                                                               <<03.EB>>04480000
PROCEDURE CXSETCATALOG EXECUTORHEAD;                           <<06.EB>>04482000
   OPTION EXTERNAL;                                            <<06.EB>>04484000
                                                               <<06.EB>>04486000
PROCEDURE CXSHOWCATALOG EXECUTORHEAD;                          <<06.EB>>04488000
   OPTION EXTERNAL;                                            <<06.EB>>04490000
PROCEDURE CXALTLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>04492000
PROCEDURE CXLISTLOG EXECUTORHEAD; OPTION EXTERNAL;             <<00506>>04494000
PROCEDURE CXSHOWLOGSTATUS EXECUTORHEAD; OPTION EXTERNAL;       <<00506>>04496000
PROCEDURE CXGETLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>04498000
PROCEDURE CXRELLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>04500000
                                                               <<00506>>04502000
                                                               <<06.EB>>04504000
                                                               <<00256>>04506000
PROCEDURE RELCOMREC(COMFN,RECNO,ERRNO);                        <<00256>>04508000
   VALUE COMFN,RECNO; INTEGER COMFN,RECNO,ERRNO;               <<00256>>04510000
   OPTION EXTERNAL;                                            <<00256>>04512000
                                                               <<00256>>04514000
PROCEDURE FREADDIR(FILENUM,TARGET,TCOUNT,RECNUM);              <<00256>>04516000
   VALUE FILENUM,TCOUNT,RECNUM;                                <<00256>>04518000
   INTEGER FILENUM,TCOUNT;                                     <<00256>>04520000
   LOGICAL ARRAY TARGET;                                       <<00256>>04522000
   DOUBLE RECNUM;                                              <<00256>>04524000
   OPTION EXTERNAL;                                            <<00256>>04526000
                                                               <<00256>>04528000
PROCEDURE FLOCK(FILENUM,LOCKCOND);                             <<00256>>04530000
   VALUE FILENUM,LOCKCOND; INTEGER FILENUM; LOGICAL LOCKCOND;  <<00256>>04532000
   OPTION EXTERNAL;                                            <<00256>>04534000
                                                               <<00256>>04536000
PROCEDURE FUNLOCK(FILENUM);                                    <<00256>>04538000
   VALUE FILENUM; INTEGER FILENUM;                             <<00256>>04540000
   OPTION EXTERNAL;                                            <<00256>>04542000
                                                               <<00256>>04544000
PROCEDURE SEARCHCOMFILE(COMFN,UNAME,ANAME,UREC,FREC,ERRNO);    <<00884>>04546000
   VALUE COMFN;  BYTE ARRAY UNAME,ANAME;                       <<00884>>04548000
   INTEGER COMFN,UREC,FREC,ERRNO;                              <<00884>>04550000
   OPTION VARIABLE,EXTERNAL;                                   <<00884>>04552000
                                                               <<00256>>04554000
INTEGER PROCEDURE THISCPU;                                     <<0306>> 04556000
   OPTION EXTERNAL;                                            <<0306>> 04558000
PROCEDURE CXOUTFENCE EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>04560000
                                                               <<00552>>04562000
PROCEDURE CXRECALL EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>04564000
                                                               <<00552>>04566000
PROCEDURE CXREFUSE EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>04568000
                                                               <<00552>>04570000
PROCEDURE CXREPLY EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>04572000
                                                               <<00552>>04574000
PROCEDURE CXRESUMEJOB EXECUTORHEAD;OPTION EXTERNAL;            <<00552>>04576000
                                                               <<00552>>04578000
<<PROCEDURE CXSPOOL EXECUTORHEAD; OPTION EXTERNAL;>>           <<00552>>04580000
                                                               <<00552>>04582000
PROCEDURE CXSTREAMS EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>04584000
                                                               <<00552>>04586000
PROCEDURE CXCONSOLE  EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>04588000
                                                               <<00552>>04590000
PROCEDURE CXTAKE EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>04592000
                                                               <<00552>>04594000
PROCEDURE CXUP EXECUTORHEAD; OPTION EXTERNAL;                  <<00552>>04596000
                                                               <<00552>>04598000
PROCEDURE CXWELCOME EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>04600000
                                                               <<00552>>04602000
PROCEDURE CXASSOCIATE EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>04604000
                                                               <<00552>>04606000
LOGICAL PROCEDURE MASTEROP; OPTION EXTERNAL;                   <<00552>>04608000
                                                               <<00552>>04610000
PROCEDURE CXMPLINE EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>04612000
                                                               <<00552>>04614000
PROCEDURE CXDSCONTROL EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>04616000
                                                               <<00552>>04618000
PROCEDURE CXMON EXECUTORHEAD; OPTION EXTERNAL;                 <<00552>>04620000
                                                               <<00552>>04622000
PROCEDURE CXMOFF EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>04624000
                                                               <<00552>>04626000
PROCEDURE CXVMOUNT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>04628000
                                                               <<00552>>04630000
PROCEDURE CXLMOUNT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>04632000
                                                               <<00552>>04634000
PROCEDURE CXLDISMOUNT EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>04636000
                                                               <<00552>>04638000
PROCEDURE CXMRJECONTROL EXECUTORHEAD; OPTION EXTERNAL;         <<00552>>04640000
                                                               <<00552>>04642000
PROCEDURE CXJOBSECURITY EXECUTORHEAD; OPTION EXTERNAL;         <<00552>>04644000
                                                               <<00552>>04646000
PROCEDURE CXDISASSOCIATE EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>04648000
PROCEDURE CXSTARTSPOOL EXECUTORHEAD; OPTION EXTERNAL;          <<00552>>04650000
PROCEDURE CXSTOPSPOOL  EXECUTORHEAD; OPTION EXTERNAL;          <<00552>>04652000
PROCEDURE CXSUSPENDSPOOL EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>04654000
PROCEDURE CXRESUMESPOOL  EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>04656000
PROCEDURE CXALTSPOOLFILE EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>04658000
PROCEDURE CXDELETESPOOLFILE EXECUTORHEAD; OPTION EXTERNAL;     <<00552>>04660000
                                                               <<00552>>04662000
PROCEDURE CXDOWNLOAD EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>04664000
                                                               <<00552>>04666000
PROCEDURE CXABORTIO EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>04668000
                                                               <<00552>>04670000
PROCEDURE CXABORTJOB EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>04672000
                                                               <<00552>>04674000
PROCEDURE CXACCEPT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>04676000
                                                               <<00552>>04678000
PROCEDURE CXALLOW EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>04680000
                                                               <<00552>>04682000
<<PROCEDURE CXALTFILE EXECUTORHEAD; OPTION EXTERNAL;>>         <<00552>>04684000
                                                               <<00552>>04686000
PROCEDURE CXALTJOB EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>04688000
                                                               <<00552>>04690000
PROCEDURE CXBREAKJOB EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>04692000
                                                               <<00552>>04694000
<<PROCEDURE CXDELETE EXECUTORHEAD; OPTION EXTERNAL;>>          <<00552>>04696000
                                                               <<00552>>04698000
PROCEDURE CXDISALLOW EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>04700000
                                                               <<00552>>04702000
PROCEDURE CXDOWN EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>04704000
                                                               <<00552>>04706000
PROCEDURE CXGIVE EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>04708000
                                                               <<00552>>04710000
PROCEDURE CXHEADOFF EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>04712000
                                                               <<00552>>04714000
PROCEDURE CXHEADON EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>04716000
                                                               <<00552>>04718000
PROCEDURE CXJOBFENCE EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>04720000
                                                               <<00552>>04722000
PROCEDURE CXLIMIT EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>04724000
                                                               <<00552>>04726000
PROCEDURE CRUNCH(N1,N2,N3,DEST,NWORDS);                        <<02554>>04728000
   INTEGER NWORDS;                                             <<02554>>04730000
   INTEGER ARRAY DEST;                                         <<02554>>04732000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>04734000
   OPTION EXTERNAL;                                            <<02554>>04736000
PROCEDURE CXLOG EXECUTORHEAD; OPTION EXTERNAL;                 <<00601>>04738000
PROCEDURE CXMIOENABLE EXECUTORHEAD; OPTION EXTERNAL;           <<00575>>04740000
                                                               <<00575>>04742000
PROCEDURE CXMIODISABLE EXECUTORHEAD; OPTION EXTERNAL;          <<00575>>04744000
                                                               <<00575>>04746000
PROCEDURE CXTUNE EXECUTORHEAD; OPTION EXTERNAL;                <<01549>>04748000
INTEGER PROCEDURE XRETJTENTRY(N1,N2,N3,SIZE,INFO);             <<02554>>04750000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>04752000
   INTEGER SIZE;                                               <<02554>>04754000
   INTEGER ARRAY INFO;                                         <<02554>>04756000
   OPTION EXTERNAL;                                            <<02554>>04758000
<<                                                                      04760000
      FORWARD PROCEDURE DECLARATIONS                                    04762000
                                  >>                                    04764000
   INTEGER PROCEDURE CYIMPLCTFILE'(LHS,RHS,LENR);              <<U.RAO>>04766000
   VALUE LENR;                                                 <<U.RAO>>04768000
   INTEGER LENR;                                               <<U.RAO>>04770000
   BYTE ARRAY LHS, RHS;                                        <<U.RAO>>04772000
   OPTION PRIVILEGED, UNCALLABLE, FORWARD;                     <<U.RAO>>04774000
                                                               <<U.RAO>>04776000
   PROCEDURE DELIMPFILE(PARM,FNAME);                                    04778000
   VALUE PARM;                                                          04780000
   LOGICAL PARM;                                                        04782000
   BYTE ARRAY FNAME;                                                    04784000
   OPTION PRIVILEGED, UNCALLABLE, FORWARD;                              04786000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<U.RAO>>04788000
VALUE FNUM;                                                    <<U.RAO>>04790000
INTEGER FNUM,PARMNUM;                                          <<U.RAO>>04792000
OPTION PRIVILEGED, UNCALLABLE,FORWARD;                         <<U.RAO>>04794000
                                                                        04796000
   PROCEDURE CIERR(ERRNUM,ERRADR,PARMMASK,PARM);               <<U.RAO>>04798000
   VALUE ERRNUM,PARMMASK,PARM;                                 <<U.RAO>>04800000
   INTEGER ERRNUM,PARMMASK,PARM;                               <<U.RAO>>04802000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>04804000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE,FORWARD;              <<U.RAO>>04806000
                                                               <<U.RAO>>04808000
   PROCEDURE PRINTCARET(ERRADR);                               <<U.RAO>>04810000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>04812000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                       <<U.RAO>>04814000
                                                               <<U.RAO>>04816000
LOGICAL PROCEDURE CYORGCOMS'(ERRNUM,PARMNUM,IMAGE,LEVEL,NEWENTRY,       04818000
                             VSCOMM,SPECMASK);                 <<RV.PV>>04820000
VALUE LEVEL;                                                   <<U.RAO>>04822000
INTEGER ERRNUM;                                                <<U.RAO>>04824000
INTEGER PARMNUM;                                               <<U.RAO>>04826000
BYTE ARRAY IMAGE;                                              <<U.RAO>>04828000
INTEGER LEVEL;                                                 <<U.RAO>>04830000
INTEGER ARRAY NEWENTRY;                                        <<U.RAO>>04832000
ARRAY VSCOMM;                                                  <<RV.PV>>04834000
ARRAY SPECMASK;                                                <<RV.PV>>04836000
OPTION VARIABLE,PRIVILEGED,UNCALLABLE,FORWARD;                 <<U.RAO>>04838000
                                                                        04840000
   INTEGER PROCEDURE SYSLIST (ELEMENT, LEVEL, PARMS, SIRS);             04842000
   VALUE LEVEL, PARMS, SIRS;                                            04844000
   ARRAY ELEMENT;                                                       04846000
   INTEGER LEVEL, PARMS;                                                04848000
   DOUBLE SIRS;                                                         04850000
   OPTION FORWARD, PRIVILEGED, UNCALLABLE;                              04852000
                                                                        04854000
PROCEDURE CYDIRERR'(DIRECRETURN,OKMASK,ERRNUM);                <<U.RAO>>04856000
VALUE DIRECRETURN,OKMASK;                                      <<U.RAO>>04858000
DOUBLE DIRECRETURN;                                            <<U.RAO>>04860000
INTEGER ERRNUM;                                                <<U.RAO>>04862000
LOGICAL OKMASK;                                                <<U.RAO>>04864000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>04866000
                                                                        04868000
   PROCEDURE GET'FILECODE(FILECODE,MNEMONIC,MNEMONIC'LENGTH);  <<01454>>04870000
   INTEGER FILECODE,MNEMONIC'LENGTH;                           <<01454>>04872000
   BYTE ARRAY MNEMONIC;                                        <<01454>>04874000
   OPTION UNCALLABLE,PRIVILEGED,FORWARD;                       <<01454>>04876000
                                                               <<01454>>04878000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>04880000
VALUE PDEF; DOUBLE PDEF;                                       <<U.RAO>>04882000
LOGICAL GPTR,APTR,ERRPTR;                                      <<U.RAO>>04884000
OPTION PRIVILEGED, UNCALLABLE, FORWARD;                        <<U.RAO>>04886000
                                                               <<U.RAO>>04888000
LOGICAL PROCEDURE CIBADFILENAME(ERRNUM,PARM);                  <<U.RAO>>04890000
VALUE PARM;                                                    <<U.RAO>>04892000
INTEGER ERRNUM;                                                <<U.RAO>>04894000
DOUBLE PARM;                                                   <<U.RAO>>04896000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>04898000
                                                               <<U.RAO>>04900000
INTEGER PROCEDURE CHECKHOMEACCT(PPRESULT);                     <<U.RAO>>04902000
INTEGER ARRAY PPRESULT;                                        <<U.RAO>>04904000
OPTION PRIVILEGED, UNCALLABLE, FORWARD;                        <<U.RAO>>04906000
                                                                        04908000
INTEGER PROCEDURE CHECKHOMEGROUP(PPRESULT);                    <<U.RAO>>04910000
INTEGER ARRAY PPRESULT;                                        <<U.RAO>>04912000
OPTION PRIVILEGED, UNCALLABLE, FORWARD;                        <<U.RAO>>04914000
                                                                        04916000
PROCEDURE RESET'TERMINALMODE;                                  <<00851>>04918000
OPTION UNCALLABLE,FORWARD;                                     <<00851>>04920000
PROCEDURE LOADERROR(ERRNUM);                                   <<U.RAO>>04922000
VALUE ERRNUM; INTEGER ERRNUM;                                  <<U.RAO>>04924000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>04926000
                                                               <<U.RAO>>04928000
LOGICAL PROCEDURE CREATEERROR;                                 <<U.RAO>>04930000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>04932000
                                                               <<U.RAO>>04934000
   INTEGER PROCEDURE GETFLABEL(FILEREF,LEN,FLABEL,FLDN,                 04936000
   FADDR,FNUM,SIRINFO);                                        <<04.RO>>04938000
   VALUE LEN;                                                           04940000
   INTEGER LEN,FLDN;                                                    04942000
   INTEGER FNUM;                                               <<04.RO>>04944000
   ARRAY FLABEL;                                                        04946000
   BYTE ARRAY FILEREF;                                                  04948000
   DOUBLE FADDR,SIRINFO;                                                04950000
   OPTION FORWARD,VARIABLE,PRIVILEGED,UNCALLABLE;                       04952000
                                                                        04954000
PROCEDURE CONDEXP(EXP,EVALUE,ERRNUM,ENDADR,PARMNUM);           <<U.RAO>>04956000
BYTE ARRAY EXP;                                                <<U.RAO>>04958000
LOGICAL EVALUE;                                                <<U.RAO>>04960000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>04962000
OPTION FORWARD;                                                <<U.RAO>>04964000
PROCEDURE TRANSJCWEQUATE(PARM, VAL, ERR, ADR);                 <<U.RAO>>04966000
BYTE ARRAY PARM;                                               <<U.RAO>>04968000
INTEGER VAL;                                                   <<U.RAO>>04970000
INTEGER ERR,ADR;                                               <<U.RAO>>04972000
OPTION FORWARD;                                                <<U.RAO>>04974000
   PROCEDURE RESETDUMP;                                                 04976000
   OPTION FORWARD,PRIVILEGED;                                           04978000
                                                                        04980000
   PROCEDURE SETDUMP(FLAGS);                                            04982000
   VALUE FLAGS;                                                         04984000
   LOGICAL FLAGS;                                                       04986000
   OPTION PRIVILEGED,FORWARD;                                           04988000
                                                                        04990000
   LOGICAL PROCEDURE REQUESTSERVICE;                                    04992000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                04994000
                                                                        04996000
   PROCEDURE SETSERVICE(DISP);                                          04998000
   VALUE DISP;                                                          05000000
   LOGICAL DISP;                                                        05002000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                05004000
                                                                        05006000
   PROCEDURE WELCOMEMES(WDST,FUNNYTERMINAL);                  <<A00.04>>05008000
   VALUE WDST,FUNNYTERMINAL;                                  <<A00.04>>05010000
   LOGICAL FUNNYTERMINAL;                                     <<A00.04>>05012000
   INTEGER WDST;                                                        05014000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                05016000
                                                               <<DS0.0>>05018000
   PROCEDURE CXDSLINED EXECUTORHEAD;                           <<DS0.0>>05020000
   OPTION FORWARD,PRIVILEGED,UNCALLABLE;                       <<DS0.0>>05022000
                                                               <<DS0.0>>05024000
   PROCEDURE CXREMOTED EXECUTORHEAD;                           <<DS0.0>>05026000
   OPTION FORWARD,PRIVILEGED,UNCALLABLE;                       <<DS0.0>>05028000
                                                               <<DS0.0>>05030000
   LOGICAL PROCEDURE CREATEPROC'ERR(ERROR,ERRNUM);             <<01452>>05032000
   VALUE ERROR; INTEGER ERROR,ERRNUM;                          <<01452>>05034000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                       <<01452>>05036000
                                                               <<01452>>05038000
   PROCEDURE CXRFAD EXECUTORHEAD;                              <<DS0.0>>05040000
   OPTION FORWARD,PRIVILEGED,UNCALLABLE;                       <<DS0.0>>05042000
                                                                        05044000
   PROCEDURE CXSHOWCOM EXECUTORHEAD;                                    05046000
   OPTION FORWARD,PRIVILEGED,UNCALLABLE;                                05048000
                                                               <<01115>>05050000
PROCEDURE CXFOREIGN EXECUTORHEAD;                              <<01115>>05052000
OPTION EXTERNAL;                                               <<01115>>05054000
                                                               <<01452>>05056000
LOGICAL PROCEDURE CISUBSYSFINISH(MESSGTYPE,ERRNUM,PARMNUM);    <<01452>>05058000
   VALUE MESSGTYPE;                                            <<01452>>05060000
   INTEGER MESSGTYPE,ERRNUM,PARMNUM;                           <<01452>>05062000
   OPTION UNCALLABLE,PRIVILEGED,FORWARD;                       <<01452>>05064000
                                                                        05066000
LOGICAL PROCEDURE JOBSESSIONMAIN; OPTION FORWARD;              <<14.EB>>05068000
                                                               <<04193>>05070000
PROCEDURE STACKMARK( WHICH, DELQ, STAT, RELP, XREG );          <<04193>>05072000
   VALUE WHICH;                                                <<04193>>05074000
   INTEGER WHICH, DELQ, STAT, RELP, XREG;                      <<04193>>05076000
OPTION VARIABLE, UNCALLABLE, PRIVILEGED, FORWARD;              <<04193>>05078000
                                                               <<04193>>05080000
PROCEDURE SYSINTERR( ERRN, BACK );                             <<04193>>05082000
   VALUE   ERRN, BACK;                                         <<04193>>05084000
   INTEGER ERRN, BACK;                                         <<04193>>05086000
OPTION UNCALLABLE, PRIVILEGED, FORWARD;                        <<04193>>05088000
                                                               <<04193>>05090000
                                                               <<14.EB>>05092000
$PAGE    "FILE AND BUILD COMMAND EXECUTORS"                             05094000
$CONTROL   SEGMENT  =  CIFILEB                                          05096000
                                                                        05098000
LOGICAL PROCEDURE CHECKEXPDATE(ERRNUM, FIELDLEN, DATASOURCE,   <<U.RAO>>05100000
    DATATARGET);                                               <<U.RAO>>05102000
VALUE FIELDLEN;                                                <<U.RAO>>05104000
INTEGER ERRNUM, FIELDLEN;                                      <<U.RAO>>05106000
BYTE ARRAY DATASOURCE, DATATARGET;                             <<U.RAO>>05108000
OPTION INTERNAL;                                               <<04.RO>>05110000
<<This procedure checks the expiration date field for labeled>><<U.RAO>>05112000
<<tapes.  The format for this field is MM/DD/YY.  They may all><<U.RAO>>05114000
<<be zero.  The procedure calls CIERR directly.  ERRNUM is the><<U.RAO>>05116000
<<usual CI error parameter.  FIELDLEN is the length of the >>  <<U.RAO>>05118000
<<expiration date field as determined in the FILE command by>> <<U.RAO>>05120000
<<MYCOMMAND.  It is used to check for extraneous data.  >>     <<U.RAO>>05122000
<<DATASOURCE and DATATARGET are just what they seem.    >>     <<U.RAO>>05124000
BEGIN                                                          <<U.RAO>>05126000
INTEGER MONTH;                                                 <<U.RAO>>05128000
INTEGER DAY;                                                   <<U.RAO>>05130000
INTEGER YEAR;                                                  <<U.RAO>>05132000
INTEGER NUMLEN;  <<LENGTH OF THE INDIVIDUAL DATA FIELD>>       <<U.RAO>>05134000
INTEGER MAXDAYS;  <<USED TO COPE WITH LEAP YEAR COMPLICATIONS>><<U.RAO>>05136000
BYTE POINTER SOURCEPTR;   <<CURRENT LOCATION IN SOURCE>>       <<U.RAO>>05138000
INTEGER ARRAY MONTHARR(0:1) = PB :=    <<DAYS OF EACH MONTH>>  <<U.RAO>>05140000
   0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31;          <<U.RAO>>05142000
SUBROUTINE GETTOKEN(TARGET);                                   <<U.RAO>>05144000
INTEGER TARGET;                                                <<U.RAO>>05146000
<<FINDS AND COMPUTES EACH PART OF THE DATE FIELD>>             <<U.RAO>>05148000
BEGIN                                                          <<U.RAO>>05150000
SCAN SOURCEPTR WHILE [8/%15,8/" "],1;                          <<U.RAO>>05152000
@SOURCEPTR := TOS;                                             <<U.RAO>>05154000
MOVE SOURCEPTR := SOURCEPTR WHILE N,1;                         <<U.RAO>>05156000
NUMLEN := TOS-@SOURCEPTR;                                      <<U.RAO>>05158000
TARGET := BINARY(SOURCEPTR, NUMLEN);  <<CONVERT TO BINARY>>    <<U.RAO>>05160000
END;                                                           <<U.RAO>>05162000
@SOURCEPTR := @DATASOURCE;                                     <<U.RAO>>05164000
MOVE DATATARGET := "00/00/0";  <<INITIALIZE RETURN SPACE>>     <<U.RAO>>05166000
GETTOKEN(MONTH);   <<COMPUTE MONTH VALUE>>                     <<U.RAO>>05168000
IF NOT(1<=NUMLEN<=2) OR NOT(0<=MONTH<=12) THEN   <<INVALID MONT<<U.RAO>>05170000
   CIERR(ERRNUM := FILEXPINVMONTH, SOURCEPTR)                  <<U.RAO>>05172000
ELSE                                                           <<U.RAO>>05174000
   BEGIN   <<MONTH CHECKED OUT OK, DO DAY>>                    <<U.RAO>>05176000
   ASCII(MONTH, -10, DATATARGET(1));  <<PUT IN RESULT FIELD>>  <<U.RAO>>05178000
   SCAN SOURCEPTR(NUMLEN) WHILE [8/%15,8/" "],1;               <<U.RAO>>05180000
   IF BPS0 <> "/" THEN                                         <<U.RAO>>05182000
      CIERR(ERRNUM := FILEXPNOSLASHMD, BPS0)                   <<U.RAO>>05184000
   ELSE   <<FOUND SLASH, LOOK FOR DAY>>                        <<U.RAO>>05186000
      BEGIN                                                    <<U.RAO>>05188000
      @SOURCEPTR := TOS+1;                                     <<U.RAO>>05190000
      GETTOKEN(DAY);                                           <<U.RAO>>05192000
      IF MONTH=0 AND DAY<>0 THEN  <<00/00/00 BAD>>             <<U.RAO>>05194000
         CIERR(ERRNUM := FILEXPDAYZERO, SOURCEPTR)             <<U.RAO>>05196000
      ELSE IF NOT(1<=NUMLEN<=2) THEN                           <<00617>>05198000
         CIERR(ERRNUM := FILEXPINVDAY,SOURCEPTR,%10000,MAXDAYS)<<U.RAO>>05200000
      ELSE   <<DAY CHECKED OUT>>                               <<U.RAO>>05202000
         BEGIN                                                 <<U.RAO>>05204000
         ASCII(DAY, -10, DATATARGET(4));                       <<U.RAO>>05206000
         SCAN SOURCEPTR(NUMLEN) WHILE [8/%15,8/" "],1;         <<U.RAO>>05208000
         IF BPS0 <> "/" THEN                                   <<U.RAO>>05210000
            CIERR(ERRNUM := FILEXPNOSLASHDY, BPS0)             <<U.RAO>>05212000
         ELSE                                                  <<U.RAO>>05214000
            BEGIN                                              <<U.RAO>>05216000
            @SOURCEPTR := TOS+1;                               <<U.RAO>>05218000
            GETTOKEN(YEAR);                                    <<U.RAO>>05220000
            MAXDAYS:=MONTHARR(MONTH) + <<LEAP YEAR CORRECTION>><<00617>>05222000
               (IF YEAR MOD 4 = 0 AND MONTH=2 THEN 1 ELSE 0);  <<00617>>05224000
            IF MONTH <> 0 AND NOT(1<=DAY<=MAXDAYS) THEN        <<00617>>05226000
               CIERR(ERRNUM:=FILEXPINVDAY,,%10000,MAXDAYS)     <<00617>>05228000
            ELSE                                               <<00617>>05230000
            IF MONTH=0 AND YEAR<>0 THEN  <<EXPECTED 00/00/00>> <<U.RAO>>05232000
               CIERR(ERRNUM := FILEXPNONZERO, SOURCEPTR)       <<U.RAO>>05234000
            ELSE                                               <<U.RAO>>05236000
               IF @SOURCEPTR(NUMLEN)-@DATASOURCE <> FIELDLEN THEN       05238000
                  CIERR(ERRNUM := FILEXPXTRNDATA, SOURCEPTR(NUMLEN))    05240000
            ELSE   <<ALL CHECKED OUT, DO IT>>                  <<U.RAO>>05242000
               BEGIN                                           <<U.RAO>>05244000
               ASCII(YEAR, -10, DATATARGET(7));                <<U.RAO>>05246000
               CHECKEXPDATE := TRUE;                           <<U.RAO>>05248000
               END;                                            <<U.RAO>>05250000
            END;                                               <<U.RAO>>05252000
         END;                                                  <<U.RAO>>05254000
      END;                                                     <<U.RAO>>05256000
   END;                                                        <<U.RAO>>05258000
END;   <<PROCEDURE CHECKEXPDATE>>                              <<U.RAO>>05260000
PROCEDURE CXFILE EXECUTORHEAD;                                 <<U.RAO>>05262000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>05264000
BEGIN                                                          <<U.RAO>>05266000
BYTE ARRAY PKEYLIST (0:1) = PB :=                              <<U.RAO>>05268000
   << FLAGS-BYTE (FOLLOWING WORD) = DISALLOW NEW/OLD/SYS($)/BUIL>>      05270000
   6,3, "DEV", 0,                                              <<U.RAO>>05272000
   7,4, "DISC", 6,                                             <<U.RAO>>05274000
   6,3, "REC", 0,                                              <<U.RAO>>05276000
   7,4, "CODE", 2,                                             <<U.RAO>>05278000
   7,4, "CCTL", 0,                                             <<U.RAO>>05280000
   9,6, "NOCCTL", 0,                                           <<U.RAO>>05282000
   7,4, "TEMP", 2,                                             <<U.RAO>>05284000
   7,4, "SAVE", 3,                                             <<U.RAO>>05286000
   6,3, "DEL", 3,                                              <<U.RAO>>05288000
   6,3, "ACC", 1,                                              <<U.RAO>>05290000
   6,3, "SHR", 1,                                              <<U.RAO>>05292000
   6,3, "EAR", 1,                                              <<U.RAO>>05294000
   7,4, "SEMI", 1,                                             <<01549>>05296000
   6,3, "EXC", 1,                                              <<U.RAO>>05298000
   6,3, "BUF", 1,                                              <<U.RAO>>05300000
   8,5, "NOBUF", 1,                                            <<U.RAO>>05302000
   7,4, "COPY", 1,                                             <<01549>>05304000
   9,6, "NOCOPY", 1,                                           <<01549>>05306000
   5,2, "MR", 1,                                               <<U.RAO>>05308000
   7,4, "NOMR", 1,                                             <<U.RAO>>05310000
   9,6, "GMULTI", 1,                                           <<01549>>05312000
   8,5, "MULTI", 1,                                            <<U.RAO>>05314000
   10,7, "NOMULTI", 1,                                         <<U.RAO>>05316000
   10,7, "NOLABEL", 3,                                         <<U.RAO>>05318000
   8,5, "FORMS", 1,                                            <<U.RAO>>05320000
   8,5, "LABEL", 3,                                            <<U.RAO>>05322000
   7,4, "LOCK", 1,                                             <<U.RAO>>05324000
   9,6, "NOLOCK", 1,                                           <<U.RAO>>05326000
   7,4, "WAIT", 1,                                             <<U.RAO>>05328000
   9,6, "NOWAIT", 1,                                           <<U.RAO>>05330000
   6,3, "STD", 3,                                              <<01724>>05332000
   6,3, "RIO",2,                                               <<00634>>05334000
   8,5, "NORIO",2,                                             <<00634>>05336000
   6,3,"ENV",1,                                                <<01549>>05338000
   7,4,"OUTQ", 1,                                              <<01549>>05340000
   6,3, "MSG", 2,                                              <<01549>>05342000
   6,3, "CIR", 2,                                              <<01549>>05344000
   6,3, "DEN", 3,                                              <<02569>>05346000
   0;                                                          <<U.RAO>>05348000
EQUATE PKEYLISTL = 272;                                        <<02569>>05350000
BYTE ARRAY KEYLIST (0:PKEYLISTL-1);                            <<U.RAO>>05352000
BYTE ARRAY PACCTYPES(0:1) = PB :=                              <<U.RAO>>05354000
   4,2, "IN",                                                  <<U.RAO>>05356000
   5,3, "OUT",                                                 <<U.RAO>>05358000
   9,7, "OUTKEEP",                                             <<U.RAO>>05360000
   8,6, "APPEND",                                              <<U.RAO>>05362000
   7,5, "INOUT",                                               <<U.RAO>>05364000
   8,6, "UPDATE",                                              <<U.RAO>>05366000
   0;                                                          <<U.RAO>>05368000
EQUATE ACCTYPEL = 42;                                          <<U.RAO>>05370000
BYTE ARRAY ACCTYPES(0:ACCTYPEL-1);                             <<U.RAO>>05372000
ENTRY CXBUILD, PARSE'FILE'EQ;                                  <<01200>>05374000
LABEL STARTPARSE;          << COMMOM CODE TO BOTH ENTRY PTS >> <<01200>>05376000
                                                               <<U.RAO>>05378000
<<VARIABLES FOR THE PARSE>>                                    <<U.RAO>>05380000
LOGICAL BUILDFLAG := FALSE;                                    <<U.RAO>>05382000
INTEGER NUMPARMS;                                              <<U.RAO>>05384000
EQUATE MAXPARMS = 32;                                          <<01549>>05386000
BYTE POINTER PARMPTR;  <<POINTER TO CURRENT PARAMETER>>        <<U.RAO>>05388000
INTEGER PARMLEN;  <<LENGTH OF CURRENT PARAMETER>>              <<U.RAO>>05390000
BYTE SAVEDELIM;                                                <<02053>>05392000
INTEGER NEXTDELIM;  <<DELIMITER FOLLOWING CURRENT PARAMETER>>  <<U.RAO>>05394000
DOUBLE DELIMS := [8/",",8/"=",8/";",8/%15]D;                   <<01117>>05396000
BYTE ARRAY BDELIMS (*) = DELIMS;                               <<01117>>05398000
DEFINE DELIMTYPE = (13:3)#;                                    <<U.RAO>>05400000
EQUATE COMMA = 0,  <<EQUATES FOR INDEX IN DELIMITER ARRAY>>    <<U.RAO>>05402000
       EQUALS = 1,                                             <<U.RAO>>05404000
       SEMICOLON = 2,                                          <<U.RAO>>05406000
       CR = 3;                                                 <<U.RAO>>05408000
INTEGER COMTYPE;  <<HOLDS TYPE OF COMMAND WHILE IN PROCKEY>>   <<U.RAO>>05410000
EQUATE BUILD = 0,  <<EQUATES FOR VALUES OF COMTYPE>>           <<U.RAO>>05412000
       SYSDEF = 1,                                             <<U.RAO>>05414000
       OLD = 2,                                                <<U.RAO>>05416000
       NEW = 3;                                                <<U.RAO>>05418000
LOGICAL GPNTR := 0,   <<HOLD BYTE POINTERS TO APPROPRIATE ENTRY<<U.RAO>>05420000
        APNTR := 0,                                            <<U.RAO>>05422000
        GPNTR2 := 0,                                           <<U.RAO>>05424000
        APNTR2 := 0,                                           <<U.RAO>>05426000
        APNTRENV := 0,   <<"ENV=FILENAME">>                    <<01549>>05428000
        GPNTRENV := 0,                                         <<01549>>05430000
        ERRPNTR := 0;                                          <<U.RAO>>05432000
BYTE POINTER GROUP = GPNTR,                                    <<U.RAO>>05434000
             ACCT = APNTR,                                     <<U.RAO>>05436000
             GROUP2 = GPNTR2,                                  <<U.RAO>>05438000
             ACCT2 = APNTR2,                                   <<U.RAO>>05440000
             GROUPENV = GPNTRENV,                              <<02554>>05442000
             ACCTENV  = APNTRENV,                              <<02554>>05444000
             ERRADR = ERRPNTR;                                 <<U.RAO>>05446000
                                                               <<U.RAO>>05448000
<<VARIABLES FOR THE EXECUTION PHASE>>                          <<U.RAO>>05450000
BYTE POINTER DICTPTR;  <<DICTIONARY POINTER FOR SEARCH INTRINSIC>>      05452000
ARRAY WENTRY(0:71);   <<HOLDS PROTOTYPE ENTRY FOR JDT>>        <<U.RAO>>05454000
BYTE ARRAY BENTRY(*)=WENTRY;                                   <<U.RAO>>05456000
INTEGER ARRAY                                                  <<02554>>05458000
   FILE'ENTRY(0:71),      << HOLDS FILE ENTRY FROM JDT >>      <<02554>>05460000
   DEST(0:14);            << HOLDS OUTPUT OF CRUNCH    >>      <<02554>>05462000
INTEGER                                                        <<02554>>05464000
   SIZE,                  << FOR CRUNCH CALL           >>      <<02554>>05466000
   INDEX;                 << GENERAL LOOP VARIABLE     >>      <<02554>>05468000
BYTE ARRAY                                                     <<02554>>05470000
   BFILE'ENTRY(*) = FILE'ENTRY;                                <<02554>>05472000
INTEGER NEXTENTRYX := 6;  <<USED IN SETTING UP WENTRY>>        <<U.RAO>>05474000
BYTE BLANK := " ";                                             <<U.RAO>>05476000
                                                               <<U.RAO>>05478000
<<DATA VARIABLES>>                                             <<U.RAO>>05480000
BYTE ARRAY FORMSMSG(0:73);                                     <<U.RAO>>05482000
BYTE ARRAY TAPELABEL(*)=FORMSMSG(49);                          <<U.RAO>>05484000
BYTE ARRAY SAVEDCOMIMAGE(0:BCOMMANDBUFLEN - 1);                <<02663>>05486000
INTEGER FORMSMSGLEN := 0;                                      <<U.RAO>>05488000
INTEGER TAPELABELLEN := 0;                                     <<U.RAO>>05490000
EQUATE                                                         <<04171>>05492000
   MAXDEVLEN      = 44, << when this changes, change the one in<<04171>>05494000
                        << FOPEN  segment FILESYS6A.           <<04171>>05496000
   MAXDEVCLASSLEN = 8;  << maximum device class name >>        <<04171>>05498000
INTEGER DEVLEN := 0;                                           <<U.RAO>>05500000
DOUBLE DISC := "DISC";                                         <<U.RAO>>05502000
BYTE POINTER DEV := @DISC;                                     <<U.RAO>>05504000
INTEGER ARRAY DEVINFO(0:8);                                    <<04171>>05506000
BYTE POINTER BPTR;                                             <<01117>>05508000
DEFINE                                                         <<04171>>05510000
   FLUSH'COMMAND =                                             <<04171>>05512000
      BEGIN                                                    <<04171>>05514000
         PARSE'ERR(ERRNUM,BPTR);                               <<04171>>05516000
         RETURN;                                               <<04171>>05518000
      END;#;                                                   <<04171>>05520000
LOGICAL FOPTIONS := 0;                                         <<U.RAO>>05522000
LOGICAL AOPTIONS := 0;                                         <<U.RAO>>05524000
LOGICAL FLAGS1 := 0;  <<PROTOTYPE PARAMETER PRESENT MASK>>     <<U.RAO>>05526000
LOGICAL FLAGS2 := 0;  <<WORD 2 OF FLAGS>>                      <<U.RAO>>05528000
EQUATE DELETE = 4,   <<EQUATES FOR DISPOSITION PARAMETERS>>    <<U.RAO>>05530000
       TEMP = 2,                                               <<U.RAO>>05532000
       SAVE = 1;                                               <<U.RAO>>05534000
EQUATE STD = 0,  <<EQUATES FOR FILE TYPE>>                     <<01549>>05536000
       RIO = 2,                                                <<01549>>05538000
       CIR = 4,                                                <<01549>>05540000
       MSG = 6;                                                <<01549>>05542000
EQUATE NOMULTI     = 0,  <<EQUATES FOR MULTIACCESS>>           <<01549>>05544000
       LOCALMULTI  = 1,                                        <<01549>>05546000
       GLOBALMULTI = 2;                                        <<01549>>05548000
INTEGER DISPOSITION := SAVE;  <<DISPOSITION OF FILE AT CLOSE>> <<U.RAO>>05550000
INTEGER RECSIZE := 0;                                          <<U.RAO>>05552000
INTEGER BLOCKFACTOR := 0;                                      <<U.RAO>>05554000
DOUBLE FILESIZE := 0D;                                         <<U.RAO>>05556000
INTEGER NUMEXTENTS := 0;                                       <<U.RAO>>05558000
INTEGER INITALLOC := 0;                                        <<U.RAO>>05560000
INTEGER OUTPRI := 0;                                           <<U.RAO>>05562000
INTEGER NUMCOPIES := 0;                                        <<U.RAO>>05564000
INTEGER FILECODE := 0;                                         <<U.RAO>>05566000
INTEGER NUMBUFFERS := 0;                                       <<U.RAO>>05568000
EQUATE DEFAULTACCESS = 0,  <<ACCESS TYPE FIELD>>               <<U.RAO>>05570000
       EXCLUSIVE     = 1,                                      <<U.RAO>>05572000
       EXCLUSIVEREAD = 2,                                      <<U.RAO>>05574000
       SHARE         = 3;                                      <<U.RAO>>05576000
LOGICAL PARSE'ONLY;          << TRUE IF ONLY DOING PARSE >>    <<01200>>05578000
LOGICAL STOP;                                                  <<02663>>05580000
<< Variables for FOPEN device parameter keywords >>            <<02569>>05584000
BYTE POINTER                                                   <<01851>>05586000
   DENS,                                                       <<02569>>05588000
   OUTQ,                                                       <<01851>>05590000
   ENV;                                                        <<01851>>05592000
INTEGER                                                        <<01851>>05594000
   DUMMY,          << Dummy for procedure call >>              <<02569>>05596000
   DENSLEN := 0,                                               <<02569>>05598000
   ENVLEN := 0,                                                <<01851>>05600000
   OUTQLEN := 0,                                               <<01851>>05602000
   KEYS'LEN := 0;  << Total length of device parms >>          <<02569>>05604000
LOGICAL FLAGS3 := FALSE;                                       <<01549>>05606000
DEFINE                                                         <<01549>>05608000
   FLAGDENS = FLAGS3.(12:1)#,                                  <<02569>>05610000
   FLAGADEV = FLAGS3.(15:1)#,                                  <<01549>>05612000
   FLAGENV = FLAGS3.(14:1)#,                                   <<01549>>05614000
   FLAGOUTQ = FLAGS3.(13:1)#;                                  <<01549>>05616000
                                                               <<U.RAO>>05618000
                                                               <<02569>>05620000
<< The PARMS array (and its equivalences) MUST be the last >>  <<02569>>05622000
<< Q-relative variable defined in the procedure because it >>  <<02569>>05624000
<< is a direct array.  Otherwise, the procedure will run   >>  <<02569>>05626000
<< out of Primary Q space. >>                                  <<02569>>05628000
                                                               <<02569>>05630000
DOUBLE ARRAY PARMS(0:MAXPARMS) = Q;                            <<02569>>05632000
BYTE POINTER FORMALDES = PARMS;                                <<02569>>05634000
INTEGER FORMALDESDATA = PARMS + 1;                             <<02569>>05636000
BYTE POINTER ACTUALDES = PARMS + 2;                            <<02569>>05638000
BYTE ACTUALDESLEN = PARMS + 3;                                 <<02569>>05640000
                                                               <<02569>>05642000
<<FOPTIONS DEFINES>>                                           <<U.RAO>>05644000
DEFINE                                                         <<U.RAO>>05646000
   FILETYPE    = (2:3) #,                                      <<01549>>05648000
   ALLOWFILEEQ = (5:1)#,                                       <<U.RAO>>05650000
   TAPELABELF  = (6:1)#,                                       <<U.RAO>>05652000
   CCTL        = (7:1)#,                                       <<U.RAO>>05654000
   RECORDFMT   = (8:2)#,                                       <<U.RAO>>05656000
   DEFAULTDES  = (10:3)#,                                      <<U.RAO>>05658000
   ASCIIBINARY = (13:1)#,                                      <<U.RAO>>05660000
   DOMAIN      = (14:2)#;                                      <<U.RAO>>05662000
                                                               <<U.RAO>>05664000
<<AOPTIONS DEFINES>>                                           <<U.RAO>>05666000
DEFINE                                                         <<U.RAO>>05668000
   COPY        = (3:1)#,                                       <<01549>>05670000
   NOWAIT      = (4:1)#,                                       <<U.RAO>>05672000
   MULTIACCESS = (5:2)#,                                       <<01549>>05674000
   NOBUF       = (7:1)#,                                       <<U.RAO>>05676000
   EXCLACCESS  = (8:2)#,                                       <<U.RAO>>05678000
   LOCKING     = (10:1)#,                                      <<U.RAO>>05680000
   MULTIRECORD = (11:1)#,                                      <<U.RAO>>05682000
   ACCESSTYPE  = (12:4)#;                                      <<U.RAO>>05684000
                                                               <<U.RAO>>05686000
<<PARAMETER BIT MASK DEFINES - SEE JDT DESCRIPTION>>           <<U.RAO>>05688000
DEFINE                                                         <<U.RAO>>05690000
   FLAGANAME       = FLAGS1.(15:1)#,                           <<U.RAO>>05692000
   FLAGDEV         = FLAGS1.(14:1)#,                           <<U.RAO>>05694000
   FLAGDOMAIN      = FLAGS1.(13:1)#,                           <<U.RAO>>05696000
   FLAGASCII       = FLAGS1.(12:1)#,                           <<U.RAO>>05698000
   FLAGDEFDESIG    = FLAGS1.(11:1)#,                           <<U.RAO>>05700000
   FLAGRECFMT      = FLAGS1.(10:1)#,                           <<U.RAO>>05702000
   FLAGCCTL        = FLAGS1.(9:1)#,                            <<U.RAO>>05704000
   FLAGCOPY        = FLAGS1.(8:1) #,                           <<01549>>05706000
   FLAGACCESSTYPE  = FLAGS1.(7:1)#,                            <<U.RAO>>05708000
   FLAGMULTIREC    = FLAGS1.(6:1)#,                            <<U.RAO>>05710000
   FLAGEXCLUSIVE   = FLAGS1.(5:1)#,                            <<U.RAO>>05712000
   FLAGBUFINHIBIT  = FLAGS1.(4:1)#,                            <<U.RAO>>05714000
   FLAGNUMBUFS     = FLAGS1.(3:1)#,                            <<U.RAO>>05716000
   FLAGDISP        = FLAGS1.(2:1)#,                            <<U.RAO>>05718000
   FLAGRECSIZE     = FLAGS1.(1:1)#,                            <<U.RAO>>05720000
   FLAGBLOCKFACTOR = FLAGS1.(0:1)#,                            <<U.RAO>>05722000
   FLAGINITALLOC   = FLAGS2.(15:1)#,                           <<U.RAO>>05724000
   FLAGNUMEXTS     = FLAGS2.(14:1)#,                           <<U.RAO>>05726000
   FLAGFILESIZE    = FLAGS2.(13:1)#,                           <<U.RAO>>05728000
   FLAGFILECODE    = FLAGS2.(12:1)#,                           <<U.RAO>>05730000
   FLAGOUTPRI      = FLAGS2.(11:1)#,                           <<U.RAO>>05732000
   FLAGNUMCOPIES   = FLAGS2.(10:1)#,                           <<U.RAO>>05734000
   FLAGMULTIACCESS = FLAGS2.(9:1)#,                            <<U.RAO>>05736000
   FLAGWAIT        = FLAGS2.(8:1)#,                            <<U.RAO>>05738000
   FLAGDYNLOCKING = FLAGS2.(7:1)#,                             <<U.RAO>>05740000
   FLAGBACKREF    = FLAGS2.(6:1)#,                             <<U.RAO>>05742000
   FLAGUSERLABELS = FLAGS2.(3:1)#,                             <<U.RAO>>05744000
   FLAGFORMS      = FLAGS2.(2:1)#,                             <<U.RAO>>05746000
   FLAGLABELEDTAPE= FLAGS2.(1:1)#,                             <<U.RAO>>05748000
   FLAGFTYPE      = FLAGS2.(0:1)#;                             <<01549>>05750000
<< JDT FILE ENTRY DEFINES - SEE JDT DESCRIPTION >>             <<02554>>05752000
DEFINE                                                         <<02554>>05754000
   FORMAL'DES'LEN        = FILE'ENTRY.(8:8)#,                  <<02554>>05756000
   FORMAL'DES'NAME       = BFILE'ENTRY(2)#,                    <<02554>>05758000
   ACTUAL'DES'LEN        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>05760000
                                       3).(0:8)#,              <<02554>>05762000
   DEVICE'DES'LEN        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>05764000
                                       3).(8:8)#,              <<02554>>05766000
   DEVICE'DES'NAME       = BFILE'ENTRY(FORMAL'DES'LEN * 2 +    <<02554>>05768000
                                      ACTUAL'DES'LEN +         <<02554>>05770000
                                       8)#,                    <<02554>>05772000
   DEVICE'PRESENT        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>05774000
                                       1).(14:1)#;             <<02554>>05776000
                                                               <<U.RAO>>05778000
                                                               <<01200>>05780000
<<                 *********************                   >>  <<01200>>05782000
<<                 *     PARSE'ERR     *                   >>  <<01200>>05784000
<<                 *********************                   >>  <<01200>>05786000
                                                               <<01200>>05788000
SUBROUTINE PARSE'ERR (ERROR, ERRADR);                          <<01200>>05790000
 VALUE ERROR;                                                  <<01200>>05792000
  INTEGER ERROR;                                               <<01200>>05794000
  BYTE ARRAY ERRADR;                                           <<01200>>05796000
<< SUBROUTINE TO HANDLE ERRORS ENCOUNTERED DURING FILE      >> <<01200>>05798000
<< EQUATION PARSING.  IF A SPECIAL PARSE IS IN PROGRESS     >> <<01200>>05800000
<< (I.E. PARSE'ONLY = TRUE) THEN SIMPLY SET THE ERROR       >> <<01200>>05802000
<< RETURN.  IF A CI COMMAND IS BEING EXECUTED (I.E. :FILE   >> <<01200>>05804000
<< :BUILD) THEN CALL CIERR.                                 >> <<01200>>05806000
BEGIN                                                          <<01200>>05808000
IF NOT PARSE'ONLY THEN                                         <<01200>>05810000
  CIERR (ERROR, ERRADR);                                       <<01200>>05812000
END << PARSE'ERR >>;                                           <<01200>>05814000
                                                               <<U.RAO>>05816000
<<                 *********************                   >>  <<U.RAO>>05818000
<<                 *      GETNEXT      *                   >>  <<U.RAO>>05820000
<<                 *********************                   >>  <<U.RAO>>05822000
                                                               <<U.RAO>>05824000
SUBROUTINE GETNEXT;                                            <<U.RAO>>05826000
<<THIS SUBROUTINE EXTRACTS THE NEXT PARAMETER FROM PARMS>>     <<U.RAO>>05828000
<<AND DECOMPOSES THE MYCOMMAND RETURNED ENTRY.  IT ALSO CHECKS><<U.RAO>>05830000
<<FOR THE TOO MANY PARAMETERS CASE.  >>                        <<U.RAO>>05832000
BEGIN                                                          <<U.RAO>>05834000
TOS := PARMS(PARMNUM);  <<GET NEXT ENTRY>>                     <<U.RAO>>05836000
NEXTDELIM := S0.DELIMTYPE;  <<GET TRAILING DELIMITER>>         <<U.RAO>>05838000
PARMLEN := TOS&LSR(8);  <<LENGTH OF ENTRY>>                    <<U.RAO>>05840000
@PARMPTR := TOS;  <<FIRST WORD OF MYCOMMAND ENTRY>>            <<U.RAO>>05842000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>05844000
IF PARMNUM > MAXPARMS THEN  <<TOO MANY PARAMETERS>>            <<U.RAO>>05846000
   BEGIN                                                       <<U.RAO>>05848000
   IF BUILDFLAG THEN                                           <<U.RAO>>05850000
      PARSE'ERR(ERRNUM := BLD2MP,PARMPTR)                      <<01200>>05852000
   ELSE                                                        <<U.RAO>>05854000
      PARSE'ERR(ERRNUM := FILE2MP,PARMPTR);                    <<01200>>05856000
   ASSEMBLE(EXIT 3);  <<BAIL OUT OF CXFILE>>                   <<U.RAO>>05858000
   END;                                                        <<U.RAO>>05860000
END;  <<SUBROUTINE GETNEXT>>                                   <<U.RAO>>05862000
                                                               <<U.RAO>>05864000
<<                 *********************                   >>  <<U.RAO>>05866000
<<                 *    CHECKFDESIG    *                   >>  <<U.RAO>>05868000
<<                 *********************                   >>  <<U.RAO>>05870000
                                                               <<U.RAO>>05872000
LOGICAL SUBROUTINE CHECKFDESIG;                                <<U.RAO>>05874000
BEGIN                                                          <<U.RAO>>05876000
<<NOTE:  A FORMAL FILE DESIGNATOR MUST HAVE THE SAME FORMAT>>  <<U.RAO>>05878000
<<AS AN ACTUAL FILE DESIGNATOR, BUT IT MAY NOT BE A SYSTEM>>   <<U.RAO>>05880000
<<DEFINED FILE OR A BACK REFERENCED FILE.>>                    <<U.RAO>>05882000
CHECKFDESIG := FALSE;                                          <<U.RAO>>05884000
GETNEXT;  <<EXPLODE PARMS ENTRY FOR FILE NAME>>                <<U.RAO>>05886000
ERRNUM := CHECKFILENAME'(PARMS&LSR(8),GPNTR,APNTR,ERRPNTR);    <<U.RAO>>05888000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>05890000
   PARSE'ERR(ERRNUM,ERRADR)                                    <<01200>>05892000
ELSE IF > THEN  <<NOT STANDARD FILE NAME>>                     <<U.RAO>>05894000
   IF ERRNUM = 0 THEN <<BACK REFERENCED FILE NAME>>            <<U.RAO>>05896000
      PARSE'ERR(ERRNUM := FILEFDSGNOBACK, FORMALDES)           <<01200>>05898000
   ELSE                                                        <<U.RAO>>05900000
      PARSE'ERR(ERRNUM := FILEFDSGNOSYS, FORMALDES)            <<01200>>05902000
ELSE  <<OK - REGULAR FORMAL DESIGNATOR>>                       <<U.RAO>>05904000
   BEGIN                                                       <<U.RAO>>05906000
   CHECKFDESIG := TRUE;                                        <<U.RAO>>05908000
   IF GPNTR = 0 THEN GPNTR := @BLANK;                          <<U.RAO>>05910000
   IF APNTR = 0 THEN APNTR := @BLANK;                          <<U.RAO>>05912000
   END                                                         <<U.RAO>>05914000
END;                                                           <<U.RAO>>05916000
                                                               <<U.RAO>>05918000
<<                 *********************                   >>  <<U.RAO>>05920000
<<                 *  BLDCHECKFDESIG   *                   >>  <<U.RAO>>05922000
<<                 *********************                   >>  <<U.RAO>>05924000
                                                               <<U.RAO>>05926000
LOGICAL SUBROUTINE BLDCHECKFDESIG;                             <<U.RAO>>05928000
BEGIN                                                          <<U.RAO>>05930000
<<NOTE:  A FORMAL FILE DESIGNATOR MUST HAVE THE SAME FORMAT>>  <<U.RAO>>05932000
<<AS AN ACTUAL FILE DESIGNATOR, BUT IT MAY NOT BE A SYSTEM>>   <<U.RAO>>05934000
<<DEFINED FILE>>                                               <<U.RAO>>05936000
BLDCHECKFDESIG := FALSE;                                       <<U.RAO>>05938000
GETNEXT;  <<EXPLODE PARMS ENTRY FOR FILE NAME>>                <<U.RAO>>05940000
ERRNUM := CHECKFILENAME'(PARMS&LSR(8),GPNTR,APNTR,ERRPNTR);    <<U.RAO>>05942000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>05944000
   PARSE'ERR(ERRNUM,ERRADR)                                    <<01200>>05946000
ELSE IF > AND ERRNUM<>0 AND ERRNUM<>2 THEN  <<NOT STD FILE NAME<<U.RAO>>05948000
   PARSE'ERR(ERRNUM := BLDNOSYSFILES, FORMALDES)               <<01200>>05950000
ELSE IF ERRNUM=2 THEN   <<IS $NEWPASS, ALLOW>>                 <<U.RAO>>05952000
   BEGIN                                                       <<00449>>05954000
   BLDCHECKFDESIG := TRUE;                                     <<00449>>05956000
   ERRNUM := 0;                                                <<00449>>05958000
   END                                                         <<00449>>05960000
ELSE  <<OK - REGULAR FORMAL DESIGNATOR>>                       <<U.RAO>>05962000
   BEGIN                                                       <<U.RAO>>05964000
   BLDCHECKFDESIG := TRUE;                                     <<U.RAO>>05966000
   IF GPNTR = 0 THEN GPNTR := @BLANK;                          <<U.RAO>>05968000
   IF APNTR = 0 THEN APNTR := @BLANK;                          <<U.RAO>>05970000
   END                                                         <<U.RAO>>05972000
END;                                                           <<U.RAO>>05974000
                                                               <<U.RAO>>05976000
<<                 *********************                   >>  <<U.RAO>>05978000
<<                 *   CHECKADESIG     *                   >>  <<U.RAO>>05980000
<<                 *********************                   >>  <<U.RAO>>05982000
                                                               <<U.RAO>>05984000
LOGICAL SUBROUTINE CHECKADESIG;                                <<U.RAO>>05986000
<<CHECK FORM OF ACTUAL DESIGNATOR.  MAY BE ANY SORT OF FILE NAM<<U.RAO>>05988000
<<IF IT IS A BACK REFERENCED FILE, WE GO AHEAD AND DO THE FILE <<U.RAO>>05990000
<<EQUATE NOW, SINCE IT SHOULD NOT HAVE ANY PARAMETERS.>>       <<U.RAO>>05992000
BEGIN                                                          <<U.RAO>>05994000
GETNEXT;                                                       <<U.RAO>>05996000
CHECKADESIG := TRUE;                                           <<U.RAO>>05998000
TOS := CHECKFILENAME'(PARMS(1)&LSR(8),GPNTR2,APNTR2,ERRPNTR);  <<U.RAO>>06000000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>06002000
   BEGIN                                                       <<U.RAO>>06004000
   ERRNUM := TOS;                                              <<U.RAO>>06006000
   PARSE'ERR(ERRNUM, ERRADR);                                  <<01200>>06008000
   CHECKADESIG := FALSE                                        <<U.RAO>>06010000
   END                                                         <<U.RAO>>06012000
ELSE IF = THEN  <<ORDINARY ACTUAL FILE DESIGNATOR>>            <<U.RAO>>06014000
   BEGIN                                                       <<U.RAO>>06016000
   DEL;                                                        <<U.RAO>>06018000
   FLAGANAME := TRUE                                           <<U.RAO>>06020000
   END                                                         <<U.RAO>>06022000
ELSE IF > AND (S0<>0) THEN                                     <<U.RAO>>06024000
   BEGIN  <<SYSTEM DEFINED FILE NAME>>                         <<U.RAO>>06026000
   FOPTIONS.DEFAULTDES := TOS;                                          06028000
   IF (FOPTIONS.DEFAULTDES=6) AND (NUMPARMS>PARMNUM) THEN  <<PARMS>>    06030000
      BEGIN  <<WITH $NULL, WHICH IS ILLEGAL>>                  <<U.RAO>>06032000
      CHECKADESIG := FALSE;                                    <<U.RAO>>06034000
      GETNEXT;                                                 <<U.RAO>>06036000
      PARSE'ERR(ERRNUM := FILEADESNULL2MP, PARMPTR);           <<01200>>06038000
      END;                                                     <<U.RAO>>06040000
   FLAGDEFDESIG := TRUE;                                       <<U.RAO>>06042000
   END                                                         <<U.RAO>>06044000
ELSE   <<MUST BE BACK REFERENCED FILE>>                        <<U.RAO>>06046000
   BEGIN                                                       <<U.RAO>>06048000
   <<THIS IS THE END OF THE LINE FOR A BACK REFERENCE.  EITHER><<U.RAO>>06050000
   <<WE WILL DETECT AN ERROR AND REPORT IT OR WE WILL INSERT THE>>      06052000
   <<ENTRY INTO THE JOB DIRECTORY TABLE (JDT).>>               <<U.RAO>>06054000
   DEL;  <<POP ZERO FROM CHECKFILENAME'>>                      <<U.RAO>>06056000
   CHECKADESIG := FALSE;                                       <<U.RAO>>06058000
   IF NUMPARMS > 2 THEN  <<TOO MANY PARAMETERS>>               <<U.RAO>>06060000
      BEGIN                                                    <<U.RAO>>06062000
      GETNEXT;  <<TO FORCE PARMPTR TO THE OFFENDING ITEM>>     <<U.RAO>>06064000
      PARSE'ERR(ERRNUM := FILEADESIGBR2MP, PARMPTR)            <<01200>>06066000
      END                                                      <<U.RAO>>06068000
   ELSE                                                        <<U.RAO>>06070000
      BEGIN                                                    <<U.RAO>>06072000
      <<CREATE ENTRY, ATTEMPT TO INSERT IT>>                   <<U.RAO>>06074000
      IF GPNTR2 = 0 THEN GPNTR2 := @BLANK;                     <<U.RAO>>06076000
      IF APNTR2 = 0 THEN APNTR2 := @BLANK;                     <<U.RAO>>06078000
      @ACTUALDES := @ACTUALDES+1;  <<MOVE PAST "*">>           <<U.RAO>>06080000
      ACTUALDESLEN := ACTUALDESLEN-1;                          <<U.RAO>>06082000
      PARMNUM := 0;  <<CLEAN UP RETURN PARAMETER>>             <<U.RAO>>06084000
      <<NOW FORMAT WENTRY>>                                    <<U.RAO>>06086000
      WENTRY := 1;   <<SET PMASK - NAME ONLY PARM PRESENT>>    <<U.RAO>>06088000
      WENTRY(1) := %1000;  <<SET PMASK WORD 2 - POINTER WENTRY><<U.RAO>>06090000
      BENTRY(4) := ACTUALDESLEN;                               <<U.RAO>>06092000
      BENTRY(5):=0;  <<CLEAR DEVLEN>>                          <<00080>>06094000
      MOVE BENTRY(6) := ACTUALDES,(ACTUALDESLEN);              <<U.RAO>>06096000
      NEXTENTRYX := (ACTUALDESLEN+29)&LSR(1); <<LENGTH IN WORDS<<U.RAO>>06098000
      IF PARSE'ONLY THEN                                       <<01200>>06100000
         BEGIN                                                 <<01200>>06102000
         << COPY LOCAL TABLE ENTRY OVER STRING PASSED TO   >>  <<01200>>06104000
         << PARSE'FILE'EQ.  THIS RETURNS THE PARSED FILE   >>  <<01200>>06106000
         << EQUATION INFO TO THE CALLER.                   >>  <<01200>>06108000
         MOVE PARMSP := BENTRY, (ACTUALDESLEN+8);              <<01200>>06110000
         END                                                   <<01200>>06112000
      ELSE                                                     <<01200>>06114000
      CASE XADDJTENTRY(FORMALDES,GROUP,ACCT,-3,NEXTENTRYX,WENTRY,       06116000
               ACTUALDES,GROUP2,ACCT2) OF                      <<U.RAO>>06118000
         BEGIN                                                 <<U.RAO>>06120000
            ;  <<0 - NO PROBLEM>>                              <<U.RAO>>06122000
            CIERR(ERRNUM := FEQTABFULLXPLCT);                  <<U.RAO>>06124000
            ;  <<DUPLICATE NAME CAN'T HAPPEN>>                 <<U.RAO>>06126000
            BEGIN  <<ACTUAL DESIGNATOR NOT FOUND>>             <<U.RAO>>06128000
               QUALIFYFILENAME(ACTUALDES,BENTRY);              <<U.RAO>>06130000
               CIERR(ERRNUM := FILEBREFMISADES,,0,@BENTRY);    <<U.RAO>>06132000
            END;                                               <<U.RAO>>06134000
            BEGIN  <<TOO MANY BACK REFERENCES>>                <<U.RAO>>06136000
               QUALIFYFILENAME(ACTUALDES,BENTRY);              <<U.RAO>>06138000
               CIERR(ERRNUM := TOOMANYFEQBREF,,0,@BENTRY);     <<U.RAO>>06140000
            END;                                               <<U.RAO>>06142000
            BEGIN  << CIRCULAR CLINE EQUATIONS >>              <<00834>>06144000
               CIERR(ERRNUM := CIRCULARFEQ);                   <<00834>>06146000
            END;                                               <<00834>>06148000
         END; <<OF CASE>>                                      <<U.RAO>>06150000
      END;                                                     <<U.RAO>>06152000
   END;  << BACK REFERENCE CASE>>                              <<U.RAO>>06154000
END;  <<CHECKADESIG>>                                          <<U.RAO>>06156000
                                                               <<U.RAO>>06158000
                                                               <<01549>>06160000
<<                 *********************                   >>  <<01549>>06162000
<<                 * CHECKENVFILEDESIG *                   >>  <<02523>>06164000
<<                 *********************                   >>  <<01549>>06166000
                                                               <<01549>>06168000
LOGICAL SUBROUTINE CHECKENVFILEDESIG;                          <<02523>>06170000
<< CHECK FORM OF THE ACTUAL FILE DESIGNATOR PARAMETER      >>  <<02523>>06172000
<< FOR THE "ENV=" KEYWORD.  NO SYSTEM FILES ALLOWED,       >>  <<02523>>06174000
<< EXCEPT $OLDPASS.                                        >>  <<02523>>06176000
<<                                                         >>  <<02523>>06178000
BEGIN                                                          <<01549>>06180000
CHECKENVFILEDESIG := FALSE;                                    <<02554>>06182000
TOS := CHECKFILENAME'(PARMS(PARMNUM-1)&LSR(8),GPNTRENV,        <<01549>>06184000
           APNTRENV,ERRPNTR);                                  <<01549>>06186000
IF < THEN  <<ERROR IN NAME>>                                   <<01549>>06188000
   BEGIN                                                       <<01549>>06190000
   ERRNUM := TOS;                                              <<01549>>06192000
   PARSE'ERR(ERRNUM, ERRADR);                                  <<01549>>06194000
   RETURN;                                                     <<02554>>06196000
   END                                                         <<01549>>06198000
ELSE IF = THEN  <<ORDINARY ACTUAL FILE DESIGNATOR>>            <<01549>>06200000
   BEGIN                                                       <<01549>>06202000
   DEL;                                                        <<01549>>06204000
   END                                                         <<01549>>06206000
ELSE IF > AND (S0<>0) THEN                                     <<01549>>06208000
   BEGIN  <<CHECK FOR $OLDPASS>>                               <<01549>>06210000
   IF S0 <> 3 <<NOT $OLDPASS>> THEN                            <<01549>>06212000
   BEGIN  <<SYSTEM DEFINED FILE NAME>>                         <<01549>>06214000
      DEL;                                                     <<01851>>06216000
      PARSE'ERR(ERRNUM := FILEADESSYS, PARMPTR);               <<01549>>06220000
      RETURN;                                                  <<02554>>06222000
   END                                                         <<01851>>06224000
   ELSE DEL;                                                   <<01851>>06226000
   END                                                         <<01549>>06228000
ELSE   <<MUST BE BACK REFERENCED FILE>>                        <<01549>>06230000
   BEGIN                                                       <<01549>>06232000
   DEL;  <<POP ZERO FROM CHECKFILENAME'>>                      <<01549>>06236000
      <<IT IS A VALID FILENAME>>                               <<01549>>06238000
   IF GPNTRENV = 0 THEN GPNTRENV := @BLANK;                    <<02554>>06240000
   IF APNTRENV = 0 THEN APNTRENV := @BLANK;                    <<02554>>06242000
   IF PARMPTR(1) = FORMALDES,(PARMLEN - 1) THEN                <<02554>>06244000
      PARSE'ERR(ERRNUM := CIRCULARFEQ,PARMPTR);                <<02554>>06246000
                                                               <<02554>>06248000
   IF ERRNUM <> 0 THEN RETURN;                                 <<02554>>06250000
   CASE XRETJTENTRY(PARMPTR(1),GROUPENV,ACCTENV                <<02554>>06252000
                    ,SIZE,FILE'ENTRY) OF                       <<02554>>06254000
      BEGIN                                                    <<02554>>06256000
         BEGIN                                                 <<02554>>06258000
            IF LOGICAL(DEVICE'PRESENT) THEN                    <<02554>>06260000
               BEGIN                                           <<02554>>06262000
                  INDEX := -1;                                 <<02554>>06264000
                  @BPTR := @DEVICE'DES'NAME;                   <<02554>>06266000
                  WHILE (INDEX := INDEX + 1) <=                <<02554>>06268000
                        (DEVICE'DES'LEN - 5) DO                <<02554>>06270000
                     IF BPTR(INDEX) = ";ENV=" THEN             <<02554>>06272000
                     PARSE'ERR(ERRNUM:=FILECONTENV,PARMPTR);   <<02554>>06274000
               END;                                            <<02554>>06276000
            IF ERRNUM <> 0 THEN RETURN;                        <<02554>>06278000
            CRUNCH(FORMALDES,GROUP,ACCT,DEST,SIZE);            <<02554>>06280000
            @BPTR := @DEST&LSL(1);                             <<02554>>06282000
            IF BPTR = FORMAL'DES'NAME,                         <<02554>>06284000
                      (FORMAL'DES'LEN * 2) THEN                <<02554>>06286000
               PARSE'ERR(ERRNUM := CIRCULARFEQ,PARMPTR);       <<02554>>06288000
         END;                                                  <<02554>>06290000
         BEGIN                                                 <<02554>>06292000
            QUALIFYFILENAME(PARMPTR(1),BFILE'ENTRY);           <<02554>>06294000
            IF PARSE'ONLY THEN                                 <<02554>>06296000
               ERRNUM := FILEBREFMISADES                       <<02554>>06298000
            ELSE                                               <<02554>>06300000
               CIERR(ERRNUM := FILEBREFMISADES,,0,             <<02554>>06302000
                     @BFILE'ENTRY);                            <<02554>>06304000
         END;                                                  <<02554>>06306000
         BEGIN                                                 <<02554>>06308000
            QUALIFYFILENAME(PARMPTR(1),BFILE'ENTRY);           <<02554>>06310000
            IF PARSE'ONLY THEN                                 <<02554>>06312000
               ERRNUM := FILEBREFMISADES                       <<02554>>06314000
            ELSE                                               <<02554>>06316000
               CIERR(ERRNUM := FILEBREFMISADES,,0,             <<02554>>06318000
                     @BFILE'ENTRY);                            <<02554>>06320000
         END;                                                  <<02554>>06322000
      END;         << CASE >>                                  <<02554>>06324000
   END;  << BACK REFERENCE CASE>>                              <<01549>>06328000
   IF ERRNUM = 0 THEN  CHECKENVFILEDESIG := TRUE;              <<02554>>06330000
END;     <<CHECKENVFILEDESIG>>                                 <<02523>>06332000
                                                               <<01549>>06334000
<<                 *********************                   >>  <<U.RAO>>06336000
<<                 *    CHECKDOMAIN    *                   >>  <<U.RAO>>06338000
<<                 *********************                   >>  <<U.RAO>>06340000
                                                               <<U.RAO>>06342000
LOGICAL SUBROUTINE CHECKDOMAIN;                                <<U.RAO>>06344000
BEGIN                                                          <<U.RAO>>06346000
<<THIS ROUTINE PARSES THE DOMAIN PARAMETER IN A FILE EQUATE.>> <<U.RAO>>06348000
<<IT ALSO VERIFIES THAT THE DOMAIN AND THE DEFAULT DESIGNATOR>><<U.RAO>>06350000
<<ARE COMPATIBLE.>>                                            <<U.RAO>>06352000
CHECKDOMAIN := TRUE;                                           <<U.RAO>>06354000
GETNEXT;                                                       <<U.RAO>>06356000
IF FOPTIONS.DEFAULTDES <> 0 THEN  <<DOMAIN SPECIFIED FOR >>    <<U.RAO>>06358000
   PARSE'ERR(-FILEDOMAINSYSDF,PARMPTR)   << SYS DEF FILE >>    <<01200>>06360000
ELSE  <<IS REGULAR FILE REFERENCE>>                            <<U.RAO>>06362000
   BEGIN                                                       <<U.RAO>>06364000
   FLAGDOMAIN := TRUE;   <<DOMAIN SPECIFIED>>                  <<U.RAO>>06366000
   IF (PARMLEN=3) AND (PARMPTR="OLD") THEN                     <<U.RAO>>06368000
      FOPTIONS.DOMAIN := 1                                     <<U.RAO>>06370000
   ELSE IF (PARMLEN=7) AND (PARMPTR="OLDTEMP") THEN            <<U.RAO>>06372000
      FOPTIONS.DOMAIN := 2                                     <<U.RAO>>06374000
   ELSE IF (PARMLEN<>3) OR (PARMPTR<>"NEW") THEN               <<U.RAO>>06376000
      BEGIN  <<UNIDENTIFIED DOMAIN>>                           <<U.RAO>>06378000
      CHECKDOMAIN := FALSE;                                    <<U.RAO>>06380000
      IF PARMLEN = 0 THEN   <<MISSING>>                        <<U.RAO>>06382000
         PARSE'ERR(ERRNUM := FILEXPCTDOMAIN, PARMPTR)          <<01200>>06384000
      ELSE                                                     <<U.RAO>>06386000
         PARSE'ERR(ERRNUM := FILEINVLDDOMAIN, PARMPTR);        <<01200>>06388000
      END                                                      <<U.RAO>>06390000
   END;                                                        <<U.RAO>>06392000
END;  <<SUBROUTINE CHECKDOMAIN>>                               <<U.RAO>>06394000
                                                               <<U.RAO>>06396000
<<                 *********************                   >>  <<U.RAO>>06398000
<<                 *  CHECKLABELDATA   *                   >>  <<U.RAO>>06400000
<<                 *********************                   >>  <<U.RAO>>06402000
                                                               <<U.RAO>>06404000
LOGICAL SUBROUTINE CHECKLABELDATA;                             <<U.RAO>>06406000
<<CHECKS SYNTAX OF TAPE LABEL DATA.  FORM REQUIRED IS>>        <<U.RAO>>06408000
<<LABEL[=[VOLID][,[TYPE][,[EXPIRATION DATE][,[SEQUENCE NO.]]]]]<<U.RAO>>06410000
BEGIN                                                          <<U.RAO>>06412000
CHECKLABELDATA := TRUE;                                        <<U.RAO>>06414000
FOPTIONS.TAPELABELF := TRUE;  <<FLAG REQUIRES TAPE LABEL>>     <<U.RAO>>06416000
FLAGLABELEDTAPE := TRUE;  <<INTERNAL FLAG FOR PMASK>>          <<U.RAO>>06418000
IF <> THEN   <<REDUNDANTLY SPECIFIED PARAMETER>>               <<U.RAO>>06420000
   BEGIN                                                       <<U.RAO>>06422000
   PARSE'ERR(-FILEREDUNDLABEL, PARMPTR);                       <<01200>>06424000
   TAPELABELLEN := 0;                                          <<U.RAO>>06426000
   END;                                                        <<U.RAO>>06428000
IF NEXTDELIM=EQUALS THEN   <<NON-DEFAULT SPECIFIED>>           <<U.RAO>>06430000
   BEGIN                                                       <<U.RAO>>06432000
   CHECKLABELDATA := FALSE;                                    <<U.RAO>>06434000
   GETNEXT;                                                    <<U.RAO>>06436000
   INDEX := LOGICAL(@PARMPTR) - LOGICAL(@PARMSP);              <<02663>>06438000
   @BPTR := @SAVEDCOMIMAGE(INDEX);                             <<02663>>06440000
   IF PARMLEN <> 0 THEN  <<VOLID PRESENT>>                     <<U.RAO>>06442000
      IF PARMPTR = """" THEN << SPECIAL CHARS IN VOLID >>      <<02663>>06444000
         BEGIN                                                 <<02663>>06446000
         STOP := FALSE;                                        <<02663>>06448000
         @BPTR := LOGICAL(@BPTR) + 1;                          <<02663>>06450000
         WHILE NOT STOP DO                                     <<02663>>06452000
            BEGIN                                              <<02663>>06454000
            SCAN BPTR UNTIL %6442,1; << QUOTE'CR >>            <<02663>>06456000
            IF CARRY THEN                                      <<02663>>06458000
               BEGIN                                           <<02663>>06460000
               DEL;                                            <<02663>>06462000
               PARSE'ERR(ERRNUM := FILEMISSQUOTE,PARMPTR);     <<02663>>06464000
               STOP := TRUE;                                   <<02663>>06466000
               END                                             <<02663>>06468000
            ELSE                                               <<02663>>06470000
               BEGIN                                           <<02663>>06472000
               INDEX := LS0 - LOGICAL(@BPTR);                  <<02663>>06474000
               @BPTR := LOGICAL(TOS);                          <<02663>>06476000
               IF BPTR(1) = """" THEN                          <<02663>>06478000
                  BEGIN                                        <<02663>>06480000
                  INDEX := INDEX + 1;                          <<02663>>06482000
                  @BPTR := LOGICAL(@BPTR) + 1;                 <<02663>>06484000
                  END                                          <<02663>>06486000
               ELSE                                            <<02663>>06488000
                  STOP := TRUE;                                <<02663>>06490000
               IF (INDEX + TAPELABELLEN) > 6 THEN              <<02663>>06492000
                  BEGIN                                        <<02663>>06494000
                  PARSE'ERR(ERRNUM:=FILEVOLID2LONG,PARMPTR);   <<02663>>06496000
                  STOP := TRUE;                                <<02663>>06498000
                  END                                          <<02663>>06500000
               ELSE                                            <<02663>>06502000
                  BEGIN                                        <<02663>>06504000
                  MOVE TAPELABEL(TAPELABELLEN) :=              <<02663>>06506000
                       BPTR(-INDEX),(INDEX);                   <<02663>>06508000
                  TAPELABELLEN := TAPELABELLEN + INDEX;        <<02663>>06510000
                  @BPTR := LOGICAL(@BPTR) + 1;                 <<02663>>06512000
                  END;                                         <<02663>>06514000
               END;                                            <<02663>>06516000
            END; << WHILE LOOP >>                              <<02663>>06518000
         INDEX := -1;                                          <<02663>>06520000
         WHILE (INDEX := INDEX + 1) < TAPELABELLEN AND         <<02663>>06522000
               ERRNUM = 0 DO                                   <<02663>>06524000
            BEGIN                                              <<02663>>06526000
            IF NOT (%40 <= INTEGER(TAPELABEL(INDEX))           <<02663>>06528000
                        <= %176) THEN                          <<02663>>06530000
               PARSE'ERR(ERRNUM := FILENONPRINTCHAR,PARMPTR);  <<02663>>06532000
            IF TAPELABEL(INDEX) = "=" THEN GETNEXT;            <<02663>>06534000
            IF TAPELABEL(INDEX) = ";" OR                       <<02663>>06536000
               TAPELABEL(INDEX) = "," THEN                     <<02663>>06538000
               PARSE'ERR(ERRNUM := FILECOMMASEMINOK,PARMPTR);  <<02663>>06540000
            END;                                               <<02663>>06542000
         END                                                   <<02663>>06544000
      ELSE                                                     <<02663>>06546000
      IF PARMLEN > 6 THEN   <<INVALID VOLID>>                  <<U.RAO>>06548000
         PARSE'ERR(ERRNUM := FILEVOLID2LONG, PARMPTR)          <<01200>>06550000
      ELSE                                                     <<U.RAO>>06552000
         BEGIN                                                 <<U.RAO>>06554000
         TOS := PARMS(PARMNUM-1);                              <<U.RAO>>06556000
         DELB;   <<POP POINTER GARBAGE>>                       <<U.RAO>>06558000
         IF TOS.(10:1) THEN  <<EMBEDDED SPECIAL CHARACTER>>    <<U.RAO>>06560000
            PARSE'ERR(ERRNUM := FILEVOLIDSPECAL, PARMPTR)      <<01200>>06562000
         ELSE   <<VOLID OK>>                                   <<U.RAO>>06564000
            BEGIN                                              <<U.RAO>>06566000
            TAPELABELLEN := PARMLEN;                           <<U.RAO>>06568000
            MOVE TAPELABEL := BPTR,(PARMLEN);                  <<02663>>06570000
            END;                                               <<U.RAO>>06572000
         END;                                                  <<U.RAO>>06574000
   IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN                    <<U.RAO>>06576000
      BEGIN   <<TYPE SPECIFIED?>>                              <<U.RAO>>06578000
      TAPELABEL(TAPELABELLEN) := ",";                          <<U.RAO>>06580000
      TAPELABELLEN := TAPELABELLEN+1;                          <<U.RAO>>06582000
      GETNEXT;   <<SET UP FOR TYPE FIELD>>                     <<U.RAO>>06584000
      IF PARMLEN <> 0 THEN   <<TYPE PRESENT>>                  <<U.RAO>>06586000
         IF PARMLEN<>3 OR PARMPTR<>"ANS" AND PARMPTR<>"IBM" THEN        06588000
            PARSE'ERR(ERRNUM := FILEINVVOLTYPE, PARMPTR)       <<01200>>06590000
         ELSE  <<VALID VOLUME TYPE, SAVE IT>>                  <<U.RAO>>06592000
            BEGIN                                              <<U.RAO>>06594000
            MOVE TAPELABEL(TAPELABELLEN) := PARMPTR,(PARMLEN); <<U.RAO>>06596000
            TAPELABELLEN := TAPELABELLEN+PARMLEN;              <<U.RAO>>06598000
            END;   <<OF PROCESSING OF TYPE>>                   <<U.RAO>>06600000
      IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN                 <<U.RAO>>06602000
         BEGIN   <<CHECK FOR EXPIRATION DATE>>                 <<U.RAO>>06604000
         TAPELABEL(TAPELABELLEN) := ",";                       <<U.RAO>>06606000
         TAPELABELLEN := TAPELABELLEN+1;                       <<U.RAO>>06608000
         GETNEXT;  <<SET UP FOR EXPIRATION DATE FIELD>>        <<U.RAO>>06610000
         IF PARMLEN <> 0 THEN  <<EXPIRATION DATE FIELD PRESENT><<U.RAO>>06612000
            IF CHECKEXPDATE(ERRNUM, PARMLEN, PARMPTR,          <<U.RAO>>06614000
                      TAPELABEL(TAPELABELLEN)) THEN            <<U.RAO>>06616000
               TAPELABELLEN := TAPELABELLEN+8;  <<VALID EXP DAT<<U.RAO>>06618000
         IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN              <<U.RAO>>06620000
            BEGIN  <<SEQUENCE NUMBER FIELD SPECIFIED?>>        <<U.RAO>>06622000
            TAPELABEL(TAPELABELLEN) := ",";                    <<U.RAO>>06624000
            TAPELABELLEN := TAPELABELLEN+1;                    <<U.RAO>>06626000
            GETNEXT;                                           <<U.RAO>>06628000
            IF PARMLEN <> 0 THEN  <<SEQ NUM PRESENT>>          <<U.RAO>>06630000
               BEGIN                                           <<U.RAO>>06632000
               TOS := PARMS(PARMNUM-1);                        <<U.RAO>>06634000
               DELB;                                           <<U.RAO>>06636000
               IF LS0.(10:1) OR PARMLEN>4 THEN                 <<U.RAO>>06638000
                  BEGIN                                        <<U.RAO>>06640000
                  PARSE'ERR(ERRNUM := FILEXPINVSEQ, PARMPTR);  <<01200>>06642000
                  DEL;                                         <<U.RAO>>06644000
                  END                                          <<U.RAO>>06646000
               ELSE IF TOS.(8:1) AND PARMPTR<>"NEXT" AND       <<U.RAO>>06648000
                     PARMPTR<>"ADDF" THEN  <<ASCII IN SEQ FIELD<<U.RAO>>06650000
                  PARSE'ERR(ERRNUM := FILEXPINVSEQ, PARMPTR)   <<01200>>06652000
               ELSE   <<SEQUENCE OK>>                          <<U.RAO>>06654000
                  BEGIN                                        <<U.RAO>>06656000
                  MOVE TAPELABEL(TAPELABELLEN) := PARMPTR,(PARMLEN);    06658000
                  TAPELABELLEN := TAPELABELLEN+PARMLEN;        <<U.RAO>>06660000
                  END;                                         <<U.RAO>>06662000
               END;                                            <<U.RAO>>06664000
            END;                                               <<U.RAO>>06666000
         END;                                                  <<U.RAO>>06668000
      END;                                                     <<U.RAO>>06670000
   IF ERRNUM=0 THEN  <<CHECK FOR EXTRANEOUS DATA>>             <<U.RAO>>06672000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>06674000
         BEGIN                                                 <<U.RAO>>06676000
         CHECKLABELDATA := TRUE;                               <<U.RAO>>06678000
         WHILE TAPELABEL(TAPELABELLEN-1) = "," DO              <<U.RAO>>06680000
            TAPELABELLEN := TAPELABELLEN-1;                    <<U.RAO>>06682000
         END                                                   <<U.RAO>>06684000
      ELSE   <<EXTRANEOUS PARAMETER>>                          <<U.RAO>>06686000
         BEGIN                                                 <<U.RAO>>06688000
         GETNEXT;                                              <<U.RAO>>06690000
         PARSE'ERR(ERRNUM := FILEXTRNLABEL, PARMPTR);          <<01200>>06692000
         END;                                                  <<U.RAO>>06694000
   END;                                                        <<U.RAO>>06696000
END;   <<SUBROUTINE CHECKLABELDATA>>                           <<U.RAO>>06698000
                                                               <<U.RAO>>06700000
<<                 *********************                   >>  <<U.RAO>>06702000
<<                 *     PROCDISC      *                   >>  <<U.RAO>>06704000
<<                 *********************                   >>  <<U.RAO>>06706000
                                                               <<U.RAO>>06708000
LOGICAL SUBROUTINE PROCDISC;                                   <<U.RAO>>06710000
BEGIN                                                          <<U.RAO>>06712000
PROCDISC := FALSE;                                             <<U.RAO>>06714000
IF NEXTDELIM <> EQUALS THEN  <<MISSING DELIMITER BEFORE LIST>> <<U.RAO>>06716000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>06718000
ELSE  <<DO SUB PARAMETER LIST>>                                <<U.RAO>>06720000
   BEGIN                                                       <<U.RAO>>06722000
   IF FLAGFILESIZE OR FLAGNUMEXTS OR FLAGINITALLOC THEN        <<U.RAO>>06724000
      BEGIN <<PREVIOUSLY SPECIFIED, CLEAN UP FROM BEFORE, WARN><<U.RAO>>06726000
      PARSE'ERR(-FILEDISCOVERIDE,PARMPTR);                     <<01200>>06728000
      FLAGFILESIZE := FALSE;                                   <<U.RAO>>06730000
      FLAGNUMEXTS := FALSE;                                    <<U.RAO>>06732000
      FLAGINITALLOC := FALSE;                                  <<U.RAO>>06734000
      END;                                                     <<U.RAO>>06736000
   <<FIRST CANDIDATE IS RECORD SIZE>>                          <<U.RAO>>06738000
   GETNEXT;                                                    <<U.RAO>>06740000
   IF PARMLEN <> 0 THEN   <<RECORD SIZE SPECIFIED>>            <<U.RAO>>06742000
      BEGIN                                                    <<U.RAO>>06744000
      FLAGFILESIZE := TRUE;                                    <<U.RAO>>06746000
      FILESIZE := DBINARY(PARMPTR, PARMLEN);                   <<U.RAO>>06748000
      IF <> OR (FILESIZE <= 0D) THEN                           <<U.RAO>>06750000
         BEGIN                                                 <<U.RAO>>06752000
         PARSE'ERR(ERRNUM := FILEFILESIZE,PARMPTR);            <<01200>>06754000
         RETURN;   <<BAIL OUT>>                                <<U.RAO>>06756000
         END;                                                  <<U.RAO>>06758000
      END;                                                     <<U.RAO>>06760000
   <<NEXT CANDIDATE IS THE NUMBER OF EXTENTS>>                 <<U.RAO>>06762000
   IF NEXTDELIM = COMMA THEN  <<OTHER PARMS WERE SPECIFIED>>   <<U.RAO>>06764000
      BEGIN                                                    <<U.RAO>>06766000
      GETNEXT;                                                 <<U.RAO>>06768000
      IF PARMLEN <> 0 THEN   <<BLOCKING FACTOR PRESENT>>       <<U.RAO>>06770000
         BEGIN  <<ATTEMPT TO PARSE IT>>                        <<U.RAO>>06772000
         FLAGNUMEXTS := TRUE;                                  <<U.RAO>>06774000
         NUMEXTENTS := BINARY(PARMPTR, PARMLEN);               <<U.RAO>>06776000
         IF <> OR NOT(1<=NUMEXTENTS<=32) THEN                  <<U.RAO>>06778000
            BEGIN  <<ERROR IN VALUE>>                          <<U.RAO>>06780000
            PARSE'ERR(ERRNUM := FILEEXTENTSPROB, PARMPTR);     <<01200>>06782000
            RETURN                                             <<U.RAO>>06784000
            END;                                               <<U.RAO>>06786000
         END;                                                  <<U.RAO>>06788000
      <<NEXT CANDIDATE IS THE NUMBER OF INITIALLY ALLOCATED EXTENTS>>   06790000
      IF NEXTDELIM = COMMA THEN  <<FURTHER PARMS WERE SPECIFIED>>       06792000
         BEGIN                                                 <<U.RAO>>06794000
         GETNEXT;                                              <<U.RAO>>06796000
         IF PARMLEN <> 0 THEN  <<INITIAL ALLOCATION PRESENT>>  <<U.RAO>>06798000
            BEGIN                                              <<U.RAO>>06800000
            FLAGINITALLOC := TRUE;                             <<U.RAO>>06802000
            IF NOT FLAGNUMEXTS THEN NUMEXTENTS := 32;          <<U.RAO>>06804000
            INITALLOC := BINARY(PARMPTR,PARMLEN);              <<U.RAO>>06806000
            IF <> OR (INITALLOC > NUMEXTENTS) THEN             <<U.RAO>>06808000
               IF PARSE'ONLY THEN ERRNUM := FILEINITALLOCBD    <<01200>>06810000
               ELSE CIERR(ERRNUM:=FILEINITALLOCBD,PARMPTR,     <<01200>>06812000
                          %10000,NUMEXTENTS);                  <<01200>>06814000
            END;                                               <<U.RAO>>06816000
         END;                                                  <<U.RAO>>06818000
      IF NOT BUILDFLAG THEN                                    <<U.RAO>>06820000
         BEGIN  <<EXTENT SIZE MUST FIT IN 5 BITS>>             <<U.RAO>>06822000
         NUMEXTENTS := NUMEXTENTS-1;                           <<U.RAO>>06824000
         INITALLOC := INITALLOC-1;                             <<U.RAO>>06826000
         END;                                                  <<U.RAO>>06828000
      END;                                                     <<U.RAO>>06830000
   IF ERRNUM = 0 THEN                                          <<U.RAO>>06832000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>06834000
         PROCDISC := TRUE                                      <<U.RAO>>06836000
      ELSE  <<UNKNOWN PARAMETER AT END OF LIST>>               <<U.RAO>>06838000
         BEGIN                                                 <<U.RAO>>06840000
         GETNEXT;                                              <<U.RAO>>06842000
         PARSE'ERR(ERRNUM := FILEDISCXPARMS, PARMPTR);         <<01200>>06844000
         END;                                                  <<U.RAO>>06846000
   END;                                                        <<U.RAO>>06848000
END;                                                           <<U.RAO>>06850000
                                                               <<U.RAO>>06852000
<<                 *********************                   >>  <<U.RAO>>06854000
<<                 *   CHECKFORMMSG    *                   >>  <<U.RAO>>06856000
<<                 *********************                   >>  <<U.RAO>>06858000
                                                               <<U.RAO>>06860000
LOGICAL SUBROUTINE CHECKFORMMSG;                               <<U.RAO>>06862000
<<VALIDATES AND PROCESSES FORMS MESSAGE>>                      <<U.RAO>>06864000
BEGIN                                                          <<U.RAO>>06866000
CHECKFORMMSG := FALSE;                                         <<U.RAO>>06868000
IF NEXTDELIM <> EQUALS THEN  <<MISSING MESSAGE>>               <<U.RAO>>06870000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>06872000
ELSE   <<PARSE FORMMSG PARAMETER>>                             <<U.RAO>>06874000
   BEGIN                                                       <<U.RAO>>06876000
   FLAGFORMS := TRUE;                                          <<U.RAO>>06878000
   IF <> THEN  <<REDUNDANTLY SPECIFIED>>                       <<U.RAO>>06880000
      PARSE'ERR(-FILEFORMOVERRID, PARMPTR);                    <<01200>>06882000
   GETNEXT;                                                    <<U.RAO>>06884000
   SCAN PARMPTR UNTIL [8/%15,8/"."],1;  <<LOOK FOR ".">>       <<U.RAO>>06886000
   IF CARRY THEN   <<FOUND CR INSTEAD>>                        <<U.RAO>>06888000
      BEGIN                                                    <<U.RAO>>06890000
      PARSE'ERR(ERRNUM := FILEFMSNOPERIOD, BPS0);              <<01200>>06892000
      DEL;  <<POP POINTER ON TOS>>                             <<U.RAO>>06894000
      END                                                      <<U.RAO>>06896000
   ELSE  <<MESSAGE IS PRESENT, SAVE IT>>                       <<U.RAO>>06898000
      BEGIN                                                    <<U.RAO>>06900000
      FORMSMSGLEN := TOS-@PARMPTR;                             <<U.RAO>>06902000
      IF FORMSMSGLEN > 49 THEN   <<MESSAGE TOO LONG>>          <<U.RAO>>06904000
         BEGIN                                                 <<U.RAO>>06906000
         PARSE'ERR(-FILEFMSTOOLONG, PARMPTR(49));              <<01200>>06908000
         FORMSMSGLEN := 49;                                    <<U.RAO>>06910000
         END;  <<HANDLING OF LINE TOO LONG CASE>>              <<U.RAO>>06912000
      FORMSMSG(FORMSMSGLEN) := ".";                            <<U.RAO>>06914000
      MOVE FORMSMSG := PARMPTR, (FORMSMSGLEN);                 <<U.RAO>>06916000
      CHECKFORMMSG := TRUE;                                    <<U.RAO>>06918000
      FORMSMSGLEN := FORMSMSGLEN+1;  <<FOR PERIOD>>            <<U.RAO>>06920000
      INDEX := -1;@BPTR := @PARMPTR;                           <<04179>>06922000
      WHILE BPTR(INDEX := INDEX + 1) <> "." DO                 <<04179>>06924000
         BEGIN << check for delimiters inside formsmsg >>      <<04179>>06926000
            IF BPTR(INDEX) = "=" OR                            <<04179>>06928000
               BPTR(INDEX) = "," OR                            <<04179>>06930000
               BPTR(INDEX) = ";" THEN                          <<04179>>06932000
               GETNEXT; << advance to next parameter >>        <<04179>>06934000
         END;                                                  <<04179>>06936000
      END;                                                     <<U.RAO>>06938000
   END;                                                        <<U.RAO>>06940000
END;   <<SUBROUTINE CHECKFORMMSG>>                             <<U.RAO>>06942000
                                                               <<U.RAO>>06944000
<<                 *********************                   >>  <<U.RAO>>06946000
<<                 *      PROCDEV      *                   >>  <<U.RAO>>06948000
<<                 *********************                   >>  <<U.RAO>>06950000
                                                               <<U.RAO>>06952000
LOGICAL SUBROUTINE PROCDEV;                                    <<U.RAO>>06954000
<<PARSES DEVICE PARAMETER LIST.  THINGS TO WATCH OUT FOR INCLUDE>>      06956000
<<1) MISSING EQUALS SIGN  2) INVALID DEVICE NAME  3) DS LINE NAME>>     06958000
<<4) OUTPRI  5) NUMCOPIES  6) EXTRANEOUS PARAMETERS.  >>       <<U.RAO>>06960000
BEGIN                                                          <<U.RAO>>06962000
PROCDEV := FALSE;                                              <<U.RAO>>06964000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>06966000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>06968000
ELSE  <<DO SUB PARAMETER LIST>>                                <<U.RAO>>06970000
   BEGIN                                                       <<U.RAO>>06972000
   IF FLAGADEV OR FLAGOUTPRI OR FLAGNUMCOPIES THEN             <<01549>>06974000
      BEGIN  <<REDUNDANTLY SPECIFIED DEVICE PARAMETERS>>       <<U.RAO>>06976000
      PARSE'ERR(-FILEDEVOVERRIDE, PARMPTR); <<WARN USER>>      <<01200>>06978000
      FLAGADEV := FALSE;                                       <<01549>>06980000
      @DEV := @DISC & LSL(1); <<REINITIALIZE POINTER>>         <<02569>>06982000
      DEVLEN := 0;                                             <<02569>>06984000
      FLAGOUTPRI := FALSE;                                     <<U.RAO>>06986000
      FLAGNUMCOPIES := FALSE;                                  <<U.RAO>>06988000
      END;                                                     <<U.RAO>>06990000
   <<FIRST CANDIDATE IS THE DEVICE NAME>>                      <<U.RAO>>06992000
   GETNEXT;                                                    <<U.RAO>>06994000
   IF PARMLEN <> 0 THEN                                        <<U.RAO>>06996000
      BEGIN                                                    <<U.RAO>>06998000
      FLAGADEV := TRUE;  << GOT DEVICE PART >>                 <<02569>>07002000
      IF COMTYPE=SYSDEF THEN  <<SYSTEM DEFINED FILE>>          <<U.RAO>>07004000
         BEGIN  <<DEVICE SYSTEM DEFINED>>                      <<U.RAO>>07006000
         PARSE'ERR(ERRNUM := FILESYSDEFDEV, PARMPTR);          <<01200>>07008000
         RETURN                                                <<U.RAO>>07010000
         END;                                                  <<U.RAO>>07012000
      @BPTR:=@DEV:=@PARMPTR; << SET AT 1ST CHAR OF DEV >>      <<01117>>07014000
      TOS:=PARMS(PARMNUM-1); << CURRENT PARM >>                <<01117>>07016000
      DEVLEN:=PARMLEN;                                         <<01117>>07018000
      IF PARMLEN > MAXDEVLEN THEN                              <<04171>>07020000
         BEGIN                                                 <<04171>>07022000
            DDEL;                                              <<04171>>07024000
            ERRNUM := FILEDEVNAME2LNG;                         <<04171>>07026000
            FLUSH'COMMAND;                                     <<04171>>07028000
                                                               <<04171>>07030000
         END;                                                  <<04171>>07032000
      DELB; << DELETE POINTER WORD >>                          <<01117>>07034000
      IF TOS.(10:1) THEN << DEV CONTAINS SPECIALS >>           <<01117>>07036000
         BEGIN                                                 <<01117>>07038000
           MOVE DEV := DEV WHILE AN,1;                         <<04171>>07040000
           STOP := FALSE;                                      <<04171>>07042000
           DO                                                  <<04171>>07044000
              BEGIN                                            <<04171>>07046000
                 IF BPS0 = "#" THEN                            <<04171>>07048000
                    BEGIN                                      <<04171>>07050000
                       IF (S0 - @BPTR) > MAXDEVCLASSLEN THEN   <<04171>>07052000
                          BEGIN                                <<04171>>07054000
                             DEL;                              <<04171>>07056000
                             ERRNUM := FILEDSNAME2LONG;        <<04171>>07058000
                             FLUSH'COMMAND;                    <<04171>>07060000
                                                               <<04171>>07062000
                          END;                                 <<04171>>07064000
                       TOS := TOS + 1;                         <<04171>>07066000
                       @BPTR := S0;                            <<04171>>07068000
                       ASSEMBLE(DUP);                          <<04171>>07070000
                       MOVE * := * WHILE AN,1;                 <<04171>>07072000
                    END                                        <<04171>>07074000
                 ELSE                                          <<04171>>07076000
                 IF BPS0 = " " THEN                            <<04171>>07078000
                    BEGIN                                      <<04171>>07080000
                       IF PARMLEN > (S0 - @DEV) THEN           <<04171>>07082000
                          BEGIN                                <<04171>>07084000
                             DEL;                              <<04171>>07086000
                             ERRNUM := FILEINVALDEVNAME;       <<04171>>07088000
                             FLUSH'COMMAND;                    <<04171>>07090000
                                                               <<04171>>07092000
                          END                                  <<04171>>07094000
                       ELSE                                    <<04171>>07096000
                          BEGIN                                <<04171>>07098000
                             DEL;                              <<04171>>07100000
                             STOP := TRUE;                     <<04171>>07102000
                          END;                                 <<04171>>07104000
                    END                                        <<04171>>07106000
                 ELSE                                          <<04171>>07108000
                 IF BPS0 = BDELIMS(NEXTDELIM) THEN             <<04171>>07110000
                    BEGIN                                      <<04171>>07112000
                       DEL;                                    <<04171>>07114000
                       STOP := TRUE;                           <<04171>>07116000
                    END                                        <<04171>>07118000
                 ELSE                                          <<04171>>07120000
                    BEGIN                                      <<04171>>07122000
                       DEL;                                    <<04171>>07124000
                       ERRNUM := FILEINVALDEVNAME;             <<04171>>07126000
                       FLUSH'COMMAND;                          <<04171>>07128000
                                                               <<04171>>07130000
                    END;                                       <<04171>>07132000
              END UNTIL STOP;                                  <<04171>>07134000
                                                               <<04171>>07136000
        END  << special character inside dev >>                <<04171>>07138000
     ELSE                                                      <<04171>>07140000
        BEGIN                                                  <<04171>>07142000
           IF DEVLEN > MAXDEVCLASSLEN THEN                              07144000
              BEGIN                                                     07146000
                 ERRNUM := FILEDEVNAME2LNG;                             07148000
                 FLUSH'COMMAND;                                         07150000
              END;                                                      07152000
           X := GETDEVINFO(DEV,DEVINFO) + 1;                   <<04171>>07154000
           CASE *X OF                                          <<04171>>07156000
              BEGIN                                            <<04171>>07158000
                 << virtual device >>                          <<04171>>07160000
                 BEGIN                                         <<04171>>07162000
                    ERRNUM := FILEVIRTUALDEV;                  <<04171>>07164000
                    FLUSH'COMMAND;                             <<04171>>07166000
                 END;                                          <<04171>>07168000
                 << ok >>                                      <<04171>>07170000
                    ;                                          <<04171>>07172000
                 << invalid class >>                           <<04171>>07174000
                 BEGIN                                         <<04171>>07176000
                    ERRNUM := FILEINVLDCLASPEC;                <<04171>>07178000
                    FLUSH'COMMAND;                             <<04171>>07180000
                 END;                                          <<04171>>07182000
                 << unknown class name >>                      <<04171>>07184000
                 BEGIN                                         <<04171>>07186000
                    ERRNUM := FILEUNKNOWNDEV;                  <<04171>>07188000
                    FLUSH'COMMAND;                             <<04171>>07190000
                 END;                                          <<04171>>07192000
                 << unknown logical device number >>           <<04171>>07194000
                 BEGIN                                         <<04171>>07196000
                    ERRNUM := FILEDONTKNOWLDEV;                <<04171>>07198000
                    FLUSH'COMMAND;                             <<04171>>07200000
                 END;                                          <<04171>>07202000
              END; << case of GETDEVINFO returns >>            <<04171>>07204000
        END; << device w/o special characters >>               <<04171>>07206000
      END;  <<PROCESSING OF DEVICE NAME>>                      <<U.RAO>>07208000
   IF (ERRNUM=0) AND (NEXTDELIM=COMMA) THEN                    <<U.RAO>>07210000
      BEGIN  <<MORE PARAMETERS, CHECK FOR OUTPRI>>             <<U.RAO>>07212000
      GETNEXT;                                                 <<U.RAO>>07214000
      IF (COMTYPE=BUILD) OR (COMTYPE=OLD) OR                   <<U.RAO>>07216000
            ((COMTYPE=SYSDEF) LAND (FOPTIONS.DEFAULTDES<>1)) THEN       07218000
         PARSE'ERR(ERRNUM := FILEOUTPRINOT, PARMPTR)           <<01200>>07220000
      ELSE IF PARMLEN <> 0 THEN  <<OUTPRI EVIDENTLY SPECIFIED>><<U.RAO>>07222000
         BEGIN                                                 <<U.RAO>>07224000
         FLAGOUTPRI := TRUE;                                   <<U.RAO>>07226000
         OUTPRI := BINARY(PARMPTR, PARMLEN);                   <<U.RAO>>07228000
         IF <> OR NOT(1<= OUTPRI <= 13) THEN                   <<U.RAO>>07230000
            PARSE'ERR(ERRNUM := FILEOUTPRIINVLD, PARMPTR);     <<01200>>07232000
         END;                                                  <<U.RAO>>07234000
      IF (ERRNUM=0) AND (NEXTDELIM=COMMA) THEN                 <<U.RAO>>07236000
         BEGIN  <<FURTHER PARAMETER(S)>>                       <<U.RAO>>07238000
         GETNEXT;                                              <<U.RAO>>07240000
         IF PARMLEN <> 0 THEN   <<NUMCOPIES SPECIFIED>>        <<U.RAO>>07242000
            BEGIN                                              <<U.RAO>>07244000
            FLAGNUMCOPIES := TRUE;                             <<U.RAO>>07246000
            NUMCOPIES := BINARY(PARMPTR, PARMLEN);             <<U.RAO>>07248000
            IF <> OR NOT(1 <= NUMCOPIES <= 127) THEN           <<U.RAO>>07250000
               PARSE'ERR(ERRNUM := FILENUMCOPINVLD, PARMPTR);  <<01200>>07252000
            END;                                               <<U.RAO>>07254000
         END;  <<NUMCOPIES CASE>>                              <<U.RAO>>07256000
      END;  <<SPOOLING PARAMETERS>>                            <<U.RAO>>07258000
   IF ERRNUM = 0 THEN                                          <<U.RAO>>07260000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>07262000
         PROCDEV := TRUE                                       <<U.RAO>>07264000
      ELSE                                                     <<U.RAO>>07266000
         BEGIN  <<EXTRANEOUS PARAMETERS>>                      <<U.RAO>>07268000
         GETNEXT;                                              <<U.RAO>>07270000
         PARSE'ERR(ERRNUM := FILEDEVXPARMS, PARMPTR);          <<01200>>07272000
      END;                                                     <<U.RAO>>07274000
   END;                                                        <<U.RAO>>07276000
END;  <<SUBROUTINE PROCDEV>>                                   <<U.RAO>>07278000
                                                               <<U.RAO>>07280000
<<                 *********************                   >>  <<U.RAO>>07282000
<<                 *      PROCREC      *                   >>  <<U.RAO>>07284000
<<                 *********************                   >>  <<U.RAO>>07286000
                                                               <<U.RAO>>07288000
LOGICAL SUBROUTINE PROCREC;                                    <<U.RAO>>07290000
<<SYNTAX  REC=[recsize][,[blockfactor][,[F/V/U][,[BINARY/ASCII]]]]>>    07292000
BEGIN                                                          <<U.RAO>>07294000
PROCREC := FALSE;                                              <<U.RAO>>07296000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>07298000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>07300000
ELSE                                                           <<U.RAO>>07302000
   BEGIN  <<PARSE PARAMETER LIST>>                             <<U.RAO>>07304000
   IF FLAGRECSIZE OR FLAGBLOCKFACTOR OR FLAGRECFMT OR FLAGASCII THEN    07306000
      BEGIN  <<REDUNDANTLY SPECIFIED, WARN, CLEAN UP>>         <<U.RAO>>07308000
      PARSE'ERR(-FILERECOVERRIDE, PARMPTR);                    <<01200>>07310000
      FLAGRECSIZE := FALSE;                                    <<U.RAO>>07312000
      FLAGBLOCKFACTOR := FALSE;                                <<U.RAO>>07314000
      FLAGRECFMT := FALSE;                                     <<U.RAO>>07316000
      FOPTIONS.RECORDFMT := 0;  <<DEFAULT TO F>>               <<U.RAO>>07318000
      FLAGASCII := FALSE;                                      <<U.RAO>>07320000
      FOPTIONS.ASCIIBINARY := 0;  <<DEFAULT TO BINARY>>        <<U.RAO>>07322000
      END;                                                     <<U.RAO>>07324000
   <<FIRST CANDIDATE IS RECSIZE>>                              <<U.RAO>>07326000
   GETNEXT;                                                    <<U.RAO>>07328000
   IF PARMLEN <> 0 THEN  <<RECSIZE EVIDENTLY SPECIFIED>>       <<U.RAO>>07330000
      BEGIN                                                    <<U.RAO>>07332000
      FLAGRECSIZE := TRUE;                                     <<U.RAO>>07334000
      RECSIZE := BINARY(PARMPTR, PARMLEN);                     <<U.RAO>>07336000
      IF <> OR (RECSIZE = 0) THEN                              <<U.RAO>>07338000
         PARSE'ERR(ERRNUM := FILEBADRECSIZE, PARMPTR);         <<01200>>07340000
      END;                                                     <<U.RAO>>07342000
   IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN                    <<U.RAO>>07344000
      BEGIN <<FURTHER PARAMETERS TO PARSE>>                    <<U.RAO>>07346000
      <<NEXT CANDIDATE IS THE BLOCKING FACTOR>>                <<U.RAO>>07348000
      GETNEXT;                                                 <<U.RAO>>07350000
      IF PARMLEN <> 0 THEN  <<BLOCKING FACTOR SPECIFIED>>      <<U.RAO>>07352000
         BEGIN                                                 <<U.RAO>>07354000
         FLAGBLOCKFACTOR := TRUE;                              <<U.RAO>>07356000
         BLOCKFACTOR := BINARY(PARMPTR, PARMLEN);              <<U.RAO>>07358000
         IF <> OR NOT (1 <= BLOCKFACTOR <= 255) THEN           <<U.RAO>>07360000
            PARSE'ERR(ERRNUM := FILEBADBLOCKING, PARMPTR);     <<01200>>07362000
         END;                                                  <<U.RAO>>07364000
      IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN                 <<U.RAO>>07366000
         BEGIN  <<FURTHER PARAMETERS, NEXT IS RECORD FORMAT>>  <<U.RAO>>07368000
         GETNEXT;                                              <<U.RAO>>07370000
         IF PARMLEN<>0 THEN  <<RECORD FORMAT SPECIFIED>>       <<U.RAO>>07372000
            BEGIN                                              <<U.RAO>>07374000
            FLAGRECFMT := TRUE;                                <<U.RAO>>07376000
            IF (PARMLEN=1) AND (PARMPTR="F") THEN              <<U.RAO>>07378000
               FOPTIONS.RECORDFMT := 0                         <<U.RAO>>07380000
            ELSE IF (PARMLEN=1) AND (PARMPTR="V") THEN         <<U.RAO>>07382000
               FOPTIONS.RECORDFMT := 1                         <<U.RAO>>07384000
            ELSE IF (PARMLEN=1) AND (PARMPTR="U") THEN         <<U.RAO>>07386000
               FOPTIONS.RECORDFMT := 2                         <<U.RAO>>07388000
            ELSE   <<UNKNOWN RECORD FORMAT>>                   <<U.RAO>>07390000
               PARSE'ERR(ERRNUM := FILEUNKRECFMT, PARMPTR);    <<01200>>07392000
            END;                                               <<U.RAO>>07394000
         IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN              <<U.RAO>>07396000
            BEGIN   <<FURTHER PARAMETER(S)>>                   <<U.RAO>>07398000
            GETNEXT;  <<NEXT CANDIDATE IS BINARY/ASCII>>       <<U.RAO>>07400000
            IF PARMLEN <> 0 THEN   <<ASCII/BINARY SPECIFIED>>  <<U.RAO>>07402000
               BEGIN                                           <<U.RAO>>07404000
               FLAGASCII := TRUE;                              <<U.RAO>>07406000
               IF (PARMLEN=5) AND (PARMPTR="ASCII") THEN       <<U.RAO>>07408000
                  FOPTIONS.ASCIIBINARY := TRUE                 <<U.RAO>>07410000
               ELSE IF (PARMLEN=6) AND (PARMPTR="BINARY") THEN <<U.RAO>>07412000
                  FOPTIONS.ASCIIBINARY := FALSE                <<U.RAO>>07414000
               ELSE                                            <<U.RAO>>07416000
                  PARSE'ERR(ERRNUM:=FILEASCIIINVALD, PARMPTR); <<01200>>07418000
               END;                                            <<U.RAO>>07420000
            END;                                               <<U.RAO>>07422000
         END;                                                  <<U.RAO>>07424000
      END;                                                     <<U.RAO>>07426000
   IF ERRNUM = 0 THEN                                          <<U.RAO>>07428000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>07430000
         PROCREC := TRUE                                       <<U.RAO>>07432000
      ELSE  <<EXTRANEOUS DELIMITER - UNKNOWN PARAMETER?>>      <<U.RAO>>07434000
         BEGIN                                                 <<U.RAO>>07436000
         GETNEXT;                                              <<U.RAO>>07438000
         PARSE'ERR(ERRNUM := FILERECXTRANPRM, PARMPTR);        <<01200>>07440000
         END;                                                  <<U.RAO>>07442000
   END;                                                        <<U.RAO>>07444000
END;   <<PROCREC>>                                             <<U.RAO>>07446000
                                                               <<U.RAO>>07448000
<<                 *********************                   >>  <<U.RAO>>07450000
<<                 *     PROCFCODE     *                   >>  <<U.RAO>>07452000
<<                 *********************                   >>  <<U.RAO>>07454000
                                                               <<U.RAO>>07456000
LOGICAL SUBROUTINE PROCFCODE;                                  <<U.RAO>>07458000
BEGIN                                                          <<U.RAO>>07460000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>07462000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>07464000
ELSE                                                           <<U.RAO>>07466000
   BEGIN   <<PARSE PARAMETER>>                                 <<U.RAO>>07468000
   GETNEXT;                                                    <<U.RAO>>07470000
   FLAGFILECODE := TRUE;                                       <<U.RAO>>07472000
   IF <> THEN   <<REDUNDANTLY SPECIFIED>>                      <<U.RAO>>07474000
      PARSE'ERR(-FILEFCODEREDUND, PARMPTR);                    <<01200>>07476000
   IF PARMLEN = 0 THEN  <<MISSING, DEFAULT TO 0>>              <<U.RAO>>07478000
      BEGIN                                                    <<U.RAO>>07480000
      FILECODE := 0;                                           <<U.RAO>>07482000
      PARSE'ERR(-FILEFCODEDEFALT, PARMPTR);                    <<01200>>07484000
      END                                                      <<U.RAO>>07486000
   ELSE  <<FILE CODE PARAMETER PRESENT>>                       <<U.RAO>>07488000
      BEGIN                                                    <<U.RAO>>07490000
      IF (PARMPTR<>NUMERIC) AND (PARMPTR<>"+") AND (PARMPTR<>"-") THEN  07492000
         BEGIN  <<APPARENTLY A NAMED CODE>>                    <<U.RAO>>07494000
         GET'FILECODE(FILECODE,PARMPTR,PARMLEN);               <<01454>>07496000
         IF <> THEN                                            <<01454>>07498000
            PARSE'ERR(ERRNUM := FILEUNKFCODE, PARMPTR);        <<01454>>07500000
         END                                                   <<U.RAO>>07502000
      ELSE   <<NUMERIC FILE CODE>>                             <<U.RAO>>07504000
         BEGIN                                                 <<U.RAO>>07506000
         FILECODE := BINARY(PARMPTR, PARMLEN);                 <<U.RAO>>07508000
         IF <> OR (FILECODE < 0) THEN                          <<U.RAO>>07510000
            PARSE'ERR(ERRNUM := FILEFCODEVALUE, PARMPTR);      <<01200>>07512000
         END;                                                  <<U.RAO>>07514000
      END;                                                     <<U.RAO>>07516000
   END;                                                        <<U.RAO>>07518000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>07520000
   PROCFCODE := FALSE                                          <<U.RAO>>07522000
ELSE IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN        <<U.RAO>>07524000
   BEGIN                                                       <<U.RAO>>07526000
   GETNEXT;                                                    <<U.RAO>>07528000
   PROCFCODE := FALSE;                                         <<U.RAO>>07530000
   PARSE'ERR(ERRNUM := FILECODEXTRNDEL, PARMPTR);              <<01200>>07532000
   END                                                         <<U.RAO>>07534000
ELSE                                                           <<U.RAO>>07536000
   PROCFCODE := TRUE;                                          <<U.RAO>>07538000
END;  <<PROCFCODE>>                                            <<U.RAO>>07540000
                                                               <<U.RAO>>07542000
<<                 *********************                   >>  <<U.RAO>>07544000
<<                 *    PROCACCESS     *                   >>  <<U.RAO>>07546000
<<                 *********************                   >>  <<U.RAO>>07548000
                                                               <<U.RAO>>07550000
LOGICAL SUBROUTINE PROCACCESS;                                 <<U.RAO>>07552000
BEGIN                                                          <<U.RAO>>07554000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>07556000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>07558000
ELSE                                                           <<U.RAO>>07560000
   BEGIN                                                       <<U.RAO>>07562000
   MOVE ACCTYPES := PACCTYPES, (ACCTYPEL);                     <<U.RAO>>07564000
   FLAGACCESSTYPE := TRUE;                                     <<U.RAO>>07566000
   IF <> THEN                                                  <<U.RAO>>07568000
      PARSE'ERR(-FILEACCESSREDND, PARMPTR);                    <<01200>>07570000
   GETNEXT;                                                    <<U.RAO>>07572000
   IF PARMLEN = 0 THEN  <<ACCESS SPECIFICATION REQUIRED>>      <<U.RAO>>07574000
      PARSE'ERR(ERRNUM := FILEACCREQVALUE, PARMPTR)            <<01200>>07576000
   ELSE                                                        <<U.RAO>>07578000
      BEGIN  <<PARAMETER SUPPLIED, SCAN TABLE FOR IT>>         <<U.RAO>>07580000
      TOS := SEARCH(PARMPTR, PARMLEN, ACCTYPES) -1;            <<U.RAO>>07582000
      IF < THEN  <<UNKNOWN ACCESS TYPE>>                       <<U.RAO>>07584000
         BEGIN                                                 <<U.RAO>>07586000
         DEL;                                                  <<U.RAO>>07588000
         PARSE'ERR(ERRNUM := FILEACCINVALID, PARMPTR)          <<01200>>07590000
         END                                                   <<U.RAO>>07592000
      ELSE                                                     <<U.RAO>>07594000
         AOPTIONS.ACCESSTYPE := TOS;  <<ORDINAL IN PACCTYPES>> <<U.RAO>>07596000
      END                                                      <<U.RAO>>07598000
   END;                                                        <<U.RAO>>07600000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>07602000
   PROCACCESS := FALSE                                         <<U.RAO>>07604000
ELSE IF (NEXTDELIM <> CR) AND (NEXTDELIM <> SEMICOLON) THEN    <<U.RAO>>07606000
   BEGIN  <<EXTRANEOUS PARAMETER OR SYNTAX ERROR>>             <<U.RAO>>07608000
   GETNEXT;                                                    <<U.RAO>>07610000
   PROCACCESS := FALSE;                                        <<U.RAO>>07612000
   PARSE'ERR(ERRNUM := FILEACCXTRNPARM, PARMPTR);              <<01200>>07614000
   END                                                         <<U.RAO>>07616000
ELSE                                                           <<U.RAO>>07618000
   PROCACCESS := TRUE                                          <<U.RAO>>07620000
END;  <<SUBROUTINE PROCACCESS>>                                <<U.RAO>>07622000
                                                               <<U.RAO>>07624000
<<                 *********************                   >>  <<U.RAO>>07626000
<<                 *     PROCFBUF      *                   >>  <<U.RAO>>07628000
<<                 *********************                   >>  <<U.RAO>>07630000
                                                               <<U.RAO>>07632000
LOGICAL SUBROUTINE PROCBUF;                                    <<U.RAO>>07634000
BEGIN  <<PARSES BUF= PARAMETER>>                               <<U.RAO>>07636000
AOPTIONS.NOBUF := FALSE;                                       <<U.RAO>>07638000
FLAGBUFINHIBIT := TRUE; <<SO NOBUF IS SET FALSE IN FOPEN>>     <<00886>>07640000
IF <> THEN     <<NOBUF PREVIOUSLY SPECIFIED>>                  <<U.RAO>>07642000
   PARSE'ERR(-FILENOBUFBUF,PARMPTR);                           <<01200>>07644000
NUMBUFFERS := 2;  <<DEFAULT>>                                  <<U.RAO>>07646000
FLAGNUMBUFS := TRUE;                                           <<U.RAO>>07648000
IF <> THEN   <<BUF= PREVIOUSLY SPECIFIED>>                     <<U.RAO>>07650000
   PARSE'ERR(-FILEBUFOVERRIDE, PARMPTR);                       <<01200>>07652000
IF NEXTDELIM = EQUALS THEN   <<NUMBER OF BUFFERS SPECIFIED>>   <<U.RAO>>07654000
   BEGIN                                                       <<U.RAO>>07656000
   GETNEXT;                                                    <<U.RAO>>07658000
   IF PARMLEN <> 0 THEN                                        <<U.RAO>>07660000
      BEGIN                                                    <<U.RAO>>07662000
      NUMBUFFERS := BINARY(PARMPTR, PARMLEN);                  <<U.RAO>>07664000
      IF <> OR NOT(0 <= NUMBUFFERS <= 16) THEN                 <<U.RAO>>07666000
         PARSE'ERR(ERRNUM := FILEINVLDBUFNUM, PARMPTR);        <<01200>>07668000
      END                                                      <<U.RAO>>07670000
   END;                                                        <<U.RAO>>07672000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>07674000
   PROCBUF := FALSE                                            <<U.RAO>>07676000
ELSE IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN        <<U.RAO>>07678000
   BEGIN <<EXTRANEOUS PARAMETER>>                              <<U.RAO>>07680000
   GETNEXT;                                                    <<U.RAO>>07682000
   PROCBUF := FALSE;                                           <<U.RAO>>07684000
   PARSE'ERR(ERRNUM := FILEBUFXTRANDEL, PARMPTR);              <<01200>>07686000
   END                                                         <<U.RAO>>07688000
ELSE                                                           <<U.RAO>>07690000
   PROCBUF := TRUE;                                            <<U.RAO>>07692000
END;                                                           <<U.RAO>>07694000
                                                               <<01549>>07696000
                                                               <<01549>>07698000
<<                 *********************                   >>  <<01549>>07700000
<<                 *     PROCENV       *                   >>  <<01549>>07702000
<<                 *********************                   >>  <<01549>>07704000
                                                               <<01549>>07706000
LOGICAL SUBROUTINE PROCENV;                                    <<01549>>07708000
<<PARSES ENV PARAMETER>>                                       <<01549>>07710000
<<CHECKS FOR EQUAL SIGN>>                                      <<01549>>07712000
<<VALID FILENAME>>                                             <<01549>>07714000
<< OK IF NO FILE NAME, GLOBAL ENV. FILE WILL >>                <<01851>>07716000
<< BE USED BY FOPEN.                         >>                <<01851>>07718000
                                                               <<01549>>07720000
BEGIN                                                          <<01549>>07722000
   PROCENV := FALSE;                                           <<01549>>07724000
   IF NEXTDELIM <> EQUALS THEN                                 <<01549>>07726000
      PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))     <<01549>>07728000
   ELSE                                                        <<01549>>07730000
      BEGIN                                                    <<01549>>07732000
         IF FLAGENV THEN                                       <<01549>>07734000
            BEGIN   <<REDUNDANTLY SPECIFIED ENV PARM>>         <<01549>>07736000
               PARSE'ERR(-FILEENVOVERRIDE,PARMPTR);            <<01549>>07738000
               FLAGENV := FALSE; <<WARN USER>>                 <<01549>>07740000
            END;                                               <<01549>>07742000
         GETNEXT;                                              <<01851>>07744000
         IF PARMLEN <> 0 THEN                                  <<01851>>07746000
            IF NOT CHECKENVFILEDESIG THEN                      <<02523>>07748000
               RETURN;                                         <<01851>>07750000
         @ENV := @PARMPTR;                                     <<01851>>07752000
         ENVLEN := PARMLEN;                                    <<01851>>07754000
         FLAGENV := TRUE;                                      <<01549>>07756000
         IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN       <<01851>>07760000
            PROCENV := TRUE                                    <<01851>>07762000
         ELSE                                                  <<01851>>07764000
            BEGIN                                              <<01851>>07766000
               GETNEXT;                                        <<01851>>07768000
               PARSE'ERR(ERRNUM:=FILEENVXPARMS,PARMPTR);       <<01851>>07770000
            END;                                               <<01851>>07772000
         END;                                                  <<01549>>07774000
    END; <<SUBROUTINE PROCENV>>                                <<01549>>07776000
                                                               <<01549>>07778000
                                                               <<01549>>07780000
                                                               <<01549>>07782000
<<                 *********************                   >>  <<01549>>07784000
<<                 *     PROCOUTQ      *                   >>  <<01549>>07786000
<<                 *********************                   >>  <<01549>>07788000
                                                               <<01549>>07790000
LOGICAL SUBROUTINE PROCOUTQ;                                   <<01549>>07792000
<<PARSES OUTQ PARAMETER>>                                      <<01549>>07794000
<<CHECKS FOR EQUAL SIGN>>                                      <<01549>>07796000
<<VALID ALPHANUMERIC OUTQ NAME UP TO 8 CHARS>>                 <<01549>>07798000
<< OK IF NO OUTQNAME, GLOBAL OUTQ NAME WILL >>                 <<01851>>07800000
<< BE USED BY FOPEN.                        >>                 <<01851>>07802000
                                                               <<01549>>07804000
BEGIN                                                          <<01549>>07806000
                                                               <<01549>>07808000
   PROCOUTQ := FALSE;                                          <<01549>>07810000
   IF NEXTDELIM <> EQUALS THEN                                 <<01549>>07812000
      PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))     <<01549>>07814000
   ELSE                                                        <<01549>>07816000
      BEGIN                                                    <<01549>>07818000
         IF FLAGOUTQ THEN                                      <<01549>>07820000
         BEGIN  <<REDUNDANTLY SPECIFIED OUTQ PARM>>            <<01549>>07822000
            PARSE'ERR(-FILEOUTQOVERRIDE,PARMPTR);              <<01549>>07824000
            FLAGOUTQ := FALSE;                                 <<01549>>07826000
         END;                                                  <<01549>>07828000
         GETNEXT;                                              <<01549>>07830000
            MOVE PARMPTR := PARMPTR WHILE ANS;                 <<01549>>07832000
            TOS := PARMS(PARMNUM-1); <<DOUBLE FOR OUTQNAME>>   <<01549>>07834000
            DELB;  <<POP POINTER WORD>>                        <<01549>>07836000
            IF TOS.(10:1) THEN <<OUTQNAME CONTAINS SPECIALS>>  <<01549>>07838000
               PARSE'ERR(ERRNUM := OUTQNAMEALPHNUM,PARMPTR)    <<01549>>07840000
            ELSE                                               <<01549>>07842000
               IF PARMLEN > 8 THEN                             <<01549>>07844000
               PARSE'ERR(ERRNUM := OUTQNAME2LNG,PARMPTR)       <<01549>>07846000
            ELSE                                               <<01549>>07848000
               IF PARMPTR = NUMERIC THEN                       <<01549>>07850000
               PARSE'ERR(ERRNUM := OUTQNAMENOTALPH,PARMPTR)    <<01549>>07852000
            ELSE                                               <<01549>>07854000
               BEGIN  <<GOOD OUTQ NAME>>                       <<01549>>07856000
                  @OUTQ := @PARMPTR;                           <<01851>>07858000
                  OUTQLEN := PARMLEN;                          <<01851>>07860000
                  FLAGOUTQ := TRUE;                            <<01549>>07862000
                  IF ERRNUM = 0 THEN                           <<01549>>07866000
                     IF (NEXTDELIM = CR) OR                    <<01549>>07868000
                        (NEXTDELIM = SEMICOLON) THEN           <<01549>>07870000
                     PROCOUTQ := TRUE                          <<01549>>07872000
                     ELSE                                      <<01549>>07874000
                        BEGIN                                  <<01549>>07876000
                           GETNEXT;                            <<01549>>07878000
                           PARSE'ERR(ERRNUM := FILEOUTQXPARMS, <<01549>>07880000
                                  PARMPTR);                    <<01549>>07882000
                        END;                                   <<01549>>07884000
               END;                                            <<01549>>07886000
      END;                                                     <<01549>>07888000
END; <<SUBROUTINE PROCOUTQ>>                                   <<01549>>07890000
                                                               <<01549>>07892000
                                                               <<01549>>07894000
<<                 ********************                    >>  <<02569>>07896000
<<                 *     PROCDENS     *                    >>  <<02569>>07898000
<<                 ********************                    >>  <<02569>>07900000
LOGICAL SUBROUTINE PROCDENS;                                   <<02569>>07902000
<<Parses the DEN parameter. Checks for equal sign followed >>  <<02569>>07904000
<<by an optional density value.                            >>  <<02569>>07906000
<<SYNTAX:   ;DEN=[1600/6250]                               >>  <<02569>>07908000
BEGIN                                                          <<02569>>07910000
PROCDENS:=FALSE;                                               <<02569>>07912000
IF NEXTDELIM <> EQUALS THEN                                    <<02569>>07914000
  PARSE'ERR(ERRNUM:=FILEREQEQSIGN,PARMPTR(PARMLEN))            <<02569>>07916000
ELSE                                                           <<02569>>07918000
  BEGIN                                                        <<02569>>07920000
     IF FLAGDENS THEN                                          <<02569>>07922000
       BEGIN     <<REDUNDANTLY SPECFIED DENS PARM>>            <<02569>>07924000
          PARSE'ERR(-FILEDENSOVERRID,PARMPTR);                 <<02569>>07926000
          FLAGDENS := FALSE;   <<WARN USER>>                   <<02569>>07928000
       END;      <<REDUNDANTLY SPECIFIED DENS PARM>>           <<02569>>07930000
     GETNEXT;    <<LOOK FOR DENSITY VALUE>>                    <<02569>>07932000
     IF PARMLEN <> 0 THEN                                      <<02569>>07934000
       BEGIN           <<PARM FOUND>>                          <<02569>>07936000
          IF PARSE'DENSITY(PARMPTR,PARMLEN,DUMMY) THEN         <<02569>>07938000
             FLAGDENS := TRUE                                  <<02569>>07940000
          ELSE                                                 <<02569>>07942000
             BEGIN      << Invalid density subparameter >>     <<02569>>07944000
                PARSE'ERR(ERRNUM:=FILEDENSINVAL,PARMPTR);      <<02569>>07946000
                FLAGDENS := FALSE;                             <<02569>>07948000
             END;                                              <<02569>>07950000
       END             <<PARM FOUND>>                          <<02569>>07952000
     ELSE FLAGDENS := TRUE;    <<DEFAULT CASE>>                <<02569>>07954000
     IF FLAGDENS THEN        << GOOD PARM >>                   <<02569>>07956000
       BEGIN                                                   <<02569>>07958000
          @DENS := @PARMPTR;                                   <<02569>>07960000
          DENSLEN := PARMLEN;                                  <<02569>>07962000
          IF ERRNUM = 0  THEN                                  <<02569>>07964000
            IF (NEXTDELIM = CR) OR (NEXTDELIM = SEMICOLON)     <<02569>>07966000
              THEN PROCDENS := TRUE                            <<02569>>07968000
            ELSE BEGIN                                         <<02569>>07970000
                 GETNEXT;                                      <<02569>>07972000
                 PARSE'ERR(ERRNUM:=FILEDENSXPARM,PARMPTR);     <<02569>>07974000
                 END;                                          <<02569>>07976000
       END;     <<GOOD PARM>>                                  <<02569>>07978000
  END;                                                         <<02569>>07980000
END;      << SUBROUTINE PROCDENS >>                            <<02569>>07982000
                                                               <<02569>>07984000
                                                               <<02569>>07986000
<<                 *********************                   >>  <<U.RAO>>07988000
<<                 *      PROCKEY      *                   >>  <<U.RAO>>07990000
<<                 *********************                   >>  <<U.RAO>>07992000
                                                               <<U.RAO>>07994000
LOGICAL SUBROUTINE PROCKEY;                                    <<U.RAO>>07996000
<<Processes the parameter list.  Note that it is only called       >>   07998000
<<if it appears that a parameter list is present.  In general      >>   08000000
<<this routine only controls the parse;  Anything which is even    >>   08002000
<<moderately complex (i.e, has parameters) is done in a further    >>   08004000
<<subroutine.  In essence, we must do four things in this routine. >>   08006000
<<1)  Identify the parameters which are not appropriate to this    >>   08008000
<<    form of the command.                                         >>   08010000
<<2)  Control the scan through the parameter list.  (done with     >>   08012000
<<    a do loop around a case statement.                           >>   08014000
<<3)  Process trivial parameters like WAIT, NOMR and a few others  >>   08016000
<<    which simply involve setting a few bits somewhere.           >>   08018000
<<4)  Look for extraneous subparameters on the trivial parameters. >>   08020000
<<Another thing to note is that for the most part we allow the     >>   08022000
<<user to specify a parameter redundantly, using the latest        >>   08024000
<<occurrence as the controlling one.                               >>   08026000
BEGIN                                                          <<U.RAO>>08028000
PROCKEY := FALSE;                                              <<U.RAO>>08030000
MOVE KEYLIST := PKEYLIST, (PKEYLISTL);                         <<U.RAO>>08032000
<<NOW GET COMTYPE.  COMTYPE IS AN INTEGER INDICATING WHICH >>  <<U.RAO>>08034000
<<TYPE OF COMMAND THIS IS.                                 >>  <<U.RAO>>08036000
IF BUILDFLAG THEN                                              <<U.RAO>>08038000
   COMTYPE := BUILD                                            <<U.RAO>>08040000
ELSE IF FOPTIONS.DEFAULTDES = 0 THEN  <<REGULAR FILEREFERENCE>><<U.RAO>>08042000
   IF FOPTIONS.DOMAIN = 0 THEN                                 <<U.RAO>>08044000
      COMTYPE := NEW                                           <<U.RAO>>08046000
   ELSE                                                        <<U.RAO>>08048000
      COMTYPE := OLD                                           <<U.RAO>>08050000
ELSE IF FOPTIONS.DEFAULTDES = 2 THEN <<$NEWPASS>>              <<U.RAO>>08052000
   COMTYPE := NEW                                              <<U.RAO>>08054000
ELSE IF FOPTIONS.DEFAULTDES = 3 THEN  <<$OLDPASS>>             <<U.RAO>>08056000
   COMTYPE := OLD                                              <<U.RAO>>08058000
ELSE   <<$STDIN, $STDLIST, $STDINX>>                           <<U.RAO>>08060000
   COMTYPE := SYSDEF;                                          <<U.RAO>>08062000
<<NOW DO BODY OF KEYWORD PROCESSING>>                          <<U.RAO>>08064000
DO    <<UNTIL ERROR OR END OF PARAMETERS>>                     <<U.RAO>>08066000
   BEGIN                                                       <<U.RAO>>08068000
   GETNEXT;  <<SET UP NEXT KEYWORD>>                           <<U.RAO>>08070000
   IF PARMLEN = 0 THEN  <<DOUBLED DELIMITER>>                  <<U.RAO>>08072000
      PARSE'ERR(-FILEEXTRANDELIM, PARMPTR)                     <<01200>>08074000
   ELSE   <<NON-BLANK STRING>>                                 <<U.RAO>>08076000
      BEGIN   <<IDENTIFY KEYWORD>>                             <<U.RAO>>08078000
      TOS := SEARCH(PARMPTR, PARMLEN, KEYLIST, DICTPTR);       <<U.RAO>>08080000
      <<BEFORE PROCESSING, CHECK TO SEE THAT THIS KEYWORD IS>> <<U.RAO>>08082000
      <<APPROPRIATE FOR THIS PARTICULAR VERSION OF THE COMMAND><<U.RAO>>08084000
      IF (S0 <> 0)  <<VALID KEY NAME>>   AND                   <<U.RAO>>08086000
         (((1&LSL(COMTYPE)) LAND LOGICAL(DICTPTR)) <> 0) THEN  <<U.RAO>>08088000
         BEGIN  <<KEYWORD OUT OF CONTEXT>>                     <<U.RAO>>08090000
         DEL;  <<POP ORDINAL OF KEYWORD>>                      <<U.RAO>>08092000
         <<FIXUP KEYWORD TO BE PARAMETER TO GENMSG>>           <<U.RAO>>08094000
         TOS := PARMPTR(PARMLEN);                              <<U.RAO>>08096000
         PARMPTR(X) := 0;                                      <<U.RAO>>08098000
         CASE *COMTYPE OF                                      <<U.RAO>>08100000
            BEGIN                                              <<U.RAO>>08102000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTBLD         <<01200>>08104000
            ELSE                                               <<01200>>08106000
               CIERR(ERRNUM:=FILECONTXTBLD,PARMPTR,0,@PARMPTR);<<01200>>08108000
                                                               <<01200>>08110000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTSYSDF       <<01200>>08112000
            ELSE                                               <<01200>>08114000
               CIERR(ERRNUM:=FILECONTXTSYSDF,PARMPTR,0,        <<01200>>08116000
                     @PARMPTR);                                <<01200>>08118000
                                                               <<01200>>08120000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTOLD         <<01200>>08122000
            ELSE                                               <<01200>>08124000
               CIERR(ERRNUM:=FILECONTXTOLD,PARMPTR,0,@PARMPTR);<<01200>>08126000
                                                               <<01200>>08128000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTNEW         <<01200>>08130000
            ELSE                                               <<01200>>08132000
               CIERR(ERRNUM:=FILECONTXTNEW,PARMPTR,0,@PARMPTR);<<01200>>08134000
            END;                                               <<U.RAO>>08136000
         PARMPTR(PARMLEN) := TOS;                              <<U.RAO>>08138000
         RETURN                                                <<U.RAO>>08140000
         END;                                                  <<U.RAO>>08142000
      <<WE KNOW THAT THIS KEYWORD IS APPROPRIATE TO THIS>>     <<U.RAO>>08144000
      <<FORM OF THE FILE OR BUILD COMMAND.  NOW ACTUALLY PROCESS>>      08146000
      <<THE KEYWORD>>                                          <<U.RAO>>08148000
      CASE *TOS OF                                             <<U.RAO>>08150000
         BEGIN                                                 <<U.RAO>>08152000
            BEGIN  <<UNKNOWN KEYWORD>>                         <<U.RAO>>08154000
            IF BUILDFLAG THEN                                  <<U.RAO>>08156000
               PARSE'ERR(ERRNUM := BLDUNKNOWNKEY, PARMPTR)     <<01200>>08158000
            ELSE   <<FILE COMMAND>>                            <<U.RAO>>08160000
               PARSE'ERR(ERRNUM := FILEUNKNOWNKEY, PARMPTR);   <<01200>>08162000
            RETURN;                                            <<U.RAO>>08164000
            END;                                               <<U.RAO>>08166000
                                                               <<U.RAO>>08168000
            <<DEV = >>                                         <<U.RAO>>08170000
            IF NOT PROCDEV THEN RETURN;                        <<U.RAO>>08172000
                                                               <<U.RAO>>08174000
            <<DISC = >>                                        <<U.RAO>>08176000
            IF NOT PROCDISC THEN RETURN;                       <<U.RAO>>08178000
                                                               <<U.RAO>>08180000
            <<REC = >>                                         <<U.RAO>>08182000
            IF NOT PROCREC THEN RETURN;                        <<U.RAO>>08184000
                                                               <<U.RAO>>08186000
            <<FILE CODE>>                                      <<U.RAO>>08188000
            IF NOT PROCFCODE THEN RETURN;                      <<U.RAO>>08190000
                                                               <<U.RAO>>08192000
            <<CCTL>>                                           <<U.RAO>>08194000
            BEGIN                                              <<U.RAO>>08196000
               FOPTIONS.CCTL := TRUE;   <<ALSO CHECKS PREVIOUS STATE>>  08198000
               IF = AND FLAGCCTL THEN   <<INCONSISTENT WITH AND >>      08200000
                  PARSE'ERR(-FILENOCCTLCCTL, PARMPTR);         <<01200>>08202000
               FLAGCCTL := TRUE;                               <<U.RAO>>08204000
            END;                                               <<U.RAO>>08206000
                                                               <<U.RAO>>08208000
            <<NOCCTL>>                                         <<U.RAO>>08210000
            BEGIN                                              <<U.RAO>>08212000
               FOPTIONS.CCTL := FALSE;                         <<U.RAO>>08214000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS CCTL>><<U.RAO>>08216000
                  PARSE'ERR(-FILECCTLNOCCTL, PARMPTR);         <<01200>>08218000
               FLAGCCTL := TRUE;                               <<U.RAO>>08220000
            END;                                               <<U.RAO>>08222000
                                                               <<U.RAO>>08224000
            <<TEMP>>                                           <<U.RAO>>08226000
            BEGIN                                              <<U.RAO>>08228000
               FLAGDISP := TRUE;                               <<U.RAO>>08230000
               IF <> THEN  <<POSSIBLE CONTRADICTION>>          <<U.RAO>>08232000
                  IF DISPOSITION = DELETE THEN                 <<U.RAO>>08234000
                     PARSE'ERR(-FILEDELTEMP, PARMPTR)          <<01200>>08236000
                  ELSE IF DISPOSITION = SAVE THEN              <<U.RAO>>08238000
                     PARSE'ERR(-FILESAVETEMP, PARMPTR);        <<01200>>08240000
               DISPOSITION := TEMP;                            <<U.RAO>>08242000
            END;                                               <<U.RAO>>08244000
                                                               <<U.RAO>>08246000
            <<SAVE>>                                           <<U.RAO>>08248000
            BEGIN                                              <<U.RAO>>08250000
               FLAGDISP := TRUE;                               <<U.RAO>>08252000
               IF <> THEN  <<POSSIBLE CONFLICT WITH PREVIOUS SPEC>>     08254000
                  IF DISPOSITION = DELETE THEN                 <<U.RAO>>08256000
                     PARSE'ERR(-FILEDELSAVE, PARMPTR)          <<01200>>08258000
                  ELSE IF DISPOSITION = TEMP THEN              <<U.RAO>>08260000
                     PARSE'ERR(-FILETEMPSAVE, PARMPTR);        <<01200>>08262000
               DISPOSITION := SAVE;                            <<U.RAO>>08264000
            END;                                               <<U.RAO>>08266000
                                                               <<U.RAO>>08268000
            <<DEL>>                                            <<U.RAO>>08270000
            BEGIN                                              <<U.RAO>>08272000
               FLAGDISP := TRUE;                               <<U.RAO>>08274000
               IF <> THEN  <<POSSIBLE INCONSISTENCY WITH PREVIOUS>>     08276000
                  IF DISPOSITION  = TEMP THEN                  <<U.RAO>>08278000
                     PARSE'ERR(-FILETEMPDEL, PARMPTR)          <<01200>>08280000
                  ELSE IF DISPOSITION = SAVE THEN              <<U.RAO>>08282000
                     PARSE'ERR(-FILESAVEDEL, PARMPTR);         <<01200>>08284000
               DISPOSITION := DELETE;                          <<U.RAO>>08286000
            END;                                               <<U.RAO>>08288000
                                                               <<U.RAO>>08290000
            <<ACCESS>>                                         <<U.RAO>>08292000
            IF NOT PROCACCESS THEN RETURN;                     <<U.RAO>>08294000
                                                               <<U.RAO>>08296000
            <<SHARE>>                                          <<U.RAO>>08298000
            BEGIN                                              <<U.RAO>>08300000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>08302000
               IF <> THEN                                      <<U.RAO>>08304000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<U.RAO>>08306000
                     PARSE'ERR(-FILEEXCLSHARE, PARMPTR)        <<01200>>08308000
                  ELSE IF AOPTIONS.EXCLACCESS = EXCLUSIVEREAD THEN      08310000
                     PARSE'ERR(-FILEEXCLSHARE,PARMPTR);        <<01549>>08312000
               AOPTIONS.EXCLACCESS := SHARE;                   <<U.RAO>>08314000
            END;                                               <<U.RAO>>08316000
                                                               <<U.RAO>>08318000
            <<EAR>>                                            <<U.RAO>>08320000
            BEGIN                                              <<U.RAO>>08322000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>08324000
               IF <> THEN                                      <<U.RAO>>08326000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<U.RAO>>08328000
                     PARSE'ERR(-FILEEXCLEAR, PARMPTR)          <<01200>>08330000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<U.RAO>>08332000
                     PARSE'ERR(-FILESHAREEAR, PARMPTR);        <<01200>>08334000
               AOPTIONS.EXCLACCESS := EXCLUSIVEREAD;           <<U.RAO>>08336000
            END;                                               <<U.RAO>>08338000
                                                               <<01549>>08340000
            <<SEMI>>                                           <<01549>>08342000
            BEGIN                                              <<01549>>08344000
               FLAGEXCLUSIVE := TRUE;                          <<01549>>08346000
               IF <> THEN                                      <<01549>>08348000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<01549>>08350000
                     PARSE'ERR(-FILEEXCLSEMI,PARMPTR)          <<01549>>08352000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<01549>>08354000
                     PARSE'ERR(-FILESHARESEMI,PARMPTR);        <<01549>>08356000
               AOPTIONS.EXCLACCESS := EXCLUSIVEREAD;           <<01549>>08358000
            END;                                               <<01549>>08360000
                                                               <<01549>>08362000
                                                               <<U.RAO>>08364000
            <<EXC>>                                            <<U.RAO>>08366000
            BEGIN                                              <<U.RAO>>08368000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>08370000
               IF <> THEN                                      <<U.RAO>>08372000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVEREAD THEN  <<U.RAO>>08374000
                     PARSE'ERR(-FILEEAREXCL, PARMPTR)          <<01200>>08376000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<U.RAO>>08378000
                     PARSE'ERR(-FILESHAREEXCL, PARMPTR);       <<01200>>08380000
               AOPTIONS.EXCLACCESS := EXCLUSIVE;               <<U.RAO>>08382000
            END;                                               <<U.RAO>>08384000
                                                               <<U.RAO>>08386000
            <<BUF = >>                                         <<U.RAO>>08388000
            IF NOT PROCBUF THEN RETURN;                        <<U.RAO>>08390000
                                                               <<U.RAO>>08392000
            <<NOBUF>>                                          <<U.RAO>>08394000
            BEGIN                                              <<U.RAO>>08396000
               AOPTIONS.NOBUF := TRUE;                         <<U.RAO>>08398000
               FLAGNUMBUFS := FALSE;  << IN CASE PREVIOUS BUF= <<U.RAO>>08400000
               IF <> THEN  <<WAS A PREVIOUS BUF = PARAMETER>>  <<U.RAO>>08402000
                  PARSE'ERR(-FILEBUFNOBUF, PARMPTR);           <<01200>>08404000
               FLAGBUFINHIBIT := TRUE;  <<INHIBIT BUFFERING>>  <<U.RAO>>08406000
            END;                                               <<U.RAO>>08408000
            <<COPY>>                                           <<01549>>08410000
            BEGIN                                              <<01549>>08412000
               AOPTIONS.COPY := TRUE;                          <<01549>>08414000
               IF = AND FLAGCOPY THEN                          <<01549>>08416000
                  PARSE'ERR(-FILENOCOPYCOPY, PARMPTR);         <<01549>>08418000
               FLAGCOPY := TRUE;                               <<01549>>08420000
            END;                                               <<01549>>08422000
                                                               <<01549>>08424000
            <<NOCOPY>>                                         <<01549>>08426000
            BEGIN                                              <<01549>>08428000
               AOPTIONS.COPY := FALSE;                         <<01549>>08430000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS COPY>><<01549>>08432000
                  PARSE'ERR(-FILECOPYNOCOPY, PARMPTR);         <<01549>>08434000
               FLAGCOPY := TRUE;                               <<01549>>08436000
            END;                                               <<01549>>08438000
                                                               <<01549>>08440000
                                                               <<U.RAO>>08442000
            <<MR>>                                             <<U.RAO>>08444000
            BEGIN                                              <<U.RAO>>08446000
               AOPTIONS.MULTIRECORD := TRUE;                   <<U.RAO>>08448000
               IF = AND FLAGMULTIREC THEN                      <<U.RAO>>08450000
                  PARSE'ERR(-FILENOMRMR, PARMPTR);             <<01200>>08452000
               FLAGMULTIREC := TRUE;                           <<U.RAO>>08454000
            END;                                               <<U.RAO>>08456000
                                                               <<U.RAO>>08458000
            <<NOMR>>                                           <<U.RAO>>08460000
            BEGIN                                              <<U.RAO>>08462000
               AOPTIONS.MULTIRECORD := FALSE;                  <<U.RAO>>08464000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS MR>>  <<U.RAO>>08466000
                  PARSE'ERR(-FILEMRNOMR, PARMPTR);             <<01200>>08468000
               FLAGMULTIREC := TRUE;                           <<U.RAO>>08470000
            END;                                               <<U.RAO>>08472000
                                                               <<U.RAO>>08474000
            <<GLOBAL MULTIACCESS>>                             <<01549>>08476000
            BEGIN                                              <<01549>>08478000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>08480000
            IF <> THEN                                         <<01549>>08482000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>08484000
                  BEGIN                                        <<01549>>08486000
                  PARSE'ERR(-FILENOMULTGMULT, PARMPTR);        <<01549>>08488000
                  PARSE'ERR(-FILEMULTIGMULTI, PARMPTR);        <<01549>>08490000
                  END;                                         <<01549>>08492000
            AOPTIONS.MULTIACCESS:=GLOBALMULTI;                 <<01549>>08494000
            END;                                               <<01549>>08496000
            <<LOCAL MULTIACCESS>>                              <<01549>>08498000
            BEGIN                                              <<01549>>08500000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>08502000
            IF <> THEN                                         <<01549>>08504000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>08506000
                  BEGIN                                        <<01549>>08508000
                  PARSE'ERR(-FILENOMULTIMULTI, PARMPTR);       <<01549>>08510000
                  ;  <<ALREADY WAS SET TO LOCAL>>              <<01549>>08512000
                  PARSE'ERR(-FILEGMULTIMULTI, PARMPTR);        <<01549>>08514000
                  END;                                         <<01549>>08516000
            AOPTIONS.MULTIACCESS:=LOCALMULTI;                  <<01549>>08518000
            END;                                               <<01549>>08520000
                                                               <<01549>>08522000
            <<NO MULTIACCESS>>                                 <<01549>>08524000
            BEGIN                                              <<01549>>08526000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>08528000
            IF <> THEN                                         <<01549>>08530000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>08532000
                  BEGIN                                        <<01549>>08534000
                  ;  <<ALREADY SET TO NO MULTIACCESS>>         <<01549>>08536000
                  PARSE'ERR(-FILEMULTINOMULTI, PARMPTR);       <<01549>>08538000
                  PARSE'ERR(-FILEGMULTNOMULT, PARMPTR);        <<01549>>08540000
                  END;                                         <<01549>>08542000
            AOPTIONS.MULTIACCESS:=NOMULTI;                     <<01549>>08544000
            END;                                               <<01549>>08546000
            <<NOLABEL>>                                        <<U.RAO>>08548000
            BEGIN                                              <<U.RAO>>08550000
               FOPTIONS.TAPELABELF := FALSE;                   <<U.RAO>>08552000
               IF <> THEN  <<INCONSISTENTLY SPECIFIED>>        <<U.RAO>>08554000
                  BEGIN                                        <<U.RAO>>08556000
                  PARSE'ERR(-FILELABELNOLABEL, PARMPTR);       <<01200>>08558000
                  TAPELABELLEN := 0;  <<RESET>>                <<U.RAO>>08560000
                  END;                                         <<U.RAO>>08562000
               FLAGLABELEDTAPE := TRUE;                        <<01099>>08564000
            END;                                               <<U.RAO>>08566000
                                                               <<U.RAO>>08568000
            <<FORMS>>                                          <<U.RAO>>08570000
            IF NOT CHECKFORMMSG THEN RETURN;                   <<U.RAO>>08572000
                                                               <<U.RAO>>08574000
            <<LABEL=>>                                         <<U.RAO>>08576000
            IF NOT CHECKLABELDATA THEN RETURN;                 <<U.RAO>>08578000
                                                               <<U.RAO>>08580000
            <<LOCK>>                                           <<U.RAO>>08582000
            BEGIN                                              <<U.RAO>>08584000
               AOPTIONS.LOCKING := TRUE;                       <<U.RAO>>08586000
               IF = AND FLAGDYNLOCKING THEN                    <<U.RAO>>08588000
                  PARSE'ERR(-FILENOLOCKLOCK, PARMPTR);         <<01200>>08590000
               FLAGDYNLOCKING := TRUE;                         <<U.RAO>>08592000
            END;                                               <<U.RAO>>08594000
                                                               <<U.RAO>>08596000
            <<NOLOCK>>                                         <<U.RAO>>08598000
            BEGIN                                              <<U.RAO>>08600000
               AOPTIONS.LOCKING := FALSE;                      <<04.RO>>08602000
               IF <> THEN   <<INCONSISTENT>>                   <<U.RAO>>08604000
                  PARSE'ERR(-FILELOCKNOLOCK, PARMPTR);         <<01200>>08606000
               FLAGDYNLOCKING := TRUE;                         <<U.RAO>>08608000
            END;                                               <<U.RAO>>08610000
                                                               <<U.RAO>>08612000
            <<WAIT>>                                           <<U.RAO>>08614000
            BEGIN                                              <<U.RAO>>08616000
               AOPTIONS.NOWAIT := FALSE;                       <<U.RAO>>08618000
               IF <> THEN                                      <<U.RAO>>08620000
                  PARSE'ERR(-FILENOWAITWAIT, PARMPTR);         <<01200>>08622000
               FLAGWAIT := TRUE;                               <<U.RAO>>08624000
            END;                                               <<U.RAO>>08626000
                                                               <<U.RAO>>08628000
            <<NOWAIT>>                                         <<U.RAO>>08630000
            BEGIN                                              <<U.RAO>>08632000
               AOPTIONS.NOWAIT := TRUE;                        <<U.RAO>>08634000
               IF = AND FLAGWAIT THEN                          <<U.RAO>>08636000
                  PARSE'ERR(-FILEWAITNOWAIT, PARMPTR);         <<01200>>08638000
               FLAGWAIT := TRUE;                               <<U.RAO>>08640000
            END;                                               <<U.RAO>>08642000
                                                               <<01549>>08644000
            <<STD>>                                            <<01549>>08646000
            BEGIN                                              <<01549>>08648000
            FLAGFTYPE:=TRUE;                                   <<01549>>08650000
            IF <> THEN                                         <<01549>>08652000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>08654000
                  BEGIN                                        <<01549>>08656000
                  ;  <<ALREADY SET TO STD>>                    <<01549>>08658000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>08660000
                  PARSE'ERR(-FILERIOSTD, PARMPTR);             <<01549>>08662000
                  ;                                            <<01549>>08664000
                  PARSE'ERR(-FILECIRSTD, PARMPTR);             <<01549>>08666000
                  ;                                            <<01549>>08668000
                  PARSE'ERR(-FILEMSGSTD, PARMPTR);             <<01549>>08670000
                  END;                                         <<01549>>08672000
            FOPTIONS.FILETYPE:=STD;                            <<01549>>08674000
            END;                                               <<01549>>08676000
                                                               <<01549>>08678000
            <<RIO>>                                            <<01549>>08680000
            BEGIN                                              <<01549>>08682000
            FLAGFTYPE:=TRUE;                                   <<01549>>08684000
            IF <> THEN                                         <<01549>>08686000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>08688000
                  BEGIN                                        <<01549>>08690000
                  PARSE'ERR(-FILESTDRIO, PARMPTR);             <<01549>>08692000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>08694000
                  ;  <<ALREADY SET TO RIO>>                    <<01549>>08696000
                  ;                                            <<01549>>08698000
                  PARSE'ERR(-FILECIRRIO, PARMPTR);             <<01549>>08700000
                  ;                                            <<01549>>08702000
                  PARSE'ERR(-FILEMSGRIO, PARMPTR);             <<01549>>08704000
                  END;                                         <<01549>>08706000
            FOPTIONS.FILETYPE:=RIO;                            <<01549>>08708000
            END;                                               <<01549>>08710000
                                                               <<01549>>08712000
            <<NORIO>>                                          <<01549>>08714000
            BEGIN                                              <<01549>>08716000
            FLAGFTYPE:=TRUE;                                   <<01549>>08718000
            IF <> THEN                                         <<01549>>08720000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>08722000
                  BEGIN                                        <<01549>>08724000
                  ;  <<ALREADY SET TO STD>>                    <<01549>>08726000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>08728000
                  PARSE'ERR(-FILERIOSTD, PARMPTR);             <<01549>>08730000
                  ;                                            <<01549>>08732000
                  PARSE'ERR(-FILECIRSTD, PARMPTR);             <<01549>>08734000
                  ;                                            <<01549>>08736000
                  PARSE'ERR(-FILEMSGSTD, PARMPTR);             <<01549>>08738000
                  END;                                         <<01549>>08740000
            FOPTIONS.FILETYPE:=STD;                            <<01549>>08742000
            END;                                               <<01549>>08744000
                                                               <<01549>>08746000
                                                               <<01549>>08748000
            <<ENV>>                                            <<01549>>08750000
            IF NOT PROCENV THEN RETURN;                        <<01549>>08752000
                                                               <<01549>>08754000
            <<OUTQ>>                                           <<01549>>08756000
            IF NOT PROCOUTQ THEN RETURN;                       <<01549>>08758000
                                                               <<01549>>08760000
            <<MSG>>                                            <<01549>>08762000
            BEGIN                                              <<01549>>08764000
            FLAGFTYPE:=TRUE;                                   <<01549>>08766000
            IF <> THEN                                         <<01549>>08768000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>08770000
                  BEGIN                                        <<01549>>08772000
                  PARSE'ERR(-FILESTDMSG, PARMPTR);             <<01549>>08774000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>08776000
                  PARSE'ERR(-FILERIOMSG, PARMPTR);             <<01549>>08778000
                  ;                                            <<01549>>08780000
                  PARSE'ERR(-FILECIRMSG, PARMPTR);             <<01549>>08782000
                  END;                                         <<01549>>08784000
            FOPTIONS.FILETYPE:=MSG;                            <<01549>>08786000
            END;                                               <<01549>>08788000
                                                               <<01549>>08790000
            <<CIR>>                                            <<01549>>08792000
            BEGIN                                              <<01549>>08794000
            FLAGFTYPE:=TRUE;                                   <<01549>>08796000
            IF <> THEN                                         <<01549>>08798000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>08800000
                  BEGIN                                        <<01549>>08802000
                  PARSE'ERR(-FILESTDCIR, PARMPTR);             <<01549>>08804000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>08806000
                  PARSE'ERR(-FILERIOCIR, PARMPTR);             <<01549>>08808000
                  ;                                            <<01549>>08810000
                  ;  <<ALREADY SET TO CIRCULAR>>               <<01549>>08812000
                  ;                                            <<01549>>08814000
                  PARSE'ERR(-FILEMSGCIR, PARMPTR);             <<01549>>08816000
                  END;                                         <<01549>>08818000
            FOPTIONS.FILETYPE:=CIR;                            <<01549>>08820000
            END;                                               <<01549>>08822000
                                                               <<01549>>08824000
                                                               <<U.RAO>>08826000
            << DEN >>                                          <<02569>>08828000
            IF NOT PROCDENS THEN RETURN;                       <<02569>>08830000
                                                               <<02569>>08832000
         END;  <<OF CASE>>                                     <<U.RAO>>08834000
      END;  <<OF ELSE CLAUSE>>                                 <<U.RAO>>08836000
   END                                                         <<U.RAO>>08838000
      UNTIL NEXTDELIM <> SEMICOLON;                            <<U.RAO>>08840000
                                                               <<U.RAO>>08842000
<<Parse terminated because the next delimiter indicated that  ><<U.RAO>>08844000
<<what followed was not a keyword.  If it was not a carriage  ><<U.RAO>>08846000
<<return then there was a syntax error.  Since all of the     ><<U.RAO>>08848000
<<parsers of keywords with subparameters are responsible for  ><<U.RAO>>08850000
<<checking for extraneous or unexpected delimiters, the only  ><<U.RAO>>08852000
<<time the next delimiter would not be a carriage return would><<U.RAO>>08854000
<<be after one of the keywords which has no qualifiers.       ><<U.RAO>>08856000
IF NEXTDELIM <> CR THEN                                        <<U.RAO>>08858000
   BEGIN  <<HANDLE EXTRANEOUS DELIMITERS>>                     <<U.RAO>>08860000
   <<FIRST FIXUP SO PARAMETER NAME CAN BE PASSED TO CIERR>>    <<U.RAO>>08862000
   TOS := @PARMPTR;                                            <<U.RAO>>08864000
   TOS := BPS0(PARMLEN);                                       <<U.RAO>>08866000
   BPS1(X) := 0;                                               <<U.RAO>>08868000
   GETNEXT;                                                    <<U.RAO>>08870000
   IF PARSE'ONLY THEN ERRNUM := FILENOXPCTSPARM                <<01200>>08872000
   ELSE                                                        <<01200>>08874000
      CIERR(ERRNUM := FILENOXPCTSPARM, PARMPTR, 0, @BPS1);     <<01200>>08876000
   BPS1(X) := TOS;  <<RESTORE PREVIOUS VALUE OVER 0>>          <<U.RAO>>08878000
   DEL;  <<POP POINTER>>                                       <<U.RAO>>08880000
   END                                                         <<U.RAO>>08882000
ELSE                                                           <<U.RAO>>08884000
   PROCKEY := TRUE;                                            <<U.RAO>>08886000
END;  <<SUBROUTINE PROCKEY>>                                   <<U.RAO>>08888000
                                                               <<U.RAO>>08890000
<<                 *********************                   >>  <<U.RAO>>08892000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>08894000
<<                 *********************                   >>  <<U.RAO>>08896000
                                                               <<U.RAO>>08898000
<<MAIN BODY OF FILE COMMAND>>                                  <<U.RAO>>08900000
<<This code does three things, parse the file name part, invoke<<U.RAO>>08902000
<<the parse of any keywords which might be present, and do the><<U.RAO>>08904000
<<call to the routine which sets up the JDT entry.>>           <<U.RAO>>08906000
<<Note that when a failure is detected, this procedure is exited>>      08908000
<<immediately.>>                                               <<U.RAO>>08910000
                                                               <<01200>>08912000
<< NORMAL ENTRY POINT FOR :FILE COMMAND >>                     <<01255>>08914000
PARSE'ONLY := FALSE;                                           <<01200>>08916000
GOTO STARTPARSE;                                               <<01200>>08918000
                                                               <<01200>>08920000
<< PARSE'FILE'EQ IS AN ENTRY POINT TO PERFORM ONLY THE PARSE >><<01200>>08922000
<< OF A FILE EQUATION.  THE PARSED FILE EQUATION TABLE IS    >><<01200>>08924000
<< NOT ADDED TO THE JDT BUT RATHER RETURNED TO THE CALLER    >><<01200>>08926000
<< THROUGH THE 1ST PARAMETER OF THE CALL.                    >><<01200>>08928000
PARSE'FILE'EQ:                                                 <<01200>>08930000
PARSE'ONLY := TRUE;                                            <<01200>>08932000
                                                               <<01200>>08934000
STARTPARSE:                                                    <<01200>>08936000
PARMNUM := 0;                                                  <<U.RAO>>08938000
MOVE SAVEDCOMIMAGE := PARMSP,(BCOMMANDBUFLEN);                 <<02663>>08940000
MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARMS);                  <<U.RAO>>08942000
IF NUMPARMS=0 THEN  <<LACKS REQUIRED FORMAL FILE DESIGNATOR>>  <<U.RAO>>08944000
   BEGIN                                                       <<U.RAO>>08946000
   PARMNUM := 1;                                               <<U.RAO>>08948000
   CIERR(ERRNUM := FILEREQFDESIG,PARMSP(1));                   <<U.RAO>>08950000
   RETURN;                                                     <<U.RAO>>08952000
   END;                                                        <<U.RAO>>08954000
<<FIRST STEP IS TO PARSE THE FORMAL FILE DESIGNATOR>>          <<U.RAO>>08956000
IF NOT CHECKFDESIG THEN RETURN;                                <<U.RAO>>08958000
<<HAVE VALID FORMAL FILE DESIGNATOR.  NOW LOOK FOR ACTUAL FDESIG.>>     08960000
IF NUMPARMS=1 THEN <<REQUIRES AT LEAST ONE OTHER PARM>>        <<U.RAO>>08962000
   BEGIN                                                       <<U.RAO>>08964000
   CIERR(ERRNUM := FILEREQSOMEPARM,FORMALDES(PARMLEN));        <<U.RAO>>08966000
   RETURN                                                      <<U.RAO>>08968000
   END;                                                        <<U.RAO>>08970000
IF NEXTDELIM=EQUALS THEN   <<ACTUAL DESIGNATOR PROMISED>>      <<U.RAO>>08972000
   IF NOT CHECKADESIG THEN RETURN;                             <<U.RAO>>08974000
<<CHECK FOR FILE DOMAIN>>                                      <<U.RAO>>08976000
IF NEXTDELIM=COMMA THEN   <<DOMAIN PROMISED>>                  <<U.RAO>>08978000
   IF NOT CHECKDOMAIN THEN RETURN;                             <<U.RAO>>08980000
<<THE ONLY LEGAL THING AFTER THIS IS THE KEYWORD LIST, IF ANY>>         08982000
IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN             <<U.RAO>>08984000
   BEGIN  <<UNEXPECTED DELIMITERS, SYNTAX ERROR>>              <<U.RAO>>08986000
   GETNEXT;                                                    <<U.RAO>>08988000
   PARSE'ERR(ERRNUM := FILEXSTRTPARMCR, PARMPTR(-1));          <<01200>>08990000
   RETURN                                                      <<U.RAO>>08992000
   END;                                                        <<U.RAO>>08994000
<<NOW HAVE NAME INFO COMPLETELY PARSED.>>                      <<U.RAO>>08996000
                                                               <<U.RAO>>08998000
<<NEXT STEP IS THE PARSE OF THE PARAMETER LIST, IF PRESENT.>>  <<U.RAO>>09000000
IF NEXTDELIM = SEMICOLON THEN  <<SOME PARAMETERS EVIDENTLY EXIST>>      09002000
   IF NOT PROCKEY THEN RETURN;                                 <<U.RAO>>09004000
                                                               <<U.RAO>>09006000
<<At this point we have parsed the entire command.  If we made it   >>  09008000
<<this far, there are no obvious problems.  All parameters have been>>  09010000
<<put into the appropriate forms and saved in local variables by the>>  09012000
<<appropriate names.  It remains but to build the entry and         >>  09014000
<<insert it in the Job Directory Table.                             >>  09016000
PARMNUM := 0;                                                  <<U.RAO>>09018000
                                                               <<02569>>09020000
<< Device flag set only if one of the components is present >> <<02569>>09022000
FLAGDEV := FLAGADEV LOR FLAGDENS LOR FLAGENV LOR FLAGOUTQ;     <<02569>>09024000
                                                               <<02569>>09026000
WENTRY := FLAGS1;  <<PMASK WORD 1>>                            <<U.RAO>>09028000
WENTRY(1) := FLAGS2;  <<SECOND WORD OF PMASK>>                 <<U.RAO>>09030000
WENTRY(2) := 0;   <<NAME AND DEVICE LENGTH AND KEYWORD LEN>>   <<01549>>09032000
IF FLAGANAME THEN  <<ACTUAL DESIGNATOR PRESENT>>               <<U.RAO>>09034000
   BEGIN                                                       <<U.RAO>>09036000
   BENTRY(4) := ACTUALDESLEN;                                  <<U.RAO>>09038000
   MOVE BENTRY(NEXTENTRYX) := ACTUALDES, (ACTUALDESLEN);       <<U.RAO>>09040000
   NEXTENTRYX := NEXTENTRYX+INTEGER(ACTUALDESLEN);             <<U.RAO>>09042000
   END;                                                        <<U.RAO>>09044000
IF FLAGDEV THEN                                                <<02569>>09046000
   BEGIN           << SOME DEVICE INFO SPECIFIED >>            <<02569>>09048000
   IF FLAGADEV THEN                                            <<02569>>09050000
      BEGIN        << DEVICE NAME SPECIFIED >>                 <<02569>>09052000
   MOVE BENTRY(NEXTENTRYX) := DEV, (DEVLEN);                   <<U.RAO>>09054000
   NEXTENTRYX := NEXTENTRYX+DEVLEN;                            <<U.RAO>>09056000
      END;                                                     <<02569>>09058000
   IF FLAGDENS THEN                                            <<02569>>09060000
      BEGIN                                                    <<02569>>09062000
          MOVE BENTRY(NEXTENTRYX) := ";DEN=";                  <<02569>>09064000
          NEXTENTRYX := NEXTENTRYX + 5;                        <<02569>>09066000
          MOVE BENTRY(NEXTENTRYX) := DENS, (DENSLEN);          <<02569>>09068000
          NEXTENTRYX := NEXTENTRYX + DENSLEN;                  <<02569>>09070000
          KEYS'LEN := KEYS'LEN + DENSLEN + 5;                  <<02569>>09072000
      END;                                                     <<02569>>09074000
   IF FLAGENV THEN                                             <<01851>>09076000
      BEGIN                                                    <<01851>>09078000
         MOVE BENTRY(NEXTENTRYX) := ";ENV=";                   <<01851>>09080000
         NEXTENTRYX := NEXTENTRYX + 5;                         <<01851>>09082000
         MOVE BENTRY(NEXTENTRYX) := ENV,(ENVLEN);              <<01851>>09084000
         NEXTENTRYX := NEXTENTRYX + ENVLEN;                    <<01851>>09086000
         KEYS'LEN := KEYS'LEN + ENVLEN + 5;                    <<02569>>09088000
      END;                                                     <<01851>>09090000
   IF FLAGOUTQ THEN                                            <<01851>>09092000
      BEGIN                                                    <<01851>>09094000
         MOVE BENTRY(NEXTENTRYX) := ";OUTQ=";                  <<01851>>09096000
         NEXTENTRYX := NEXTENTRYX + 6;                         <<01851>>09098000
         MOVE BENTRY(NEXTENTRYX) := OUTQ,(OUTQLEN);            <<01851>>09100000
         NEXTENTRYX := NEXTENTRYX + OUTQLEN;                   <<01851>>09102000
         KEYS'LEN := KEYS'LEN + OUTQLEN + 6;                   <<01851>>09104000
      END;                                                     <<01851>>09106000
   IF KEYS'LEN <> 0 THEN                                       <<01851>>09108000
      BEGIN                                                    <<01851>>09110000
         KEYS'LEN := KEYS'LEN + 1;                             <<01851>>09112000
         BENTRY(NEXTENTRYX) := %15;                            <<01851>>09114000
         NEXTENTRYX := NEXTENTRYX + 1;                         <<01851>>09116000
      END;                                                     <<01851>>09118000
   BENTRY(5) := DEVLEN + KEYS'LEN;                             <<01851>>09120000
   END;                                                        <<U.RAO>>09122000
<<THIS ENDS THE VARIABLE PORTIONS OF THE WENTRY>>              <<U.RAO>>09124000
X := (NEXTENTRYX+1)&LSR(1);  <<WORD OFFSET FROM WENTRY BASE>>  <<U.RAO>>09126000
WENTRY(X) := FOPTIONS;                                         <<U.RAO>>09128000
WENTRY(X:=X+1) := AOPTIONS;                                    <<U.RAO>>09130000
TOS := NUMBUFFERS&LSL(8);                                      <<U.RAO>>09132000
TOS.(8:5) := INITALLOC;                                        <<U.RAO>>09134000
WENTRY(X:=X+1) := TOS LOR LOGICAL(DISPOSITION);                <<U.RAO>>09136000
WENTRY(X:=X+1) := RECSIZE;                                     <<U.RAO>>09138000
WENTRY(X:=X+1) := LOGICAL(NUMEXTENTS)&LSL(11) LOR LOGICAL(BLOCKFACTOR); 09140000
TOS := FILESIZE;                                               <<U.RAO>>09142000
ASSEMBLE(XCH);                                                 <<U.RAO>>09144000
WENTRY(X:=X+1) := TOS;  <<FIRST WORD OF FILESIZE>>             <<U.RAO>>09146000
WENTRY(X:=X+1) := TOS;  <<SECOND WORD>>                        <<U.RAO>>09148000
WENTRY(X:=X+1) := FILECODE;                                    <<U.RAO>>09150000
WENTRY(X:=X+1) := (LOGICAL(OUTPRI)&LSL(7)LOR LOGICAL(NUMCOPIES))&LSL(5);09152000
      WENTRY(X:=X+1) := 0;  <<USER LABELS COUNT>>              <<U.RAO>>09154000
      WENTRY(X:=X+1) := FORMSMSGLEN + TAPELABELLEN;            <<U.RAO>>09156000
      IF WENTRY(X) <> 0 THEN                                   <<U.RAO>>09158000
         BEGIN  <<MOVE IN OPTIONAL DATA>>                      <<U.RAO>>09160000
         TOS := (@WENTRY(X)+1)&LSL(1);  <<BYTE ADDRESS>>       <<U.RAO>>09162000
         IF FORMSMSGLEN<>0 THEN   <<MOVE IN FORMS MESSAGE>>    <<U.RAO>>09164000
            MOVE * := FORMSMSG, (FORMSMSGLEN), 2;              <<U.RAO>>09166000
         IF TAPELABELLEN<>0 THEN   <<MOVE IN TAPE LABEL DATA>> <<U.RAO>>09168000
            BEGIN                                              <<U.RAO>>09170000
            IF FORMSMSGLEN=0 THEN   <<MUST INSERT ".">>        <<U.RAO>>09172000
               BEGIN                                           <<U.RAO>>09174000
               BPS0 := ".";                                    <<U.RAO>>09176000
               TOS := TOS+1;                                   <<U.RAO>>09178000
               WENTRY(X) := WENTRY(X)+1;                       <<U.RAO>>09180000
               FORMSMSGLEN := 1;                               <<U.RAO>>09182000
               END;                                            <<U.RAO>>09184000
            MOVE * := TAPELABEL,(TAPELABELLEN),2;              <<U.RAO>>09186000
            BPS0 := ";";                                       <<U.RAO>>09188000
            WENTRY(X) := WENTRY(X)+1;                          <<U.RAO>>09190000
            TAPELABELLEN := TAPELABELLEN+1;                    <<U.RAO>>09192000
            END;                                               <<U.RAO>>09194000
         DEL;                                                  <<U.RAO>>09196000
         X := X+(FORMSMSGLEN+TAPELABELLEN+1)&LSR(1);           <<U.RAO>>09198000
         END;                                                  <<U.RAO>>09200000
IF PARSE'ONLY THEN                                             <<01200>>09202000
   BEGIN                                                       <<01200>>09204000
   << COPY LOCAL TABLE ENTRY OVER THE STRING PASSED TO     >>  <<01200>>09206000
   << PARSE'FILE'EQ.  THIS RETURNS THE PARSED FILE         >>  <<01200>>09208000
   << EQUATION INFO TO THE CALLER.                         >>  <<01200>>09210000
   X := (X+1) * 2;                                             <<01200>>09212000
   MOVE PARMSP := BENTRY, (X);                                 <<01200>>09214000
   END                                                         <<01200>>09216000
ELSE                                                           <<01200>>09218000
   BEGIN                                                       <<01200>>09220000
   << ADD TABLE ENTRY TO JDT >>                                <<01200>>09222000
   IF ADDJTENTRY(FORMALDES,GROUP,ACCT,-3,X+1,WENTRY) <> 0 THEN <<01200>>09224000
      CIERR(ERRNUM := FEQTABFULLXPLCT);  << INSERT FAILED >>   <<01200>>09226000
   END;                                                        <<01200>>09228000
RETURN;                                                        <<U.RAO>>09230000
                                                               <<U.RAO>>09232000
<<  ***  END OF CXFILE  ***   >>                               <<U.RAO>>09234000
                                                               <<U.RAO>>09236000
<<  ***   CXBUILD   ***  >>                                    <<U.RAO>>09238000
CXBUILD:                                                       <<U.RAO>>09240000
                                                               <<U.RAO>>09242000
<<This differs from the procedure for the FILE command primarily>>      09244000
<<in that we do an FOPEN instead of calling jobtables.          >>      09246000
                                                               <<U.RAO>>09248000
BUILDFLAG := TRUE;                                             <<U.RAO>>09250000
PARSE'ONLY := FALSE;                                           <<01255>>09252000
FOPTIONS := %2000;   <<DISALLOWS FILE EQUATES  >>              <<U.RAO>>09254000
PARMNUM := 0;                                                  <<U.RAO>>09256000
MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARMS);                  <<U.RAO>>09258000
IF NUMPARMS=0 THEN  <<LACKS REQUIRED FILE NAME>>               <<U.RAO>>09260000
   BEGIN                                                       <<U.RAO>>09262000
   PARMNUM := 1;                                               <<U.RAO>>09264000
   CIERR(ERRNUM := BLDREQFILENAME, PARMSP(1));                 <<U.RAO>>09266000
   END                                                         <<U.RAO>>09268000
ELSE IF BLDCHECKFDESIG THEN  <<FILE NAME IS VALID>>            <<U.RAO>>09270000
IF NEXTDELIM=COMMA THEN   <<DOMAIN NOT APPROPRIATE>>           <<U.RAO>>09272000
   BEGIN                                                       <<U.RAO>>09274000
   GETNEXT;                                                    <<U.RAO>>09276000
   CIERR(ERRNUM := BLDDOMAINNOT,PARMPTR);                      <<U.RAO>>09278000
   END                                                         <<U.RAO>>09280000
ELSE IF NEXTDELIM=EQUALS THEN  <<ACTUAL DESIGNATOR NOT APPROPRIATE>>    09282000
   BEGIN                                                       <<U.RAO>>09284000
   GETNEXT;                                                    <<U.RAO>>09286000
   CIERR(ERRNUM := BLDNOTADES,PARMPTR);                        <<U.RAO>>09288000
   END                                                         <<U.RAO>>09290000
ELSE  <<NAME SEEMS OK>>                                        <<U.RAO>>09292000
   BEGIN                                                       <<U.RAO>>09294000
   IF NEXTDELIM=SEMICOLON THEN  <<APPARENTLY KEYWORD LIST FOLLOWS>>     09296000
      IF NOT PROCKEY THEN   <<PARSE OF KEYWORD LIST FAILED>>   <<U.RAO>>09298000
         RETURN;                                               <<U.RAO>>09300000
   <<NOW JUST DO BUILD - FOPEN, FOLLOWED BY FCLOSE>>           <<U.RAO>>09302000
   SAVEDELIM := DEV(DEVLEN);                                   <<02053>>09304000
   DEV(DEVLEN) := %15; <<GET'DEV'PARMS WILL NOT GET CONFUSED >><<01835>>09306000
   IF FILECODE = 1090 THEN                                     <<00506>>09308000
      BEGIN                                                    <<00506>>09310000
      BLOCKFACTOR:=32;                                         <<00506>>09312000
      FOPTIONS.(13:1):=1;                                      <<00506>>09314000
      RECSIZE:=-256;                                           <<00506>>09316000
      IF NUMEXTENTS <= 0 THEN NUMEXTENTS:=1;                   <<00506>>09318000
      TOS:=FILESIZE:=FILESIZE+DOUBLE(BLOCKFACTOR);             <<00506>>09320000
      FILESIZE:=FILESIZE/DOUBLE(BLOCKFACTOR*NUMEXTENTS);       <<00506>>09322000
      TOS:=NUMEXTENTS*BLOCKFACTOR;                             <<00506>>09324000
      ASSEMBLE(DIVL);                                          <<00506>>09326000
      IF TOS <> 0 THEN FILESIZE:=FILESIZE+1D;                  <<00506>>09328000
      ASSEMBLE(DEL);                                           <<00506>>09330000
      FILESIZE:=FILESIZE*DOUBLE((BLOCKFACTOR)*NUMEXTENTS);     <<00506>>09332000
      FILESIZE:=FILESIZE-DOUBLE(BLOCKFACTOR);                  <<00506>>09334000
      FLAGBLOCKFACTOR:=1;                                      <<00506>>09336000
      END;                                                     <<00506>>09338000
   TOS := 0;  <<RETURN SPACE FOR FOPEN>>                       <<U.RAO>>09340000
   TOS := @FORMALDES;                                          <<U.RAO>>09342000
   TOS := FOPTIONS;                                            <<U.RAO>>09344000
   TOS := %100;   <<EXCLUSIVE ACCESS>>                         <<U.RAO>>09346000
   TOS := RECSIZE;                                             <<U.RAO>>09348000
   TOS := @DEV;                                                <<U.RAO>>09350000
   TOS := 0;  <<FORMS MESSAGE>>                                <<U.RAO>>09352000
   TOS := 0;   <<USER LABELS>>                                 <<U.RAO>>09354000
   TOS := BLOCKFACTOR;                                         <<U.RAO>>09356000
   TOS := 1;   <<NUMBER OF BUFFERS FOR OPEN>>                  <<U.RAO>>09358000
   TOS := FILESIZE;                                            <<U.RAO>>09360000
   TOS := NUMEXTENTS;                                          <<U.RAO>>09362000
   TOS := INITALLOC;                                           <<U.RAO>>09364000
   TOS := FILECODE;                                            <<U.RAO>>09366000
   <<NOW DO OPTION VARIABLE MASK>>                             <<U.RAO>>09368000
   TOS := %16020;   <<PROTOTYPE SPL OPTION VAR MASK>>          <<U.RAO>>09370000
   TOS.(6:1)  := FLAGRECSIZE;                                  <<U.RAO>>09372000
   TOS.(7:1)  := FLAGADEV;                                     <<02569>>09374000
   TOS.(10:1) := FLAGBLOCKFACTOR;                              <<U.RAO>>09376000
   TOS.(12:1) := FLAGFILESIZE;                                 <<U.RAO>>09378000
   TOS.(13:1) := FLAGNUMEXTS;                                  <<U.RAO>>09380000
   TOS.(14:1) := FLAGINITALLOC;                                <<U.RAO>>09382000
   TOS.(15:1) := FLAGFILECODE;                                 <<U.RAO>>09384000
   <<MASK IS COMPLETE, ALL PARMS STACKED.>>                    <<U.RAO>>09386000
   ASSEMBLE(PCAL DFOPEN);                                      <<00200>>09388000
   IF CARRY THEN                                               <<U.RAO>>09390000
      BEGIN  <<OPEN FAILED ON NEW FILE>>                       <<U.RAO>>09392000
      FERROR'(*, PARMNUM);                                     <<U.RAO>>09394000
      QUALIFYFILENAME(FORMALDES, BENTRY);                      <<U.RAO>>09396000
      CIERR(ERRNUM := BLDFAILED,,0,@BENTRY);                   <<U.RAO>>09398000
      END                                                      <<U.RAO>>09400000
   ELSE                                                        <<U.RAO>>09402000
      BEGIN  <<TRY CLOSE>>                                     <<U.RAO>>09404000
      FCLOSE(S0,DISPOSITION,0);                                <<U.RAO>>09406000
      IF CARRY THEN                                            <<U.RAO>>09408000
         BEGIN                                                 <<U.RAO>>09410000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>09412000
         QUALIFYFILENAME(FORMALDES,BENTRY);                    <<U.RAO>>09414000
         CIERR(ERRNUM := BLDFAILED,,0,@BENTRY);                <<U.RAO>>09416000
         END;                                                  <<U.RAO>>09418000
      END;                                                     <<U.RAO>>09420000
   DEV(DEVLEN) := SAVEDELIM;                                   <<02053>>09422000
   END;                                                        <<U.RAO>>09424000
END;   <<PROCEDURE CXFILE/CXBUILD>>                            <<U.RAO>>09426000
                                                                        09428000
$PAGE   "FILE MANAGEMENT COMMAND EXECUTORS--RESET,SAVE,PURGE,RENAME"    09430000
$CONTROL   SEGMENT  =  CICOMSYS                                         09432000
                                                               <<DS0.0>>09434000
COMMENT                                                        <<01452>>09436000
THIS PROCEDURE CREATES THE DSCOPY PROCESS AND PASSES TO IT THE <<01452>>09438000
NECESSARY INFORMATION. THE COMMAND STRING IS PASSED USING THE  <<01452>>09440000
"INFO" FACILITY IN CREATEPROCESS.                              <<01452>>09442000
;                                                              <<01452>>09444000
                                                               <<01452>>09446000
PROCEDURE CXDSCOPY EXECUTORHEAD;                               <<01452>>09448000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01452>>09450000
                                                               <<01452>>09452000
BEGIN                                                          <<01452>>09454000
ARRAY NAME'(0:7);                                              <<01452>>09456000
BYTE ARRAY NAME(*) = NAME';                                    <<01452>>09458000
INTEGER PIN,                                                   <<01452>>09460000
        LEN,                                                   <<01452>>09462000
        ERROR;                                                 <<01452>>09464000
ARRAY ITEMCODES(0:10);                                         <<01452>>09466000
ARRAY ITEMS(0:10);                                             <<01452>>09468000
BYTE POINTER TEMPBP;  << POINTER TO PARAMETER STRING >>        <<01452>>09470000
                                                               <<01452>>09472000
EQUATE                                                         <<01452>>09474000
  UNKNOWN'PROG    =  6;   << CREATEPROC. CAN'T FIND PROGRAM >> <<01452>>09476000
                                                               <<01452>>09478000
<< GET ADDRESS AND LENGTH OF PARAMETER STRING >>               <<01452>>09480000
SCAN PARMSP WHILE %6440,1;  << CR, BLANK >>                    <<01452>>09482000
IF CARRY THEN   << ALL BLANKS >>                               <<01452>>09484000
   BEGIN                                                       <<01452>>09486000
   DEL;                                                        <<01452>>09488000
   @TEMPBP := @PARMSP;                                         <<01452>>09490000
   LEN := 0;                                                   <<01452>>09492000
   END                                                         <<01452>>09494000
ELSE                                                           <<01452>>09496000
   BEGIN        << SOMETHING THERE >>                          <<01452>>09498000
   @TEMPBP := TOS;                                             <<01452>>09500000
   SCAN TEMPBP UNTIL %15,1;  << CR >>                          <<01452>>09502000
   LEN := TOS - @TEMPBP;                                       <<01452>>09504000
   END;                                                        <<01452>>09506000
                                                               <<01452>>09508000
MOVE NAME := "DSCOPY.PUB.SYS ";                                <<01452>>09510000
                                                               <<01452>>09512000
MOVE ITEMCODES := (3, << FLAGS >>                              <<01452>>09514000
                  11, << INFO STRING ADDRESS >>                <<01452>>09516000
                  12, << INFO STRING LENGTH >>                 <<01452>>09518000
                   0);                                         <<01452>>09520000
                                                               <<01452>>09522000
ITEMS(0) := 1;                                                 <<01452>>09524000
ITEMS(1) := @TEMPBP;                                           <<01452>>09526000
ITEMS(2) := LEN;                                               <<01452>>09528000
ITEMS(3) := 0;                                                 <<01452>>09530000
                                                               <<01452>>09532000
SETJCW(GETJCW LAND %37777);  << CLEAR ABORT BITS >>            <<01452>>09534000
                                                               <<01452>>09536000
CREATEPROCESS (ERROR, PIN, NAME, ITEMCODES, ITEMS);            <<01452>>09538000
IF < THEN                                                      <<01452>>09540000
   BEGIN         << ERROR. PROCESS NOT CREATED >>              <<01452>>09542000
   NAME(6) := 0;                                               <<01452>>09544000
   IF ERROR = UNKNOWN'PROG THEN                                <<01452>>09546000
      CIERR( ERRNUM := SUBSNOTFOUND, , 0, @NAME )              <<01452>>09548000
   ELSE                                                        <<01452>>09550000
      BEGIN                                                    <<01452>>09552000
      CREATEPROC'ERR( ERROR, ERRNUM );                         <<01452>>09554000
      CIERR( ERRNUM := SUBSNOTCREATE, , 0, @NAME );            <<01452>>09556000
      END;                                                     <<01452>>09558000
   END                                                         <<01452>>09560000
ELSE                                                           <<01452>>09562000
   BEGIN                                                       <<01452>>09564000
   << CHECK FOR CREATEPROCESS WARNING. >>                      <<01452>>09566000
   IF > THEN CREATEPROC'ERR( -ERROR, ERRNUM );                 <<01452>>09568000
                                                               <<01452>>09570000
   AWAKE( PIN * PCBSIZE, 1, 2 );                               <<01452>>09572000
   CISUBSYSFINISH( 3, ERRNUM, PARMNUM );                       <<01452>>09574000
   END;                                                        <<01452>>09576000
                                                               <<01452>>09578000
END;  << CXDSCOPY >>                                           <<01452>>09580000
                                                               <<01452>>09582000
PROCEDURE CXRFAD EXECUTORHEAD;                                 <<DS0.0>>09584000
OPTION PRIVILEGED,UNCALLABLE;                                  <<DS0.0>>09586000
BEGIN                                                          <<DS0.0>>09588000
<<  DUMMY PROCEDURE FOR COMMANDS "REMOTE", "DSLINE", AND "RFA".         09590000
    IF THE DS/3000 SUBSYSTEM RESIDES IN THE SYSTEM THE PLABELS          09592000
    WILL BE LOCATED IN SYSTEM DB LOCATIONS 360,361, AND 362.            09594000
    IF THE PLABEL IS ZERO THE SUBSYSTEM IS NOT PRESENT AND THE          09596000
    CORRESPONDING CI ERROR NUMBER IS REPORTED.  IF THE LABEL DOES       09598000
    EXIST THE RESPECTIVE PROCEDURE IS CALLED TO PROCESS THE COMMAND.    09600000
                                                                        09602000
                                                                      >>09604000
     ENTRY                                                     <<DS0.0>>09606000
        CXDSLINED,                                             <<DS0.0>>09608000
        CXREMOTED;                                             <<DS0.0>>09610000
                                                               <<DS0.0>>09612000
     ERRNUM := 1;                                              <<DS0.0>>09614000
    CXDSLINED:                                                 <<DS0.0>>09616000
     ERRNUM := ERRNUM + 1;                                     <<DS0.0>>09618000
    CXREMOTED:                                                 <<DS0.0>>09620000
     ERRNUM := ERRNUM + %1342;                                 <<DS0.0>>09622000
     TOS := @PARMSP;                                           <<DS0.0>>09624000
     TOS := @ERRNUM;                                           <<DS0.0>>09626000
     TOS := @PARMNUM;                                          <<DS0.0>>09628000
     TOS := ABSOLUTE(ERRNUM);                                  <<DS0.0>>09630000
     IF <> THEN                                                <<DS0.0>>09632000
        BEGIN                                                  <<DS0.0>>09634000
           ERRNUM := 0;                                        <<DS0.0>>09636000
           ASSEMBLE(PCAL 0);                                   <<DS0.0>>09638000
        END                                                    <<DS0.0>>09640000
        ELSE                                                   <<DS0.0>>09642000
             CIERR(ERRNUM := DSSUBSNOTFOUND);                  <<U.RAO>>09644000
END;                                                           <<DS0.0>>09646000
$CONTROL SEGMENT=CICOMSYS                                               09648000
                                                                        09650000
  <<This procedure calls the SHOWCOM command in CS>>                    09652000
                                                                        09654000
  PROCEDURE CXSHOWCOM EXECUTORHEAD;                                     09656000
    OPTION PRIVILEGED,UNCALLABLE;                                       09658000
    BEGIN                                                               09660000
      TOS:=0;                                                           09662000
      TOS:=@PARMSP;                                                     09664000
      TOS:=@ERRNUM;                                                     09666000
      TOS:=@PARMNUM;                                                    09668000
      TOS:=ABSOLUTE(SYSDB+PLAB'SHOWCOM);                                09670000
      IF < THEN ASSEMBLE(PCAL 0)                                        09672000
           ELSE ASSEMBLE(DDEL,DDEL);                                    09674000
    END;                                                                09676000
                                                                        09678000
PROCEDURE CXCLINE EXECUTORHEAD;                                         09680000
   OPTION PRIVILEGED,UNCALLABLE;                               <<02317>>09682000
BEGIN                                                                   09684000
<< Note that this command, CLINE, is really part of the CS >>  <<U.RAO>>09686000
<< subsystem.                                   >>             <<01165>>09688000
<< September 1, 1978        Bob Gerstmyer          >>          <<01165>>09690000
     INTEGER NUMPARMS;                                                  09692000
     EQUATE MAXPARMS = 50,                                              09694000
            PARMSIZE = MAXPARMS - 1;                                    09696000
     DOUBLE ARRAY PARMS(0:PARMSIZE);                                    09698000
     LBPARMDECS;                                                        09700000
     DOUBLE PRAM;                                                       09702000
   BYTE POINTER PARMPTR;   << POINTER TO CURRENT PARAMETER >>  <<01165>>09704000
   INTEGER PARMLEN,    << LENGTH OF CURRENT PARAMETER >>       <<01165>>09706000
      NEXTDELIM;   << DELIMITER FOLLOWING CURRENT PARAMETER >> <<01165>>09708000
     LOGICAL T3;                                               <<01165>>09710000
   INTEGER BINARYDIGIT,        << USED BY BINARY INTRINSIC >>  <<01165>>09712000
      ENTRYNUM, T1, PARM'INDX;                                 <<01165>>09714000
     LOGICAL NOTFINISHED = T3,                                 <<01165>>09716000
         MOREPARMS := FALSE;<< NEED TO CALL MYCOMMAND AGAIN >> <<01165>>09718000
     LOGICAL                                                   <<01165>>09720000
         LASTPARM'DONE,<<TRUE IF LAST PARM FOR THIS KEY DONE>> <<01165>>09722000
          FLAGS := 0,                                          <<01165>>09724000
          FLAGS1 := 0,                                         <<01165>>09726000
          FLAGS2 := 0,                                         <<01165>>09728000
          COPTIONS := 0,                                       <<01165>>09730000
          AOPTIONS := 0,                                       <<01165>>09732000
          DOPTIONS := 0,                                       <<01165>>09734000
          BUFFSIZE := 0,                                       <<01165>>09736000
          NUMBUFFERS := 0,                                     <<01165>>09738000
          CTRACEINFO := 0;                                     <<01165>>09740000
     INTEGER                                                   <<01165>>09742000
          DEVLEN := 0,                                         <<01165>>09744000
          MISCLEN := 0,                                        <<01165>>09746000
          LOCIDLEN := 0,                                       <<01165>>09748000
          REMIDLEN := 0,                                       <<01165>>09750000
          DRIVERLEN := 0,                                      <<01165>>09752000
          SUPLISTLEN := 0,                                     <<01165>>09754000
          PHLISTLEN := 0,                                      <<01165>>09756000
          POLLISTLEN := 0;                                     <<01165>>09758000
   INTEGER STRINGLEN := 0,PHLISTNUM := 0;                      <<01165>>09760000
     DOUBLE                                                    <<01165>>09762000
          INSPEED := 0D,                                       <<01165>>09764000
          OUTSPEED := 0D;                                      <<01165>>09766000
     INTEGER I,LOC,LEN,LISTLEN,SEQNUM,SEQTYPE,                 <<01165>>09768000
             DIGITYPE,STRINGTYPE;                              <<01165>>09770000
   EQUATE ERRNAME=%176;                                        <<01165>>09772000
     EQUATE                                                    <<01165>>09774000
          PKEYLISTL     = 170,                                 <<01165>>09776000
          PDELIMITERSL  =   6;                                 <<01165>>09778000
     EQUATE                                                    <<01165>>09780000
          CODEMAX      = 63,                                   <<01165>>09782000
          LMODEMAX     = 15,                                   <<01165>>09784000
          PROTOMAX     = 255;                                  <<01165>>09786000
     EQUATE                                                    <<01165>>09788000
          MAXPHONELEN    = 20,                                 <<01165>>09790000
          MAXIDSEQLEN    = 16,                                 <<01165>>09792000
          MAXCOMPSEQLEN  =  7;                                 <<01165>>09794000
     EQUATE                                                    <<01165>>09796000
        << DELIMITER INDICES >>                                <<01165>>09798000
        COMMA      = 0,                                        <<01165>>09800000
        EQUALS     = 1,                                        <<01165>>09802000
        SEMICOLON  = 2,                                        <<01165>>09804000
        QUOTE      = 3,                                        <<01165>>09806000
        LEFTPAREN  = 4,                                        <<01165>>09808000
        RIGHTPAREN = 5,                                        <<01165>>09810000
        CR         = 6,                                        <<01165>>09812000
          STRING      = 0,                                     <<01165>>09814000
          DIGITS      = 1,                                     <<01165>>09816000
          HEX         = 0,                                     <<01165>>09818000
          OCTAL       = 1,                                     <<01165>>09820000
          ASCII       = 0,                                     <<01165>>09822000
          EBCDIC      = 1,                                     <<01165>>09824000
          TOEBCDIC    = 2;                                     <<01165>>09826000
     EQUATE CARRIAGERETURN = %15;                              <<01165>>09828000
     EQUATE                                                    <<01165>>09830000
          STARTOFPTRS      = 30,                               <<01165>>09832000
          LOCIDPTR         = STARTOFPTRS,                      <<01165>>09834000
          REMIDPTR         = LOCIDPTR + 1,                     <<01165>>09836000
          SUPLISTPTR       = REMIDPTR + 1,                     <<01165>>09838000
          PHLISTPTR        = SUPLISTPTR + 1,                   <<01165>>09840000
          POLLISTPTR       = PHLISTPTR + 1,                    <<01165>>09842000
          MISCPTR          = POLLISTPTR + 1,                   <<01165>>09844000
          STARTOFLISTS     = MISCPTR + 1,                      <<01165>>09846000
          MINENTRYSIZE1    = 7,                                <<01165>>09848000
          MINENTRYSIZE2    = STARTOFLISTS;                     <<01165>>09850000
     LOGICAL POINTER MISC,POLLIST;                             <<01165>>09852000
   EQUATE                                                      <<01165>>09854000
      CLN'DIALVAL       = 1769,   << EXPECT W,R,RW,NO OR 1-3 >><<01165>>09856000
      CLN'LMODEVAL   = 1769,  << EXPECT PRI,SEC,MPCNT,MPSEC,DTE,DCE >>  09858000
      CLN'CODEVAL    = 1769,  << EXPECT >>                     <<01165>>09860000
      CLN'DUALVAL    = 1769,  << EXPECT LOW OR HIGH >>         <<01165>>09862000
      CLN'PROTOVAL   = 1769,  << EXPECT BSC, MRJE, OR HPDLCI >><<01165>>09864000
      CLN'XPCTCOMMA  = 1769,  << EXPECT COMMA >>               <<01165>>09866000
      CLN'XPCTSEMIC  = 1769,  << EXPECT SEMICOLON >>           <<01165>>09868000
      CLN'XPCTQUOTE   = 1769,   << EXPECT QUOTE >>             <<01165>>09870000
      CLN'XPCT1ALPHA  = 1769,   << EXPECT A,E,O,H >>           <<01165>>09872000
       CLNUNDEFKEYVAL  =  1769,                                <<01165>>09874000
       CLN2MP          =  1769,                                <<01165>>09876000
       CLNPARM2LONG    =  1769,                                <<01165>>09878000
       CLNBADELIMITER  =  1769,                                <<01165>>09880000
      CLN'UNDEFKEYVAL  =  1769,                                <<01165>>09882000
      CLNXPCTASTRSK    =  1769,                                <<01165>>09884000
      CLN'XPCTPAREN   =  1769,                                 <<01165>>09886000
      CLNXPCTKEYVAL   =  1769,   << KEY VALUE EXPECTED >>      <<01165>>09888000
      CLN'XPCTQU'PAR  = 1769;   << EXPECT QUOTE OR PAREN FOR STRING >>  09890000
                                                               <<01165>>09892000
     LOGICAL POINTER WFENTRY;                                  <<01165>>09894000
     BYTE POINTER FENTRY;                                      <<01165>>09896000
     BYTE ARRAY PDELIMITERS(*)=PB:=",=;""()";                  <<01165>>09898000
     BYTE ARRAY PKEYLIST (*) = PB :=                           <<01165>>09900000
          5,3,"DEV",        << KEY WORDS RECOGNIZED >>         <<01165>>09902000
          6,4,"MISC",                                          <<01165>>09904000
          5,3,"BUF",                                           <<01165>>09906000
          6,4,"DIAL",                                          <<01165>>09908000
          7,5,"PROTO",                                         <<01165>>09910000
          6,4,"CODE",                                          <<01165>>09912000
          6,4,"DUAL",                                          <<01165>>09914000
          7,5,"LMODE",                                         <<01165>>09916000
          8,6,"DRIVER",                                        <<01165>>09918000
          7,5,"SPEED",                                         <<01165>>09920000
         10,8,"DOPTIONS",                                      <<01165>>09922000
          7,5,"TRACE",                                         <<01165>>09924000
          9,7,"NOTRACE",                                       <<01165>>09926000
          6,4,"NOID",                                          <<01165>>09928000
         10,8,"TIMEOUTS",                                      <<01165>>09930000
         12,10,"NOTIMEOUTS",                                   <<01165>>09932000
          4,2,"ID",                                            <<01165>>09934000
          7,5,"LOCID",                                         <<01165>>09936000
          7,5,"REMID",                                         <<01165>>09938000
          9,7,"POLLIST",                                       <<01165>>09940000
          8,6,"PHLIST",                                        <<01165>>09942000
         10,8,"DOWNFILE",                                      <<01165>>09944000
         9,7,"SUPLIST",                                        <<01165>>09946000
          0;                                                   <<01165>>09948000
     BYTE ARRAY KEYLIST(0:PKEYLISTL);                          <<01165>>09950000
     BYTE ARRAY DELIMITERS(0:PDELIMITERSL);                    <<01165>>09952000
     BYTE ARRAY N1(0:1),N2(*)=N1;                              <<01165>>09954000
     BYTE POINTER                                              <<01165>>09956000
          DEV,                                                 <<01165>>09958000
          LIST,                                                <<01165>>09960000
          LOCID,                                               <<01165>>09962000
          REMID,                                               <<01165>>09964000
          SUPLIST,                                             <<01165>>09966000
          PHLIST,                                              <<01165>>09968000
          DRIVER,                                              <<01165>>09970000
          FORMDES,                                             <<01165>>09972000
          BACKREFNAME;                                         <<01165>>09974000
     DEFINE  << PARTIAL FIELDS >>                              <<01165>>09976000
          DIALFLD     = (12: 2)#,                              <<01165>>09978000
          CODEFLD     = (10: 6)#,                              <<01165>>09980000
          DUALFLD     = ( 4: 2)#,                              <<01165>>09982000
          LMODEFLD    = ( 6: 4)#,                              <<01165>>09984000
          PROTOFLD    = ( 0: 8)#,                              <<01165>>09986000
          INHIBTOUT   = ( 0: 1)#,                              <<01165>>09988000
          TRACEWRAP   = ( 1: 1)#,                              <<01165>>09990000
          DELIMTYPE   = (11: 5)#,                              <<01165>>09992000
          TRACESPEC   = ( 2: 1)#,                              <<01165>>09994000
          TRACETYPE   = ( 0: 1)#,                              <<01165>>09996000
          TRACEMASK   = ( 2:9)#,                                        09998000
          TRACENTNUM  = (11:5)#,                                        10000000
          INHIBIDSEQ  = ( 1: 1)#;                              <<01165>>10002000
                                                               <<01165>>10004000
SUBROUTINE CEXIT(ERRORVALUE);                                  <<01165>>10006000
VALUE ERRORVALUE; INTEGER ERRORVALUE;                          <<01165>>10008000
   BEGIN             << EXIT WITH ERROR >>                     <<01165>>10010000
   CIERR(ERRNUM := ERRORVALUE,PARMPTR);                        <<01165>>10012000
   ASSEMBLE (EXIT 3);                                          <<01165>>10014000
   END;                                                        <<01165>>10016000
                                                               <<01165>>10018000
SUBROUTINE MOVESTRING;                                         <<01165>>10020000
   << MOVE STRING POINTED TO BY PARMPTR TO LIST(LOC) >>        <<01165>>10022000
   BEGIN                                                       <<01165>>10024000
   IF STRINGTYPE = ASCII THEN                                  <<01165>>10026000
      MOVE LIST(LOC) := PARMPTR , (PARMLEN)                    <<01165>>10028000
   ELSE CTRANSLATE(TOEBCDIC,PARMPTR,LIST(LOC),PARMLEN);        <<01165>>10030000
   TOS := PARMLEN;     << ADD INTEGER TO BYTE VALUE BELOW >>   <<01165>>10032000
   LIST(LEN) := TOS + LIST(LEN);   << ADD PARAMETER LENGTH >>  <<01165>>10034000
   LOC := LOC + PARMLEN;                                       <<01165>>10036000
   STRINGLEN := STRINGLEN + PARMLEN;                           <<01165>>10038000
   END <<MOVESTRING>>;                                         <<01165>>10040000
                                                               <<01165>>10042000
SUBROUTINE CHECKNAME(ALLOWSPECIALS);                           <<01165>>10044000
VALUE ALLOWSPECIALS; LOGICAL ALLOWSPECIALS;                    <<01165>>10046000
   << CHECKS FORMALDESIGNATOR  - NO SPECIAL CHARS ALLOWED               10048000
             BACK REFERENCE    - SPECIAL CHARS ALLOWED                  10050000
   >>                                                          <<01165>>10052000
   BEGIN                                                       <<01165>>10054000
   IF PARMLEN = 0 THEN CEXIT(CLN'NO'NAME);                     <<01165>>10056000
   TOS:=PARMS(PARMNUM - 1);  << PARMNUM INCREMENTED ALREADY >> <<01165>>10058000
   TOS := TOS & LSR(5);     << SPECIAL CHAR INFO >>            <<01165>>10060000
   IF LS0 AND NOT ALLOWSPECIALS THEN                           <<01165>>10062000
        CEXIT(CLNMBEDSPECIALS);                                <<01165>>10064000
     TOS:=TOS & LSR(1);         << LOSE SPECIAL CHAR INFO >>   <<01165>>10066000
   IF LS0 THEN  <<NUMERICS>>                                   <<01165>>10068000
      IF PARMPTR = NUMERIC THEN CEXIT(CLNLEADINGNUM);          <<01165>>10070000
   IF PARMLEN > 8 THEN CEXIT(CLNNAME2LONG);                    <<01165>>10072000
   ASSEMBLE(DDEL);        <<DELETE PARMS>>                     <<01165>>10074000
END <<CHECKNAME>>;                                             <<01165>>10076000
                                                               <<01165>>10078000
SUBROUTINE TRYBINARYCONVERT(ERRVALUE);                         <<01165>>10080000
VALUE ERRVALUE; INTEGER ERRVALUE;                              <<01165>>10082000
   BEGIN                                                       <<01165>>10084000
   << ATTEMPTS TO CONVERT CURRENT PARAMETER USING BINARY INTRINSIC.     10086000
      IF NOT NUMERIC, THEN CEXIT WITH ERROR=ERRVALUE.                   10088000
      IF SUCCESSFUL, RESULT IS RETURNED IN BINARYDIGIT.            >>   10090000
   IF PARMPTR <> NUMERIC THEN CEXIT(ERRVALUE);                 <<01165>>10092000
   BINARYDIGIT := BINARY(PARMPTR,PARMLEN);                     <<01165>>10094000
   IF <> THEN CEXIT(CLNBADINT);                                <<01165>>10096000
   END;     << TRYBINARYCONVERT >>                             <<01165>>10098000
                                                               <<01165>>10100000
                                                               <<01165>>10102000
LOGICAL SUBROUTINE GETNEXTPARM;                                <<01165>>10104000
   << THIS SUBROUTINE EXTRACTS THE NEXT PARAMETER FROM PARMS AND        10106000
      DECOMPOSES THE MYCOMMAND RETURNED ENTRY. ALSO CHECKS FOR          10108000
      TOO MANY PARAMETER CASE.                                          10110000
   >>                                                          <<01165>>10112000
   BEGIN                                                       <<01165>>10114000
   IF PARMNUM >= NUMPARMS THEN                                 <<01165>>10116000
     IF MOREPARMS THEN      << MORE PARMS ARE AVAILABLE >>     <<01165>>10118000
      BEGIN                                                    <<01165>>10120000
        MYCOMMAND(PARMPTR(PARMLEN+1),DELIMITERS,MAXPARMS,      <<01165>>10122000
               NUMPARMS,PARMS);                                <<01165>>10124000
        IF = THEN MOREPARMS := FALSE;                          <<01165>>10126000
        PARMNUM := 0;                                          <<01165>>10128000
        END                                                    <<01165>>10130000
      ELSE RETURN;<<GETNEXTPARM=FALSE-NO MORE PARMS AVAILABLE>><<01165>>10132000
   GETNEXTPARM := TRUE;                                        <<01165>>10134000
   TOS := PARMS(PARMNUM);       << GET NEXT ENTRY >>           <<01165>>10136000
   NEXTDELIM := S0.DELIMTYPE;   << GET TRAILING DELIMITER >>   <<01165>>10138000
   PARMLEN := TOS & LSR(8);     << LENGTH OF ENTRY >>          <<01165>>10140000
   @PARMPTR := TOS;             << FIRST WORD OF MYCOMMAND ENTRY >>     10142000
   PARMNUM := PARMNUM + 1;                                     <<01165>>10144000
   IF PARMNUM > MAXPARMS THEN CEXIT(CLN2MP);   << TOO MANY PARA<<01165>>10146000
   END <<GETNEXTPARM>>;                                        <<01165>>10148000
                                                               <<01165>>10150000
SUBROUTINE CHECKBACKREF;                                       <<01165>>10152000
   BEGIN                                                       <<01165>>10154000
   << CHECKS BACK REFERENCED LINE DESIGNATOR.                           10156000
      PROCESSING ENDS IN THIS SUBROUTINE        >>             <<01165>>10158000
   GETNEXTPARM;                                                <<01165>>10160000
   IF PARMLEN = 0 THEN CEXIT(CLNREQADESIG);                    <<01165>>10162000
   IF PARMPTR <> "*" THEN CEXIT(CLNXPCTASTRSK);                <<01165>>10164000
   IF NUMPARMS > 2 THEN                                        <<01165>>10166000
      BEGIN                                                    <<01165>>10168000
      @PARMPTR := @PARMPTR + PARMLEN;   << UPDATE FOR CEXIT >> <<01165>>10170000
      CEXIT(CLNBREF2MP);                                       <<01165>>10172000
      END;                                                     <<01165>>10174000
    @BACKREFNAME := @BACKREFNAME + 1;                          <<01165>>10176000
    @PARMPTR := @PARMPTR + 1;       << MOVE PAST ASTERISK >>   <<01165>>10178000
    PARMLEN := PARMLEN - 1;                                    <<01165>>10180000
    CHECKNAME(ERRCLINEDESIG);                                  <<01165>>10182000
    PUSH(S); DUPLICATE;                                        <<01165>>10184000
    @WFENTRY := TOS;                                           <<01165>>10186000
    @FENTRY := TOS & LSL(1);                                   <<01165>>10188000
    TOS := MINENTRYSIZE1;                                      <<01165>>10190000
    ASSEMBLE(ADDS 0);                                          <<01165>>10192000
    WFENTRY := 1;                                              <<01165>>10194000
    WFENTRY(1) := %1000;                                       <<01165>>10196000
    WFENTRY(2) := PARMLEN;                                     <<01165>>10198000
    MOVE FENTRY(6) := BACKREFNAME , (PARMLEN);                 <<01165>>10200000
    TOS := PARMLEN;                                            <<01165>>10202000
    DUPLICATE;                                                 <<01165>>10204000
    IF TOS THEN TOS := TOS + 1;     << MAKE LENGTH EVEN >>     <<01165>>10206000
    TOS := TOS & LSR(1);                                       <<01165>>10208000
    T1 := TOS + 3;                                             <<01165>>10210000
    T1 := XADDJTENTRY(FORMDES,N1,N2,-4,T1,WFENTRY,             <<01165>>10212000
                      BACKREFNAME,N1,N2);                      <<01165>>10214000
      CASE * T1 OF                                             <<01165>>10216000
      BEGIN                                                    <<01165>>10218000
           RETURN;                                             <<01165>>10220000
           BEGIN   <<TABLE FULL>>                              <<01165>>10222000
           CIERR(ERRNUM := ERRCTABFULL);                       <<01165>>10224000
           RETURN                                              <<01165>>10226000
           END;                                                <<01165>>10228000
           ;                                                   <<01165>>10230000
           BEGIN   <<BACK REF NOT FOUND>>                      <<01165>>10232000
           CIERR(ERRNUM := ERRCNOTFOUND);                      <<01165>>10234000
           RETURN                                              <<01165>>10236000
           END;                                                <<01165>>10238000
           BEGIN   <<TOO MANY CLINE EQUATIONS IN TABLE >>      <<01165>>10240000
           CIERR(ERRNUM := ERR2MCREF);                         <<01165>>10242000
           RETURN                                              <<01165>>10244000
           END;                                                <<01165>>10246000
      END;         << CASE STATEMENT >>                        <<01165>>10248000
      RETURN;                                                  <<01165>>10250000
    END;   << CHECKBACKREF >>                                  <<01165>>10252000
                                                               <<01165>>10254000
SUBROUTINE TRACEPARMS;                                         <<01165>>10256000
   << HANDLES THE SPECIFIED TRACE PARAMETERS >>                <<01165>>10258000
   BEGIN                                                       <<01165>>10260000
   GETNEXTPARM;                                                <<01165>>10262000
   IF NEXTDELIM <> COMMA AND PARMLEN = 0 THEN CEXIT(CLN'XPCTCOMMA);     10264000
   PARM'INDX := -1;                                            <<01165>>10266000
   WHILE (PARM'INDX := PARM'INDX + 1) <= 3 DO                  <<01165>>10268000
      BEGIN                                                    <<01165>>10270000
      IF PARMLEN <> 0 THEN                                     <<01165>>10272000
         CASE * PARM'INDX OF                                   <<01165>>10274000
            BEGIN                                              <<01165>>10276000
                BEGIN    << "ALL" SPECIFIED >>                 <<01165>>10278000
                IF PARMPTR = "ALL" THEN CTRACEINFO.TRACETYPE := 1       10280000
                ELSE CEXIT(CLN'UNDEFKEYVAL);                   <<01165>>10282000
                END;                                           <<01165>>10284000
                BEGIN    << TRACE MASK SPECIFIED >>            <<01165>>10286000
                TRYBINARYCONVERT(CLNUNDEFKEYVAL);              <<01165>>10288000
                IF BINARYDIGIT > %777  THEN CEXIT(CLNBNDSERR0'127);     10290000
                CTRACEINFO.TRACEMASK := BINARYDIGIT;           <<01165>>10292000
                END;                                           <<01165>>10294000
                BEGIN    << NUM TRACE ENTRIES SPEC >>          <<01165>>10296000
                TRYBINARYCONVERT(CLNUNDEFKEYVAL);              <<01165>>10298000
                IF BINARYDIGIT > 256 THEN CEXIT(CLNBNDSERR0'377);       10300000
                CTRACEINFO.TRACENTNUM := BINARYDIGIT;          <<01165>>10302000
                END;                                           <<01165>>10304000
                IF PARMPTR = "WRAP" THEN CTRACEINFO.TRACEWRAP := 1      10306000
                ELSE CEXIT(CLNUNDEFKEYVAL);                    <<01165>>10308000
            END <<CASE>>;                                      <<01165>>10310000
         IF NEXTDELIM <> COMMA THEN PARM'INDX := 3             <<01165>>10312000
         ELSE GETNEXTPARM;                                     <<01165>>10314000
      END;      << DO WHILE PARM'INDX < 3 >>                   <<01165>>10316000
   END;      << TRACEPARMS >>                                  <<01165>>10318000
                                                               <<01165>>10320000
SUBROUTINE EXTRACTARG(NOTOPTIONAL);                            <<01165>>10322000
VALUE NOTOPTIONAL; LOGICAL NOTOPTIONAL;                        <<01165>>10324000
   BEGIN                                                       <<01165>>10326000
   << GETS ARGUMENT OF KEY WORD (IF ANY) >>                    <<01165>>10328000
   IF NEXTDELIM <> EQUALS THEN                                 <<01165>>10330000
      BEGIN    << EQUAL SIGN EXPECTED >>                       <<01165>>10332000
      @PARMPTR := @PARMPTR + PARMLEN;    << UPDATE FOR CEXIT >><<01165>>10334000
      CEXIT(CLNXPCTEQSIGN);                                    <<01165>>10336000
      END;                                                     <<01165>>10338000
   GETNEXTPARM;                                                <<01165>>10340000
   IF PARMLEN = 0 AND NOTOPTIONAL THEN CEXIT(CLNKEYVALNOTOPT); <<01165>>10342000
   END <<EXTRACTARG>>;                                         <<01165>>10344000
SUBROUTINE CHECKSTRINGSEQ;                                     <<01165>>10346000
   << PARMPTR POINTS TO "A,E,O,H" CHARACTER >>                 <<01165>>10348000
   << CHECKS ASCII STRINGS (LENGTHS AND DELIMITERS) >>         <<01165>>10350000
   BEGIN                                                       <<01165>>10352000
   NOTFINISHED := TRUE; STRINGLEN := 0;                        <<01165>>10354000
   LEN := LOC; LIST(LEN) := 0;                                 <<01165>>10356000
   LOC := LOC + 1;                                             <<01165>>10358000
   WHILE NOTFINISHED DO                                        <<01165>>10360000
      BEGIN                                                    <<01165>>10362000
      GETNEXTPARM;                                             <<01165>>10364000
      IF NEXTDELIM <> QUOTE THEN                               <<01165>>10366000
         BEGIN        << ERROR - NEEDED QUOTE >>               <<01165>>10368000
         @PARMPTR := @PARMPTR + PARMLEN;     << UPDATE FOR CEXIT >>     10370000
         CEXIT(CLN'XPCTQUOTE);                                 <<01165>>10372000
         END;                                                  <<01165>>10374000
      IF PARMLEN <> 0 THEN MOVESTRING;                         <<01165>>10376000
      GETNEXTPARM;                                             <<01165>>10378000
      << DOES THIS WORK ??? >>                                 <<01165>>10380000
      IF NEXTDELIM = QUOTE AND PARMLEN = 0 THEN                <<01165>>10382000
         BEGIN     << DOUBLE QUOTES >>                         <<01165>>10384000
         PARMLEN := 1;                                         <<01165>>10386000
         MOVESTRING;                                           <<01165>>10388000
         END                                                   <<01165>>10390000
       ELSE NOTFINISHED := FALSE;                              <<01165>>10392000
       END;                                                    <<01165>>10394000
    END;      << CHECKSTRINGSEQ >>                             <<01165>>10396000
                                                               <<01165>>10398000
SUBROUTINE CHECKDIGITSEQ;                                      <<01165>>10400000
<< CHECKS NUMERIC STRING (OCTAL OR HEX) FOR BOUNDS VIOLATION.           10402000
   CONVERTS TO DESIRED FORM.                                            10404000
>>                                                             <<01165>>10406000
   BEGIN                                                       <<01165>>10408000
   LOC := LOC + 1; STRINGLEN := 1;                             <<01165>>10410000
   DO BEGIN                                                    <<01165>>10412000
      GETNEXTPARM;                                             <<01165>>10414000
      IF NEXTDELIM <> COMMA AND NEXTDELIM <> RIGHTPAREN THEN   <<01165>>10416000
         BEGIN                                                 <<01165>>10418000
         @PARMPTR := @PARMPTR + PARMLEN; << UPDATE FOR CEXIT >><<01165>>10420000
         CEXIT(CLNBADELIMITER);                                <<01165>>10422000
         END;                                                  <<01165>>10424000
      IF PARMLEN = 0 THEN CEXIT(CLNKEYVALNOTOPT);              <<01165>>10426000
      IF DIGITYPE = OCTAL THEN                                 <<01165>>10428000
         BEGIN                                                 <<01165>>10430000
         IF (LEN := PARMLEN) > 3 THEN CEXIT(CLNPARM2LONG);     <<01165>>10432000
         I := -1; WHILE (I := I + 1) < LEN DO                  <<01165>>10434000
            IF PARMPTR(I) > %67 THEN CEXIT(CLNUNDEFKEYVAL);    <<01165>>10436000
         TOS := BINARY(PARMPTR,PARMLEN);                       <<01165>>10438000
         IF <> THEN CEXIT(CLNBADINT);                          <<01165>>10440000
         I := X := 0;                                          <<01165>>10442000
         DO BEGIN                                              <<01165>>10444000
            TOS := 10;                                         <<01165>>10446000
            ASSEMBLE(DIV);                                     <<01165>>10448000
            I := I + (TOS & LSL(X));                           <<01165>>10450000
            X := X + 3;                                        <<01165>>10452000
            DUPLICATE;                                         <<01165>>10454000
            END UNTIL TOS = 0;                                 <<01165>>10456000
         ASSEMBLE(DEL);                                        <<01165>>10458000
         IF NOT (0<=I<=%377) THEN CEXIT(CLNBNDSERR0'377);      <<01165>>10460000
         LIST(LOC) := I;                                       <<01165>>10462000
         END                                                   <<01165>>10464000
      ELSE                                                     <<01165>>10466000
         BEGIN      << DIGITYPE  IS HEX  >>                    <<01165>>10468000
         IF NOT (1<=PARMLEN<=2) THEN CEXIT(CLNPARM2LONG);      <<01165>>10470000
         IF (%60<=INTEGER(PARMPTR)<=%71) THEN   << IT'S 0-9 >> <<01165>>10472000
            TOS := PARMPTR - %60                               <<01165>>10474000
         ELSE IF (%101<=INTEGER(PARMPTR)<=%106) THEN << A-E >> <<01165>>10476000
              TOS := PARMPTR - %67                             <<01165>>10478000
         ELSE CEXIT(CLNUNDEFKEYVAL);                           <<01165>>10480000
         IF PARMLEN = 2 THEN                                   <<01165>>10482000
            BEGIN                                              <<01165>>10484000
            TOS := TOS & LSL(4);    << MULTIPLY DIGIT BY 16 >> <<01165>>10486000
            @PARMPTR := @PARMPTR + 1;<< MOVE TO SECOND DIGIT >><<01165>>10488000
            IF (%60<=INTEGER(PARMPTR)<=%71) THEN << IT'S 0-9 >><<01165>>10490000
               TOS := PARMPTR - %60                            <<01165>>10492000
            ELSE IF(%101<=INTEGER(PARMPTR)<=%106) THEN<< A-E >><<01165>>10494000
               TOS := PARMPTR - %67                            <<01165>>10496000
            ELSE CEXIT(CLNUNDEFKEYVAL);                        <<01165>>10498000
            END                                                <<01165>>10500000
         ELSE TOS := 0;                                        <<01165>>10502000
         LIST(LOC) := TOS + TOS;                               <<01165>>10504000
         END;                                                  <<01165>>10506000
      LOC := LOC + 1;                                          <<01165>>10508000
      END UNTIL (LISTLEN := LISTLEN + 1) > MAXIDSEQLEN OR      <<01165>>10510000
          NEXTDELIM = RIGHTPAREN;                              <<01165>>10512000
   IF NEXTDELIM <> RIGHTPAREN THEN CEXIT(CLN'XPCTPAREN);       <<01165>>10514000
   LIST(LOC - LISTLEN) := LISTLEN - 1;                         <<01165>>10516000
   GETNEXTPARM;                                                <<01165>>10518000
   END;      << CHECKDIGITSEQ >>                               <<01165>>10520000
                                                               <<01165>>10522000
SUBROUTINE CHECKSEQUENCE;                                      <<01165>>10524000
   BEGIN                                                       <<01165>>10526000
   IF PARMLEN = 0 THEN     <<MAYBE SPECIAL CHARACTER>>         <<01165>>10528000
      BEGIN                                                    <<01165>>10530000
      IF NEXTDELIM = QUOTE THEN                                <<01165>>10532000
         BEGIN     << QUOTED STRING >>                         <<01165>>10534000
         SEQTYPE := STRING;                                    <<01165>>10536000
         STRINGTYPE := ASCII;                                  <<01165>>10538000
         END                                                   <<01165>>10540000
      ELSE IF NEXTDELIM = LEFTPAREN THEN                       <<01165>>10542000
         BEGIN     << DIGIT STRING >>                          <<01165>>10544000
         SEQTYPE := DIGITS;                                    <<01165>>10546000
         DIGITYPE := OCTAL;                                    <<01165>>10548000
         END                                                   <<01165>>10550000
      ELSE CEXIT(CLN'XPCTQU'PAR);                              <<01165>>10552000
      END                                                      <<01165>>10554000
   ELSE IF PARMPTR = ALPHA AND PARMLEN = 1 THEN                <<01165>>10556000
      BEGIN     << ONE ALPHA CHARACTER >>                      <<01165>>10558000
      IF PARMPTR = "A" THEN                                    <<01165>>10560000
         BEGIN                                                 <<01165>>10562000
         SEQTYPE := STRING;                                    <<01165>>10564000
         STRINGTYPE := ASCII;                                  <<01165>>10566000
         END                                                   <<01165>>10568000
      ELSE IF PARMPTR = "E" THEN                               <<01165>>10570000
         BEGIN                                                 <<01165>>10572000
         SEQTYPE := STRING;                                    <<01165>>10574000
         STRINGTYPE := EBCDIC;                                 <<01165>>10576000
         END                                                   <<01165>>10578000
      ELSE IF PARMPTR = "O" THEN                               <<01165>>10580000
         BEGIN                                                 <<01165>>10582000
         SEQTYPE := DIGITS;                                    <<01165>>10584000
         DIGITYPE := OCTAL;                                    <<01165>>10586000
         END                                                   <<01165>>10588000
      ELSE IF PARMPTR = "H" THEN                               <<01165>>10590000
         BEGIN                                                 <<01165>>10592000
         SEQTYPE := DIGITS;                                    <<01165>>10594000
         DIGITYPE := HEX;                                      <<01165>>10596000
         END                                                   <<01165>>10598000
      ELSE CEXIT(CLN'XPCT1ALPHA);                              <<01165>>10600000
                                                               <<01165>>10602000
      << FIRST ALPHA CHARACTER OK >>                           <<01165>>10604000
      IF SEQTYPE = STRING AND NEXTDELIM <> QUOTE THEN          <<01165>>10606000
         CEXIT(CLN'XPCTQUOTE);                                 <<01165>>10608000
      IF SEQTYPE = DIGITS AND NEXTDELIM <> LEFTPAREN THEN      <<01165>>10610000
         CEXIT(CLN'XPCTPAREN);                                 <<01165>>10612000
        END       << END ONE ALPHA CHARACTER >>                <<01165>>10614000
     ELSE CEXIT(CLN'XPCT1ALPHA);                               <<01165>>10616000
     IF SEQTYPE = STRING THEN CHECKSTRINGSEQ                   <<01165>>10618000
     ELSE CHECKDIGITSEQ;                                       <<01165>>10620000
   END <<CHECKSEQUENCE>>;                                      <<01165>>10622000
                                                               <<01165>>10624000
SUBROUTINE PROCKEY;                                            <<01165>>10626000
   << PROCESS ALL KEY WORDS ALLOWED IN :CLINE >>               <<01165>>10628000
   BEGIN                                                       <<01165>>10630000
   TOS := FLAGS;                                               <<01165>>10632000
   WHILE GETNEXTPARM DO                                        <<01165>>10634000
      BEGIN                                                    <<01165>>10636000
      IF PARMLEN = 0 THEN CEXIT(CLNXPCTKEY);                   <<01165>>10638000
      ENTRYNUM := SEARCH(PARMPTR,PARMLEN,KEYLIST);             <<01165>>10640000
      CASE ENTRYNUM OF                                         <<01165>>10642000
         BEGIN                                                 <<01165>>10644000
                                                               <<01165>>10646000
         CEXIT(CLNXPCTKEY);                                    <<01165>>10648000
                                                               <<01165>>10650000
         BEGIN            << DEV >>                            <<01165>>10652000
         EXTRACTARG(1);                                        <<01165>>10654000
         IF (DEVLEN := PARMLEN) > 8 THEN CEXIT(CLNDEV2LONG);   <<01165>>10656000
          @DEV := @PARMPTR;                                    <<01165>>10658000
          ASSEMBLE(TSBC 15);                                   <<01165>>10660000
          END;                                                 <<01165>>10662000
                                                               <<01165>>10664000
         BEGIN          << MISC >>                             <<01165>>10666000
         EXTRACTARG(1);                                        <<01165>>10668000
         IF NEXTDELIM <> COMMA THEN CEXIT(CLN'XPCTCOMMA);      <<01165>>10670000
         LASTPARM'DONE := FALSE;     << MORE MISCARRAY VALUES YET >>    10672000
         @MISC := (@PARMPTR - 1)&LSR(1); LOC := 0;             <<01165>>10674000
         DO BEGIN                                              <<01165>>10676000
            TRYBINARYCONVERT(CLNUNDEFKEYVAL);                  <<01165>>10678000
            MISC(LOC) := BINARYDIGIT;                          <<01165>>10680000
            LOC := LOC + 1;                                    <<01165>>10682000
            IF NEXTDELIM = COMMA THEN GETNEXTPARM              <<01165>>10684000
            ELSE LASTPARM'DONE := TRUE;   << NO MORE MISCARRAY <<01165>>10686000
            END UNTIL LASTPARM'DONE;                           <<01165>>10688000
         TOS := LOC;     << CHECK FOR ODD NUMBER OF VALUES >>  <<01165>>10690000
         IF TOS THEN CEXIT(CLNXPCTKEYVAL);                     <<01165>>10692000
         MISCLEN := LOC;                                       <<01165>>10694000
         TOS := FLAGS2;                                        <<01165>>10696000
         ASSEMBLE(TSBC  0);                                    <<01165>>10698000
         FLAGS2 := TOS;                                        <<01165>>10700000
         END;                                                  <<01165>>10702000
                                                               <<01165>>10704000
         BEGIN          << BUFF >>                             <<01165>>10706000
         DUPLICATE;                                            <<01165>>10708000
         TOS:=TOS LAND %6;                                     <<01165>>10710000
         IF TOS <> 0 THEN CEXIT(CLNDUPKEY);                    <<01165>>10712000
         EXTRACTARG(0);                                        <<01165>>10714000
         IF PARMLEN <> 0 THEN                                  <<01165>>10716000
            BEGIN    << FIRST PARAMETER, NUMBUFFS, EXPECTED >> <<01165>>10718000
            TRYBINARYCONVERT(CLNUNDEFKEYVAL);                  <<01165>>10720000
            NUMBUFFERS := BINARYDIGIT;                         <<01165>>10722000
            ASSEMBLE(TSBC 14);                                 <<01165>>10724000
            END                                                <<01165>>10726000
         ELSE IF NEXTDELIM = SEMICOLON THEN CEXIT(CLNXPCTKEYVAL);       10728000
         IF NEXTDELIM = COMMA THEN                             <<01165>>10730000
            BEGIN   << SECOND PARAMETER, BUFFSIZE, EXPECTED >> <<01165>>10732000
            GETNEXTPARM;                                       <<01165>>10734000
            IF PARMLEN = 0 THEN CEXIT(CLNXPCTKEYVAL);          <<01165>>10736000
            TRYBINARYCONVERT(CLNUNDEFKEYVAL);                  <<01165>>10738000
            BUFFSIZE := BINARYDIGIT;                           <<01165>>10740000
            ASSEMBLE(TSBC 13);                                 <<01165>>10742000
            END;                                               <<01165>>10744000
         END;                                                  <<01165>>10746000
                                                               <<01165>>10748000
         BEGIN          << DIAL >>                             <<01165>>10750000
         EXTRACTARG(1);                                        <<01165>>10752000
         IF PARMLEN = 1 THEN                                   <<01165>>10754000
            BEGIN                                              <<01165>>10756000
            IF PARMPTR = "W" THEN TOS := 0                     <<01165>>10758000
            ELSE IF PARMPTR = "R" THEN TOS := 1                <<01165>>10760000
            ELSE CEXIT(CLN'DIALVAL);                           <<01165>>10762000
            END                                                <<01165>>10764000
         ELSE IF PARMLEN = 2 THEN                              <<01165>>10766000
            BEGIN                                              <<01165>>10768000
            IF PARMPTR = "RW" THEN TOS := 2                    <<01165>>10770000
            ELSE IF PARMPTR = "NO" THEN TOS := 3               <<01165>>10772000
            ELSE CEXIT(CLN'DIALVAL);                           <<01165>>10774000
            END                                                <<01165>>10776000
         ELSE CEXIT(CLN'DIALVAL);                              <<01165>>10778000
         AOPTIONS.DIALFLD := TOS;                              <<01165>>10780000
         ASSEMBLE(TSBC 12);                                    <<01165>>10782000
         END;                                                  <<01165>>10784000
                                                               <<01165>>10786000
         BEGIN          << PROTO >>                            <<01165>>10788000
         EXTRACTARG(1);                                        <<01165>>10790000
         IF PARMPTR = "BSC" THEN TOS := 1                      <<01165>>10792000
         ELSE IF PARMPTR = "MRJE" THEN TOS := 2                <<01165>>10794000
         ELSE IF PARMPTR = "HPDLC1" THEN TOS := 3              <<01165>>10796000
         ELSE                                                  <<01165>>10798000
            BEGIN       << PROTOCOL NUMBER SPECIFIED >>        <<01165>>10800000
            TRYBINARYCONVERT(CLN'PROTOVAL);                    <<01165>>10802000
            IF NOT (0 <=BINARYDIGIT <=PROTOMAX) THEN           <<01165>>10804000
               CEXIT(CLNBNDSERR0'377)                          <<01165>>10806000
            ELSE TOS:=BINARYDIGIT;                             <<01165>>10808000
            END;                                               <<01165>>10810000
         AOPTIONS.PROTOFLD := TOS;                             <<01165>>10812000
         ASSEMBLE(TSBC 11);                                    <<01165>>10814000
         END;                                                  <<01165>>10816000
                                                               <<01165>>10818000
          BEGIN          << CODE >>                            <<01165>>10820000
          EXTRACTARG(1);                                       <<01165>>10822000
          IF PARMPTR = "SENSE" THEN TOS := 1                   <<01165>>10824000
          ELSE IF PARMPTR = "ASCII" THEN TOS := 2              <<01165>>10826000
          ELSE IF PARMPTR = "EBCDIC" THEN TOS := 3             <<01165>>10828000
          ELSE                                                 <<01165>>10830000
             BEGIN    << CODE SPECIFIED BY NUMBER >>           <<01165>>10832000
             TRYBINARYCONVERT(CLN'CODEVAL);                    <<01165>>10834000
             IF NOT (0 <= BINARYDIGIT <= CODEMAX) THEN         <<01165>>10836000
                CEXIT(CLNBNDSERR0'63)                          <<01165>>10838000
             ELSE TOS:=BINARYDIGIT;                            <<01165>>10840000
             END;                                              <<01165>>10842000
         COPTIONS.CODEFLD := TOS;                              <<01165>>10844000
         ASSEMBLE(TSBC 10);                                    <<01165>>10846000
         END;                                                  <<01165>>10848000
                                                               <<01165>>10850000
         BEGIN          << DUAL >>                             <<01165>>10852000
         EXTRACTARG(1);                                        <<01165>>10854000
         IF NOT (3 <= PARMLEN <= 4) THEN CEXIT(CLN'DUALVAL);   <<01165>>10856000
         IF PARMPTR = "LOW" THEN TOS := 1                      <<01165>>10858000
         ELSE IF PARMPTR = "HIGH" THEN TOS := 2                <<01165>>10860000
         ELSE CEXIT(CLN'DUALVAL);                              <<01165>>10862000
         COPTIONS.DUALFLD := TOS;                              <<01165>>10864000
         ASSEMBLE(TSBC  9);                                    <<01165>>10866000
         END;                                                  <<01165>>10868000
                                                               <<01165>>10870000
         BEGIN          << LMODE >>                            <<01165>>10872000
         EXTRACTARG(1);                                        <<01165>>10874000
         IF PARMPTR = "PRI" THEN TOS := 1                      <<01165>>10876000
         ELSE IF PARMPTR = "SEC" THEN TOS := 2                 <<01165>>10878000
         ELSE IF PARMPTR = "MPCNT" THEN TOS := 3               <<01165>>10880000
         ELSE IF PARMPTR = "MPSEC" THEN TOS := 4               <<01165>>10882000
         ELSE IF PARMPTR = "DTE" THEN TOS := 5                 <<01165>>10884000
         ELSE IF PARMPTR = "DCE" THEN TOS := 6                 <<01165>>10886000
         ELSE                                                  <<01165>>10888000
            BEGIN      << LOCAL MODE NUMBER SPECIFIED >>       <<01165>>10890000
            TRYBINARYCONVERT(CLN'LMODEVAL);                    <<01165>>10892000
            IF NOT (0<= BINARYDIGIT <=LMODEMAX) THEN           <<01165>>10894000
               CEXIT(CLNBNDSERR0'15)                           <<01165>>10896000
            ELSE TOS:=BINARYDIGIT;                             <<01165>>10898000
            END;                                               <<01165>>10900000
         COPTIONS.LMODEFLD := TOS;                             <<01165>>10902000
         ASSEMBLE(TSBC  8);                                    <<01165>>10904000
         END;                                                  <<01165>>10906000
                                                               <<01165>>10908000
         BEGIN          << DRIVER >>                           <<01165>>10910000
         EXTRACTARG(1);                                        <<01165>>10912000
         IF (DRIVERLEN := PARMLEN) > 8 THEN CEXIT(CLNDRIVERNAM2LN);     10914000
         @DRIVER := @PARMPTR;                                  <<01165>>10916000
         ASSEMBLE(TSBC  7);                                    <<01165>>10918000
         END;                                                  <<01165>>10920000
                                                               <<01165>>10922000
         BEGIN          << SPEED >>                            <<01165>>10924000
         DUPLICATE;                                            <<01165>>10926000
         IF (TOS LAND %14000) <> 0 THEN CEXIT(CLNDUPKEY);      <<01165>>10928000
         EXTRACTARG(0);                                        <<01165>>10930000
         IF PARMLEN <> 0 THEN                                  <<01165>>10932000
            BEGIN    << FIRST PARM, INSPEED, EXPECTED >>       <<01165>>10934000
            TOS := DBINARY(PARMPTR,PARMLEN);                   <<01165>>10936000
            IF <> THEN CEXIT(CLNBADINT);                       <<01165>>10938000
            INSPEED := TOS;                                    <<01165>>10940000
            ASSEMBLE(TSBC 4);                                  <<01165>>10942000
            END                                                <<01165>>10944000
         ELSE IF NEXTDELIM = SEMICOLON THEN CEXIT(CLNXPCTKEYVAL);       10946000
         IF NEXTDELIM = COMMA THEN                             <<01165>>10948000
            BEGIN  << SECOND PARAMETER, OUTSPEED, EXPECTED >>  <<01165>>10950000
            GETNEXTPARM;                                       <<01165>>10952000
            IF PARMLEN = 0 THEN CEXIT(CLNXPCTKEYVAL);          <<01165>>10954000
            TOS := DBINARY(PARMPTR,PARMLEN);                   <<01165>>10956000
            IF <> THEN CEXIT(CLNBADINT);                       <<01165>>10958000
            OUTSPEED := TOS;                                   <<01165>>10960000
            ASSEMBLE(TSBC 3);                                  <<01165>>10962000
            END;                                               <<01165>>10964000
          END;                                                 <<01165>>10966000
                                                               <<01165>>10968000
         BEGIN          << DOPTIONS >>                         <<01165>>10970000
         EXTRACTARG(1);                                        <<01165>>10972000
         TRYBINARYCONVERT(CLNUNDEFKEYVAL);                     <<01165>>10974000
         DOPTIONS := BINARYDIGIT;                              <<01165>>10976000
         ASSEMBLE(TSBC 2);                                     <<01165>>10978000
         END;                                                  <<01165>>10980000
                                                               <<01165>>10982000
         BEGIN          << TRACE >>                            <<01165>>10984000
         COPTIONS.TRACESPEC := TRUE;                           <<01165>>10986000
         IF NEXTDELIM = EQUALS THEN                            <<01165>>10988000
            BEGIN                                              <<01165>>10990000
            TRACEPARMS;                                        <<01165>>10992000
            ASSEMBLE(TSBC  0);                                 <<01165>>10994000
            END;                                               <<01165>>10996000
         ASSEMBLE(TSBC  1);                                    <<01165>>10998000
         END;    << END OF "TRACE" SPECIFIED >>                <<01165>>11000000
                                                               <<01165>>11002000
         BEGIN          << NOTRACE >>                          <<01165>>11004000
         ASSEMBLE(TSBC  1);                                    <<01165>>11006000
         END;                                                  <<01165>>11008000
                                                               <<01165>>11010000
         BEGIN          << NOID >>                             <<01165>>11012000
         COPTIONS.INHIBIDSEQ := TRUE;                          <<01165>>11014000
         TOS := FLAGS1;                                        <<01165>>11016000
         ASSEMBLE(TSBC 15);                                    <<01165>>11018000
         FLAGS1 := TOS;                                        <<01165>>11020000
         END;                                                  <<01165>>11022000
                                                               <<01165>>11024000
         BEGIN      << TIMEOUTS >>                             <<01165>>11026000
         TOS := FLAGS1;                                        <<01165>>11028000
         ASSEMBLE(TSBC 14);                                    <<01165>>11030000
         COPTIONS.INHIBTOUT := 0;                              <<01165>>11032000
         FLAGS1 := TOS;                                        <<01165>>11034000
         END;                                                  <<01165>>11036000
                                                               <<01165>>11038000
         BEGIN      << NO TIME OUTS >>                         <<01165>>11040000
         TOS := FLAGS1;                                        <<01165>>11042000
         ASSEMBLE(TSBC 14);                                    <<01165>>11044000
         COPTIONS.INHIBTOUT := 1;                              <<01165>>11046000
         FLAGS1 := TOS;                                        <<01165>>11048000
         END;                                                  <<01165>>11050000
                                                               <<01165>>11052000
         BEGIN          << ID >>                               <<01165>>11054000
         TOS := FLAGS1;                                        <<01165>>11056000
         ASSEMBLE(TSBC 15);                                    <<01165>>11058000
         FLAGS1 := TOS;                                        <<01165>>11060000
         END;                                                  <<01165>>11062000
                                                               <<01165>>11064000
         BEGIN          << LOCID >>                            <<01165>>11066000
         EXTRACTARG(0);                                        <<01165>>11068000
         @LIST := @LOCID := @PARMPTR - 1; LOC := 0;            <<01165>>11070000
         CHECKSEQUENCE;                                        <<01165>>11072000
         LOCIDLEN := STRINGLEN + 1;                            <<01165>>11074000
         TOS := FLAGS2;                                        <<01165>>11076000
         ASSEMBLE(TSBC  6);                                    <<01165>>11078000
         FLAGS2 := TOS;                                        <<01165>>11080000
         END;                                                  <<01165>>11082000
                                                               <<01165>>11084000
         BEGIN          << REMID >>                            <<01165>>11086000
         EXTRACTARG(0);                                        <<01165>>11088000
         @LIST := @REMID := @PARMPTR - 1; LOC := 1;            <<01165>>11090000
   SEQNUM := LISTLEN := 0;                                     <<01165>>11092000
   LASTPARM'DONE := FALSE;   << HAVEN'T COMPLETED ALL REMOTE IDS >>     11094000
   DO BEGIN                                                    <<01165>>11096000
      SEQNUM := SEQNUM + 1;                                    <<01165>>11098000
      CHECKSEQUENCE;                                           <<01165>>11100000
      LISTLEN := LISTLEN + STRINGLEN +1;                       <<01165>>11102000
      IF NEXTDELIM = COMMA THEN GETNEXTPARM                    <<01165>>11104000
      ELSE LASTPARM'DONE := TRUE;<< NO MORE REMOTE IDS LEFT >> <<01165>>11106000
      END UNTIL LASTPARM'DONE;                                 <<01165>>11108000
         REMID := SEQNUM;                                      <<01165>>11110000
         REMIDLEN := LISTLEN + 1;                              <<01165>>11112000
         TOS := FLAGS2;                                        <<01165>>11114000
         ASSEMBLE(TSBC  5);                                    <<01165>>11116000
         FLAGS2 := TOS;                                        <<01165>>11118000
         END;                                                  <<01165>>11120000
                                                               <<01165>>11122000
         BEGIN          << POLLIST >>                          <<01165>>11124000
         END;                                                  <<01165>>11126000
                                                               <<01165>>11128000
         BEGIN          << PHLIST >>                           <<01165>>11130000
         EXTRACTARG(1);                                        <<01165>>11132000
         LASTPARM'DONE := FALSE;  << MORE PHONE NUMBERS YET >> <<01165>>11134000
         @PHLIST := @PARMPTR - 1; LOC := 0;                    <<01165>>11136000
         DO BEGIN                                              <<01165>>11138000
            IF PARMLEN > MAXPHONELEN THEN CEXIT(CLNPARM2LONG); <<01165>>11140000
            PHLIST(LOC) := PARMLEN;                            <<01165>>11142000
            MOVE PHLIST(LOC+1) := PARMPTR, (PARMLEN);          <<01165>>11144000
            LOC := LOC + PARMLEN + 1;                          <<01165>>11146000
            PHLISTNUM := PHLISTNUM + 1;                        <<01165>>11148000
            IF NEXTDELIM = COMMA THEN GETNEXTPARM              <<01165>>11150000
            ELSE LASTPARM'DONE := TRUE;                        <<01165>>11152000
            END UNTIL LASTPARM'DONE;                           <<01165>>11154000
         PHLISTLEN := LOC;                                     <<01165>>11156000
         TOS := FLAGS2;                                        <<01165>>11158000
         ASSEMBLE(TSBC  1);                                    <<01165>>11160000
         FLAGS2 := TOS;                                        <<01165>>11162000
         END;                                                  <<01165>>11164000
                                                               <<01165>>11166000
         BEGIN      << DOWN FILE NAME >>                       <<01165>>11168000
         END;                                                  <<01165>>11170000
                                                               <<01165>>11172000
         BEGIN      << SUPLIST >>                              <<01165>>11174000
         END;                                                  <<01165>>11176000
                                                               <<01165>>11178000
      END <<CASE>>;                                            <<01165>>11180000
     END;    << END OF GETNEXTPARM = TRUE >>                   <<01165>>11182000
      << NO MORE PARAMETERS TO PROCESS >>                      <<01165>>11184000
     FLAGS := TOS;                                             <<01165>>11186000
     IF NEXTDELIM <> CR THEN CEXIT(CLNBADELIMITER);            <<01165>>11188000
END <<PROCKEY>>;                                               <<01165>>11190000
                                                               <<01165>>11192000
         << ****   MAIN OF CXCLINE   **** >>                   <<01165>>11194000
     MOVE KEYLIST:=PKEYLIST,(PKEYLISTL);                       <<01165>>11196000
     MOVE DELIMITERS:=PDELIMITERS,(PDELIMITERSL);              <<01165>>11198000
     DELIMITERS(PDELIMITERSL) := CARRIAGERETURN;               <<01165>>11200000
     PARMNUM := 0;                                             <<01165>>11202000
     MYCOMMAND(PARMSP,DELIMITERS,MAXPARMS,NUMPARMS,PARMS);     <<01165>>11204000
     IF <> THEN MOREPARMS := TRUE;  <<MORE THAN MAXPARM PARAMETERS>>    11206000
     IF NUMPARMS = 0 THEN CEXIT(CLNREQLINE);                   <<01165>>11208000
     GETNEXTPARM;                                              <<01165>>11210000
     CHECKNAME(ERRNAME);                                       <<01165>>11212000
     N1 := " ";     <<FOR JOBTABLE PROCEDURES>>                <<01165>>11214000
     @FORMDES := LPARM;                                        <<01165>>11216000
     IF NEXTDELIM = EQUALS THEN                                <<01165>>11218000
        CHECKBACKREF;    << BACK REFERENCE INDICATED >>        <<01165>>11220000
     PROCKEY;         << PROCESS ALL KEY WORDS >>              <<01165>>11222000
     TOS := 0;                                                 <<01165>>11224000
     PUSH(S); DUPLICATE;                                       <<01165>>11226000
     @WFENTRY := TOS;                                          <<01165>>11228000
     @FENTRY := TOS & LSL(1);                                  <<01165>>11230000
     TOS := MINENTRYSIZE2 +                                    <<01165>>11232000
            (LOCIDLEN + 1) & LSR(1) +                          <<01165>>11234000
            (REMIDLEN + 1) & LSR(1) +                          <<01165>>11236000
            (SUPLISTLEN + 1) & LSR(1) +                        <<01165>>11238000
            (PHLISTLEN + 2) & LSR(1) +                         <<01165>>11240000
            (POLLISTLEN + 1) +                                 <<01165>>11242000
            (MISCLEN + 1);                                     <<01165>>11244000
     ASSEMBLE(ADDS 0);                                         <<01165>>11246000
     WFENTRY := FLAGS;                                         <<01165>>11248000
     WFENTRY(1) := FLAGS1;                                     <<01165>>11250000
     WFENTRY(2) := DEVLEN;                                     <<01165>>11252000
     IF DEVLEN <> 0 THEN MOVE FENTRY(14) := DEV , (DEVLEN);    <<01165>>11254000
     WFENTRY(11) := FLAGS2;                                    <<01165>>11256000
     WFENTRY(12) := DRIVERLEN & LSL(8);                        <<01165>>11258000
     IF DRIVERLEN <> 0 THEN MOVE FENTRY(26) := DRIVER , (DRIVERLEN);    11260000
     WFENTRY(17) := STARTOFPTRS;     <<LEQLISTPRT>>;           <<01165>>11262000
     WFENTRY(X := X + 1) := COPTIONS;                          <<01165>>11264000
     WFENTRY(X := X + 1) := AOPTIONS;                          <<01165>>11266000
     WFENTRY(X := X + 1) := DOPTIONS;                          <<01165>>11268000
     WFENTRY(X := X + 1) := NUMBUFFERS;                        <<01165>>11270000
     WFENTRY(X := X + 1) := BUFFSIZE;                          <<01165>>11272000
     TOS := OUTSPEED; TOS := INSPEED;                          <<01165>>11274000
     ASSEMBLE(XCH);                                            <<01165>>11276000
     WFENTRY(X := X + 1) := TOS;                               <<01165>>11278000
     WFENTRY(X := X + 1) := TOS;                               <<01165>>11280000
     ASSEMBLE(XCH);                                            <<01165>>11282000
     WFENTRY(X := X + 1) := TOS;                               <<01165>>11284000
     WFENTRY(X := X + 1) := TOS;                               <<01165>>11286000
     WFENTRY(X := X + 1) := 0;    << NOT CURRENTLY USED >>     <<01165>>11288000
     WFENTRY(X := X + 1) := 0;   << NOT CURRENTLY USED >>      <<01165>>11290000
     WFENTRY(X := X + 1) := CTRACEINFO;                        <<01165>>11292000
     LOC := STARTOFLISTS & LSL(1);                             <<01165>>11294000
     IF LOCIDLEN <> 0 THEN                                     <<01165>>11296000
        BEGIN                                                  <<01165>>11298000
        MOVE FENTRY(LOC) := LOCID , (LOCIDLEN);                <<01165>>11300000
        WFENTRY(LOCIDPTR) := LOC & LSR(1);                     <<01165>>11302000
        LOC := (LOC + LOCIDLEN + 1) & LSR(1) & LSL(1);         <<01165>>11304000
        END                                                    <<01165>>11306000
     ELSE WFENTRY(LOCIDPTR) := 0;                              <<01165>>11308000
     IF REMIDLEN <> 0 THEN                                     <<01165>>11310000
        BEGIN                                                  <<01165>>11312000
        MOVE FENTRY(LOC) := REMID , (REMIDLEN);                <<01165>>11314000
        WFENTRY(REMIDPTR) := LOC & LSR(1);                     <<01165>>11316000
        LOC := (LOC + REMIDLEN + 1) & LSR(1) & LSL(1);         <<01165>>11318000
        END                                                    <<01165>>11320000
     ELSE WFENTRY(REMIDPTR) := 0;                              <<01165>>11322000
     IF SUPLISTLEN <> 0 THEN                                   <<01165>>11324000
        BEGIN                                                  <<01165>>11326000
        MOVE FENTRY(LOC) := SUPLIST , (SUPLISTLEN);            <<01165>>11328000
        WFENTRY(SUPLISTPTR) := LOC & LSR(1);                   <<01165>>11330000
        LOC := (LOC + SUPLISTLEN + 1) & LSR(1) & LSL(1);       <<01165>>11332000
        END                                                    <<01165>>11334000
     ELSE WFENTRY(SUPLISTPTR) := 0;                            <<01165>>11336000
     IF PHLISTLEN <> 0 THEN                                    <<01165>>11338000
        BEGIN                                                  <<01165>>11340000
        MOVE FENTRY(LOC+1) := PHLIST , (PHLISTLEN);            <<01165>>11342000
        FENTRY(LOC) := PHLISTNUM;                              <<01165>>11344000
        WFENTRY(PHLISTPTR) := LOC & LSR(1);                    <<01165>>11346000
        LOC := (LOC + PHLISTLEN + 2) & LSR(1) & LSL(1);        <<01165>>11348000
        END                                                    <<01165>>11350000
     ELSE WFENTRY(PHLISTPTR) := 0;                             <<01165>>11352000
     LOC := LOC & LSR(1);     << FOR WORD ARRAYS >>            <<01165>>11354000
     IF POLLISTLEN <> 0 THEN                                   <<01165>>11356000
        BEGIN                                                  <<01165>>11358000
        MOVE WFENTRY(LOC+1) := POLLIST , (POLLISTLEN);         <<01165>>11360000
        WFENTRY(LOC) := POLLISTLEN;                            <<01165>>11362000
        WFENTRY(POLLISTPTR) := LOC;                            <<01165>>11364000
        LOC := LOC + POLLISTLEN + 1;                           <<01165>>11366000
        END                                                    <<01165>>11368000
     ELSE WFENTRY(POLLISTPTR) := 0;                            <<01165>>11370000
     IF MISCLEN <> 0 THEN                                      <<01165>>11372000
        BEGIN                                                  <<01165>>11374000
        MOVE WFENTRY(LOC+1) := MISC , (MISCLEN);               <<01165>>11376000
        WFENTRY(LOC) := MISCLEN;                               <<01165>>11378000
        WFENTRY(MISCPTR) := LOC;                               <<01165>>11380000
        LOC := LOC + MISCLEN + 1;                              <<01165>>11382000
        END                                                    <<01165>>11384000
     ELSE WFENTRY(MISCPTR) := 0;                               <<01165>>11386000
     TOS := ADDJTENTRY(FORMDES,N1,N2,-4,LOC,WFENTRY);          <<01165>>11388000
     IF TOS <> 0 THEN CIERR(ERRNUM := ERRCTABFULL);            <<01165>>11390000
     RETURN;                                                   <<01165>>11392000
END <<CXCLINE>>;                                                        11394000
$PAGE "FILE MANAGEMENT COMMAND EXECUTORS--RESET,SAVE,PURGE,RENAME"      11396000
$CONTROL    SEGMENT  =  CIFILEM                                         11398000
                                                                        11400000
      PROCEDURE CXRESET EXECUTORHEAD;                                   11402000
      OPTION PRIVILEGED,UNCALLABLE;                                     11404000
      BEGIN                                                             11406000
<< RESET, CRESET commands:  If a particular equate is to be >> <<U.RAO>>11408000
<< reset, then find it in the JDT, remove it and contract the>><<U.RAO>>11410000
<< table.  If all are to be reset, just delete the table.   >> <<U.RAO>>11412000
      DOUBLE ARRAY PARMS(0:1) =Q;                              <<U.RAO>>11414000
      BYTE POINTER BADPARM = PARMS+2;                          <<U.RAO>>11416000
      LOGICAL LBADPARM = BADPARM;                              <<U.RAO>>11418000
      INTEGER NUMPARMS;                                        <<U.RAO>>11420000
      INTEGER                                                           11422000
        JDTEND = DB+6,                                         <<U.RAO>>11424000
        JDTJCW = DB+5,    <<JOB CONTROL TABLE>>                <<U.RAO>>11426000
         JDTLINEEQ=DB+4,                                                11428000
         JDTFILEEQ=DB+3;                                                11430000
                                                                        11432000
      ARRAY                                                             11434000
        JDTJCWARR(@) = DB+5,  <<POINTS TO JCW TABLE>>          <<U.RAO>>11436000
         JDTLINE(@) = DB+4,                                             11438000
         JDTFILE(@) = DB+3;                                             11440000
      LOGICAL BLANK := "  ";  <<FOR BPNTR>>                    <<U.RAO>>11442000
<<>>                                                           <<U.RAO>>11444000
      LOGICAL X2 = PARMS+1;                                    <<U.RAO>>11446000
      LOGICAL GPNTR := 0;                                      <<U.RAO>>11448000
      LOGICAL APNTR := 0;                                      <<U.RAO>>11450000
      BYTE POINTER GROUP=GPNTR,BPNTR:=@BLANK,ACCNT=APNTR,FORMDES=PARMS; 11452000
      INTEGER TNUM;                                                     11454000
      ENTRY CXCRESET;                                                   11456000
                                                                        11458000
      IF FALSE THEN                                                     11460000
         BEGIN                                                          11462000
CXCRESET:                                                               11464000
         TNUM := 4;           <<LINE EQUATION TABLE>>                   11466000
         END ELSE TNUM := 3;  <<FILE EQUATION TABLE>>                   11468000
      MYCOMMAND(PARMSP,,2,NUMPARMS,PARMS);                     <<U.RAO>>11470000
      IF <> OR NUMPARMS=0 THEN                                 <<U.RAO>>11472000
         BEGIN  <<PARAMETER SPECIFICATION ERROR>>              <<U.RAO>>11474000
         IF = THEN PARMNUM := 1 ELSE PARMNUM := 2;             <<U.RAO>>11476000
         TOS := ERRNUM := (IF TNUM=3 THEN RESETPARMERR         <<U.RAO>>11478000
                                     ELSE CRESETPARMERR);      <<U.RAO>>11480000
         IF PARMNUM = 1 THEN TOS := @PARMSP(1)                 <<U.RAO>>11482000
                        ELSE TOS := @FORMDES;                  <<U.RAO>>11484000
         CIERR(*,*);                                           <<U.RAO>>11486000
         RETURN                                                <<U.RAO>>11488000
         END;                                                  <<U.RAO>>11490000
      IF FORMDES="@" AND X2=%443 THEN                          <<U.RAO>>11492000
         BEGIN<<ALL FILES ELIMINATED>>                                  11494000
         TOS := LOCKJIR;<<LOCK DOWN JOB SIR>>                           11496000
         SETXPXGLOB +PXGWJDT;<<GET JDT DST>>                            11498000
         EXCHANGEDB(ARRDB0(X).(6:10));                                  11500000
         IF TNUM = 3 THEN                                               11502000
         <<:FILE RESET>>                                                11504000
         IF JDTFILEEQ <> JDTLINEEQ THEN                                 11506000
         BEGIN                                                          11508000
            MOVE JDTFILE := JDTLINE,(JDTEND-JDTLINEEQ);                 11510000
            JDTEND := JDTEND-JDTLINEEQ+JDTFILEEQ;              <<U.RAO>>11512000
            JDTJCW := JDTJCW-JDTLINEEQ+JDTFILEEQ;              <<U.RAO>>11514000
            JDTLINEEQ := JDTFILEEQ;                                     11516000
         END ELSE ELSE                                                  11518000
         <<:CLINE RESET>>                                               11520000
            BEGIN   <<MOVE JCW TABLE UP>>                      <<U.RAO>>11522000
            MOVE JDTLINE := JDTJCWARR,(JDTEND-JDTJCW);         <<U.RAO>>11524000
            JDTEND := JDTEND-JDTJCW+JDTLINEEQ;                 <<U.RAO>>11526000
            JDTJCW := JDTLINEEQ;                               <<U.RAO>>11528000
            END;                                               <<U.RAO>>11530000
         EXCHANGEDB(0);                                                 11532000
         UNLOCKJIR (*);                                                 11534000
         END                                                            11536000
      ELSE                                                              11538000
         BEGIN<<INDIVIDUAL FILE>>                                       11540000
        TOS:=CHECKFILENAME'(PARMS&LSR(8),GPNTR,APNTR,LBADPARM);<<U.RAO>>11542000
         IF < THEN  <<PROBLEM PARSING FILE NAME>>              <<U.RAO>>11544000
            BEGIN                                              <<U.RAO>>11546000
            PARMNUM := 1;                                      <<U.RAO>>11548000
            ERRNUM := S0;                                      <<U.RAO>>11550000
            CIERR(*,BADPARM);                                  <<U.RAO>>11552000
            END                                                <<U.RAO>>11554000
         ELSE IF > THEN   <<SYSTEM DEFINED FILE>>              <<U.RAO>>11556000
            BEGIN                                              <<U.RAO>>11558000
            PARMNUM := 1;                                      <<U.RAO>>11560000
            CIERR(ERRNUM := REQFORMALFDESIG, FORMDES);         <<U.RAO>>11562000
            END                                                <<U.RAO>>11564000
         ELSE                                                  <<U.RAO>>11566000
            BEGIN                                              <<U.RAO>>11568000
            <<HAVE VALID FORMAL FILE DESIGNATOR. IT NOW REMAINS<<U.RAO>>11570000
            <<TO ATTEMPT TO REMOVE THIS FILE EQUATE>>          <<U.RAO>>11572000
            IF GPNTR = 0 THEN GPNTR := @BPNTR; <<SET TO BLANK>><<U.RAO>>11574000
            IF APNTR = 0 THEN APNTR := @BPNTR;                 <<U.RAO>>11576000
            IF XREMJTENTRY(FORMDES,GROUP,ACCNT,TNUM) <> 0 THEN <<U.RAO>>11578000
               BEGIN                                           <<U.RAO>>11580000
               TOS := IF TNUM=3 THEN -FEQNOTFOUND              <<U.RAO>>11582000
                               ELSE -ERRLNOTFOUND;             <<U.RAO>>11584000
               CIERR(*,FORMDES);                               <<U.RAO>>11586000
               END;                                            <<U.RAO>>11588000
            END;                                               <<U.RAO>>11590000
         END;                                                  <<U.RAO>>11592000
      END;<<CXRESET>>                                                   11594000
PROCEDURE CXRENAME EXECUTORHEAD;                                        11596000
   OPTION PRIVILEGED, UNCALLABLE;                                       11598000
BEGIN                                                                   11600000
LOGICAL DL := %26015;  <<COMMA, CR>>                           <<U.RAO>>11602000
INTEGER NUMPARMS;                                              <<U.RAO>>11604000
DOUBLE ARRAY PARMS(0:3)=Q;                                     <<U.RAO>>11606000
BYTE POINTER OLDFNAME = PARMS;                                 <<U.RAO>>11608000
BYTE OLDFNAMELEN = PARMS+1;                                    <<U.RAO>>11610000
BYTE POINTER NEWFNAME = PARMS+2;                               <<U.RAO>>11612000
BYTE POINTER TEMPPARM = PARMS+4;                               <<U.RAO>>11614000
BYTE TEMPPARMLEN = PARMS+5;                                    <<U.RAO>>11616000
BYTE POINTER ERRPTR = PARMS+6;                                 <<U.RAO>>11618000
INTEGER FOPTIONS := %2001;  <<OLD PERM., DISALLOW FILE EQ.>>   <<U.RAO>>11620000
BYTE ARRAY FULLFILENAME(0:35);                                 <<U.RAO>>11622000
                                                               <<U.RAO>>11624000
MYCOMMAND(PARMSP,DL,4,NUMPARMS,PARMS);                         <<U.RAO>>11626000
IF NUMPARMS > 3 THEN                                           <<U.RAO>>11628000
   BEGIN  <<TOO MANY PARAMETERS>>                              <<U.RAO>>11630000
   PARMNUM := 4;                                               <<U.RAO>>11632000
   CIERR(ERRNUM := RENAME2MP, ERRPTR);                         <<U.RAO>>11634000
   END                                                         <<U.RAO>>11636000
ELSE IF NUMPARMS=0 THEN                                        <<U.RAO>>11638000
   BEGIN  <<EXPECTED OLD FILE NAME>>                           <<U.RAO>>11640000
   PARMNUM := 1;                                               <<U.RAO>>11642000
   CIERR(ERRNUM := RENAMEREQOLDNAME, PARMSP(1));               <<U.RAO>>11644000
   END                                                         <<U.RAO>>11646000
ELSE IF NUMPARMS=1 THEN                                        <<U.RAO>>11648000
   BEGIN  <<EXPECTED NEW FILE NAME>>                           <<U.RAO>>11650000
   PARMNUM := 2;                                               <<U.RAO>>11652000
   CIERR(ERRNUM := RENAMEREQNEWNAME, OLDFNAME(OLDFNAMELEN));   <<U.RAO>>11654000
   END                                                         <<U.RAO>>11656000
ELSE IF CIBADFILENAME(ERRNUM,PARMS) THEN                       <<U.RAO>>11658000
   PARMNUM := 1  <<FIRST FILE NAME FAILED TO PARSE>>           <<U.RAO>>11660000
ELSE IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN                    <<U.RAO>>11662000
   PARMNUM := 2                                                <<U.RAO>>11664000
ELSE                                                           <<U.RAO>>11666000
   BEGIN                                                       <<U.RAO>>11668000
   <<WE KNOW THAT WE HAVE AT LEAST TWO GOOD PARMS.  NOW WE>>   <<U.RAO>>11670000
   <<START GETTING TO THE HEART OF THE MATTER>>                <<U.RAO>>11672000
   IF NUMPARMS = 3 THEN  <<CHECK FOR "TEMP">>                  <<U.RAO>>11674000
      IF (TEMPPARMLEN <> 4) OR (TEMPPARM <> "TEMP") THEN       <<U.RAO>>11676000
         BEGIN                                                 <<U.RAO>>11678000
         PARMNUM := 3;                                         <<U.RAO>>11680000
         CIERR(ERRNUM := RENAMEEXPECTTEMP,TEMPPARM);           <<U.RAO>>11682000
         RETURN                                                <<U.RAO>>11684000
         END                                                   <<U.RAO>>11686000
      ELSE                                                     <<U.RAO>>11688000
         FOPTIONS := %2002;  <<OLD TEMP, DISALLOW FILE EQ.>>   <<U.RAO>>11690000
   TOS := FOPEN(OLDFNAME,FOPTIONS,%10500); <<NOBUF,EXC,KSAM>>  <<06.RO>>11692000
   IF CARRY THEN  <<OPEN ON OLD FILE FAILED>>                  <<U.RAO>>11694000
      BEGIN                                                    <<U.RAO>>11696000
      FERROR'(*,PARMNUM);                                      <<U.RAO>>11698000
      QUALIFYFILENAME(OLDFNAME,FULLFILENAME);                  <<U.RAO>>11700000
      CIERR(ERRNUM := RENAMEOLDFFSERR,,0,@FULLFILENAME);       <<U.RAO>>11702000
      END                                                      <<U.RAO>>11704000
   ELSE  <<OPEN SUCCEEDED>>                                    <<U.RAO>>11706000
      BEGIN   <<TRY NEW NAME>>                                 <<U.RAO>>11708000
      FRENAME(S0,NEWFNAME);                                    <<U.RAO>>11710000
      IF CARRY THEN   <<RENAME FAILED>>                        <<U.RAO>>11712000
         BEGIN                                                 <<U.RAO>>11714000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>11716000
         CIERR(ERRNUM := RENAMEFAILED);                        <<U.RAO>>11718000
         END                                                   <<U.RAO>>11720000
      ELSE   <<NOW JUST CLOSE THE NEWLY NAMED FILE>>           <<U.RAO>>11722000
         BEGIN                                                 <<U.RAO>>11724000
         FCLOSE(S0,0,0);                                       <<U.RAO>>11726000
         IF CARRY THEN   <<CLOSE SOMEHOW FAILED>>              <<U.RAO>>11728000
            BEGIN                                              <<U.RAO>>11730000
            FERROR'(*,PARMNUM);                                <<U.RAO>>11732000
            CIERR(ERRNUM := RENAMECLSFAILED);                  <<U.RAO>>11734000
            END;                                               <<U.RAO>>11736000
         END;                                                  <<U.RAO>>11738000
      END;                                                     <<U.RAO>>11740000
   END;                                                        <<U.RAO>>11742000
END;                                                           <<U.RAO>>11744000
PROCEDURE CXPURGE EXECUTORHEAD;                                         11746000
   OPTION PRIVILEGED, UNCALLABLE;                                       11748000
BEGIN                                                                   11750000
DOUBLE DL := [8/",",8/";",8/%15,8/0]D;  <<DELIMITERS>>         <<U.RAO>>11752000
EQUATE                                                         <<U.RAO>>11754000
   COMMA = 0,                                                  <<U.RAO>>11756000
   SEMI = 1,                                                   <<U.RAO>>11758000
   CR = 2;                                                     <<U.RAO>>11760000
INTEGER NUMPARMS;                                              <<U.RAO>>11762000
INTEGER FCHECKCODE = NUMPARMS;                                 <<U.RAO>>11764000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>11766000
BYTE POINTER FILENAME = PARMS;                                 <<U.RAO>>11768000
BYTE FILENAMELEN = PARMS+1;                                    <<U.RAO>>11770000
LOGICAL FILEDATA = PARMS+1;                                    <<U.RAO>>11772000
BYTE POINTER TEMPPARM = PARMS+2;                               <<U.RAO>>11774000
BYTE TEMPPARMLEN = PARMS+3;                                    <<U.RAO>>11776000
BYTE POINTER EXTRAPARM = PARMS+4;                              <<U.RAO>>11778000
BYTE ARRAY TEMPFILENAME(0:35);  <<FOR ERROR REPORTING>>        <<U.RAO>>11780000
LOGICAL FOPTIONS := %2001;   <<OLD PERM, DISALLOW FILE EQ.>>   <<U.RAO>>11782000
EQUATE DELETE = 4,                                             <<U.RAO>>11784000
       AOPTIONS = %10501;                                      <<U.RAO>>11786000
DEFINE DELIMITER=FILEDATA.(11:5)#;                             <<U.RAO>>11788000
                                                               <<U.RAO>>11790000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>11792000
IF NUMPARMS > 2 THEN                                           <<U.RAO>>11794000
   BEGIN  <<TOO MANY PARAMETERS>>                              <<U.RAO>>11796000
   PARMNUM := 3;                                               <<U.RAO>>11798000
   CIERR(ERRNUM := PURGE2MP, EXTRAPARM);                       <<U.RAO>>11800000
   END                                                         <<U.RAO>>11802000
ELSE IF NUMPARMS = 0 THEN                                      <<U.RAO>>11804000
   BEGIN <<TOO FEW PARAMETERS>>                                <<U.RAO>>11806000
   PARMNUM := 1;                                               <<U.RAO>>11808000
   CIERR(ERRNUM := PURGEREQFNAME, PARMSP(1));                  <<U.RAO>>11810000
   END                                                         <<U.RAO>>11812000
ELSE IF CIBADFILENAME(ERRNUM,PARMS) THEN                       <<U.RAO>>11814000
   PARMNUM := 1                                                <<U.RAO>>11816000
ELSE                                                           <<U.RAO>>11818000
   BEGIN                                                       <<U.RAO>>11820000
   <<CHECK SEPARATING DELIMITER>>                              <<U.RAO>>11822000
   IF DELIMITER=SEMI THEN                                      <<U.RAO>>11824000
      CIERR(-PURGESEMICOLON,  FILENAME(FILENAMELEN));          <<U.RAO>>11826000
   <<HAVE VALID FILE NAME.  CHECK FOR "TEMP">>                 <<U.RAO>>11828000
   IF NUMPARMS = 2 THEN  <<EXPECT "TEMP">>                     <<U.RAO>>11830000
      IF (TEMPPARMLEN<>4) OR (TEMPPARM<>"TEMP") THEN           <<U.RAO>>11832000
         BEGIN                                                 <<U.RAO>>11834000
         PARMNUM := 2;                                         <<U.RAO>>11836000
         CIERR(ERRNUM := PURGEEXPECTTEMP, TEMPPARM);           <<U.RAO>>11838000
         RETURN                                                <<U.RAO>>11840000
         END                                                   <<U.RAO>>11842000
      ELSE                                                     <<U.RAO>>11844000
         FOPTIONS := %2002;  <<OLD TEMP, DISALLOW FILE EQ.>>   <<U.RAO>>11846000
   TOS :=DFOPEN(FILENAME,FOPTIONS,AOPTIONS);                   <<00200>>11848000
   IF CARRY THEN  <<OPEN FAILED>>                              <<U.RAO>>11850000
      BEGIN                                                    <<U.RAO>>11852000
      FCHECK(S0,FCHECKCODE);                                   <<U.RAO>>11854000
      IF FCHECKCODE<>52 AND FCHECKCODE<>53 AND FCHECKCODE<>58  <<U.RAO>>11856000
         THEN                                                  <<U.RAO>>11858000
         BEGIN   <<SERIOUS PURGE ERROR>>                       <<U.RAO>>11860000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>11862000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>11864000
         CIERR(ERRNUM := PURGEFOPENFAILD,,0,@TEMPFILENAME);    <<U.RAO>>11866000
         END                                                   <<U.RAO>>11868000
      ELSE                                                     <<U.RAO>>11870000
         BEGIN                                                 <<U.RAO>>11872000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>11874000
         CIERR(-PURGEFNOTFOUND,FILENAME,0,@TEMPFILENAME);      <<U.RAO>>11876000
         END                                                   <<U.RAO>>11878000
      END                                                      <<U.RAO>>11880000
   ELSE                                                        <<U.RAO>>11882000
      BEGIN <<GOOD OPEN>>                                      <<U.RAO>>11884000
      FCLOSE(S0,DELETE,0);                                     <<U.RAO>>11886000
      IF CARRY THEN                                            <<U.RAO>>11888000
         BEGIN  <<CLOSE FAILED>>                               <<U.RAO>>11890000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>11892000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>11894000
         CIERR(ERRNUM := PURGECLOSEFAILD,,0,@TEMPFILENAME);    <<U.RAO>>11896000
         END;                                                  <<U.RAO>>11898000
      END;                                                     <<U.RAO>>11900000
   END;                                                        <<U.RAO>>11902000
END;  <<CXPURGE>>                                              <<U.RAO>>11904000
PROCEDURE CXSAVE EXECUTORHEAD;                                          11906000
   OPTION PRIVILEGED, UNCALLABLE;                                       11908000
BEGIN                                                          <<U.RAO>>11910000
DOUBLE DL := [8/",",8/";",8/%15,8/0]D;  <<DELIMITERS>>         <<U.RAO>>11912000
EQUATE                                                         <<U.RAO>>11914000
   COMMA = 0,                                                  <<U.RAO>>11916000
   SEMI = 1,                                                   <<U.RAO>>11918000
   CR = 2;                                                     <<U.RAO>>11920000
LOGICAL DUMMY = DL;                                            <<U.RAO>>11922000
INTEGER NUMPARMS;                                              <<U.RAO>>11924000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>11926000
BYTE POINTER OLDFNAME = PARMS;                                 <<U.RAO>>11928000
BYTE OLDFNAMELEN=PARMS+1;                                      <<U.RAO>>11930000
LOGICAL FILENAMEDATA = PARMS+1;                                <<U.RAO>>11932000
DEFINE DELIMITER = FILENAMEDATA.(11:5)#;                       <<U.RAO>>11934000
BYTE POINTER NEWFNAME = PARMS+2;                               <<U.RAO>>11936000
BYTE NEWFNAMELEN = PARMS+3;                                    <<U.RAO>>11938000
BYTE POINTER ERRPARM = PARMS+4;                                <<U.RAO>>11940000
BYTE ARRAY TEMPFNAME(0:35);                                    <<U.RAO>>11942000
LOGICAL LERRPTR = ERRPARM;                                     <<U.RAO>>11944000
                                                               <<U.RAO>>11946000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>11948000
IF NUMPARMS > 2 THEN                                           <<U.RAO>>11950000
   BEGIN                                                       <<U.RAO>>11952000
   PARMNUM := 3;                                               <<U.RAO>>11954000
   CIERR(ERRNUM := SAVE2MP, ERRPARM);                          <<U.RAO>>11956000
   END                                                         <<U.RAO>>11958000
ELSE IF NUMPARMS = 0 THEN                                      <<U.RAO>>11960000
   BEGIN                                                       <<U.RAO>>11962000
   PARMNUM := 1;                                               <<U.RAO>>11964000
   CIERR(ERRNUM := SAVEREQFNAME,PARMSP(1));                    <<U.RAO>>11966000
   END                                                         <<U.RAO>>11968000
ELSE                                                           <<U.RAO>>11970000
   BEGIN                                                       <<U.RAO>>11972000
   IF DELIMITER=SEMI THEN  <<EXPECTED COMMA, FOUND ";", WARN>> <<U.RAO>>11974000
      CIERR(-SAVESEMICOLON, OLDFNAME(OLDFNAMELEN));            <<U.RAO>>11976000
   <<HAVE AT LEAST A LEGAL NUMBER OF PARMS. NOW VALIDATE THEM>><<U.RAO>>11978000
   TOS := CHECKFILENAME'(PARMS&LSR(8),DUMMY,DUMMY,LERRPTR);    <<U.RAO>>11980000
   IF < THEN  <<FILE NAME ERROR OF SOME SORT>>                 <<U.RAO>>11982000
      BEGIN                                                    <<U.RAO>>11984000
      PARMNUM := 1;                                            <<U.RAO>>11986000
      ERRNUM := S0;                                            <<U.RAO>>11988000
      CIERR(*,ERRPARM);                                        <<U.RAO>>11990000
      END                                                      <<U.RAO>>11992000
   ELSE IF > AND S0 <> 0 THEN                                  <<U.RAO>>11994000
      BEGIN <<SYSTEM DEFINED FILE - $OLDPASS?>>                <<U.RAO>>11996000
      IF TOS <> 3 THEN  <<NOT $OLDPASS>>                       <<U.RAO>>11998000
         BEGIN                                                 <<U.RAO>>12000000
         PARMNUM := 1;                                         <<U.RAO>>12002000
         CIERR(ERRNUM := SAVEEXPECTOLDPASS,OLDFNAME);          <<U.RAO>>12004000
         END                                                   <<U.RAO>>12006000
      ELSE IF NUMPARMS <> 2 THEN  <<MISSING NEW FILE NAME>>    <<U.RAO>>12008000
         BEGIN                                                 <<U.RAO>>12010000
         PARMNUM := 2;                                         <<U.RAO>>12012000
         CIERR(ERRNUM := SAVEREQFNAME, OLDFNAME(OLDFNAMELEN)); <<U.RAO>>12014000
         END                                                   <<U.RAO>>12016000
      ELSE                                                     <<U.RAO>>12018000
         BEGIN  <<HAVE $OLDPASS, CHECK NEW FILE NAME>>         <<U.RAO>>12020000
         TOS := CHECKFILENAME'(PARMS(1)&LSR(8),DUMMY,DUMMY,LERRPTR);    12022000
         IF < THEN   <<FILE NAME ERROR>>                       <<U.RAO>>12024000
            BEGIN                                              <<U.RAO>>12026000
            PARMNUM := 2;                                      <<U.RAO>>12028000
            ERRNUM := S0;                                      <<U.RAO>>12030000
            CIERR(*,ERRPARM);                                  <<U.RAO>>12032000
            END                                                <<U.RAO>>12034000
         ELSE IF > AND TOS <> 0 THEN                           <<U.RAO>>12036000
            BEGIN  <<SYS DEFINED FILE>>                        <<U.RAO>>12038000
            PARMNUM := 2;                                      <<U.RAO>>12040000
            CIERR(ERRNUM := SAVEREQFNAME,NEWFNAME);            <<U.RAO>>12042000
            END                                                <<U.RAO>>12044000
         ELSE  <<OK - LET'S DO IT>>                            <<U.RAO>>12046000
            BEGIN                                              <<U.RAO>>12048000
            TOS := FOPEN(,%2032,%10500);                       <<06.RO>>12050000
            IF CARRY THEN  <<OPEN FAILED>>                     <<U.RAO>>12052000
               BEGIN                                           <<U.RAO>>12054000
               FERROR'(*,PARMNUM);                             <<U.RAO>>12056000
               QUALIFYFILENAME(NEWFNAME,TEMPFNAME);            <<U.RAO>>12058000
               CIERR(ERRNUM := SAVEOPENOLDPASS,,0,@TEMPFNAME); <<U.RAO>>12060000
               END                                             <<U.RAO>>12062000
            ELSE  <<OPEN WORKED, NOW TRY RENAME>               <<RV.PV>>12064000
               BEGIN                                           <<U.RAO>>12066000
                   FRENAME (S0,NEWFNAME);                      <<RV.PV>>12068000
                   IF CARRY THEN                               <<RV.PV>>12070000
                   BEGIN                                       <<RV.PV>>12072000
                       FERROR' (*,PARMNUM);                    <<RV.PV>>12074000
                       CIERR (ERRNUM:=RENAMEFAILED);           <<RV.PV>>12076000
                   END                                         <<RV.PV>>12078000
                   ELSE                                        <<RV.PV>>12080000
                   BEGIN <<RENAME WORKED, CLOSE WITH SAVE>>    <<RV.PV>>12082000
                       FCLOSE(S0,1,0);                         <<RV.PV>>12084000
                       IF CARRY THEN   <<CLOSE FAILED >>       <<RV.PV>>12086000
                       BEGIN                                   <<RV.PV>>12088000
                          FERROR'(*,PARMNUM);                  <<RV.PV>>12090000
                          QUALIFYFILENAME(NEWFNAME,TEMPFNAME); <<RV.PV>>12092000
                          CIERR(ERRNUM:=SAVECLOSOLDPASS,,0,    <<RV.PV>>12094000
                                @TEMPFNAME);                   <<RV.PV>>12096000
                       END                                     <<RV.PV>>12098000
                   END;                                        <<RV.PV>>12100000
               END                                             <<U.RAO>>12102000
            END                                                <<U.RAO>>12104000
         END                                                   <<U.RAO>>12106000
      END                                                      <<U.RAO>>12108000
   ELSE  IF NUMPARMS=1 THEN  <<REGULAR FILE NAME>>             <<U.RAO>>12110000
      BEGIN                                                    <<U.RAO>>12112000
      TOS := FOPEN(OLDFNAME,%2002,%10500);                     <<06.RO>>12114000
      IF CARRY THEN  <<OPEN FAILED>>                           <<U.RAO>>12116000
         BEGIN                                                 <<U.RAO>>12118000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>12120000
         QUALIFYFILENAME(OLDFNAME,TEMPFNAME);                  <<U.RAO>>12122000
         CIERR(ERRNUM := SAVETEMPOPEN,,0,@TEMPFNAME);          <<U.RAO>>12124000
         END                                                   <<U.RAO>>12126000
      ELSE                                                     <<U.RAO>>12128000
         BEGIN                                                 <<U.RAO>>12130000
         FCLOSE(S0,1,0);                                       <<U.RAO>>12132000
         IF CARRY THEN  <<CLOSE FAILED>>                       <<U.RAO>>12134000
            BEGIN                                              <<U.RAO>>12136000
            FERROR'(*,PARMNUM);                                <<U.RAO>>12138000
            QUALIFYFILENAME(OLDFNAME,TEMPFNAME);               <<U.RAO>>12140000
            CIERR(ERRNUM := SAVETEMPCLOSE,,0,@TEMPFNAME);      <<U.RAO>>12142000
            END                                                <<U.RAO>>12144000
         END                                                   <<U.RAO>>12146000
      END                                                      <<U.RAO>>12148000
   ELSE  <<REGULAR FILE NAME BUT 2 PARAMETERS>>                <<U.RAO>>12150000
      CIERR(ERRNUM := SAVE2MP,NEWFNAME);                       <<U.RAO>>12152000
   END;                                                        <<U.RAO>>12154000
END;  <<CXSAVE>>                                               <<U.RAO>>12156000
INTEGER PROCEDURE FORMACCESS'(LEVEL,ACCSTRING,SEC,NUMPARMS,ERRNUM);     12158000
VALUE LEVEL;                                                   <<U.RAO>>12160000
INTEGER LEVEL,  <<LEVEL OF SECURITY - 0/1/2 = FILE/GROUP/ACCT>><<U.RAO>>12162000
        NUMPARMS, <<NUMBER OF PARAMETERS ENCOUNTERED BEFORE RETURN>>    12164000
        ERRNUM;  <<THE USUAL MEANING>>                         <<U.RAO>>12166000
BYTE ARRAY ACCSTRING;  <<POINTER TO THE ACCESS LIST>>          <<U.RAO>>12168000
DOUBLE SEC;  <<THE SECURITY MATRIX TO BE RETURNED>>            <<U.RAO>>12170000
  <<RETURN VALUE IS ADDRESS OF NEXT NON-BLANK AFTER ACCSTRING>><<U.RAO>>12172000
OPTION UNCALLABLE,PRIVILEGED;                                  <<U.RAO>>12174000
                                                               <<U.RAO>>12176000
  <<THIS PROCEDURE PARSES THE SECURITY SPECIFICATION AND RETURNS THE>>  12178000
  <<MATRIX APPROPRIATE TO THE <LEVEL> IN <SEC>.  >>            <<U.RAO>>12180000
                                                               <<U.RAO>>12182000
BEGIN                                                          <<U.RAO>>12184000
LOGICAL LEVELMASK := 1;<<BIT 15=>FILE, BIT 14=>GROUP, BIT 13=>ACCT>>    12186000
BYTE POINTER STRINGPTR = FORMACCESS';                          <<U.RAO>>12188000
BYTE POINTER PERMIT;  <<USED IN ANALYZING VALIDITY OF USER LIST<<U.RAO>>12190000
<<INDIVIDUAL PARAMETER CHARACTERISTICS VARIABLES>>             <<U.RAO>>12192000
BYTE POINTER PARM;  <<POINTER TO CURRENT PARAMETER>>           <<U.RAO>>12194000
INTEGER PARMLEN;    <<LENGTH OF CURRENT PARAMETER>>            <<U.RAO>>12196000
BYTE DELIM;         <<NEXT DELIMITER AFTER PARAMETER>>         <<U.RAO>>12198000
<<VARIABLES FOR PARSE>>                                        <<U.RAO>>12200000
BYTE ARRAY PBACCESSORS(0:1)=PB :=                              <<U.RAO>>12202000
   6,3,"ANY",%7,                                               <<U.RAO>>12204000
   5,2,"AC" ,%7,                                               <<U.RAO>>12206000
   5,2,"AL" ,%3,                                               <<U.RAO>>12208000
   5,2,"GU" ,%3,                                               <<U.RAO>>12210000
   5,2,"GL" ,%3,                                               <<U.RAO>>12212000
   5,2,"CR" ,%1,                                               <<U.RAO>>12214000
   0;                                                          <<U.RAO>>12216000
BYTE ARRAY ACCESSORS(0:31);                                    <<U.RAO>>12218000
BYTE ARRAY PBACCESSMODES(0:1)=PB :=                            <<U.RAO>>12220000
   3,1,"R",                                                    <<U.RAO>>12222000
   3,1,"A",                                                    <<U.RAO>>12224000
   3,1,"W",                                                    <<U.RAO>>12226000
   3,1,"L",                                                    <<U.RAO>>12228000
   3,1,"X",                                                    <<U.RAO>>12230000
   3,1,"S",                                                    <<U.RAO>>12232000
   0;                                                          <<U.RAO>>12234000
BYTE ARRAY ACCESSMODES(0:24);                                  <<U.RAO>>12236000
<<VARIABLES FOR PROCESSING MATRIX  (ALREADY SET FOR FILE)>>    <<U.RAO>>12238000
INTEGER FACTOR := 6;  <<BIT WIDTH OF MODE FIELD IN MATRIX>>    <<U.RAO>>12240000
INTEGER BASE := 3;  <<NUMBER OF WASTE BITS IN MATRIX+1>>       <<U.RAO>>12242000
INTEGER SHIFTCOUNT;  <<USED WHEN USER HAS DUPLICATE ACCESS>>   <<U.RAO>>12244000
                                                               <<U.RAO>>12246000
<<                 *********************                   >>  <<U.RAO>>12248000
<<                 *   PRINTWARNING    *                   >>  <<U.RAO>>12250000
<<                 *********************                   >>  <<U.RAO>>12252000
                                                               <<U.RAO>>12254000
SUBROUTINE PRINTWARNING;  <<PRINTS DUPLICATE ACCESS WARNING>>  <<U.RAO>>12256000
BEGIN                                                          <<U.RAO>>12258000
CASE *(SHIFTCOUNT/FACTOR) OF                                   <<U.RAO>>12260000
   BEGIN                                                       <<U.RAO>>12262000
   CIERR(-ACCESSRREDUND, PARM);  <<READ>>                      <<U.RAO>>12264000
   CIERR(-ACCESSAREDUND, PARM);  <<APPEND>>                    <<U.RAO>>12266000
   CIERR(-ACCESSWREDUND, PARM);  <<WRITE>>                     <<U.RAO>>12268000
   CIERR(-ACCESSLREDUND, PARM);  <<LOCK>>                      <<U.RAO>>12270000
   CIERR(-ACCESSXREDUND, PARM);  <<EXECUTE>>                   <<U.RAO>>12272000
   CIERR(-ACCESSSREDUND, PARM);  <<SAVE>>                      <<U.RAO>>12274000
   END;                                                        <<U.RAO>>12276000
END;  <<SUBROUTINE PRINTWARNING>>                              <<U.RAO>>12278000
                                                               <<U.RAO>>12280000
<<                 *********************                   >>  <<U.RAO>>12282000
<<                 *  CHECKDUPACCESS   *                   >>  <<U.RAO>>12284000
<<                 *********************                   >>  <<U.RAO>>12286000
                                                               <<U.RAO>>12288000
SUBROUTINE CHECKDUPACCESS(ACCESSMASK);                         <<U.RAO>>12290000
VALUE ACCESSMASK;                                              <<U.RAO>>12292000
DOUBLE ACCESSMASK;                                             <<U.RAO>>12294000
BEGIN                                                          <<U.RAO>>12296000
<<THIS SUBROUTINE CHECKS FOR THE POSSIBLITY OF THE USER>>      <<U.RAO>>12298000
<<HAVING SPECIFIED AN ACCESS:USER POINT REDUNDANTLY.  IF>>     <<U.RAO>>12300000
<<SO THE ROUTINE WARNS THE USER, BUT ALLOWS IT.>>              <<U.RAO>>12302000
<<THE ESSENCE OF THE PROBLEM IS THAT WE ARE PASSED A BIT>>     <<U.RAO>>12304000
<<MASK (ACCESSMASK) INDICATING THE POINTS WE JUST PARSED.>>    <<U.RAO>>12306000
<<THIS REQUIRES US TO CAREFULLY UNPACK THE INFO FROM THE >>    <<U.RAO>>12308000
<<MASK.  THE DIFFICULTY ARISES FROM THE FACT THAT THE MASK>>   <<U.RAO>>12310000
<<IS DIFFERENT BASED ON WHETHER IT IS FOR FILE, ACCT OR GROUP>><<U.RAO>>12312000
<<THE ALGORITHM IS 1) FIND OUT WHETHER ANY BITS WERE >>        <<U.RAO>>12314000
<<REDUNDANT, THEN 2) SCAN THROUGH THOSE REDUNDANT BITS,>>      <<U.RAO>>12316000
<<IDENTIFYING THEM AS TO THEIR MEANING.  FORTUNATELY THIS>>    <<U.RAO>>12318000
<<CHECK IS DONE ON A PER USER MODE BASIS, ALLOWING US TO>>     <<U.RAO>>12320000
<<PUT OUT A REASONABLE MESSAGE.>>                              <<U.RAO>>12322000
TOS := ACCESSMASK;                                             <<U.RAO>>12324000
TOS := SEC;    <<FIRST AND DOUBLES TOGETHER FOR REDUNDANT BITS><<U.RAO>>12326000
ASSEMBLE(                                                      <<U.RAO>>12328000
   CAB,  <<TWO LEAST SIGNIFICANT WORDS ON TOS>>                <<U.RAO>>12330000
   AND;  <<MERGE                             >>                <<U.RAO>>12332000
   CAB,  <<NOW DO TWO MOST SIGNIFICANT WORDS>>                 <<U.RAO>>12334000
   CAB;                                                        <<U.RAO>>12336000
   AND);  <<MERGE, LEAVING MSW ON TOS>>                        <<U.RAO>>12338000
IF DS1<>0D THEN                                                <<U.RAO>>12340000
   BEGIN   <<SOMETHING WAS REDUNDANT, FIND IT>>                <<U.RAO>>12342000
   SHIFTCOUNT := -BASE;  <<ACCOUNTS FOR UNUSED BITS>>          <<U.RAO>>12344000
   WHILE S0<>0 DO                                              <<U.RAO>>12346000
      BEGIN                                                    <<U.RAO>>12348000
      SHIFTCOUNT := SHIFTCOUNT+1;  <<FOR SCAN IDIOSINCRACIES>> <<U.RAO>>12350000
      ASSEMBLE(SCAN);                                          <<U.RAO>>12352000
      SHIFTCOUNT := SHIFTCOUNT+XREG;                           <<U.RAO>>12354000
      PRINTWARNING;                                            <<U.RAO>>12356000
      END;                                                     <<U.RAO>>12358000
   DEL;  <<POP EXHAUSTED WORD>>                                <<U.RAO>>12360000
   SHIFTCOUNT := 16-BASE;  <<REINITIALIZE FOR SECOND WORD>>    <<U.RAO>>12362000
   WHILE S0<>0 DO                                              <<U.RAO>>12364000
      BEGIN                                                    <<U.RAO>>12366000
      SHIFTCOUNT := SHIFTCOUNT+1;  <<DITTO FOR SCAN INSTR>>    <<U.RAO>>12368000
      ASSEMBLE(SCAN);                                          <<U.RAO>>12370000
      SHIFTCOUNT := SHIFTCOUNT+XREG;                           <<U.RAO>>12372000
      PRINTWARNING;                                            <<U.RAO>>12374000
      END;                                                     <<U.RAO>>12376000
   DEL;                                                        <<U.RAO>>12378000
   END                                                         <<U.RAO>>12380000
ELSE DDEL;                                                     <<U.RAO>>12382000
END;                                                           <<U.RAO>>12384000
                                                               <<U.RAO>>12386000
<<                 *********************                   >>  <<U.RAO>>12388000
<<                 *       NEXT        *                   >>  <<U.RAO>>12390000
<<                 *********************                   >>  <<U.RAO>>12392000
                                                               <<U.RAO>>12394000
SUBROUTINE NEXT;                                               <<U.RAO>>12396000
   <<FINDS THE NEXT PARAMETER, CALCULATES ITS LENGTH,>>        <<U.RAO>>12398000
   <<SETS APPROPRIATE VARIABLES, FINDS NEXT DELIMITER>>        <<U.RAO>>12400000
BEGIN                                                          <<U.RAO>>12402000
NUMPARMS := NUMPARMS+1;                                        <<U.RAO>>12404000
SCAN STRINGPTR WHILE %6440,1;                                  <<U.RAO>>12406000
ASSEMBLE(DUP,DDUP);                                            <<U.RAO>>12408000
@PARM := TOS;                                                  <<U.RAO>>12410000
MOVE * := * WHILE AS,0;                                        <<U.RAO>>12412000
ASSEMBLE(CAB,SUB);  <<CALCULATE LENGTH>>                       <<U.RAO>>12414000
PARMLEN := TOS;                                                <<U.RAO>>12416000
SCAN * WHILE %6440,1;  <<FIND NEXT DELIM>>                     <<U.RAO>>12418000
DELIM := BPS0;                                                 <<U.RAO>>12420000
@STRINGPTR := TOS+1;                                           <<U.RAO>>12422000
END;                                                           <<U.RAO>>12424000
                                                               <<U.RAO>>12426000
<<                 *********************                   >>  <<U.RAO>>12428000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>12430000
<<                 *********************                   >>  <<U.RAO>>12432000
                                                               <<U.RAO>>12434000
<<FILE SECURITY MATRIX FORMAT>>                                <<U.RAO>>12436000
<<----------------------------------------------------------------->>   12438000
<<!   !   ! R ! R ! R ! R ! R ! R ! A ! A ! A ! A ! A ! A ! W ! W !>>   12440000
<<!   !   !ANY! AC! AL! GU! GL! CR!ANY! AC! AL! GU! GL! CR!ANY! AC!>>   12442000
<<----------------------------------------------------------------->>   12444000
<<! W ! W ! W ! W ! L ! L ! L ! L ! L ! L ! X ! X ! X ! X ! X ! X !>>   12446000
<<! AL! GU! GL! CR!ANY! AC! AL! GU! GL!(CR!ANY! AC! AL! GU! GL! CR!>>   12448000
<<----------------------------------------------------------------->>   12450000
                                                               <<U.RAO>>12452000
<<FILE SECURITY VARIABLES SET ON ENTRY>>                       <<U.RAO>>12454000
IF LEVEL = 1 THEN  <<GROUP>>                                   <<U.RAO>>12456000
   BEGIN                                                       <<U.RAO>>12458000
<<GROUP SECURITY MATRIX FORMAT>>                               <<U.RAO>>12460000
<<----------------------------------------------------------------->>   12462000
<<!   !   ! R ! R ! R ! R ! R ! A ! A ! A ! A ! A ! W ! W ! W ! W !>>   12464000
<<!   !   !ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU!>>   12466000
<<----------------------------------------------------------------->>   12468000
<<! W ! L ! L ! L ! L ! L ! X ! X ! X ! X ! X ! S ! S ! S ! S ! S !>>   12470000
<<! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!>>   12472000
<<----------------------------------------------------------------->>   12474000
   FACTOR := 5;                                                <<U.RAO>>12476000
   LEVELMASK := 2;                                             <<U.RAO>>12478000
   END                                                         <<U.RAO>>12480000
ELSE  IF > THEN  <<ACCOUNT SECURITY MATRIX>>                   <<U.RAO>>12482000
   BEGIN                                                       <<U.RAO>>12484000
<<ACCOUNT SECURITY MATRIX>>                                    <<U.RAO>>12486000
<<----------------------------------------------------------------->>   12488000
<<!   !   !   !   ! R ! R ! A ! A ! W ! W ! L ! L ! X ! X ! S ! S !>>   12490000
<<!   !   !   !   !ANY! AC!ANY! AC!ANY! AC!ANY! AC!ANY! AC!ANY! AC!>>   12492000
<<----------------------------------------------------------------->>   12494000
   BASE := 5;                                                  <<U.RAO>>12496000
   FACTOR := 2;                                                <<U.RAO>>12498000
   LEVELMASK := 4;                                             <<U.RAO>>12500000
   END;                                                        <<U.RAO>>12502000
NUMPARMS := 0;                                                 <<U.RAO>>12504000
<<ALL VARIABLES HAVE BEEN INITIALIZED (EXCEPT SEC)>>           <<U.RAO>>12506000
<<NOW WE START THE ACTUAL PROCESSING. THE SCHEME IS   >>       <<U.RAO>>12508000
<<  CHECK FOR "("                                     >>       <<U.RAO>>12510000
<<  WHILE MORE ACCESS LISTS DO                        >>       <<U.RAO>>12512000
<<     PROCESS SPECIFIED ACCESS MODES INTO ACCESS MASK>>       <<U.RAO>>12514000
<<     CHECK FOR ":"                                  >>       <<U.RAO>>12516000
<<     FOR EACH SPECIFIED ACCESSOR, LOR THE ACCESS    >>       <<U.RAO>>12518000
<<        MASK INTO THE SECURITY MATRIX               >>       <<U.RAO>>12520000
<<     END                                            >>       <<U.RAO>>12522000
<<  CHECK FOR ")"                                     >>       <<U.RAO>>12524000
                                                               <<U.RAO>>12526000
SCAN ACCSTRING WHILE %6440,1;  <<STRIP BLANKS>>                <<U.RAO>>12528000
IF BPS0 <> "(" THEN                                            <<U.RAO>>12530000
   CIERR(ERRNUM := ACCESSEXPECTLPAREN, BPS0)                   <<U.RAO>>12532000
ELSE  <<HAVE LEADING "(">>                                     <<U.RAO>>12534000
   BEGIN                                                       <<U.RAO>>12536000
   TOS := TOS+1;                                               <<U.RAO>>12538000
   SCAN * WHILE %6440,1;  <<SCAN FOR NEXT NON-BLANK>>          <<U.RAO>>12540000
   @STRINGPTR := TOS;  <<INITIALIZE STRINGPTR>>                <<U.RAO>>12542000
   IF STRINGPTR = ")" THEN  <<NULL ACCESS STRING>>             <<U.RAO>>12544000
      BEGIN                                                    <<U.RAO>>12546000
      SCAN STRINGPTR(1) WHILE %6440,1;                         <<U.RAO>>12548000
      @STRINGPTR := TOS;                                       <<U.RAO>>12550000
      NUMPARMS := 1;                                           <<U.RAO>>12552000
      RETURN                                                   <<U.RAO>>12554000
      END;                                                     <<U.RAO>>12556000
   <<NOW INITIALIZE SECURITY MASK>>                            <<U.RAO>>12558000
   IF LEVEL=2 THEN SEC := [16/1,16/0]D <<ACCOUNT, FORCE S:AC>> <<U.RAO>>12560000
              ELSE SEC := 0D;                                  <<U.RAO>>12562000
   <<OK, WE HAVE THE PRELIMINARIES DONE WITH.  THE TASK>>      <<U.RAO>>12564000
   <<NOW IS TO PARSE THE BODY OF THE ACCESS LIST>>             <<U.RAO>>12566000
   MOVE ACCESSMODES := PBACCESSMODES,(25);                     <<U.RAO>>12568000
   MOVE ACCESSORS := PBACCESSORS,(32);                         <<U.RAO>>12570000
   DO BEGIN  <<UNTIL NO MORE ACCESS LISTS>>                    <<U.RAO>>12572000
      <<FIRST TASK IS TO CREATE ACCESS MASK TEMPLATE>>         <<U.RAO>>12574000
      TOS := 0D;   <<INITIALIZE TEMPLATE>>                     <<U.RAO>>12576000
      DO BEGIN  <<UNTIL END OF MODELIST>>                      <<U.RAO>>12578000
         <<STRATEGY IS TO LOOP THROUGH MODE LIST, CREATING>>   <<U.RAO>>12580000
         <<A DOUBLE WITH BITS SET FOR "ANY" WITH  THE >>       <<U.RAO>>12582000
         <<SPECIFIED MODES AND THE SPECIFIED BIT SPACING>>     <<U.RAO>>12584000
         NEXT;  <<SET CHARACTERISTICS OF NEXT PARM>>           <<U.RAO>>12586000
         TOS := SEARCH(PARM,PARMLEN,ACCESSMODES) - 1;          <<U.RAO>>12588000
         IF < THEN <<UNKNOWN ACCESS MODE>>                     <<U.RAO>>12590000
            BEGIN                                              <<U.RAO>>12592000
            IF LEVEL < 1 THEN ERRNUM:=ACCESSUNKNOWNFMODE       <<U.RAO>>12594000
            ELSE IF = THEN    ERRNUM:=ACCESSUNKNOWNGMODE       <<U.RAO>>12596000
            ELSE              ERRNUM:=ACCESSUNKNOWNAMODE;      <<U.RAO>>12598000
            CIERR(ERRNUM,PARM);                                <<U.RAO>>12600000
            RETURN;                                            <<U.RAO>>12602000
            END;                                               <<U.RAO>>12604000
         IF (S0=5) AND (LEVEL<>1) THEN                         <<U.RAO>>12606000
            BEGIN <<WARN - ILLEGAL USE OF SAVE MODE>>          <<U.RAO>>12608000
            DEL;                                               <<U.RAO>>12610000
            IF LEVEL = 0 THEN TOS := -ACCESSFSNOTPERMIT        <<U.RAO>>12612000
                         ELSE TOS := -ACCESSASNOTPERMIT;       <<U.RAO>>12614000
            CIERR( * ,PARM);                                  <<U.RAO>> 12616000
            END                                                <<U.RAO>>12618000
         ELSE                                                  <<U.RAO>>12620000
            BEGIN <<EVERYTHING GOOD, SET MASK BIT>>            <<U.RAO>>12622000
            X := TOS*FACTOR+BASE;  <<OFFSET FROM BIT 31>>      <<U.RAO>>12624000
            ASSEMBLE(DCSL 0,X;  <<ROTATE TO BIT 31>>           <<U.RAO>>12626000
                     TSBC 15);  <<SET ACCESS BIT>>             <<U.RAO>>12628000
            <<NOTE:  X HAS THE SHIFT COUNT IN IT, UPON WHICH>> <<U.RAO>>12630000
            <<THE FOLLOWING ASSEMBLE DEPENDS.  DON'T MESS IT UP<<U.RAO>>12632000
            IF <> THEN  <<ACCESS MODE REDUNDANTLY SPECIFIED>>  <<U.RAO>>12634000
               CIERR(-ACCESSREDUNDMODE, PARM);                 <<U.RAO>>12636000
            ASSEMBLE(DCSR 0,X);  <<ROTATE BACK>>               <<U.RAO>>12638000
            END                                                <<U.RAO>>12640000
         END UNTIL DELIM <> ",";                               <<U.RAO>>12642000
      <<ACCESS MODE LIST PARSED. NOW CHECK FOR ":">>           <<U.RAO>>12644000
      IF DELIM <> ":" THEN                                     <<U.RAO>>12646000
         BEGIN                                                 <<U.RAO>>12648000
         CIERR(ERRNUM := ACCESSEXPECTCOLON, STRINGPTR(-1));    <<U.RAO>>12650000
         RETURN                                                <<U.RAO>>12652000
         END;                                                  <<U.RAO>>12654000
      <<NOW PROCESS USER LIST.  AS WE FIND A VALID USER, >>    <<U.RAO>>12656000
      <<WE SHIFT THE PROTOTYPE MODE LIST (DOUBLE ON TOS) >>    <<U.RAO>>12658000
      <<AND LOR IT INTO THE NEW SECURITY MATRIX>>              <<U.RAO>>12660000
      DO BEGIN  <<UNTIL END OF USER LIST>>                     <<U.RAO>>12662000
         NEXT;                                                 <<U.RAO>>12664000
         X := SEARCH(PARM,PARMLEN,ACCESSORS,PERMIT)-1;         <<U.RAO>>12666000
         IF < THEN <<UNKNOWN ACCESSOR TYPE>>                   <<U.RAO>>12668000
            BEGIN                                              <<U.RAO>>12670000
            IF LEVEL < 1 THEN ERRNUM := ACCESSUNKNOWNFUSER     <<U.RAO>>12672000
            ELSE IF = THEN ERRNUM := ACCESSUNKNOWNGUSER        <<U.RAO>>12674000
            ELSE ERRNUM := ACCESSUNKNOWNAUSER;                 <<U.RAO>>12676000
            CIERR(ERRNUM,PARM);                                <<U.RAO>>12678000
            RETURN                                             <<U.RAO>>12680000
            END;                                               <<U.RAO>>12682000
         IF (LOGICAL(PERMIT) LAND LEVELMASK) = 0 THEN          <<U.RAO>>12684000
            BEGIN  <<WARN - NOT PERMITTED FOR THIS LEVEL>>     <<U.RAO>>12686000
            DEL;                                               <<U.RAO>>12688000
            IF LEVEL=1 THEN TOS := -ACCESSCRNOTPERMIT          <<U.RAO>>12690000
                        ELSE TOS := -ACCESSUSNOTPERMIT;        <<U.RAO>>12692000
            CIERR( * ,PARM);                                   <<U.RAO>>12694000
            END                                                <<U.RAO>>12696000
         ELSE                                                  <<U.RAO>>12698000
            BEGIN                                              <<U.RAO>>12700000
            <<HAVE VALID USER TYPE AND A VALID ACCESS MODE>>   <<U.RAO>>12702000
            <<MASK.  NOW PROCESS THE MASK INTO THE SECURITY>>  <<U.RAO>>12704000
            <<MATRIX.  THE INDEX REGISTER HAS THE ORDINAL OF>> <<U.RAO>>12706000
            <<THE USER TYPE AND THE PROTOTYPE MODE MASK IS >>  <<U.RAO>>12708000
            <<IN S-0 AND S-1>>                                 <<U.RAO>>12710000
            ASSEMBLE(DDUP;  <<COPY MODE MASK>>                 <<U.RAO>>12712000
                     DCSR 0,X); <<SHIFT COPY BY USER TYPE>>    <<U.RAO>>12714000
            CHECKDUPACCESS(DS1);                               <<U.RAO>>12716000
            TOS := SEC;                                        <<U.RAO>>12718000
            ASSEMBLE(CAB, <<GET 2 LEAST SIGNIFICANT WORDS>>    <<U.RAO>>12720000
                     OR;  <<MERGE THEM>>                       <<U.RAO>>12722000
                     CAB, <<GET 2 MOST SIGNIFICANT WORDS>>     <<U.RAO>>12724000
                     CAB;                                      <<U.RAO>>12726000
                     OR,  <<MERGE THEM>>                       <<U.RAO>>12728000
                     XCH); <<PUT BACK IN ORDER>>               <<U.RAO>>12730000
            SEC := TOS;  <<NEW BITS LOR'D INTO OLD MASK>>      <<U.RAO>>12732000
            END;                                               <<U.RAO>>12734000
         END UNTIL DELIM <> ",";                               <<U.RAO>>12736000
      DDEL;  <<POP PROTOTYPE MODE MASK>>                       <<U.RAO>>12738000
      END UNTIL DELIM <> ";";  <<GLOBAL DO LOOP>>              <<U.RAO>>12740000
                                                               <<U.RAO>>12742000
   <<WE HAVE NOW PROCESSED THE ENTIRE SET OF ACCESS LISTS>>    <<U.RAO>>12744000
   <<TIME TO FOLD OUR TENTS AND STEAL AWAY INTO THE NIGHT>>    <<U.RAO>>12746000
   IF DELIM <> ")" THEN                                        <<U.RAO>>12748000
      CIERR(ERRNUM := ACCESSEXPECTRPAREN, STRINGPTR(-1))       <<U.RAO>>12750000
   ELSE                                                        <<U.RAO>>12752000
      BEGIN  <<FIND NEXT NON-BLANK BEYOND ")">>                <<U.RAO>>12754000
      SCAN STRINGPTR WHILE %6440,1;                            <<U.RAO>>12756000
      @STRINGPTR := TOS;                                       <<U.RAO>>12758000
      END;                                                     <<U.RAO>>12760000
   END;                                                        <<U.RAO>>12762000
END;  <<FORMACCESS'>>                                          <<U.RAO>>12764000
INTEGER PROCEDURE GETFLABEL (FILEREF, LEN, FLABEL, FLDN, FADDR,         12766000
      FNUM,SIRINFO);                                           <<04.RO>>12768000
   VALUE LEN;                                                           12770000
   BYTE ARRAY FILEREF;                 <<U-SUPPLIED FILEREF>>           12772000
   INTEGER LEN;                        <<ITS LENGTH>>                   12774000
   ARRAY FLABEL;                       <<128 WD TARGET ARRAY>>          12776000
   INTEGER FLDN;                       <<FILE'S LDN>>                   12778000
   DOUBLE FADDR;                       <<FILE'S SECTOR ADDR>>           12780000
   INTEGER FNUM;  <<FNUM OF FILE FOR WHICH WE WANT FILE LABEL>><<04.RO>>12782000
   DOUBLE SIRINFO;                     <<SIR AND FLAGS TO RELEASE>>     12784000
   OPTION VARIABLE, PRIVILEGED, UNCALLABLE;                             12786000
<< ANALYZES THE FILEREFERENCE;  GETS THE FILE LABEL;  VERIFIES LOCKWORD;12788000
   AND ENSURES THAT CALLER IS CREATOR.                                  12790000
   FILESIR LOCKED ON RETURN FOR UPDATE.                                 12792000
                                                                        12794000
   ALTERNATE CALL:                                                      12796000
INTEGER PROCEDURE GETFLABEL (FILEREF, LEN, FLABEL);                     12798000
   SAME AS ABOVE BUT FILESIR RELEASED.  FOR EXAMINATION.                12800000
                                                                        12802000
   RETURNS ERROR NUMBER IF ONE WAS FOUND.>>                    <<U.RAO>>12804000
                                                                        12806000
BEGIN                                                                   12808000
   INTEGER ARRAY     JIT (*)           = DB+0;                 <<38.PV>>12810000
   INTEGER ARRAY     JIT1 (@)          = DB+2;                          12812000
   DOUBLE ARRAY      DJIT1 (@)         = DB+2;                          12814000
   INTEGER           RETURNVAL         = GETFLABEL;                     12816000
   LOGICAL           PMASK             = Q-4;                           12818000
   BYTE POINTER      BFLABEL           := @FLABEL;                      12820000
   DEFINE            FLLOCK            = BFLABEL (32)  #,               12822000
                     FLFNAME           = BFLABEL  #,                    12824000
                     FLGNAME           = BFLABEL (8)  #,                12826000
                     FLANAME           = BFLABEL (16)  #;               12828000
   INTEGER           TYPE              := ACCOUNTLEVEL;        <<38.PV>>12830000
   DOUBLE            FLABADDR          ;                       <<RV.PV>>12832000
   INTEGER           LDEV              ;                       <<RV.PV>>12834000
   BYTE POINTER      GPNTR,                                             12836000
                     ERRPTR,  <<DUMMY FOR CHECKFILENAME'>>     <<U.RAO>>12838000
                     APNTR;                                             12840000
   LOGICAL           LGPNTR            = GPNTR,                         12842000
                     LERRPTR           = ERRPTR,               <<U.RAO>>12844000
                     LAPNTR            = APNTR;                         12846000
   INTEGER ARRAY     UAN (0:3),                                         12848000
                     UN (0:3),                                          12850000
                     FNAME (0:57),                                      12852000
                     GNAME (*)         = FNAME (4),                     12854000
                     ANAME (*)         = GNAME (4);                     12856000
   BYTE ARRAY        BANUN (*)         = UAN,                           12858000
                     BFNAME (*)        = FNAME,                         12860000
                     BGNAME (*)        = GNAME,                         12862000
                     BANAME (*)        = ANAME,                         12864000
                     LOCK (*)          = ANAME (4);                     12866000
                                                                        12868000
   FNAME := "  ";                                                       12870000
   MOVE FNAME (1) := FNAME, (31);                                       12872000
   TOS := 0;  <<RETURN SPACE>>                                 <<U.RAO>>12874000
   TOS := @FILEREF;                                            <<U.RAO>>12876000
   TOS := LEN;                                                 <<U.RAO>>12878000
   TOS := CHECKFILENAME'(*,LGPNTR,LAPNTR,LERRPTR);             <<U.RAO>>12880000
   IF < THEN  <<FILE NAME PARSE ERROR>>                        <<U.RAO>>12882000
      BEGIN                                                    <<U.RAO>>12884000
      RETURNVAL := S0;                                         <<U.RAO>>12886000
      CIERR(*,ERRPTR);                                         <<U.RAO>>12888000
      RETURN                                                   <<U.RAO>>12890000
      END                                                      <<U.RAO>>12892000
   ELSE IF > THEN  <<REQUIRES ACTUAL DESIGNATOR>>              <<U.RAO>>12894000
      BEGIN                                                    <<U.RAO>>12896000
      CIERR(RETURNVAL := REQFORMALFDESIG);                     <<U.RAO>>12898000
      RETURN                                                   <<U.RAO>>12900000
      END;                                                     <<U.RAO>>12902000
   MOVE BFNAME := FILEREF WHILE ANS, 0;                                 12904000
   IF BPS0 = "/" THEN                                                   12906000
      BEGIN                                                             12908000
      TOS := @LOCK;                                                     12910000
      ASSEMBLE (XCH, INCA);                                             12912000
      MOVE * := * WHILE ANS, 0;                                         12914000
      END;                                                              12916000
   IF BPS0 = "." THEN                                                   12918000
      BEGIN                                                             12920000
      TYPE := TYPE -1;                                                  12922000
      MOVE BGNAME := GPNTR WHILE ANS, 0;                                12924000
      IF BPS0 = "." THEN                                                12926000
         BEGIN                                                          12928000
         TYPE := TYPE -1;                                               12930000
         MOVE BANAME := APNTR WHILE ANS;                                12932000
         END ELSE                                              <<31.PV>>12934000
          WHO (,,,,,BANAME);                                   <<31.PV>>12936000
      END ELSE                                                 <<31.PV>>12938000
       WHO (,,,,BGNAME,BANAME);                                <<31.PV>>12940000
   <<AT THIS POINT WE HAVE THE FILE NAME.  NEXT WE OPEN THE>>  <<04.RO>>12942000
   <<FILE.  THIS HAS NO RELEVANCE TO THE ACTUAL ACCESSING OF>> <<04.RO>>12944000
   <<THE FILE.  IT'S ONLY PURPOSE IS TO CAUSE A MOUNT OF THE>> <<04.RO>>12946000
   <<PRIVATE VOLUME, IF NECESSARY>>                            <<04.RO>>12948000
   FNUM := FOPEN(FILEREF,%2001,%10717);<<INONLY,NOBUF,NO SEC.>><<01652>>12950000
   IF <> THEN                                                  <<04.RO>>12952000
      BEGIN   <<OPEN FAILED, TELL USER>>                       <<04.RO>>12954000
      FERROR'(FNUM, TYPE);                                     <<04.RO>>12956000
      QUALIFYFILENAME(FILEREF, BFNAME);                        <<04.RO>>12958000
      CIERR(RETURNVAL := GETFLABOPEN,,0,@BFNAME);              <<04.RO>>12960000
      RETURN                                                   <<04.RO>>12962000
      END;                                                     <<04.RO>>12964000
   PUSH (DL);                                                           12966000
   X := TOS-PS0(-1);                                           <<U.RAO>>12968000
   EXCHANGEDB (ARRDB6 (X).(6:10));                                      12970000
   TOS := DJIT1 (4);                                                    12972000
   TOS := DJIT1 (5);                                                    12974000
   TOS := DJIT1 (10);                                                   12976000
   TOS := DJIT1 (11);                                                   12978000
   EXCHANGEDB (0);                                                      12980000
   MOVE UAN := ARRS7, (8);                                              12982000
DOOVER:                                                                 12984000
   TOS := FILESIR;                                                      12986000
   TOS := GETSIR (FILESIR);                                             12988000
   IF PMASK THEN SIRINFO := DS1;                                        12990000
   FGETINFO (FNUM,,,,,,LDEV,,,,,,,,,,,,,FLABADDR);             <<RV.PV>>12992000
   TOS := 0;                                                            12994000
   TOS := LDEV;                                                <<RV.PV>>12996000
   TOS := FLABADDR;                                            <<RV.PV>>12998000
   TOS := 0;                                                            13000000
   TOS := @FLABEL;                                                      13002000
   IF PMASK THEN                                                        13004000
      BEGIN                                                             13006000
      FLDN := S4;                                                       13008000
      FADDR := DS3;                                                     13010000
      END;                                                              13012000
   TOS := FLABIO (*,*,*,*);                                             13014000
   IF TOS <> 0 THEN  <<DISC IO ERROR>>                         <<U.RAO>>13016000
      BEGIN                                                    <<U.RAO>>13018000
      TOS := SIRINFO;                                          <<06.RO>>13020000
      RELSIR(*,*);  <<RELEASE FILE SIR>>                       <<06.RO>>13022000
      CIERR(RETURNVAL := DISCIOERR);                           <<U.RAO>>13024000
      FCLOSE(FNUM,0,0);                                        <<06.RO>>13026000
      RETURN;                                                  <<06.RO>>13028000
      END;                                                     <<U.RAO>>13030000
   IF FLANAME <> BANUN,(16) THEN  <<CREATOR CONFLICT>>         <<U.RAO>>13032000
      BEGIN                                                    <<U.RAO>>13034000
      TOS := SIRINFO;                                          <<06.RO>>13036000
      RELSIR(*,*);   <<RELEASE FILE SYSTEM SIR>>               <<06.RO>>13038000
      CIERR(RETURNVAL := NOTCREATOR);                          <<U.RAO>>13040000
      FCLOSE(FNUM,0,0);                                        <<06.RO>>13042000
      RETURN;                                                  <<06.RO>>13044000
      END;                                                     <<U.RAO>>13046000
   IF NOT (PMASK) THEN                                                  13048000
      BEGIN                                                    <<04.RO>>13050000
         TOS := SIRINFO;                                       <<06.RO>>13052000
         RELSIR(*,*);  <<RELEASE FILE SIR>>                    <<06.RO>>13054000
         FCLOSE(FNUM,0,0);                                     <<04.RO>>13056000
      END;                                                     <<04.RO>>13058000
EXIT:                                                          << ... >>13060000
   END    <<GETFLABEL>>;                                                13062000
LOGICAL PROCEDURE ALTSECURITY(ERRNUM,FILEREF,TYPE,SEC);        <<U.RAO>>13064000
VALUE FILEREF,TYPE,SEC;                                        <<U.RAO>>13066000
DOUBLE FILEREF,SEC;                                            <<U.RAO>>13068000
INTEGER ERRNUM,TYPE;                                           <<U.RAO>>13070000
OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                       <<U.RAO>>13072000
<<THIS PROCEDURE IS CALLED BY CXRELEASE, CXSECURE, CXALTSEC>>  <<U.RAO>>13074000
<<ITS FUNCTION IS TO ACTUALLY DO THE FILE LABEL MANIPULATIONS>><<U.RAO>>13076000
<<FILEREF IS A DOUBLE WITH A BYTE POINTER TO THE BEGINNING OF>><<U.RAO>>13078000
<<THE FILE REFERENCE IN WORD 1 AND THE LENGTH OF THE FILE    >><<U.RAO>>13080000
<<REFERENCE IN WORD 2.  THIS IS USUALLY OBTAINED BY A LSR(8) >><<U.RAO>>13082000
<<ON THE DOUBLE RETURNED FROM MYCOMMAND.                     >><<U.RAO>>13084000
<<TYPE = 1 => SECURE THE FILE                                >><<U.RAO>>13086000
<<     = 0 => RELEASE THE FILE                               >><<U.RAO>>13088000
<<     = -1 => ALTER THE SECURITY MASK.                      >><<U.RAO>>13090000
<<SEC IS PRESENT IFF TYPE = -1 AND IS NEW SECURITY MASK.     >><<U.RAO>>13092000
BEGIN                                                          <<U.RAO>>13094000
DOUBLE SIRINFO; <<FILE SYSTEM SIR>>                            <<U.RAO>>13096000
DOUBLE FADDR;                                                  <<U.RAO>>13098000
INTEGER FLDN;  <<LOGICAL DEVICE NUMBER>>                       <<U.RAO>>13100000
INTEGER ARRAY FLABEL(0:127);                                   <<U.RAO>>13102000
DOUBLE ARRAY DFLABEL(*)=FLABEL;                                <<U.RAO>>13104000
LOGICAL PMASK = Q-4;                                           <<U.RAO>>13106000
BYTE POINTER FREF = FILEREF;                                   <<U.RAO>>13108000
INTEGER LEN = FILEREF+1;                                       <<U.RAO>>13110000
INTEGER FNUM;  <<HOLDS FNUM OF FILEREF OPENED IN GETFLABEL>>   <<04.RO>>13112000
                                                               <<U.RAO>>13114000
ALTSECURITY := FALSE;                                          <<U.RAO>>13116000
ERRNUM := GETFLABEL(FREF,LEN,FLABEL,FLDN,FADDR,FNUM,SIRINFO);  <<U.RAO>>13118000
IF ERRNUM = 0 THEN                                             <<U.RAO>>13120000
   BEGIN  <<OK - GO ON>>                                       <<U.RAO>>13122000
   IF PMASK THEN <<ALTSEC, SINCE NEW SECURITY MASK PASSED>>    <<U.RAO>>13124000
      DFLABEL(FLSECMATRIX) := SEC                              <<U.RAO>>13126000
   ELSE  <<RELEASE/SECURE>>                                    <<U.RAO>>13128000
      FLABEL(FLSECURE).(15:1) := TYPE;                         <<U.RAO>>13130000
   TOS := FLABIO(FLDN,FADDR,1,FLABEL);                         <<U.RAO>>13132000
   TOS := SIRINFO;                                             <<U.RAO>>13134000
   RELSIR(*,*);  <<RELEASE FILE SYSTEM SIR GOTTEN BY GETFLABEL><<U.RAO>>13136000
   FCLOSE(FNUM,0,0);  <<CLOSE MODIFIED FILE>>                  <<04.RO>>13138000
   ALTSECURITY := TRUE;                                        <<U.RAO>>13140000
   IF TOS <> 0 THEN                                            <<U.RAO>>13142000
      BEGIN                                                    <<U.RAO>>13144000
      ALTSECURITY := FALSE;                                    <<U.RAO>>13146000
      CIERR(ERRNUM := DISCIOERR);                              <<U.RAO>>13148000
      END;                                                     <<U.RAO>>13150000
   FLABEL := 0;                                                <<U.RAO>>13152000
   MOVE FLABEL(1) := FLABEL,(127);                             <<U.RAO>>13154000
   END;                                                        <<U.RAO>>13156000
END;                                                           <<U.RAO>>13158000
PROCEDURE CXRELEASE EXECUTORHEAD;                              <<U.RAO>>13160000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>13162000
BEGIN                                                          <<U.RAO>>13164000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>13166000
BYTE POINTER ERRPTR = PARMS+2;                                 <<U.RAO>>13168000
INTEGER NUMPARMS;                                              <<U.RAO>>13170000
DOUBLE DL:=COMMASEMICR;                                        <<U.RAO>>13172000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>13174000
PARMNUM := 1;                                                  <<U.RAO>>13176000
IF NUMPARMS >= 2 THEN                                          <<U.RAO>>13178000
   CIERR(ERRNUM := RELEASE2MP, ERRPTR)                         <<U.RAO>>13180000
ELSE IF NUMPARMS < 1 THEN                                      <<U.RAO>>13182000
   CIERR(ERRNUM := RELEASENOTENUF, PARMSP(1))                  <<U.RAO>>13184000
ELSE   <<EVERYTHING PARSED OK>>                                <<U.RAO>>13186000
   IF ALTSECURITY(ERRNUM,PARMS&LSR(8),0) THEN                  <<U.RAO>>13188000
      PARMNUM := 0;  <<EVERYTHING IS FINE>>                    <<U.RAO>>13190000
END;                                                           <<U.RAO>>13192000
PROCEDURE CXSECURE EXECUTORHEAD;                               <<U.RAO>>13194000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>13196000
BEGIN                                                          <<U.RAO>>13198000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>13200000
BYTE POINTER ERRPTR = PARMS+2;                                 <<U.RAO>>13202000
INTEGER NUMPARMS;                                              <<U.RAO>>13204000
DOUBLE DL := COMMASEMICR;                                      <<U.RAO>>13206000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>13208000
PARMNUM := 1;                                                  <<U.RAO>>13210000
IF NUMPARMS >= 2 THEN                                          <<U.RAO>>13212000
   CIERR(ERRNUM := SECURE2MP,ERRPTR)                           <<U.RAO>>13214000
ELSE IF NUMPARMS < 1 THEN                                      <<U.RAO>>13216000
   CIERR(ERRNUM := SECURENOTENUF, PARMSP(1))                   <<U.RAO>>13218000
ELSE  <<EVERYTHING PARSED OK SO FAR>>                          <<U.RAO>>13220000
   IF ALTSECURITY(ERRNUM, PARMS&LSR(8),1) THEN                 <<U.RAO>>13222000
      PARMNUM := 0;                                            <<U.RAO>>13224000
END;                                                           <<U.RAO>>13226000
PROCEDURE CXALTSEC EXECUTORHEAD;                               <<U.RAO>>13228000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>13230000
BEGIN                                                          <<U.RAO>>13232000
DOUBLE ARRAY PARMS(0:1) = Q;                                   <<U.RAO>>13234000
INTEGER DL := SEMICR;                                          <<U.RAO>>13236000
INTEGER NUMPARMS;                                              <<U.RAO>>13238000
DOUBLE SEC := [6/32,6/32,6/32,6/32,6/32]D;                     <<U.RAO>>13240000
BYTE POINTER ACCSTRING = PARMS+2;                              <<U.RAO>>13242000
                                                               <<U.RAO>>13244000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>13246000
IF NUMPARMS < 1 THEN                                           <<U.RAO>>13248000
   BEGIN                                                       <<U.RAO>>13250000
   PARMNUM := 1;                                               <<U.RAO>>13252000
   CIERR(ERRNUM := ALTSECNOTENUF, PARMSP(1));                  <<U.RAO>>13254000
   END                                                         <<U.RAO>>13256000
ELSE                                                           <<U.RAO>>13258000
   BEGIN                                                       <<U.RAO>>13260000
   IF > THEN  <<MODELIST INCLUDED?>>                           <<U.RAO>>13262000
      BEGIN                                                    <<U.RAO>>13264000
      TOS := FORMACCESS'(0,ACCSTRING,SEC,NUMPARMS,ERRNUM);     <<U.RAO>>13266000
      IF ERRNUM > 0 THEN   <<ERROR REPORTED>>                  <<U.RAO>>13268000
         BEGIN                                                 <<U.RAO>>13270000
         PARMNUM := NUMPARMS;                                  <<U.RAO>>13272000
         RETURN                                                <<U.RAO>>13274000
         END;                                                  <<U.RAO>>13276000
      IF BPS0 <> %15 <<CR>> THEN                               <<U.RAO>>13278000
         BEGIN                                                 <<U.RAO>>13280000
         PARMNUM := NUMPARMS+1;                                <<U.RAO>>13282000
         CIERR(ERRNUM := ALTSEC2MP, BPS0);                     <<U.RAO>>13284000
         RETURN                                                <<U.RAO>>13286000
         END;                                                  <<U.RAO>>13288000
      END;                                                     <<U.RAO>>13290000
   IF NOT ALTSECURITY(ERRNUM,PARMS&LSR(8),-1,SEC) THEN         <<U.RAO>>13292000
      PARMNUM := 1;                                            <<U.RAO>>13294000
   END;                                                        <<U.RAO>>13296000
END;  <<CXALTSEC>>                                             <<U.RAO>>13298000
$PAGE    "LISTF EXECUTOR AND RELATED PROCEDURES"                        13300000
$CONTROL   SEGMENT  =  CILISTF                                          13302000
                                                                        13304000
PROCEDURE LISTFNOTMTDMSG (GHVSNAME',SOURCEDST);                <<RV.PV>>13306000
    VALUE SOURCEDST;  INTEGER SOURCEDST;                       <<RV.PV>>13308000
    ARRAY GHVSNAME';                                           <<RV.PV>>13310000
    OPTION PRIVILEGED, UNCALLABLE;                             <<04.RO>>13312000
    BEGIN                                                      <<RV.PV>>13314000
        ARRAY                                                  <<RV.PV>>13316000
            HVSNAME (0:(NAMESIZE*3)-1);                        <<RV.PV>>13318000
        BYTE ARRAY                                             <<RV.PV>>13320000
            STRING (0:((NAMESIZE*3)*2)+2);                     <<RV.PV>>13322000
        TOS := @HVSNAME;                                       <<RV.PV>>13324000
        TOS := SOURCEDST;                                      <<RV.PV>>13326000
        TOS := @GHVSNAME';                                     <<RV.PV>>13328000
        TOS := NAMESIZE*3;                                     <<RV.PV>>13330000
        ASSEMBLE (MFDS);                                       <<RV.PV>>13332000
        FORMNAME (1,STRING,HVSNAME (NAMESIZE*2),               <<RV.PV>>13334000
                  HVSNAME (NAMESIZE),HVSNAME,HVSNAME);         <<RV.PV>>13336000
        CIERR (-LISTFHVSNOTMTD,,0,@STRING);                    <<RV.PV>>13338000
    END;<<OF LISTFNOTMTDMSG>>                                  <<RV.PV>>13340000
                                                               <<04.KM>>13342000
                                                               <<04.KM>>13344000
$CONTROL  SEGMENT=CILISTF                                      <<04.KM>>13346000
<<********************************************************************>>13348000
<< M U L T I L I N E >>                                        <<04.KM>>13350000
                                                               <<04.KM>>13352000
INTEGER PROCEDURE MULTILINE(FILE,MSG,MSGLEN,FIELD,FIELDLEN,    <<04.KM>>13354000
                            LASTCCTL,PREFIX,PREFIXLEN);        <<04.KM>>13356000
  VALUE FILE,MSG,MSGLEN,FIELD,FIELDLEN,LASTCCTL,PREFIXLEN;     <<04.KM>>13358000
  INTEGER FILE,MSGLEN,FIELD,FIELDLEN,LASTCCTL,PREFIXLEN;       <<04.KM>>13360000
  BYTE POINTER MSG;                                            <<04.KM>>13362000
  BYTE ARRAY PREFIX;                                           <<04.KM>>13364000
  OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                       <<04.KM>>13366000
BEGIN                                                          <<04.KM>>13368000
  COMMENT:                                                     <<04.KM>>13370000
    WRITES "MSG" TO "FILE" AT POSITION "FIELD" WITHIN RECORD.  <<04.KM>>13372000
    IF "MSGLEN" EXCEEDS "FIELDLEN", THE MESSAGE IS BROKEN ON   <<04.KM>>13374000
    WORD BOUNDARY AND WRITTEN ON MULTIPLE LINES.  FIRST LINE   <<04.KM>>13376000
    MAY BE PREFACED BY "PREFIX" -- SUBSEQUENT LINES CONTAIN    <<04.KM>>13378000
    BLANKS TO THE LEFT OF "FIELD".  LAST LINE IS WRITTEN WITH  <<04.KM>>13380000
    "CCTL" CARRIAGE CONTROL.                                   <<04.KM>>13382000
                                                               <<04.KM>>13384000
    RETURNS SAME CONDITION CODE AS FCONTROL OR FWRITE.  ALSO   <<04.KM>>13386000
    RETURNS FILE SYSTEM ERROR NUMBER (FCHECK).                 <<04.KM>>13388000
                                                               <<04.KM>>13390000
    INPUT PARAMETERS:                                          <<04.KM>>13392000
      MSGLEN=    # BYTES (POSITIVE)                            <<04.KM>>13394000
      FIELD=     0-ORIGINED BYTE POSITION WITHIN RECORD        <<04.KM>>13396000
      FIELDLEN=  # BYTES (POSITIVE)                            <<04.KM>>13398000
      LASTCCTL=  "FWRITE" CCTL                                 <<04.KM>>13400000
      PREFIXLEN= # BYTES (POSITIVE).                           <<04.KM>>13402000
                                                               <<04.KM>>13404000
    DEFAULT VALUES ARE:                                        <<04.KM>>13406000
      FILE=      $STDLIST                                      <<04.KM>>13408000
      MSGLEN=    0                                             <<04.KM>>13410000
      FIELD=     0                                             <<04.KM>>13412000
      FIELDLEN=  RECSIZE-FIELD                                 <<04.KM>>13414000
      LASTCCTL=  0                                             <<04.KM>>13416000
      PREFIXLEN= 0.                                            <<04.KM>>13418000
                                                               <<04.KM>>13420000
    IF "FIELD" EXCEEDS RECSIZE THE DEFAULT IS TAKEN.  HOWEVER, <<04.KM>>13422000
    FIELD+FIELDLEN MAY EXCEED RECSIZE.  IF FILE<=0 OR FIELD<0  <<04.KM>>13424000
    OR FIELDLEN<=0, THE CORRESPONDING DEFAULT IS TAKEN.  IF    <<04.KM>>13426000
    "MSG" OR "PREFIX" IS NOT PASSED, THE CORRESPONDING DEFAULT <<04.KM>>13428000
    "MSGLEN" OR "PREFIXLEN" IS TAKEN.                          <<04.KM>>13430000
    ;                                                          <<04.KM>>13432000
                                                               <<04.KM>>13434000
  INTEGER MLINEVALUE= MULTILINE;                               <<04.KM>>13436000
  LABEL EXITINSTR;                                             <<04.KM>>13438000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<04.KM>>13440000
                                                               <<04.KM>>13442000
  DEFINE FNFLAG= QPARM.(8:1) #,        <<FILE PASSED>>         <<04.KM>>13444000
         MFLAG=  QPARM.(9:1) #,        <<MSG PASSED>>          <<04.KM>>13446000
         MLFLAG= QPARM.(10:1) #,       <<MSGLEN PASSED>>       <<04.KM>>13448000
         FFLAG=  QPARM.(11:1) #,       <<FIELD PASSED>>        <<04.KM>>13450000
         FLFLAG= QPARM.(12:1) #,       <<FIELDLEN PASSED>>     <<04.KM>>13452000
         LFLAG=  QPARM.(13:1) #,       <<LASTCCTL PASSED>>     <<04.KM>>13454000
         PFLAG=  QPARM.(14:1) #,       <<PREFIX PASSED>>       <<04.KM>>13456000
         PLFLAG= QPARM #;              <<PREFIXLEN PASSED>>    <<04.KM>>13458000
  DEFINE QCC=     6:2 #;                                       <<04.KM>>13460000
  EQUATE CCL=     1,                                           <<04.KM>>13462000
         CCE=     2,                                           <<04.KM>>13464000
         CCG=     0,                                           <<04.KM>>13466000
         STDLIST= 2;                                           <<04.KM>>13468000
  BYTE TOPSTACK= MULTILINE,                                    <<04.KM>>13470000
       DUMMY=    TOPSTACK;                                     <<04.KM>>13472000
  BYTE POINTER TEMP;                                           <<04.KM>>13474000
  INTEGER QSTATUS= Q-1,                                        <<04.KM>>13476000
          X=       X,                                          <<04.KM>>13478000
          S0=      S-0,                                        <<04.KM>>13480000
          DL,                                                  <<04.KM>>13482000
          LAST,                                                <<04.KM>>13484000
          RECSIZE,                                             <<04.KM>>13486000
          CCTL;                                                <<04.KM>>13488000
  LOGICAL QPARM= Q-4;                                          <<04.KM>>13490000
  POINTER WTEMP;                                               <<04.KM>>13492000
  INTRINSIC FWRITE,FGETINFO,FCHECK;                            <<04.KM>>13494000
                                                               <<04.KM>>13496000
  ARRAY WBUF(*)=     Q;                                        <<04.KM>>13498000
  BYTE ARRAY BUF(*)= WBUF;                                     <<04.KM>>13500000
                                                               <<04.KM>>13502000
                                                               <<04.KM>>13504000
  <<*******************>>                                      <<04.KM>>13506000
  << SUBROUTINE CXEXIT >>                                      <<04.KM>>13508000
  <<*******************>>                                      <<04.KM>>13510000
                                                               <<04.KM>>13512000
  SUBROUTINE CXEXIT(CCODE); VALUE CCODE; INTEGER CCODE;        <<04.KM>>13514000
  BEGIN                                                        <<04.KM>>13516000
    QSTATUS.(QCC):=CCODE;                                      <<04.KM>>13518000
    IF CCODE=CCE THEN MULTILINE:=0                             <<04.KM>>13520000
    ELSE FCHECK(FILE,MLINEVALUE);                              <<04.KM>>13522000
    EXITPROC;                                                  <<04.KM>>13524000
  END <<SUBROUTINE CXEXIT>>;                                   <<04.KM>>13526000
                                                               <<04.KM>>13528000
                                                               <<04.KM>>13530000
  <<***************************>>                              <<04.KM>>13532000
  << SUBROUTINE BLANKLEFTFIELD >>                              <<04.KM>>13534000
  <<***************************>>                              <<04.KM>>13536000
                                                               <<04.KM>>13538000
  SUBROUTINE BLANKLEFTFIELD;                                   <<04.KM>>13540000
  BEGIN                                                        <<04.KM>>13542000
    BUF:=" ";                                                  <<04.KM>>13544000
    MOVE BUF(1):=BUF,(FIELD);                                  <<04.KM>>13546000
  END <<SUBROUTINE BLANKLEFTFIELD>>;                           <<04.KM>>13548000
                                                               <<04.KM>>13550000
                                                               <<04.KM>>13552000
  <<*********************>>                                    <<04.KM>>13554000
  << SUBROUTINE BYTESIZE >>                                    <<04.KM>>13556000
  <<*********************>>                                    <<04.KM>>13558000
                                                               <<04.KM>>13560000
  INTEGER SUBROUTINE BYTESIZE(LENGTH);                         <<04.KM>>13562000
    VALUE LENGTH; INTEGER LENGTH;                              <<??,KM>>13564000
  BEGIN                                                        <<04.KM>>13566000
    BYTESIZE:=IF LENGTH=-32768 OR LENGTH>=16384 THEN 32767     <<04.KM>>13568000
              ELSE IF LENGTH<0 THEN -LENGTH                    <<04.KM>>13570000
              ELSE 2*LENGTH;                                   <<04.KM>>13572000
  END <<SUBROUTINE BYTESIZE>>;                                 <<04.KM>>13574000
                                                               <<04.KM>>13576000
                                                               <<04.KM>>13578000
  <<**************************>>                               <<04.KM>>13580000
  << SUBROUTINE LASTWORDINDEX >>                               <<04.KM>>13582000
  <<**************************>>                               <<04.KM>>13584000
                                                               <<04.KM>>13586000
  INTEGER SUBROUTINE LASTWORDINDEX;                            <<04.KM>>13588000
  BEGIN                                                        <<04.KM>>13590000
    COMMENT:                                                   <<04.KM>>13592000
      FIND WORD BOUNDARY.  WE ASSUME THAT MSG(0) IS NONBLANK   <<04.KM>>13594000
      (IE., "MSG" HAS BEEN LEFT-DEBLANKED);                    <<04.KM>>13596000
                                                               <<04.KM>>13598000
    X:=FIELDLEN;                                               <<04.KM>>13600000
    WHILE X>0 AND MSG(X)<>" " DO X:=X-1;                       <<04.KM>>13602000
    LASTWORDINDEX:=IF X>0 THEN X ELSE FIELDLEN;                <<04.KM>>13604000
  END <<SUBROUTINE LASTWORDINDEX>>;                            <<04.KM>>13606000
                                                               <<04.KM>>13608000
                                                               <<04.KM>>13610000
  <<***********************>>                                  <<04.KM>>13612000
  << SUBROUTINE SKIPBLANKS >>                                  <<04.KM>>13614000
  <<***********************>>                                  <<04.KM>>13616000
                                                               <<04.KM>>13618000
  SUBROUTINE SKIPBLANKS;                                       <<04.KM>>13620000
  BEGIN                                                        <<04.KM>>13622000
    X:=0;                                                      <<04.KM>>13624000
    WHILE X<MSGLEN AND MSG(X)=" " DO X:=X+1;                   <<04.KM>>13626000
    @MSG:=@MSG(X);                                             <<04.KM>>13628000
    MSGLEN:=MSGLEN-X;                                          <<04.KM>>13630000
  END <<SUBROUTINE SKIPBLANKS>>;                               <<04.KM>>13632000
                                                               <<04.KM>>13634000
                                                               <<04.KM>>13636000
  <<*********************>>                                    <<04.KM>>13638000
  << SUBROUTINE WORDSIZE >>                                    <<04.KM>>13640000
  <<*********************>>                                    <<04.KM>>13642000
                                                               <<04.KM>>13644000
  INTEGER SUBROUTINE WORDSIZE(BYTELENGTH);                     <<04.KM>>13646000
    VALUE BYTELENGTH; INTEGER BYTELENGTH;                      <<04.KM>>13648000
  BEGIN                                                        <<04.KM>>13650000
    WORDSIZE:=(BYTELENGTH/2)+BYTELENGTH.(15:1);                <<04.KM>>13652000
  END <<SUBROUTINE WORDSIZE>>;                                 <<04.KM>>13654000
                                                               <<04.KM>>13656000
                                                               <<04.KM>>13658000
  <<**********************>>                                   <<04.KM>>13660000
  << SUBROUTINE WRITELINE >>                                   <<04.KM>>13662000
  <<**********************>>                                   <<04.KM>>13664000
                                                               <<04.KM>>13666000
  SUBROUTINE WRITELINE;                                        <<04.KM>>13668000
  BEGIN                                                        <<04.KM>>13670000
    COMMENT:                                                   <<04.KM>>13672000
      FILL IN "FIELD" WITH AS MUCH OF "MSG" AS POSSIBLE.       <<04.KM>>13674000
      WE ASSUME THAT "MSG" HAS BEEN RIGHT-DEBLANKED.  NOTE     <<04.KM>>13676000
      THAT AREA TO THE LEFT OF "FIELD" MAY OR MAY NOT BE       <<04.KM>>13678000
      BLANK, TO BE SET-UP BY CALLER;                           <<04.KM>>13680000
                                                               <<04.KM>>13682000
    SKIPBLANKS;                                                <<04.KM>>13684000
    IF MSGLEN<=FIELDLEN THEN           <<ASSUME FL>=1>>        <<04.KM>>13686000
      BEGIN                                                    <<04.KM>>13688000
      LAST:=MSGLEN;                    <<ASSUME ML>0>>         <<04.KM>>13690000
      CCTL:=LASTCCTL;                                          <<04.KM>>13692000
      END                                                      <<04.KM>>13694000
    ELSE                                                       <<04.KM>>13696000
      BEGIN                                                    <<04.KM>>13698000
      LAST:=LASTWORDINDEX;                                     <<04.KM>>13700000
      CCTL:=0;                                                 <<04.KM>>13702000
      END;                                                     <<04.KM>>13704000
    MOVE BUF(FIELD):=MSG,(LAST);                               <<04.KM>>13706000
    FWRITE(FILE,WBUF,-(FIELD+LAST),CCTL);                      <<04.KM>>13708000
    IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                 <<04.KM>>13710000
    @MSG:=@MSG(LAST);                                          <<04.KM>>13712000
    MSGLEN:=MSGLEN-LAST;                                       <<04.KM>>13714000
  END <<SUBROUTINE WRITELINE>>;                                <<04.KM>>13716000
                                                               <<04.KM>>13718000
                                                               <<04.KM>>13720000
  <<************************>>                                 <<04.KM>>13722000
  << SUBROUTINE WRITEPREFIX >>                                 <<04.KM>>13724000
  <<************************>>                                 <<04.KM>>13726000
                                                               <<04.KM>>13728000
  SUBROUTINE WRITEPREFIX;                                      <<04.KM>>13730000
  BEGIN                                                        <<04.KM>>13732000
    COMMENT:                                                   <<04.KM>>13734000
      WRITE PREFIX ON SEPARATE LINE;                           <<04.KM>>13736000
                                                               <<04.KM>>13738000
    TOS:=WORDSIZE(PREFIXLEN);          <<ALLOCATE BUFFER>>     <<04.KM>>13740000
    @TEMP:=(@WTEMP:=@S0)&LSL(1);                               <<04.KM>>13742000
    ASSEMBLE(ADDS 0);                                          <<04.KM>>13744000
    MOVE TEMP:=PREFIX,(PREFIXLEN);                             <<04.KM>>13746000
    FWRITE(FILE,WTEMP,-PREFIXLEN,0);                           <<04.KM>>13748000
    IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                 <<04.KM>>13750000
    TOS:=WORDSIZE(PREFIXLEN);          <<DEALLOCATE BUFFER>>   <<04.KM>>13752000
    ASSEMBLE(SUBS 0);                                          <<04.KM>>13754000
  END <<SUBROUTINE WRITEPREFIX>>;                              <<04.KM>>13756000
                                                               <<04.KM>>13758000
                                                               <<04.KM>>13760000
  <<************************>>                                 <<04.KM>>13762000
  << MAIN PROCEDURE BODY    >>                                 <<04.KM>>13764000
  <<                        >>                                 <<04.KM>>13766000
  << CHECK CALLING SEQUENCE >>                                 <<04.KM>>13768000
  <<************************>>                                 <<04.KM>>13770000
                                                               <<04.KM>>13772000
  PUSH(DL);                                                    <<04.KM>>13774000
  DL:=TOS;                                                     <<04.KM>>13776000
  IF NOT FNFLAG OR FILE<=0 THEN FILE:=STDLIST;                 <<04.KM>>13778000
                                                               <<04.KM>>13780000
  IF NOT MFLAG OR NOT MLFLAG OR MSGLEN<0 OR                    <<04.KM>>13782000
     @MSG<DL OR @MSG(MSGLEN)>@TOPSTACK THEN                    <<04.KM>>13784000
    BEGIN                                                      <<04.KM>>13786000
    @MSG:=@DUMMY;                                              <<04.KM>>13788000
    MSGLEN:=0;                                                 <<04.KM>>13790000
    END;                                                       <<04.KM>>13792000
  WHILE MSGLEN>0 AND MSG(MSGLEN-1)=" " DO MSGLEN:=MSGLEN-1;    <<04.KM>>13794000
                                                               <<04.KM>>13796000
  COMMENT:                                                     <<04.KM>>13798000
    CHECK "FIELD" & "FIELDLEN".  DEVICE RECORD SIZE IS         <<04.KM>>13800000
    DIMINISHED BY TWO (ONE FOR CCTL) TO AVOID PRINTING IN LAST <<05.KM>>13802000
    COLUMN, CAUSING EXTRA LF OR HOME-UP ON SOME DEVICES.       <<05.KM>>13804000
    "FIELD" CANNOT EQUAL "RECSIZE" TO ENSURE THAT FIELDLEN>=1; <<05.KM>>13806000
                                                               <<04.KM>>13808000
  FGETINFO(FILE,<<FNAME>>,<<FOPS>>,<<AOPS>>,RECSIZE);          <<04.KM>>13810000
  IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                   <<04.KM>>13812000
  RECSIZE:=BYTESIZE(RECSIZE)-2;                                <<05.KM>>13814000
  IF NOT FFLAG OR FIELD<0 OR FIELD>=RECSIZE THEN FIELD:=0;     <<04.KM>>13816000
  IF NOT FLFLAG OR FIELDLEN=0 THEN FIELDLEN:=RECSIZE-FIELD;    <<04.KM>>13818000
                                                               <<04.KM>>13820000
  IF NOT LFLAG THEN CCTL:=0;                                   <<04.KM>>13822000
                                                               <<04.KM>>13824000
  IF NOT PFLAG OR NOT PLFLAG OR PREFIXLEN<0 OR                 <<04.KM>>13826000
     @PREFIX<DL OR @PREFIX(PREFIXLEN)>@TOPSTACK THEN           <<04.KM>>13828000
    BEGIN                                                      <<04.KM>>13830000
    @PREFIX:=@DUMMY;                                           <<04.KM>>13832000
    PREFIXLEN:=0;                                              <<04.KM>>13834000
    END;                                                       <<04.KM>>13836000
                                                               <<04.KM>>13838000
  <<****************>>                                         <<04.KM>>13840000
  << OUTPUT MESSAGE >>                                         <<04.KM>>13842000
  <<****************>>                                         <<04.KM>>13844000
                                                               <<04.KM>>13846000
  TOS:=WORDSIZE(FIELD+FIELDLEN);       <<ALLOCATE "WBUF">>     <<04.KM>>13848000
  ASSEMBLE(ADDS 0);                                            <<04.KM>>13850000
                                                               <<04.KM>>13852000
  IF PREFIXLEN>FIELD THEN WRITEPREFIX                          <<04.KM>>13854000
  ELSE IF PREFIXLEN>0 THEN                                     <<04.KM>>13856000
    BEGIN                                                      <<04.KM>>13858000
    BLANKLEFTFIELD;                                            <<04.KM>>13860000
    MOVE BUF:=PREFIX,(PREFIXLEN);                              <<04.KM>>13862000
    WRITELINE;                                                 <<04.KM>>13864000
    END;                                                       <<04.KM>>13866000
  BLANKLEFTFIELD;                                              <<04.KM>>13868000
  WHILE MSGLEN>0 DO WRITELINE;                                 <<04.KM>>13870000
  CXEXIT(CCE);                                                 <<04.KM>>13872000
                                                               <<04.KM>>13874000
EXITINSTR:                                                     <<04.KM>>13876000
END <<PROCEDURE MULTILINE>>;                                   <<04.KM>>13878000
                                                               <<04.KM>>13880000
                                                               <<04.KM>>13882000
$CONTROL  SEGMENT=CISYSMGR                                     <<04.KM>>13884000
<<********************************************************************>>13886000
<< I M P L I C I T M N T >>                                    <<04.KM>>13888000
                                                               <<04.KM>>13890000
LOGICAL PROCEDURE IMPLICITMNT(GROUP,ACCT,MOUNTDST,PV'ERROR);   <<04.KM>>13892000
  ARRAY GROUP,ACCT;                                            <<04.KM>>13894000
  INTEGER MOUNTDST,PV'ERROR;                                   <<04.KM>>13896000
  OPTION PRIVILEGED,UNCALLABLE;                                <<04.KM>>13898000
BEGIN                                                          <<04.KM>>13900000
  COMMENT:                                                     <<04.KM>>13902000
                                                               <<04.KM>>13904000
    IMP-MOUNT DST:                                             <<04.KM>>13906000
                                                               <<04.KM>>13908000
    *********************                                      <<04.KM>>13910000
    * DSTLEN          --+-------+                              <<04.KM>>13912000
    * DSTINFOLEN      --+-----+ :                              <<04.KM>>13914000
    * DSTENTLEN         *     : :                              <<04.KM>>13916000
    * DSTENTLOC       --+---+ : :                              <<04.KM>>13918000
    * DSTENTCNT         *   : : :                              <<04.KM>>13920000
    * DSTERRCNT         *   : : :                              <<04.KM>>13922000
    * DSTMAXLEN         *   : : :                              <<04.KM>>13924000
    *         :         *   : : :                              <<04.KM>>13926000
    *===================*   : : :                              <<04.KM>>13928000
    *         :         * <-+-+ :  (FIRST AVAIL ENTRY)         <<04.KM>>13930000
    *-------------------*   :   :                              <<04.KM>>13932000
    * DSTENTERR         *   :   :                              <<04.KM>>13934000
    * DSTENTPVINFO      *   :   :                              <<04.KM>>13936000
    * DSTENTGRP  (4WDS) *   :   :                              <<04.KM>>13938000
    * DSTENTACCT (4WDS) *   :   :                              <<04.KM>>13940000
    *         :         *   :   :                              <<04.KM>>13942000
    *-------------------*   :   :                              <<04.KM>>13944000
    *         :         * <-+   :  (NEXT AVAIL ENTRY)          <<04.KM>>13946000
    *===================*       :                              <<04.KM>>13948000
    *         :         * <-----+  (AVAIL DST SPACE)           <<04.KM>>13950000
    *********************                                      <<04.KM>>13952000
                                                               <<04.KM>>13954000
                                                               <<04.KM>>13956000
    PROCEDURE IMPLICITLY MOUNTS HOME-VOL-SET OF SPECIFIED      <<04.KM>>13958000
    GROUP/ACCT.  GROUP/ACCT AND MOUNT STATUS MAY BE RECORDED IN<<04.KM>>13960000
    SPCEIFIED DATA-SEG FOR SUBSEQUENT IMPLICIT DISMOUNT.  "DB" <<04.KM>>13962000
    MUST BE POINTING TO THE STACK.                             <<04.KM>>13964000
                                                               <<04.KM>>13966000
    GROUP=    NAME OF HOME-VOL-SET GROUP                       <<04.KM>>13968000
                                                               <<04.KM>>13970000
    ACCT=     NAME OF HOME-VOL-SET ACCT                        <<04.KM>>13972000
                                                               <<04.KM>>13974000
    MOUNTDST= DST# OF DATA-SEG IN WHICH WE TRACK HOME-VOL-SETS <<04.KM>>13976000
              IMPLICITLY MOUNTED AND ERRORS ENCOUNTERED.  ENTRY<<04.KM>>13978000
              VALUES ARE:                                      <<04.KM>>13980000
                -1= DON'T USE DATA-SEG                         <<04.KM>>13982000
                 0= ALLOCATE DATA-SEG -- "MOUNTDST" IS NEW DST#<<04.KM>>13984000
                    ON EXIT                                    <<04.KM>>13986000
                >0= DST# OF PREVIOUSLY ALLOCATED DATA-SEG      <<04.KM>>13988000
                                                               <<04.KM>>13990000
    PV'ERROR= DEPENDS ON "IMPLICITMNT", VIZ:                   <<04.KM>>13992000
                TRUE=  "PV'ERROR" IS PVINFO FROM MOUNT         <<04.KM>>13994000
                       INTRINSIC                               <<04.KM>>13996000
                FALSE= "PV'ERROR" IS AN ERROR CODE.            <<04.KM>>13998000
              ERROR CODES ARE:                                 <<04.KM>>14000000
                <0= MOUNT ERROR (IFF "MOUNTDST" IS -1)         <<04.KM>>14002000
                 0= NO DATA-SEG ERROR -- MOUNT ERROR RECORDED  <<04.KM>>14004000
                    IN DATA-SEG                                <<04.KM>>14006000
                 1= OUT OF DST'S -- NO DATA-SEG ALLOCATED & NO <<04.KM>>14008000
                    MOUNT ATTEMPTED                            <<04.KM>>14010000
                 2= OUT OF VDS -- NO DATA-SEG ALLOCATED & NO   <<04.KM>>14012000
                    MOUNT ATTEMPTED                            <<04.KM>>14014000
                 3= OUT OF SPACE IN DATA-SEG -- NO MOUNT       <<04.KM>>14016000
                    ATTEMPTED                                  <<04.KM>>14018000
                 4= SYSTEM ERROR                               <<04.KM>>14020000
                                                               <<04.KM>>14022000
    IMPLICITMNT= TRUE:  MOUNT SUCCESSFUL                       <<04.KM>>14024000
               = FALSE: MOUNT UNSUCCESSFUL.  IF "PV'ERROR" IS  <<04.KM>>14026000
                        ZERO, MOUNT ERROR IS RECORDED IN       <<04.KM>>14028000
                        DATA-SEG                               <<04.KM>>14030000
                                                               <<04.KM>>14032000
    "IMPLICITMNT" SHOULD BE CALLED DURING A SYSTEM DIRECTORY   <<04.KM>>14034000
    FILE SEARCH WHEN WE WANT TO BRANCH OFF TO A PV DIRECTORY.  <<04.KM>>14036000
    (NOTE THAT CALLER IS RESPONSIBLE FOR DETERMINING THAT GROUP<<04.KM>>14038000
    RESIDES ON A VOL SET.)  WE BIND VOL SET TO GROUP.  THUS,   <<04.KM>>14040000
    CALLER INITIATES THE PV DIRECTORY SEARCH BY "REDOING" THE  <<04.KM>>14042000
    GROUP ENTRY.  IF "IMPLICITMNT" RETURNS FALSE, IT IS NOT    <<04.KM>>14044000
    NECESSARY TO "REVISIT" GROUP ENTRY.                        <<04.KM>>14046000
                                                               <<04.KM>>14048000
    IMPLICITLY MOUNTING HOME-VOL-SET PREVENTS PHYSICAL DISMOUNT<<04.KM>>14050000
    OF VOL SET DURING THE REMAINDER OF THE FILE SEARCH.  WE DO <<04.KM>>14052000
    THIS CONDITIONALLY SO THAT WE CANNOT CAUSE A PHYSICAL      <<04.KM>>14054000
    MOUNT.  THAT IS, OUR MOUNT WILL SUCCEED IFF THE VOL SET IS <<04.KM>>14056000
    ALREADY MOUNTED BY SOME USER (WITH UV CAP).  THUS, CURRENT <<04.KM>>14058000
    USER NEED NOT HAVE UV-CAP FOR FILE SEARCH SINCE HE CANNOT  <<04.KM>>14060000
    TIE UP PV RESOURCE (THEORETICALLY).                        <<04.KM>>14062000
    ;                                                          <<04.KM>>14064000
                                                               <<04.KM>>14066000
  <<**************************>>                               <<04.KM>>14068000
  <<  LOCAL "DST" STRUCTURES  >>                               <<04.KM>>14070000
  <<**************************>>                               <<04.KM>>14072000
                                                               <<04.KM>>14074000
  EQUATE  DSTFUDGE=   4,               <<KLUDGE, "EXPANDDST">> <<04.KM>>14076000
          PAGESIZE=   64,              <<EXPANSION UNIT>>      <<04.KM>>14078000
          SEGSIZE=    4000,            <<DATA-SEG SIZE>>       <<04.KM>>14080000
          INFOSIZE=   16;                                      <<04.KM>>14082000
                                                               <<04.KM>>14084000
  INTEGER ARRAY IMPINFO(0:INFOSIZE-1)= Q;                      <<04.KM>>14086000
  INTEGER IMPLEN=     IMPINFO;                                 <<04.KM>>14088000
  EQUATE  IMPINFOLEN= INFOSIZE,                                <<04.KM>>14090000
          IMPENTLEN=  16;                                      <<04.KM>>14092000
  INTEGER IMPENTLOC=  IMPINFO+3,                               <<04.KM>>14094000
          IMPENTCNT=  IMPENTLOC+1,                             <<04.KM>>14096000
          IMPERRCNT=  IMPENTCNT+1;                             <<04.KM>>14098000
  EQUATE  IMPMAXLEN=  (SEGSIZE+PAGESIZE-1)/PAGESIZE*PAGESIZE;  <<04.KM>>14100000
                                                               <<04.KM>>14102000
  INTEGER ARRAY ENTINFO(0:IMPENTLEN-1)= Q;                     <<04.KM>>14104000
  INTEGER ENTERR=           ENTINFO,                           <<04.KM>>14106000
          ENTPVINFO=        ENTERR+1;                          <<04.KM>>14108000
  INTEGER ARRAY ENTNAME(*)= ENTPVINFO+1;                       <<04.KM>>14110000
                                                               <<04.KM>>14112000
  <<******************>>                                       <<04.KM>>14114000
  <<  DST STRUCTURES  >>                                       <<04.KM>>14116000
  <<******************>>                                       <<04.KM>>14118000
                                                               <<04.KM>>14120000
  EQUATE  DSTINFO=    0,                                       <<04.KM>>14122000
          DSTLEN=     DSTINFO,                                 <<04.KM>>14124000
          DSTINFOLEN= DSTLEN+1,                                <<04.KM>>14126000
          DSTENTLEN=  DSTINFOLEN+1,                            <<04.KM>>14128000
          DSTENTLOC=  DSTENTLEN+1,                             <<04.KM>>14130000
          DSTENTCNT=  DSTENTLOC+1,                             <<04.KM>>14132000
          DSTERRCNT=  DSTENTCNT+1,                             <<04.KM>>14134000
          DSTMAXLEN=  DSTERRCNT+1;                             <<04.KM>>14136000
  INTEGER DSTENTINFO;                                          <<04.KM>>14138000
  DEFINE  DSTENTERR=    DSTENTINFO #,                          <<04.KM>>14140000
          DSTENTPVINFO= DSTENTINFO+1 #,                        <<04.KM>>14142000
          DSTENTNAME=   DSTENTINFO+2 #;                        <<04.KM>>14144000
                                                               <<04.KM>>14146000
  << ALLOCATION VALUES >>                                      <<04.KM>>14148000
                                                               <<04.KM>>14150000
  EQUATE  INCALLOC=    (IMPENTLEN+PAGESIZE-1)/PAGESIZE *       <<04.KM>>14152000
                         PAGESIZE,                             <<04.KM>>14154000
          MAXALLOC=    IMPMAXLEN+DSTFUDGE;                     <<04.KM>>14156000
  DEFINE  MINALLOC=    (INCALLOC-INITALLOC) #;                 <<04.KM>>14158000
  INTEGER INITALLOC;                                           <<04.KM>>14160000
  ARRAY   INITINFO(*)= PB:=                                    <<04.KM>>14162000
    0,IMPINFOLEN,IMPENTLEN,IMPINFOLEN,0,0,IMPMAXLEN;           <<04.KM>>14164000
                                                               <<04.KM>>14166000
  <<**************************>>                               <<04.KM>>14168000
  <<  OTHER LOCAL STRUCTURES  >>                               <<04.KM>>14170000
  <<**************************>>                               <<04.KM>>14172000
                                                               <<04.KM>>14174000
  EQUATE NOMOUNT= 0,                                           <<04.KM>>14176000
         NODST=   IM'MNTERR-IM'NODST,                          <<04.KM>>14178000
         NOVDS=   IM'MNTERR-IM'NOVDS,                          <<04.KM>>14180000
         NOSPACE= IM'MNTERR-IM'NOSPACE,                        <<04.KM>>14182000
         SYSERR=  IM'MNTERR-IM'SYSERR;                         <<04.KM>>14184000
                                                               <<04.KM>>14186000
  EQUATE CONDMOUNT'BIND= -3,                                   <<04.KM>>14188000
         ANYGEN=         -1;                                   <<04.KM>>14190000
  BYTE ARRAY HOMEVS(0:7);                                      <<04.KM>>14192000
  INTEGER REQ'ERROR:= CONDMOUNT'BIND;                          <<04.KM>>14194000
  INTEGER POINTER PS0= S-0;                                    <<04.KM>>14196000
                                                               <<04.KM>>14198000
  ARRAY ZEROES(*)=PB:= IMPENTLEN(0);                           <<04.KM>>14200000
  INTRINSIC GETDSEG,FREEDSEG;                                  <<04.KM>>14202000
  INTEGER PROCEDURE ALTDSEGSIZE(DST,INCSIZE);                  <<04.KM>>14204000
    VALUE DST,INCSIZE; INTEGER DST,INCSIZE; OPTION EXTERNAL;   <<04.KM>>14206000
                                                               <<04.KM>>14208000
  SUBROUTINE DEF'MOVEFROMDSEG;                                 <<04.KM>>14210000
  SUBROUTINE DEF'MOVETODSEG;                                   <<04.KM>>14212000
                                                               <<04.KM>>14214000
                                                               <<04.KM>>14216000
  <<****************>>                                         <<04.KM>>14218000
  << SUBROUTINE MIN >>                                         <<04.KM>>14220000
  <<****************>>                                         <<04.KM>>14222000
                                                               <<04.KM>>14224000
  INTEGER SUBROUTINE MIN(I,J); VALUE I,J; INTEGER I,J;         <<04.KM>>14226000
  BEGIN                                                        <<04.KM>>14228000
    MIN:=IF I<=J THEN I ELSE J;                                <<04.KM>>14230000
  END <<SUBROUTINE MIN>>;                                      <<04.KM>>14232000
                                                               <<04.KM>>14234000
                                                               <<04.KM>>14236000
  <<************************>>                                 <<04.KM>>14238000
  << SUBROUTINE ALLOCATEDST >>                                 <<04.KM>>14240000
  <<************************>>                                 <<04.KM>>14242000
                                                               <<04.KM>>14244000
  LOGICAL SUBROUTINE ALLOCATEDST;                              <<04.KM>>14246000
  BEGIN                                                        <<04.KM>>14248000
    COMMENT:                                                   <<04.KM>>14250000
      ALLOCATEDST= TRUE:  DATA-SEG ALLOCATED                   <<04.KM>>14252000
                   FALSE: COULD NOT ALLOCATE DATA-SEG.         <<04.KM>>14254000
                          "PV'ERROR" IS SET TO APPROPRIATE     <<04.KM>>14256000
                          VALUE.                               <<04.KM>>14258000
                                                               <<04.KM>>14260000
      WE USE (CALLABLE) "GETDSEG" HERE SO THAT DATA-SEG WILL BE<<04.KM>>14262000
      RELEASED AUTOMATICALLY IF PROCESS TERMINATES ABNORMALLY  <<04.KM>>14264000
      (HIGHLY UNEXPECTED!).  CONSEQUENTLY, WE MUST DECREASE    <<04.KM>>14266000
      SIZE OF DATA-SEG AFTER ALLOCATION;                       <<04.KM>>14268000
                                                               <<04.KM>>14270000
    ALLOCATEDST:=TRUE;                                         <<04.KM>>14272000
    INITALLOC:=-MAXALLOC;                                      <<04.KM>>14274000
    GETDSEG(MOUNTDST,INITALLOC,0);                             <<04.KM>>14276000
    IF <> THEN                                                 <<04.KM>>14278000
      BEGIN                                                    <<04.KM>>14280000
      PV'ERROR:=IF > OR MOUNTDST=%2000 THEN SYSERR             <<04.KM>>14282000
                ELSE IF MOUNTDST=%2001 THEN NODST              <<04.KM>>14284000
                ELSE NOVDS;                                    <<04.KM>>14286000
      ALLOCATEDST:=MOUNTDST:=0;                                <<04.KM>>14288000
      END                                                      <<04.KM>>14290000
    ELSE                                                       <<04.KM>>14292000
      BEGIN                                                    <<04.KM>>14294000
      MOVE IMPINFO:=INITINFO,(IMPINFOLEN);                     <<04.KM>>14296000
      DO IMPLEN:=ALTDSEGSIZE(MOUNTDST,MINALLOC) UNTIL >=;      <<04.KM>>14298000
      IF > THEN                                                <<04.KM>>14300000
        BEGIN                                                  <<04.KM>>14302000
        PV'ERROR:=SYSERR;                                      <<04.KM>>14304000
        FREEDSEG(MOUNTDST,0);                                  <<04.KM>>14306000
        ALLOCATEDST:=MOUNTDST:=0;                              <<04.KM>>14308000
        END;                                                   <<04.KM>>14310000
      END;                                                     <<04.KM>>14312000
  END <<SUBROUTINE ALLOCATEDST>>;                              <<04.KM>>14314000
                                                               <<04.KM>>14316000
                                                               <<04.KM>>14318000
  <<**********************>>                                   <<04.KM>>14320000
  << SUBROUTINE EXPANDDST >>                                   <<04.KM>>14322000
  <<**********************>>                                   <<04.KM>>14324000
                                                               <<04.KM>>14326000
  LOGICAL SUBROUTINE EXPANDDST;                                <<04.KM>>14328000
  BEGIN                                                        <<04.KM>>14330000
    COMMENT:                                                   <<04.KM>>14332000
      EXPANDDST= TRUE:  DATA-SEG EXPANDED FOR AT LEAST ONE     <<04.KM>>14334000
                        ENTRY                                  <<04.KM>>14336000
                 FALSE: COULD NOT EXPAND DATA-SEG.  "PV'ERROR" <<04.KM>>14338000
                        IS SET TO APPROPRIATE VALUE.           <<04.KM>>14340000
                                                               <<04.KM>>14342000
      ON ENTRY, "IMPENTLOC" IS INDEX OF LAST+1 WORD OF NEXT    <<04.KM>>14344000
      DST ENRTY.                                               <<04.KM>>14346000
                                                               <<04.KM>>14348000
      WE MUST AVOID USING THE "DSTFUDGE" AREA.  THIS AVOIDS    <<04.KM>>14350000
      BUGS RELATING TO ATTEMPTING TO USE THE ENTIRE DATA-SEG.  <<04.KM>>14352000
      (NOTE THAT IF/WHEN THESE BUGS ARE FIXED, THE "MIN"       <<04.KM>>14354000
      FUNCTION CAN BE REPLACED WITH SIMPLY "INCALLOC");        <<04.KM>>14356000
                                                               <<04.KM>>14358000
    EXPANDDST:=TRUE;                                           <<04.KM>>14360000
    IF IMPENTLOC<=IMPMAXLEN THEN                               <<04.KM>>14362000
      BEGIN                                                    <<04.KM>>14364000
      DO                                                       <<04.KM>>14366000
        IMPLEN:=ALTDSEGSIZE(MOUNTDST,                          <<04.KM>>14368000
                            MIN(INCALLOC,IMPMAXLEN-IMPLEN))    <<04.KM>>14370000
      UNTIL >=;                                                <<04.KM>>14372000
      END;                                                     <<04.KM>>14374000
    IF IMPENTLOC>IMPLEN THEN                                   <<04.KM>>14376000
      BEGIN                                                    <<04.KM>>14378000
      PV'ERROR:=NOSPACE;                                       <<04.KM>>14380000
      EXPANDDST:=FALSE;                                        <<04.KM>>14382000
      END;                                                     <<04.KM>>14384000
  END <<SUBROUTINE EXPANDDST>>;                                <<04.KM>>14386000
                                                               <<04.KM>>14388000
                                                               <<04.KM>>14390000
  <<************************>>                                 <<04.KM>>14392000
  << SUBROUTINE GETDSTENTRY >>                                 <<04.KM>>14394000
  <<************************>>                                 <<04.KM>>14396000
                                                               <<04.KM>>14398000
  LOGICAL SUBROUTINE GETDSTENTRY;                              <<04.KM>>14400000
  BEGIN                                                        <<04.KM>>14402000
    COMMENT:                                                   <<04.KM>>14404000
      GETDSTENTRY= TRUE:  NEW ENTRY ADDED TO DATA-SEG          <<04.KM>>14406000
                   FALSE: COULD NOT ALLOCATE OR EXPAND         <<04.KM>>14408000
                          DATA-SEG.                            <<04.KM>>14410000
                          "PV'ERROR" SET TO APPROPRIATE VALUE. <<04.KM>>14412000
                                                               <<04.KM>>14414000
      IF "MOUNTDST" IS ZERO, ALLOCATE DATA-SEG.  IF NECESSARY, <<04.KM>>14416000
      EXPAND DATA-SEG.  UPDATE PARAMETRIC INFORMATION AND      <<04.KM>>14418000
      INITIALIZE NEW ENTRY TO "MOUNTED" CONDITION.  NOTE THAT  <<04.KM>>14420000
      WE ALSO ALTER CERTAIN GLOBALS, VIZ:  "IMPINFO" &         <<04.KM>>14422000
      "ENTINFO".                                               <<04.KM>>14424000
                                                               <<04.KM>>14426000
      ON EXIT, "IMPENTLOC" IS INDEX OF LAST+1 WORD OF NEXT     <<04.KM>>14428000
      DST ENTRY, REGARDLESS OF SUCCESS OF "GETDSTENTRY";       <<04.KM>>14430000
                                                               <<04.KM>>14432000
    GETDSTENTRY:=FALSE;                                        <<04.KM>>14434000
    IF MOUNTDST>0                                              <<04.KM>>14436000
       THEN MOVEFROMDSEG(@IMPINFO,MOUNTDST,DSTINFO,IMPINFOLEN);<<04.KM>>14438000
    IF MOUNTDST>0 OR ALLOCATEDST THEN                          <<04.KM>>14440000
      BEGIN                                                    <<04.KM>>14442000
      DSTENTINFO:=IMPENTLOC;                                   <<04.KM>>14444000
      IMPENTLOC:=IMPENTLOC+IMPENTLEN;                          <<04.KM>>14446000
      IMPENTCNT:=IMPENTCNT+1;                                  <<04.KM>>14448000
      IF IMPENTLOC<=IMPLEN OR EXPANDDST THEN                   <<04.KM>>14450000
        BEGIN                                                  <<04.KM>>14452000
        ENTERR:=0;                                             <<04.KM>>14454000
        ENTPVINFO:=0;                                          <<04.KM>>14456000
        MOVE ENTNAME:=GROUP,(4),2;                             <<04.KM>>14458000
        MOVE * := ACCT,(4),2;                                  <<04.KM>>14460000
        MOVE * := ZEROES,(@ENTINFO(IMPENTLEN)-@PS0); <<0-FILL>><<04.KM>>14462000
        GETDSTENTRY:=TRUE;                                     <<04.KM>>14464000
      END;                                                     <<04.KM>>14466000
    END;                                                       <<04.KM>>14468000
  END <<SUBROUTINE GETDSTENTRY>>;                              <<04.KM>>14470000
                                                               <<04.KM>>14472000
                                                               <<04.KM>>14474000
  <<*********************>>                                    <<04.KM>>14476000
  << MAIN PROCEDURE BODY >>                                    <<04.KM>>14478000
  <<*********************>>                                    <<04.KM>>14480000
                                                               <<04.KM>>14482000
  IMPLICITMNT:=FALSE;                                          <<04.KM>>14484000
  IF MOUNTDST<0 OR GETDSTENTRY THEN                            <<04.KM>>14486000
    BEGIN                                                      <<04.KM>>14488000
    MOVE HOMEVS:="*       ";                                   <<04.KM>>14490000
    MOUNT(HOMEVS,GROUP,ACCT,REQ'ERROR,ANYGEN,PV'ERROR);        <<04.KM>>14492000
    IF >= THEN                                                 <<04.KM>>14494000
      BEGIN                                                    <<04.KM>>14496000
      IMPLICITMNT:=TRUE;                                       <<04.KM>>14498000
      ENTPVINFO:=PV'ERROR;                                     <<04.KM>>14500000
      END                                                      <<04.KM>>14502000
    ELSE IF MOUNTDST<0 THEN PV'ERROR:=-REQ'ERROR               <<04.KM>>14504000
    ELSE                                                       <<04.KM>>14506000
      BEGIN                                                    <<04.KM>>14508000
      PV'ERROR:=NOMOUNT;                                       <<04.KM>>14510000
      ENTERR:=REQ'ERROR;                                       <<04.KM>>14512000
      IMPERRCNT:=IMPERRCNT+1;                                  <<04.KM>>14514000
      END;                                                     <<04.KM>>14516000
    IF MOUNTDST>0 THEN                                         <<04.KM>>14518000
      BEGIN                                                    <<04.KM>>14520000
      MOVETODSEG(MOUNTDST,DSTENTINFO,@ENTINFO,IMPENTLEN);      <<04.KM>>14522000
      MOVETODSEG(MOUNTDST,DSTINFO,@IMPINFO,IMPINFOLEN);        <<04.KM>>14524000
      END;                                                     <<04.KM>>14526000
    END;                                                       <<04.KM>>14528000
END <<PROCEDURE IMPLICITMNT>>;                                 <<04.KM>>14530000
                                                               <<04.KM>>14532000
                                                               <<04.KM>>14534000
$CONTROL  SEGMENT=CILISTF                                      <<04.KM>>14536000
<<********************************************************************>>14538000
<< L I S T F D I S M N T >>                                    <<04.KM>>14540000
                                                               <<04.KM>>14542000
PROCEDURE LISTFDISMNT(MOUNTDST,FATALERR,GROUP,ACCT,ERRNUM);    <<04.KM>>14544000
  VALUE FATALERR;                                              <<04.KM>>14546000
  INTEGER MOUNTDST,FATALERR,ERRNUM;                            <<04.KM>>14548000
  ARRAY GROUP,ACCT;                                            <<04.KM>>14550000
  OPTION PRIVILEGED,UNCALLABLE;                                <<04.KM>>14552000
BEGIN                                                          <<04.KM>>14554000
  EQUATE CATRECSIZE=   80,                                     <<04.KM>>14556000
         MAXMSG=       160,                                    <<04.KM>>14558000
         NAMEFIELD=    4,                                      <<04.KM>>14560000
         MAXPREFIX=    NAMEFIELD+22,                           <<04.KM>>14562000
         EXPLAINFIELD= MAXPREFIX;                              <<04.KM>>14564000
  EQUATE NOMOUNT=        0,                                    <<04.KM>>14566000
         CONDMOUNT'BIND= -3,                                   <<04.KM>>14568000
         SINGLESPACE=    0,                                    <<04.KM>>14570000
         NOPARM=         %100000,                              <<04.KM>>14572000
         RETURNIT=       -1,                                   <<04.KM>>14574000
         INSERTINTEGER=  %10000,                               <<04.KM>>14576000
         STDLIST=        2;                                    <<04.KM>>14578000
  BYTE ARRAY MSG(0:MAXMSG-1),                                  <<04.KM>>14580000
             PREFIX(0:MAXPREFIX-1),                            <<04.KM>>14582000
             INBUF(0:CATRECSIZE),                              <<04.KM>>14584000
             JCWNAME(0:7),                                     <<04.KM>>14586000
             HOMEVS(0:7);                                      <<04.KM>>14588000
  BYTE POINTER NEXT,                                           <<04.KM>>14590000
               LAST;                                           <<04.KM>>14592000
  INTEGER DUMMY,                                               <<04.KM>>14594000
          NUMERRORS,                                           <<04.KM>>14596000
          PREFIXLEN,                                           <<04.KM>>14598000
          REQ'ERROR,                                           <<04.KM>>14600000
          MSGLEN,                                              <<04.KM>>14602000
          DSTENTINFO;                                          <<04.KM>>14604000
  LOGICAL FIRSTERROR:=TRUE;                                    <<04.KM>>14606000
                                                               <<04.KM>>14608000
  EQUATE DSTINFO=  0,                                          <<04.KM>>14610000
         OURINFOSIZE= 7;                                       <<04.KM>>14612000
  INTEGER ARRAY IMPINFO(0:OURINFOSIZE-1)= Q;                   <<04.KM>>14614000
  INTEGER IMPLEN=     IMPINFO,                                 <<04.KM>>14616000
          IMPINFOLEN= IMPLEN+1,                                <<04.KM>>14618000
          IMPENTLEN=  IMPINFOLEN+1,                            <<04.KM>>14620000
          IMPENTLOC=  IMPENTLEN+1,                             <<04.KM>>14622000
          IMPENTCNT=  IMPENTLOC+1,                             <<04.KM>>14624000
          IMPERRCNT=  IMPENTCNT+1,                             <<04.KM>>14626000
          IMPMAXLEN=  IMPERRCNT+1;                             <<04.KM>>14628000
                                                               <<04.KM>>14630000
  EQUATE OURENTSIZE= 10;                                       <<04.KM>>14632000
  INTEGER ARRAY ENTINFO(0:OURENTSIZE-1)= Q;                    <<04.KM>>14634000
  INTEGER ENTERR=           ENTINFO,                           <<04.KM>>14636000
          ENTPVINFO=        ENTERR+1;                          <<04.KM>>14638000
  INTEGER ARRAY ENTNAME(*)= ENTPVINFO+1,                       <<04.KM>>14640000
                ENTGRP(*)=  ENTNAME,                           <<04.KM>>14642000
                ENTACCT(*)= ENTNAME+4;                         <<04.KM>>14644000
  INTRINSIC FREEDSEG;                                          <<04.KM>>14646000
  INTEGER PROCEDURE FORMSG(IBUF,MSET,MNUM,PMASK,P1,P2,P3,P4,   <<04.KM>>14648000
                           P5,OBUF,OSIZE,OLEN,DEST,CNTL);      <<04.KM>>14650000
    VALUE MSET,MNUM,PMASK,P1,P2,P3,P4,P5,OSIZE,DEST,CNTL;      <<04.KM>>14652000
    BYTE ARRAY IBUF,OBUF;                                      <<04.KM>>14654000
    INTEGER MSET,MNUM,PMASK,P1,P2,P3,P4,P5,OSIZE,OLEN,DEST,    <<04.KM>>14656000
            CNTL;                                              <<04.KM>>14658000
    OPTION EXTERNAL;                                           <<04.KM>>14660000
                                                               <<04.KM>>14662000
  SUBROUTINE DEF'MOVEFROMDSEG;                                 <<04.KM>>14664000
                                                               <<04.KM>>14666000
                                                               <<04.KM>>14668000
  <<*******************>>                                      <<04.KM>>14670000
  << SUBROUTINE APPEND >>                                      <<04.KM>>14672000
  <<*******************>>                                      <<04.KM>>14674000
                                                               <<04.KM>>14676000
  LOGICAL SUBROUTINE APPEND(NAME,SUFFIX,BUF);                  <<04.KM>>14678000
    VALUE SUFFIX; BYTE ARRAY NAME,BUF; INTEGER SUFFIX;         <<04.KM>>14680000
  BEGIN                                                        <<04.KM>>14682000
    IF NAME(7)=" " THEN MOVE BUF:=NAME WHILE ANS,1             <<04.KM>>14684000
    ELSE MOVE BUF:=NAME,(8),2;                                 <<04.KM>>14686000
    @LAST:=TOS;                                                <<04.KM>>14688000
    LAST:=SUFFIX;                                              <<04.KM>>14690000
    APPEND:=@LAST(1);                                          <<04.KM>>14692000
  END <<SUBROUTINE APPEND>>;                                   <<04.KM>>14694000
                                                               <<04.KM>>14696000
                                                               <<04.KM>>14698000
  <<********************>>                                     <<04.KM>>14700000
  << SUBROUTINE DMERROR >>                                     <<04.KM>>14702000
  <<********************>>                                     <<04.KM>>14704000
                                                               <<04.KM>>14706000
  SUBROUTINE DMERROR(MSGSET,MSGNUM,GROUP,ACCT);                <<04.KM>>14708000
    VALUE MSGSET,MSGNUM; INTEGER MSGSET,MSGNUM;                <<04.KM>>14710000
    BYTE ARRAY GROUP,ACCT;                                     <<04.KM>>14712000
  BEGIN                                                        <<04.KM>>14714000
    IF FIRSTERROR THEN                                         <<04.KM>>14716000
      BEGIN                                                    <<04.KM>>14718000
      IF JOBSESSIONMAIN THEN FWRITE(STDLIST,DUMMY,0,0);        <<04.KM>>14720000
      CIERR(-(ERRNUM:=IM'MNTERR));                             <<04.KM>>14722000
      FIRSTERROR:=FALSE;                                       <<04.KM>>14724000
      END;                                                     <<04.KM>>14726000
    IF NOT JOBSESSIONMAIN OR REQUESTSERVICE THEN RETURN;       <<07.KM>>14728000
    @NEXT:=APPEND(GROUP,".",PREFIX(NAMEFIELD));                <<04.KM>>14730000
    PREFIXLEN:=APPEND(ACCT,":",NEXT)-LOGICAL(@PREFIX);         <<04.KM>>14732000
    MSGLEN:=0;                                                 <<04.KM>>14734000
    FORMSG(INBUF,MSGSET,MSGNUM,NOPARM,0,0,0,0,0,MSG,MAXMSG,    <<04.KM>>14736000
           MSGLEN,RETURNIT,0);                                 <<04.KM>>14738000
    MULTILINE(<<FILE>>,MSG,MSGLEN,EXPLAINFIELD,<<FIELDLEN>>,   <<04.KM>>14740000
              SINGLESPACE,PREFIX,PREFIXLEN);                   <<04.KM>>14742000
  END <<SUBROUTINE DMERROR>>;                                  <<04.KM>>14744000
                                                               <<04.KM>>14746000
                                                               <<04.KM>>14748000
  <<*********************>>                                    <<04.KM>>14750000
  << MAIN PROCEDURE BODY >>                                    <<04.KM>>14752000
  <<*********************>>                                    <<04.KM>>14754000
                                                               <<04.KM>>14756000
  MOVE PREFIX:="  *.";                                         <<04.KM>>14758000
  IF MOUNTDST>0 THEN                                           <<04.KM>>14760000
    BEGIN                                                      <<04.KM>>14762000
    MOVEFROMDSEG(@IMPINFO,MOUNTDST,DSTINFO,OURINFOSIZE);       <<04.KM>>14764000
    MOVE HOMEVS:="*       ";                                   <<04.KM>>14766000
    FOR DSTENTINFO:=IMPINFOLEN STEP IMPENTLEN                  <<04.KM>>14768000
                    UNTIL IMPENTLOC-1 DO                       <<04.KM>>14770000
      BEGIN                                                    <<04.KM>>14772000
      MOVEFROMDSEG(@ENTINFO,MOUNTDST,DSTENTINFO,OURENTSIZE);   <<04.KM>>14774000
      IF ENTERR<>0 THEN                                        <<04.KM>>14776000
        BEGIN                                                  <<04.KM>>14778000
        DMERROR(PVERRMSGSET,ENTERR,ENTGRP,ENTACCT)             <<04.KM>>14780000
        END                                                    <<04.KM>>14782000
      ELSE                                                     <<04.KM>>14784000
        BEGIN                                                  <<04.KM>>14786000
        REQ'ERROR:=CONDMOUNT'BIND;                             <<04.KM>>14788000
        DISMOUNT(HOMEVS,ENTGRP,ENTACCT,REQ'ERROR,ENTPVINFO);   <<04.KM>>14790000
        IF <> THEN                                             <<04.KM>>14792000
          BEGIN                                                <<04.KM>>14794000
          DMERROR(PVERRMSGSET,REQ'ERROR,ENTGRP,ENTACCT);       <<04.KM>>14796000
          END;                                                 <<04.KM>>14798000
        END;                                                   <<04.KM>>14800000
      END;                                                     <<04.KM>>14802000
    FREEDSEG(MOUNTDST,0);                                      <<04.KM>>14804000
    MOUNTDST:=0;                                               <<04.KM>>14806000
    END;                                                       <<04.KM>>14808000
                                                               <<04.KM>>14810000
  IF FATALERR>NOMOUNT THEN                                     <<04.KM>>14812000
    BEGIN                                                      <<04.KM>>14814000
    DMERROR(CIERRMSGSET,IM'MNTERR+FATALERR,GROUP,ACCT);        <<04.KM>>14816000
    END;                                                       <<04.KM>>14818000
END <<PROCEDURE LISTFDISMNT>>;                                 <<04.KM>>14820000
                                                              <<00.GEN>>14822000
                                                              <<00.GEN>>14824000
$CONTROL  SEGMENT=CILISTF                                      <<03.KM>>14826000
                                                               <<03.KM>>14828000
INTEGER PROCEDURE DIRMATCH(DESIGNATOR,REALNAME);              <<00.GEN>>14830000
                          VALUE DESIGNATOR,REALNAME;          <<00.GEN>>14832000
                          BYTE POINTER DESIGNATOR,            <<00.GEN>>14834000
                                       REALNAME;              <<00.GEN>>14836000
                          OPTION UNCALLABLE;                  <<00.GEN>>14838000
BEGIN                                                         <<00.GEN>>14840000
  COMMENT:                                                    <<00.GEN>>14842000
    COMPARES GENERIC AND DIRECTORY NAMES AND RETURNS AN       <<00.GEN>>14844000
    INDICATOR OF THE MATCH, VIZ.:                             <<00.GEN>>14846000
                                                              <<00.GEN>>14848000
      -1 = INITIAL SUBSTRING OF "DESIGNATOR" IS LESS          <<00.GEN>>14850000
           THAN "REALNAME"                                    <<00.GEN>>14852000
       0 = "DESIGNATOR" AND "REALNAME" MATCH                  <<00.GEN>>14854000
       1 = "DESIGNATOR" AND "REALNAME" DO NOT MATCH.          <<00.GEN>>14856000
                                                              <<00.GEN>>14858000
    NOTE THAT -1 CAN BE RETURNED ONLY IF THE INITIAL          <<00.GEN>>14860000
    SUBSTRING OF "DESIGNATOR" STARTS WITH AN ALPHABETIC       <<00.GEN>>14862000
    CHARACTER.                                                <<00.GEN>>14864000
                                                              <<00.GEN>>14866000
    ASCERTIONS:                                               <<00.GEN>>14868000
      (1) "DESIGNATOR" CONTAINS ONLY ALPHANUMERIC, "?",       <<00.GEN>>14870000
          "#" AND "@" CHARACTERS                              <<00.GEN>>14872000
      (2) "DESIGNATOR" DOES NOT CONTAIN THE SEQUENCES         <<00.GEN>>14874000
          "@?" & "@@" (THESE SHOULD BE CONVERTED TO           <<00.GEN>>14876000
          "?@" & "@" BY THE PATTERN BUILDER)                  <<00.GEN>>14878000
      (3) "REALNAME" CONTAINS ONLY ALPHANUMERIC CHARACTERS    <<00.GEN>>14880000
      (4) "DESIGNATOR" & "REALNAME" ARE 8 BYTES LONG, WITH    <<00.GEN>>14882000
          BLANK-FILL ON THE RIGHT                             <<00.GEN>>14884000
      (5) "DESIGNATOR" & "REALNAME" ARE BOTH THE SAME CASE,   <<00.GEN>>14886000
          VIZ. UPPER- OR LOWER-CASE;                          <<00.GEN>>14888000
                                                              <<00.GEN>>14890000
                                                              <<00.GEN>>14892000
  EQUATE NOCODE= -2,                                          <<00.GEN>>14894000
         LTCODE= -1,                                          <<00.GEN>>14896000
         EQCODE=  0,                                          <<00.GEN>>14898000
         GTCODE=  1;                                          <<00.GEN>>14900000
                                                              <<00.GEN>>14902000
  BYTE POINTER DLEFT,                                         <<00.GEN>>14904000
               NLEFT;                                         <<00.GEN>>14906000
  INTEGER X=         X,                                       <<00.GEN>>14908000
          MATCHCODE= DIRMATCH;                                <<00.GEN>>14910000
                                                              <<00.GEN>>14912000
  ARRAY NEXTQ(*)=    Q;                <<ALLOCATE ON TOS>>    <<00.GEN>>14914000
  BYTE POINTER DPTR= NEXTQ,                                   <<00.GEN>>14916000
               NPTR= DPTR+1;                                  <<00.GEN>>14918000
  INTEGER LENGTH=    NPTR+1;                                  <<00.GEN>>14920000
                                                              <<00.GEN>>14922000
                                                              <<00.GEN>>14924000
  <<*************************>>                               <<00.GEN>>14926000
  << DEFINE LESSER'SUBSTRING >>                               <<00.GEN>>14928000
  <<*************************>>                               <<00.GEN>>14930000
                                                              <<00.GEN>>14932000
  DEFINE LESSER'SUBSTRING=                                    <<00.GEN>>14934000
    < AND (DPTR<>SPECIAL OR DPTR=" ") #;                      <<00.GEN>>14936000
                                                              <<00.GEN>>14938000
  <<**************************>>                              <<00.GEN>>14940000
  << DEFINE RESET'MATCHSTART >>                               <<00.GEN>>14942000
  <<**************************>>                              <<00.GEN>>14944000
                                                              <<00.GEN>>14946000
  COMMENT:                                                    <<00.GEN>>14948000
    S-2 = @DPTR                                               <<00.GEN>>14950000
    S-1 = @NPTR                                               <<00.GEN>>14952000
    S-0 = LENGTH OF COMPARE.                                  <<00.GEN>>14954000
                                                              <<00.GEN>>14956000
    BACK-UP POINTERS SO THAT "@" WILL MATCH LONGER            <<00.GEN>>14958000
    SUBSTRING.  "DPTR" IS RESET TO THE RIGHT OF               <<00.GEN>>14960000
    LAST "@".  "NPTR" IS RESET TO THE RIGHT OF LAST           <<00.GEN>>14962000
    INITIAL MATCH DETERMINED BY "FIND'MATCHSTART";            <<00.GEN>>14964000
                                                              <<00.GEN>>14966000
  DEFINE RESET'MATCHSTART=                                    <<00.GEN>>14968000
    BEGIN                                                     <<00.GEN>>14970000
      @NLEFT:=@NLEFT+1;                                       <<00.GEN>>14972000
      DEL; DDEL;                                              <<00.GEN>>14974000
      TOS:=@DLEFT;                                            <<00.GEN>>14976000
      TOS:=@NLEFT;                                            <<00.GEN>>14978000
      TOS:=@REALNAME(8)-@NLEFT;                               <<00.GEN>>14980000
      DIRMATCH:=NOCODE;                                       <<00.GEN>>14982000
      FIND'MATCHSTART;                                        <<00.GEN>>14984000
    END <<DEFINE RESET'MATCHSTART>>#;                         <<00.GEN>>14986000
                                                              <<00.GEN>>14988000
  <<*********************>>                                   <<00.GEN>>14990000
  << DEFINE TURNOFFTRAPS >>                                   <<00.GEN>>14992000
  <<*********************>>                                   <<00.GEN>>14994000
                                                              <<00.GEN>>14996000
  DEFINE TURNOFFTRAPS=                                        <<00.GEN>>14998000
    BEGIN                                                     <<00.GEN>>15000000
      COMMENT:                                                <<00.GEN>>15002000
        AVOID INTEGER OVERFLOW FOR BYTE ADDRESS               <<00.GEN>>15004000
        ARITHMETIC;                                           <<00.GEN>>15006000
                                                              <<00.GEN>>15008000
      PUSH(STATUS);                                           <<00.GEN>>15010000
      TOS.(2:1):=0;                                           <<00.GEN>>15012000
      SET(STATUS);                                            <<00.GEN>>15014000
    END <<DEFINE TURNOFFTRAPS>>#;                             <<00.GEN>>15016000
                                                              <<00.GEN>>15018000
  <<****************>>                                        <<00.GEN>>15020000
  << SUBROUTINE MIN >>                                        <<00.GEN>>15022000
  <<****************>>                                        <<00.GEN>>15024000
                                                              <<00.GEN>>15026000
  INTEGER SUBROUTINE MIN(I,J); VALUE I,J; INTEGER I,J;        <<00.GEN>>15028000
  BEGIN                                                       <<00.GEN>>15030000
    MIN:=IF I<=J THEN I ELSE J;                               <<00.GEN>>15032000
  END <<SUBROUTINE MIN>>;                                     <<00.GEN>>15034000
                                                               <<03.KM>>15036000
                                                               <<03.KM>>15038000
  <<****************************>>                             <<03.KM>>15040000
  << SUBROUTINE FIND'MATCHSTART >>                             <<03.KM>>15042000
  <<****************************>>                             <<03.KM>>15044000
                                                               <<03.KM>>15046000
  SUBROUTINE FIND'MATCHSTART;                                  <<03.KM>>15048000
  BEGIN                                                        <<03.KM>>15050000
    COMMENT:                                                   <<03.KM>>15052000
      SCAN "NPTR" FOR MATCH WITH CHARACTER FOLLOWING           <<03.KM>>15054000
      "@" IN "DSTR".  SAVE POSITION IN "NLEFT" AND             <<03.KM>>15056000
      SET "LENGTH" TO LENGTH OF COMPARE;                       <<03.KM>>15058000
                                                               <<03.KM>>15060000
    IF DPTR="#" THEN                                           <<03.KM>>15062000
    BEGIN                                                      <<03.KM>>15064000
      WHILE (LENGTH:=LENGTH-1)>=0 AND                          <<03.KM>>15066000
            NPTR<>NUMERIC DO @NPTR:=@NPTR+1;                   <<03.KM>>15068000
    END                                                        <<03.KM>>15070000
    ELSE BEGIN                                                 <<03.KM>>15072000
      WHILE (LENGTH:=LENGTH-1)>=0 AND                          <<03.KM>>15074000
            NPTR<>DPTR DO @NPTR:=@NPTR+1;                      <<03.KM>>15076000
    END;                                                       <<03.KM>>15078000
                                                               <<03.KM>>15080000
    LENGTH:=LENGTH+1;                                          <<03.KM>>15082000
    IF <= THEN DIRMATCH:=GTCODE                                <<03.KM>>15084000
    ELSE BEGIN                                                 <<03.KM>>15086000
      @NLEFT:=@NPTR;                                           <<03.KM>>15088000
      LENGTH:=MIN(@DESIGNATOR(8)-@DPTR, @REALNAME(8)-@NPTR);   <<03.KM>>15090000
    END;                                                       <<03.KM>>15092000
  END <<SUBROUTINE FIND'MATCHSTART>>;                          <<03.KM>>15094000
                                                               <<03.KM>>15096000
                                                               <<03.KM>>15098000
  <<**************************>>                               <<03.KM>>15100000
  << SUBROUTINE CHECK'ENDCOND >>                               <<03.KM>>15102000
  <<**************************>>                               <<03.KM>>15104000
                                                               <<03.KM>>15106000
  SUBROUTINE CHECK'ENDCOND;                                    <<03.KM>>15108000
  BEGIN                                                        <<03.KM>>15110000
    COMMENT:                                                   <<03.KM>>15112000
      ENSURE THAT BOTH "DPTR" AND "NPTR" STRINGS ARE           <<03.KM>>15114000
      EXHAUSTED.  IF EQCODE, THEN AT LEAST ONE STRING          <<03.KM>>15116000
      IS EXHAUSTED;                                            <<03.KM>>15118000
                                                               <<03.KM>>15120000
    IF MATCHCODE=EQCODE THEN                                   <<03.KM>>15122000
    BEGIN                                                      <<03.KM>>15124000
      IF @DPTR=@DESIGNATOR(8) THEN                             <<03.KM>>15126000
      BEGIN                                                    <<03.KM>>15128000
        IF @NPTR<>@REALNAME(8) AND                             <<03.KM>>15130000
           NPTR<>" " THEN DIRMATCH:=GTCODE;                    <<03.KM>>15132000
      END                                                      <<03.KM>>15134000
      ELSE                                                     <<03.KM>>15136000
        IF DPTR<>" " THEN                                      <<03.KM>>15138000
        BEGIN                                                  <<03.KM>>15140000
          IF DPTR<>"@" OR                                      <<03.KM>>15142000
             @DPTR<>@DESIGNATOR(7) AND                         <<03.KM>>15144000
             DPTR(1)<>" " THEN DIRMATCH:=GTCODE;               <<03.KM>>15146000
        END;                                                   <<03.KM>>15148000
    END;                                                       <<03.KM>>15150000
  END <<SUBROUTINE CHECK'ENDCOND>>;                            <<03.KM>>15152000
                                                              <<00.GEN>>15154000
  <<********************>>                                    <<00.GEN>>15156000
  << SUBROUTINE CLOSURE >>                                    <<00.GEN>>15158000
  <<********************>>                                    <<00.GEN>>15160000
                                                              <<00.GEN>>15162000
  LOGICAL SUBROUTINE CLOSURE;                                 <<00.GEN>>15164000
  BEGIN                                                       <<00.GEN>>15166000
    COMMENT:                                                  <<00.GEN>>15168000
      RETURN "TRUE" IF WE'VE ENCOUNTERED AN EMBEDDED          <<00.GEN>>15170000
      "@" (CLOSURE WILDCARD).  WE ASSUME THAT WE'VE           <<00.GEN>>15172000
      DONE A "SIMPLEMATCH" FIRST.  THUS, FAILURE TO           <<00.GEN>>15174000
      FIND CLOSURE WILDCARD MEANS THAT NO FURTHER             <<00.GEN>>15176000
      MATCH IS POSSIBLE (MATCH=GTCODE).  NOTE THAT            <<00.GEN>>15178000
      IF CLOSURE WILDCARD IS AT THE END OF "DPTR",            <<00.GEN>>15180000
      THE MATCH IS DONE (MATCH=EQCODE) SINCE IT WILL          <<00.GEN>>15182000
      MATCH REMAINDER OF "NPTR";                              <<00.GEN>>15184000
                                                              <<00.GEN>>15186000
    CLOSURE:=FALSE;                                           <<00.GEN>>15188000
    IF MATCHCODE=NOCODE THEN                                  <<00.GEN>>15190000
    BEGIN                                                     <<00.GEN>>15192000
      IF DPTR<>"@" THEN DIRMATCH:=GTCODE                      <<00.GEN>>15194000
      ELSE                                                    <<00.GEN>>15196000
        IF @DPTR=@DESIGNATOR(7) OR                            <<00.GEN>>15198000
           DPTR(1)=" " THEN DIRMATCH:=EQCODE                  <<00.GEN>>15200000
      ELSE IF NPTR=" " THEN DIRMATCH:=GTCODE                  <<00.GEN>>15202000
      ELSE BEGIN                                              <<00.GEN>>15204000
        @DPTR:=@DPTR+1;                                       <<00.GEN>>15206000
        @DLEFT:=@DPTR;                                        <<00.GEN>>15208000
        @NLEFT := @NPTR;                                       <<01516>>15210000
        LENGTH:=@REALNAME(8)-@NPTR;                           <<00.GEN>>15212000
        FIND'MATCHSTART;                                      <<00.GEN>>15214000
        IF MATCHCODE=NOCODE THEN CLOSURE:=TRUE;               <<00.GEN>>15216000
      END;                                                    <<00.GEN>>15218000
    END;                                                      <<00.GEN>>15220000
  END <<SUBROUTINE CLOSURE>>;                                 <<00.GEN>>15222000
                                                              <<00.GEN>>15224000
  <<************************>>                                <<00.GEN>>15226000
  << SUBROUTINE SIMPLEMATCH >>                                <<00.GEN>>15228000
  <<************************>>                                <<00.GEN>>15230000
                                                              <<00.GEN>>15232000
  SUBROUTINE SIMPLEMATCH;                                     <<00.GEN>>15234000
  BEGIN                                                       <<00.GEN>>15236000
    COMMENT:                                                  <<00.GEN>>15238000
      S-3 = @DPTR                                             <<00.GEN>>15240000
      S-2 = @NPTR                                             <<00.GEN>>15242000
      S-1 = LENGTH OF COMPARE                                 <<00.GEN>>15244000
      S-0 = "SIMPLEMATCH" RETURN ADDRESS.                     <<00.GEN>>15246000
                                                              <<00.GEN>>15248000
      MATCH ALPHANUMERIC CHARACTERS AND SINGLE-BYTE           <<00.GEN>>15250000
      WILDCARD CHARACTERS ("?" AND "#");                      <<00.GEN>>15252000
                                                              <<00.GEN>>15254000
    X:=TOS;                            <<SAVE RETN ADDR>>     <<00.GEN>>15256000
    DO BEGIN                                                  <<00.GEN>>15258000
      IF * <> *,(TOS),0 THEN                                  <<00.GEN>>15260000
      BEGIN                                                   <<00.GEN>>15262000
  LOOP:                                                       <<00.GEN>>15264000
        IF DPTR="?" AND NPTR<>SPECIAL OR                      <<00.GEN>>15266000
           DPTR="#" AND NPTR=NUMERIC THEN                     <<00.GEN>>15268000
        BEGIN                                                 <<00.GEN>>15270000
          @DPTR:=@DPTR+1;                                     <<00.GEN>>15272000
          ASSEMBLE(INCB,DECA);                                <<00.GEN>>15274000
          IF <> THEN GO LOOP;                                 <<00.GEN>>15276000
        END;                                                  <<00.GEN>>15278000
      END;                                                    <<00.GEN>>15280000
    END UNTIL LENGTH=0 OR DPTR<>NPTR;                         <<00.GEN>>15282000
    IF = THEN DIRMATCH:=EQCODE;        <<LENGTH=0>>           <<00.GEN>>15284000
    TOS:=X;                            <<RESET RETN ADDR>>    <<00.GEN>>15286000
  END <<SUBROUTINE SIMPLEMATCH>>;                             <<00.GEN>>15288000
                                                              <<00.GEN>>15290000
                                                              <<00.GEN>>15292000
  <<***********************>>                                 <<00.GEN>>15294000
  <<                       >>                                 <<00.GEN>>15296000
  << BEGIN PROCEDURE MATCH >>                                 <<00.GEN>>15298000
  <<                       >>                                 <<00.GEN>>15300000
  <<***********************>>                                 <<00.GEN>>15302000
                                                              <<00.GEN>>15304000
  TURNOFFTRAPS;                                               <<00.GEN>>15306000
  IF DESIGNATOR=REALNAME,(8),0 THEN DIRMATCH:=EQCODE          <<00.GEN>>15308000
  ELSE IF LESSER'SUBSTRING THEN DIRMATCH:=LTCODE              <<00.GEN>>15310000
  ELSE BEGIN                                                  <<00.GEN>>15312000
    COMMENT:                                                  <<00.GEN>>15314000
      S-2 = @DPTR                                             <<00.GEN>>15316000
      S-1 = @NPTR                                             <<00.GEN>>15318000
      S-0 = COMPARE LENGTH;                                   <<00.GEN>>15320000
                                                              <<00.GEN>>15322000
    DIRMATCH:=NOCODE;                                         <<00.GEN>>15324000
    SIMPLEMATCH;                                              <<00.GEN>>15326000
    IF CLOSURE THEN                                           <<00.GEN>>15328000
    BEGIN                                                     <<00.GEN>>15330000
      DO BEGIN                                                <<00.GEN>>15332000
        DO SIMPLEMATCH UNTIL NOT CLOSURE;                     <<00.GEN>>15334000
        CHECK'ENDCOND;                                        <<00.GEN>>15336000
        IF MATCHCODE<>EQCODE THEN RESET'MATCHSTART;           <<00.GEN>>15338000
      END UNTIL MATCHCODE<>NOCODE;                             <<01454>>15340000
    END;                                                       <<01454>>15342000
  END;                                                         <<01454>>15344000
END <<PROCEDURE DIRMATCH>>;                                    <<01454>>15346000
                                                               <<01454>>15348000
                                                               <<01454>>15350000
                                                               <<01454>>15352000
PROCEDURE GET'FILECODE(FILECODE,MNEMONIC,MNEMONIC'LENGTH);     <<01454>>15354000
   INTEGER FILECODE,MNEMONIC'LENGTH;                           <<01454>>15356000
   BYTE ARRAY MNEMONIC;                                        <<01454>>15358000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01454>>15360000
                                                               <<01454>>15362000
COMMENT                                                        <<01454>>15364000
   This procedure contains two entry points for converting file<<01454>>15366000
   code mnemonics to file code values and vice versa.          <<01454>>15368000
                                                               <<01454>>15370000
GET'FILECODE                                                   <<01454>>15372000
   This entry point takes a character string, compares it to   <<01454>>15374000
   a list of HP defined file code mnemonics, and returns the   <<01454>>15376000
   integer value of the corresponding file code.               <<01454>>15378000
                                                               <<01454>>15380000
   INPUT                                                       <<01454>>15382000
      MNEMONIC -- byte array containing the character string.  <<01454>>15384000
      MNEMONIC'LENGTH -- length of the character string        <<01454>>15386000
         contained in MNEMONIC.  Must be > 0.                  <<01454>>15388000
   OUTPUT                                                      <<01454>>15390000
      FILECODE -- integer file code corresponding to the string<<01454>>15392000
         passed in MNEMONIC.  If there is no HP defined file   <<01454>>15394000
         code corresponding to the input string, the value     <<01454>>15396000
         returned in FILECODE is 0.                            <<01454>>15398000
   CONDITION CODE                                              <<01454>>15400000
      CCE -- string passed is an HP defined file code mnemonic.<<01454>>15402000
      CCG -- string passed is not an HP defined mnemonic.      <<01454>>15404000
      CCL -- error in call, length <= 0.                       <<01454>>15406000
                                                               <<01454>>15408000
GET'FILEMNEMONIC                                               <<01454>>15410000
   This entry point takes an integer value, compares it to a   <<01454>>15412000
   list of HP defined file codes, and returns the mnemonic     <<01454>>15414000
   corresponding to the input value.                           <<01454>>15416000
                                                               <<01454>>15418000
   INPUT                                                       <<01454>>15420000
      FILECODE -- integer file code.                           <<01454>>15422000
   OUTPUT                                                      <<01454>>15424000
      MNEMONIC -- 5 character mnemonic corresponding to the    <<01454>>15426000
         input value.  The mnemonic is left-justified with     <<01454>>15428000
         trailing blanks.  If the file code does not have a    <<01454>>15430000
         corresponding mnemonic, the string is all blanks.     <<01454>>15432000
      MNEMONIC'LENGTH -- the number of non-blank characters    <<01454>>15434000
         returned in MNEMONIC.                                 <<01454>>15436000
   CONDITION CODE                                              <<01454>>15438000
      CCE -- the input value had a corresponding mnemonic.     <<01454>>15440000
      CCG -- no mnemonic for file code value.                  <<01454>>15442000
      CCL -- not returned.                                     <<01454>>15444000
                                                               <<01454>>15446000
ISSUES                                                         <<01454>>15448000
   1)  The dictionary entries are of fixed length so that they <<01454>>15450000
       can be indexed.                                         <<01454>>15452000
   2)  The search for GET'FILEMNEMONIC is faster than the      <<01454>>15454000
       search for GET'FILECODE because LISTF's are done more   <<01454>>15456000
       frequently than FILE or BUILD commands.                 <<01454>>15458000
                                                               <<01454>>15460000
ADDING A NEW MNEMONIC                                          <<01454>>15462000
   1)  Change NUMBER'CODES to reflect the new number of        <<01454>>15464000
       mnemonics.                                              <<01454>>15466000
   2)  Insert an entry into BOTH the dictionary and the the    <<01454>>15468000
       file code array so that the indices match.              <<01454>>15470000
;                                                              <<01454>>15472000
                                                               <<01454>>15474000
                                                               <<01454>>15476000
                                                               <<01454>>15478000
BEGIN                                                          <<01454>>15480000
   ENTRY GET'FILEMNEMONIC;                                     <<01454>>15482000
                                                               <<01454>>15484000
   BYTE ARRAY LOCAL'BUFFER(0:7);                               <<01454>>15486000
                                                               <<01454>>15488000
   INTEGER ENTRY'NUMBER,  << INDEX OF ENTRY >>                 <<01454>>15490000
           LOWER'BOUND,   << BOUNDS FOR BINARY SEARCH >>       <<01454>>15492000
           UPPER'BOUND;                                        <<01454>>15494000
                                                               <<01454>>15496000
<< NUMBER'CODES -- the number of file codes and associated >>  <<01454>>15498000
<<    mnemonics contained in the two data structures.      >>  <<01454>>15500000
                                                               <<01454>>15502000
   EQUATE NUMBER'CODES = 41,                                            15504000
          DICT'LENGTH = NUMBER'CODES*8 + 1;                    <<01454>>15506000
                                                               <<01454>>15508000
   BYTE ARRAY LOCAL'DICT(0:DICT'LENGTH-1);                     <<01454>>15510000
                                                               <<01454>>15512000
<< MNEMONIC'DICT -- a byte array formatted for use by the    >><<01454>>15514000
<<    SEARCH intrinsic.  The "name" portion of each entry is >><<01454>>15516000
<<    five characters containing a file code mnemonic left-  >><<01454>>15518000
<<    justified with trailing blanks.  The definition        >><<01454>>15520000
<<    portion of each entry is the length of the mnemonic.   >><<01454>>15522000
                                                               <<01454>>15524000
   BYTE ARRAY MNEMONIC'DICT(0:DICT'LENGTH-1) = PB :=           <<01454>>15526000
                                                               <<01454>>15528000
8,5,"USL  ",3,     << 1024 >>                                  <<01454>>15530000
8,5,"BASD ",4,     << 1025 >>                                  <<01454>>15532000
8,5,"BASP ",4,     << 1026 >>                                  <<01454>>15534000
8,5,"BASFP",5,     << 1027 >>                                  <<01454>>15536000
8,5,"RL   ",2,     << 1028 >>                                  <<01454>>15538000
8,5,"PROG ",4,     << 1029 >>                                  <<01454>>15540000
8,5,"SL   ",2,     << 1031 >>                                  <<01454>>15542000
8,5,"VFORM",5,     << 1035 >>                                  <<01454>>15544000
8,5,"VFAST",5,     << 1036 >>                                  <<01454>>15546000
8,5,"VREF ",4,     << 1037 >>                                  <<01454>>15548000
8,5,"XLSAV",5,     << 1040 >>                                  <<01454>>15550000
8,5,"XLBIN",5,     << 1041 >>                                  <<01454>>15552000
8,5,"XLDSP",5,     << 1042 >>                                  <<01454>>15554000
8,5,"EDITQ",5,     << 1050 >>                                  <<01454>>15556000
8,5,"EDTCQ",5,     << 1051 >>                                  <<01454>>15558000
8,5,"EDTCT",5,     << 1052 >>                                  <<01454>>15560000
8,5,"TDPDT",5,     << 1054 >>                                           15562000
8,5,"TDPQM",5,     << 1055 >>                                           15564000
8,5,"TDPP ",4,     << 1056 >>                                           15566000
8,5,"TDPCP",5,     << 1057 >>                                           15568000
8,5,"TDPQ ",4,     << 1058 >>                                           15570000
8,5,"TDPXQ",5,     << 1059 >>                                           15572000
8,5,"RJEPN",5,     << 1060 >>                                  <<01454>>15574000
8,5,"QPROC",5,     << 1070 >>                                  <<01454>>15576000
8,5,"KSAMK",5,     << 1080 >>                                  <<01454>>15578000
8,5,"GRAPH",5,     << 1083 >>                                  <<01454>>15580000
8,5,"SD   ",2,     << 1084 >>                                  <<01454>>15582000
8,5,"LOG  ",3,     << 1090 >>                                  <<01454>>15584000
8,5,"WDOC ",4,     << 1100 >>                                  <<01454>>15586000
8,5,"WDICT",5,     << 1101 >>                                  <<01454>>15588000
8,5,"PCELL",5,     << 1110 >>                                  <<01454>>15590000
8,5,"PFORM",5,     << 1111 >>                                  <<01454>>15592000
8,5,"P2680",5,     << 1112 >>                                  <<01454>>15594000
8,5,"PCCMP",5,     << 1113 >>                                  <<01454>>15596000
8,5,"OPTLF",5,     << 1130 >>                                  <<01652>>15598000
8,5,"TEPES",5,     << 1131 >>                                  <<01454>>15600000
8,5,"TEPEL",5,     << 1132 >>                                  <<01454>>15602000
8,5,"TBR  ",3,     << 1140 >>                                           15604000
8,5,"TBD  ",3,     << 1141 >>                                           15606000
8,5,"SLIDE",5,     << 1145 >>                                           15608000
8,5,"FIG  ",3,     << 1146 >>                                           15610000
0;                                                             <<01454>>15612000
                                                               <<01454>>15614000
<< MNEMONIC'CODE -- an ascending ordered integer array       >><<01454>>15616000
<<    containing those HP defined file codes which have a    >><<01454>>15618000
<<    corresponding mnemonic.  The index of each element     >><<01454>>15620000
<<    corresponds to the entry number returned by the SEARCH >><<01454>>15622000
<<    intrinsic for its mnemonic.                            >><<01454>>15624000
                                                               <<01454>>15626000
   INTEGER ARRAY MNEMONIC'CODE(1:NUMBER'CODES) = PB :=         <<01454>>15628000
                                                               <<01454>>15630000
1024      << USL   >>                                          <<01454>>15632000
,1025     << BASD  >>                                          <<01454>>15634000
,1026     << BASP  >>                                          <<01454>>15636000
,1027     << BASFP >>                                          <<01454>>15638000
,1028     << RL    >>                                          <<01454>>15640000
,1029     << PROG  >>                                          <<01454>>15642000
,1031     << SL    >>                                          <<01454>>15644000
,1035     << VFORM >>                                          <<01454>>15646000
,1036     << VFAST >>                                          <<01454>>15648000
,1037     << VREF  >>                                          <<01454>>15650000
,1040     << XLSAV >>                                          <<01454>>15652000
,1041     << XLBIN >>                                          <<01454>>15654000
,1042     << XLDSP >>                                          <<01454>>15656000
,1050     << EDITQ >>                                          <<01454>>15658000
,1051     << EDTCQ >>                                          <<01454>>15660000
,1052     << EDTCT >>                                          <<01454>>15662000
<< 1053:       RESERVED FOR EDIT EXTENSIONS >>                          15664000
,1054     << TDPDT >>                                                   15666000
,1055     << TDPQM >>                                                   15668000
,1056     << TDPP  >>                                                   15670000
,1057     << TDPCP >>                                                   15672000
,1058     << TDPQ  >>                                                   15674000
,1059     << TDPCQ >>                                                   15676000
,1060     << RJEPN >>                                          <<01454>>15678000
<< 1061-1069:  RESERVED FOR RJE EXTENSIONS >>                  <<01454>>15680000
,1070     << QPROC >>                                          <<01454>>15682000
<< 1071&1072 -- QUERY WORK FILES >>                            <<01454>>15684000
<< 1073-1079:  RESERVED FOR QUERY EXTENSIONS >>                <<01454>>15686000
,1080     << KSAMK >>                                          <<01454>>15688000
,1083     << GRAPH >>                                          <<01454>>15690000
,1084     << SD    >>                                          <<01454>>15692000
,1090     << LOG   >>                                          <<01454>>15694000
,1100     << WDOC  >>                                          <<01454>>15696000
,1101     << WDICT >>                                          <<01454>>15698000
<< 1102-1109:  RESERVED FOR WORD EXTENSIONS >>                 <<01454>>15700000
,1110     << PCELL >>                                          <<01454>>15702000
,1111     << PFORM >>                                          <<01454>>15704000
,1112     << P2680 >>                                          <<01454>>15706000
,1113     << PCCMP >>                                          <<01454>>15708000
<< 1114-1129:  RESERVED FOR PSP EXTENSIONS >>                  <<01454>>15710000
,1130     << OPTLF >>                                          <<01652>>15712000
,1131     << TEPES >>                                          <<01454>>15714000
,1132     << TEPEL >>                                          <<01454>>15716000
<< 1133-1139:  RESERVED FOR PERF. TOOLS EXTENSIONS >>          <<01454>>15718000
,1140     << TBR   >>                                                   15720000
,1141     << TBD   >>                                                   15722000
<< 1142-1144:  RESERVED FOR TOOLBOX EXTENSIONS >>                       15724000
,1145     << SLIDE >>                                                   15726000
,1146     << FIG   >>                                                   15728000
<< 1147-1149:  RESERVED FOR SANDBOX EXTENSIONS >>                       15730000
;                                                              <<01454>>15732000
                                                               <<01454>>15734000
                                                               <<01454>>15736000
SUBROUTINE BINARY'SEARCH;                                      <<01454>>15738000
BEGIN                                                          <<01454>>15740000
   << INITIALIZE LOOP VARIABLES >>                             <<01454>>15742000
   LOWER'BOUND := 1;                                           <<01454>>15744000
   UPPER'BOUND := NUMBER'CODES;                                <<01454>>15746000
                                                               <<01454>>15748000
   WHILE LOWER'BOUND <= UPPER'BOUND DO                         <<01454>>15750000
      BEGIN                                                    <<01454>>15752000
      X := (LOWER'BOUND + UPPER'BOUND)/2;                      <<01454>>15754000
                                                               <<01454>>15756000
      IF FILECODE < MNEMONIC'CODE(X) THEN                      <<01454>>15758000
         UPPER'BOUND := X - 1     << LESS THAN CASE >>         <<01454>>15760000
      ELSE IF > THEN                                           <<01454>>15762000
         LOWER'BOUND := X + 1     << GREATER THAN CASE >>      <<01454>>15764000
      ELSE                                                     <<01454>>15766000
         BEGIN                                                 <<01454>>15768000
         ENTRY'NUMBER := X;       << FOUND ENTRY >>            <<01454>>15770000
         RETURN;                                               <<01454>>15772000
         END;                                                  <<01454>>15774000
      END;                << OF SEARCH LOOP >>                 <<01454>>15776000
                                                               <<01454>>15778000
   ENTRY'NUMBER := 0;     << ENTRY NOT FOUND >>                <<01454>>15780000
                                                               <<01454>>15782000
END;      << OF BINARY'SEARCH >>                               <<01454>>15784000
                                                               <<01454>>15786000
                                                               <<01454>>15788000
                                                               <<01454>>15790000
<< ENTRY POINT FOR GET'FILECODE >>                             <<01454>>15792000
                                                               <<01454>>15794000
   CC := CCL;           << SET COND CODE FOR ERROR CASE >>     <<01454>>15796000
                                                               <<01454>>15798000
   << LENGTH MUST BE POSITIVE >>                               <<01454>>15800000
   IF MNEMONIC'LENGTH <= 0 THEN RETURN;         << CCL >>      <<01454>>15802000
                                                               <<01454>>15804000
   << INITIALIZE VARIABLES FOR NOT FOUND CASE >>               <<01454>>15806000
   FILECODE := 0;                                              <<01454>>15808000
   CC := CCG;                                                  <<01454>>15810000
                                                               <<01454>>15812000
   << NO MNEMONICS > 5 CHARACTERS >>                           <<01454>>15814000
   IF MNEMONIC'LENGTH > 5 THEN RETURN;          << CCG >>      <<01454>>15816000
                                                               <<01454>>15818000
   << GET LOCAL COPY OF MNEMONIC UPSHIFTED >>                  <<01454>>15820000
   MOVE LOCAL'BUFFER := "      ";                              <<01454>>15822000
   MOVE LOCAL'BUFFER := MNEMONIC,(MNEMONIC'LENGTH);            <<01454>>15824000
   MOVE LOCAL'BUFFER := LOCAL'BUFFER WHILE ANS;                <<01454>>15826000
                                                               <<01454>>15828000
   << SEARCH FOR MNEMONIC IN DICTIONARY >>                     <<01454>>15830000
   MOVE LOCAL'DICT := MNEMONIC'DICT,(DICT'LENGTH);             <<01454>>15832000
   ENTRY'NUMBER := SEARCH(LOCAL'BUFFER,5,LOCAL'DICT);          <<01454>>15834000
                                                               <<01454>>15836000
   IF ENTRY'NUMBER <> 0 THEN                                   <<01454>>15838000
      BEGIN              << FOUND MNEMONIC >>                  <<01454>>15840000
      CC := CCE;                                               <<01454>>15842000
      FILECODE := MNEMONIC'CODE(ENTRY'NUMBER);                 <<01454>>15844000
      END;                                                     <<01454>>15846000
                                                               <<01454>>15848000
   RETURN;         << ALL DONE WITH GET'FILECODE ENTRY POINT >><<01454>>15850000
                                                               <<01454>>15852000
                                                               <<01454>>15854000
GET'FILEMNEMONIC:                                              <<01454>>15856000
                                                               <<01454>>15858000
   << INITIALIZE OUTPUT VARIABLES FOR NOT FOUND CASE >>        <<01454>>15860000
   CC := CCG;                                                  <<01454>>15862000
   MNEMONIC'LENGTH := 0;                                       <<01454>>15864000
   MOVE MNEMONIC := "     ";                                   <<01454>>15866000
                                                               <<01454>>15868000
   << CHECK IF FILE CODE IN RANGE OF POSSIBLE MNEMONICS >>     <<01454>>15870000
   IF MNEMONIC'CODE(1) <= FILECODE <=                          <<01454>>15872000
      MNEMONIC'CODE(NUMBER'CODES) THEN                         <<01454>>15874000
      BEGIN                                                    <<01454>>15876000
      BINARY'SEARCH;     << BINARY'SEARCH SETS ENTRY'NUMBER >> <<01454>>15878000
                                                               <<01454>>15880000
      IF ENTRY'NUMBER <> 0 THEN                                <<01454>>15882000
         BEGIN                << FOUND CODE >>                 <<01454>>15884000
                                                               <<01454>>15886000
         << GET LOCAL COPY OF DICTIONARY ENTRY >>              <<01454>>15888000
         MOVE LOCAL'BUFFER :=                                  <<01454>>15890000
              MNEMONIC'DICT( (ENTRY'NUMBER-1)*8 ),(8);         <<01454>>15892000
                                                               <<01454>>15894000
         << SET RETURN VARIABLES >>                            <<01454>>15896000
         CC := CCE;                                            <<01454>>15898000
         MOVE MNEMONIC := LOCAL'BUFFER(2),(5);                 <<01454>>15900000
         MNEMONIC'LENGTH := LOCAL'BUFFER(7);                   <<01454>>15902000
         END;                                                  <<01454>>15904000
      END;                                                     <<01454>>15906000
                                                               <<01454>>15908000
                                                               <<01454>>15910000
END;     << OF GET'FILECODE/MNEMONIC >>                        <<01454>>15912000
                                                               <<01454>>15914000
                                                               <<01454>>15916000
INTEGER PROCEDURE LISTFILE (PARMS);                           <<00.GEN>>15918000
   INTEGER ARRAY PARMS;                                       <<00.GEN>>15920000
   OPTION PRIVILEGED, UNCALLABLE;                                       15922000
BEGIN                                                                   15924000
                                                                        15926000
   DOUBLE ARRAY      DPARMS (*)        = PARMS;                         15928000
<< "OWN" VARIABLES IN <PARMS>. >>                                       15930000
   INTEGER ARRAY     FNAME (*)         = PARMS,                         15932000
                     CURRENTG (*)      = PARMS (4),                     15934000
                     CURRENTA (*)      = PARMS (8),                     15936000
                     CURRENTGA (*)     = CURRENTG;                      15938000
   BYTE ARRAY        BCURRENTGA (*)    = CURRENTGA;                     15940000
   DEFINE            DETAIL            = PARMS (12) #,                  15942000
                     DETAILLENGTH      = PARMS (13) #,   <<WORDS>>      15944000
                     FPNTR1            = PARMS (14) #,                  15946000
                     FPNTR2            = PARMS (15) #,                  15948000
                     SIRS              = DPARMS (8) #,                  15950000
                     FILENUM           = PARMS (18) #,                  15952000
                     DEVSIZE           = PARMS (19) #,   <<BYTES>>      15954000
                     LINENO            = PARMS (20) #,                  15956000
                     NUMPERLINECOUNT   = PARMS (21) #,         <<RV.PV>>15958000
                     TYPEW             = PARMS (22) #,         <<RV.PV>>15960000
                     GLINKAGEW         = PARMS (23) #,         <<03.KM>>15962000
                     P'GOTFILE         = PARMS (24) #,         <<03.KM>>15964000
                     P'IMPMNTDST       = PARMS (25) #,         <<03.KM>>15966000
                     P'IMPMNTERR       = PARMS (26) #,         <<03.KM>>15968000
                     P'IMPMNTNAME      = PARMS (27) #,         <<03.KM>>15970000
                     P'IMPMNTGRP       = PARMS (27) #,         <<03.KM>>15972000
                     P'IMPMNTACCT      = PARMS (31) #;         <<03.KM>>15974000
                                                                        15976000
<< LOCALS >>                                                            15978000
   EQUATE            MAXDETAILLENGTH   = 72,                            15980000
                     MDLWORDSM1        = MAXDETAILLENGTH/2 -1,          15982000
                     FINFOSIZE         = 128,                           15984000
                     LONGDEV           = 128;                           15986000
   INTEGER ARRAY     FLABEL (*),                                        15988000
                     BUF (0:MDLWORDSM1);                                15990000
   DOUBLE ARRAY      DFLABEL (*)       = FLABEL;                        15992000
   BYTE ARRAY        BBUF (*)          = BUF,                           15994000
                     TBUF (0:9);                                        15996000
   INTEGER           LEN,                                               15998000
                     BF,                                                16000000
                     NX;                                                16002000
   LOGICAL           FIRSTFILE := FALSE,  << 1ST IN GROUP >>   <<01724>>16004000
                     BADFLABEL := FALSE;  << BAD FILE LABEL >> <<01724>>16006000
   << DOUBLE (TOS) / X  --->  DOUBLE (Q), SINGLE (REM)    (ON TOS) >>   16008000
   DEFINE            FUNNYDIVIDE       = ASSEMBLE (                     16010000
                     ZERO, CAB;  LDXA, LDIV;  CAB;  LDXA, LDIV) #;      16012000
   << DOUBLE (TOS) * X  --->  DOUBLE (PRODUCT)  (ON TOS) >>             16014000
   DEFINE            FUNNYMULTIPLY     = ASSEMBLE (                     16016000
                     LDXA, LMPY;  CAB;  LDXA, MPY;  ZERO, DADD ) #;     16018000
                                                                        16020000
<< FILE LABEL >>                                                        16022000
   << FOLLOWING 3 ARRAY ADDRESSES ARE SET WHEN (IF) <FLABEL> IS INTITL>>16024000
INTEGER ARRAY     FLGA (*)       << = FLABEL (4) >>;           <<0307>> 16026000
DOUBLE ARRAY      FLEXTMAP (*)   << = FLABEL (44) >>;          <<0307>> 16028000
   BYTE ARRAY        BFLGA (*)      << = FLGA >>;                       16030000
   DEFINE            FLFLIM            = DFLABEL (15) #,                16032000
                     FLEOF             = DFLABEL (21) #,                16034000
                     FLCODE            = FLABEL (26) #,                 16036000
                     FLOPENED          = FLABEL (27) <> 0 AND           16038000
                         FLABEL (35) =ABSOLUTE(COLDLOADID) #,           16040000
                     FLRECFORMAT       = FLABEL (36) .(8:2) #,          16042000
                     FLASCII           = LOGICAL (FLABEL(36).(13:1)) #, 16044000
                     FLCNTRL           = LOGICAL (FLABEL(36).(7:1)) #,  16046000
                     FLFILETYPE    =LOGICAL(FLABEL(36).(2:3))#,<<01549>>16048000
                     FLKSAM            = (FLFILETYPE = 1) #,   <<01549>>16050000
                     FLMSGFILE         = (FLFILETYPE = 6) #,   <<01549>>16052000
                     FLRECSIZE         = FLABEL (37) #,                 16054000
                     FLBLKSIZE         = FLABEL (38) #,                 16056000
                     FLSECTOFF         = FLABEL (39) .(0:8) #,          16058000
                     FLNUMEXTS         = FLABEL (39) .(11:5) #,         16060000
                  FLLASTEXTSIZE     = FLABEL (40) #,           <<0307>> 16062000
                     FLEXTSIZE         = FLABEL (41) #;                 16064000
   BYTE ARRAY        PRIV (0:4) = PB   := "PRIV ";                      16066000
   ARRAY             FILETYPE(0:7)=PB:="     R ? O ? M ?";     <<01549>>16068000
                                                                        16070000
<< MISC. JUNK >>                                                        16072000
      DEFINE                                                            16074000
                     EJECT             = BEGIN                          16076000
                                         FWRITE (FILENUM, BUF, 0, %61); 16078000
                                         IF <> THEN                     16080000
                                            BEGIN                       16082000
                                            TOS := 2;                   16084000
                                            GOTO EXIT;                  16086000
                                            END;                        16088000
                                         LINENO := 1;                   16090000
                                         END  #,                        16092000
                     FINISHWRITE       = IF <> THEN                     16094000
                                            BEGIN                       16096000
                                            TOS := 2;                   16098000
                                            GOTO EXIT;                  16100000
                                            END;                        16102000
                                         LINENO := LINENO  #,           16104000
                     SPACE             = BEGIN                          16106000
                                         FWRITE (FILENUM, BUF, 0, %40); 16108000
                                         FINISHWRITE +1;                16110000
                                         END #,                         16112000
                     DSPACE            = BEGIN                          16114000
                                         FWRITE (FILENUM, BUF, 0, %60); 16116000
                                         FINISHWRITE +2;                16118000
                                         END #;                         16120000
                                                                        16122000
<< LIST FORMAT >>                                                       16124000
   ARRAY             TITLE1 (0:33) = PB :=  "FILENAME",        <<U.RAO>>16126000
"  CODE  ------------LOGICAL RECORD-----------  ----SPACE----";<<U.RAO>>16128000
   ARRAY             TITLE1A (0:33) = PB := "        ",        <<U.RAO>>16130000
"          SIZE  TYP        EOF      LIMIT R/B  SECTORS #X MX";<<U.RAO>>16132000
   EQUATE            OPPOS             = 8,                             16134000
                     CODEPOS           = 10,                            16136000
                     RSIZEPOS          = 21,                            16138000
                     RTYPPOS           = 24,                            16140000
                     REOFPOS           = 37,                            16142000
                     RLIMPOS           = 48,                            16144000
                     RBPOS             = 52,                            16146000
                     SECTPOS           = 61,                            16148000
                     NXPOS             = 64,                            16150000
                     MXPOS             = 67;                   <<U.RAO>>16152000
   ARRAY             AGTITLE (0:25) = PB :=                            "16154000
ACCOUNT=              GROUP=              (CONT.) ";                    16156000
   EQUATE            GROUPPOS          = 15,                            16158000
                     ACCTPOS           = 5;                             16160000
                                                                        16162000
SUBROUTINE RIGHTNUM (NUM, BBUFDEST);                                    16164000
   VALUE BBUFDEST, NUM;                                                 16166000
   INTEGER BBUFDEST, NUM;                                               16168000
<< RIGHT-JUSTIFIED NUMBER AT BBUF (BBUFDEST) >>                         16170000
BEGIN                                                                   16172000
   LEN := ASCII (NUM, 10, TBUF);                                        16174000
   MOVE BBUF (BBUFDEST -LEN +1) := TBUF, (LEN);                         16176000
   END    <<RIGHTNUM>>;                                                 16178000
SUBROUTINE RIGHTDNUM (DNUM, BBUFDEST);                                  16180000
   VALUE BBUFDEST, DNUM;                                                16182000
   INTEGER BBUFDEST;                                                    16184000
   DOUBLE DNUM;                                                         16186000
<< RIGHT-JUSTIFIED DOUBLE AT BBUF (BBUFDEST) >>                         16188000
BEGIN                                                                   16190000
   LEN := DASCII (DNUM, 10, TBUF);                                      16192000
   MOVE BBUF (BBUFDEST -LEN +1) := TBUF, (LEN);                         16194000
   END    <<RIGHTDNUM>>;                                                16196000
SUBROUTINE PRINTAG (LENGTH);                                            16198000
   VALUE LENGTH;                                                        16200000
   INTEGER LENGTH;                                                      16202000
<< PRINT "ACCOUNT/GROUP" TITLE >>                                       16204000
BEGIN                                                                   16206000
   MOVE BUF := AGTITLE, (LENGTH);                                       16208000
   MOVE BUF (ACCTPOS) := CURRENTA, (4);                                 16210000
   MOVE BUF (GROUPPOS) := CURRENTG, (4);                                16212000
   FWRITE (FILENUM, BUF, LENGTH, 0);                                    16214000
   FINISHWRITE +1;                                                      16216000
   END    <<PRINTAG>>;                                                  16218000
SUBROUTINE PRINTTITLE;                                                  16220000
<< PRINTS COLUMN HEADING INFORMATION.                                   16222000
   VERY SIMPLE PRINT FOR NOW. >>                                        16224000
BEGIN                                                                   16226000
   SPACE;                                                               16228000
   MOVE BUF := TITLE1, (DETAILLENGTH);                                  16230000
   FWRITE (FILENUM, BUF, DETAILLENGTH, 0);                              16232000
   FINISHWRITE +1;                                                      16234000
   IF DETAIL <> 0 THEN                                                  16236000
      BEGIN                                                             16238000
      MOVE BUF := TITLE1A, (DETAILLENGTH);                              16240000
      FWRITE (FILENUM, BUF, DETAILLENGTH, 0);                           16242000
      FINISHWRITE +1;                                                   16244000
      END;                                                              16246000
   SPACE;                                                               16248000
   NUMPERLINECOUNT := 0;                                                16250000
   END    <<PRINTTITLE>>;                                               16252000
                                                                        16254000
                                                                        16256000
                                                                        16258000
SUBROUTINE PRINTFORM1 (BUFSTART, LENGTH);                               16260000
   VALUE BUFSTART, LENGTH;                                              16262000
   INTEGER BUFSTART, LENGTH;                                            16264000
<< SIMPLY PRINT BUF (BUFSTART), LENGTH.  >>                             16266000
BEGIN                                                                   16268000
   FWRITE (FILENUM, BUF (BUFSTART), LENGTH, 0);                         16270000
   FINISHWRITE +1;                                                      16272000
   END    <<PRINTFORM1>>;                                               16274000
SUBROUTINE PRINTFORM2 (LENGTH, NUMBERPERLINE);                          16276000
   VALUE LENGTH, NUMBERPERLINE;                                         16278000
   INTEGER LENGTH, NUMBERPERLINE;                                       16280000
<< PUT 4 BLANKS AT BUF (LENGTH) AND WRITE IT OUT %320,                  16282000
   UNLESS THIS IS LAST ONE ON THE LINE.  >>                             16284000
BEGIN                                                                   16286000
   NUMPERLINECOUNT := NUMPERLINECOUNT -1;                               16288000
   IF < THEN    <<1ST FILE: INITIALIZE <NUMPERLINECOUNT>.>>             16290000
      NUMPERLINECOUNT := NUMBERPERLINE -1;                              16292000
   IF > THEN                                                            16294000
      BEGIN                                                             16296000
      BUF (LENGTH) := "  ";                                             16298000
      BUF (X +1) := "  ";                                               16300000
      FWRITE (FILENUM, BUF, LENGTH +2, %320);                           16302000
      FINISHWRITE;    << <LINENO> NOT MODIFIED >>                       16304000
      END                                                               16306000
   ELSE                                                                 16308000
      BEGIN                                                             16310000
      FWRITE (FILENUM, BUF, LENGTH, 0);                                 16312000
      FINISHWRITE +1;                                                   16314000
      NUMPERLINECOUNT := NUMBERPERLINE;                                 16316000
      END;                                                              16318000
   END    <<PRINTFORM2>>;                                               16320000
SUBROUTINE PRINTFORM3;                                                  16322000
<< PRINT BUF (0:35),                                                    16324000
   BLANK BUF (30:35),                                                   16326000
   PRINT BUF (30), 34.  >>                                              16328000
BEGIN                                                                   16330000
   FWRITE (FILENUM, BUF, 36, 0);                                        16332000
   FINISHWRITE +1;                                                      16334000
   BUF (30) := "  ";                                                    16336000
   MOVE BUF (31) := BUF, (5);                                           16338000
   FWRITE (FILENUM, BUF (30), 34, 0);                                   16340000
   FINISHWRITE +1;                                                      16342000
   END    <<PRINTFORM3>>;                                               16344000
                                                                        16346000
                                                                        16348000
SUBROUTINE PRINTLINE;                                                   16350000
BEGIN                                                                   16352000
   TOS := DETAIL & LSL(1);                                              16354000
   IF DEVSIZE >= LONGDEV THEN TOS := TOS +1;                            16356000
   CASE TOS OF                                                          16358000
      BEGIN                                                             16360000
         PRINTFORM2 (4, 6);                                             16362000
         PRINTFORM2 (4, 11);                                            16364000
         PRINTFORM1 (0, 25);                                            16366000
         PRINTFORM2 (25, 2);                                            16368000
         PRINTFORM1 (0, 34);                                   <<U.RAO>>16370000
         PRINTFORM1 (0,34);                                    <<U.RAO>>16372000
      END;                                                              16374000
   END    <<PRINTLINE>>;                                                16376000
                                                                        16378000
                                                                        16380000
SUBROUTINE FORMATINFO;                                                  16382000
BEGIN                                                                   16384000
   BUF := "  ";                                                         16386000
   MOVE BUF (1) := BUF, (MDLWORDSM1);                                   16388000
IF DETAIL >= 2 THEN                                                     16390000
   BEGIN                                                                16392000
   TOS := DOUBLE (FLBLKSIZE);          <<BLOCK FACTOR>>                 16394000
   TOS := FLRECSIZE;                                                    16396000
   IF = THEN TOS := TOS +128                                            16398000
   ELSE IF < THEN TOS := (-TOS +1) & LSR(1);                            16400000
   IF FLMSGFILE THEN TOS:=TOS+3;  <<ADD IN MG HDR LENGTH>>     <<01565>>16402000
   ASSEMBLE (LDIV, DEL);                                                16404000
   RIGHTNUM ((BF := TOS), RBPOS);                                       16406000
   TOS := @FLEXTMAP;                                                    16408000
   X := FLNUMEXTS;                                                      16410000
   TOS := 0;                                                            16412000
   DO BEGIN                                                             16414000
      IF DPS1(X) <> 0D THEN TOS := TOS +1;                              16416000
      X := X -1;                                                        16418000
      END                                                               16420000
   UNTIL <;                                                             16422000
   RIGHTNUM ((NX := TOS), NXPOS);                                       16424000
   ASSEMBLE (DEL);                                                      16426000
   RIGHTNUM(FLNUMEXTS+1, MXPOS);                               <<0307>> 16428000
                                                               <<0307>> 16430000
   << COMPUTE FILE SPACE IN SECTORS.  NOTE: LAST EXTENT MAY >> <<0307>> 16432000
   << CONTAIN FEWER SECTORS THAN THE OTHERS.                >> <<0307>> 16434000
   TOS := IF FLEXTMAP(FLNUMEXTS) = 0D THEN                     <<0307>> 16436000
              LOGICAL(NX)**LOGICAL(FLEXTSIZE)                  <<0307>> 16438000
          ELSE                                                 <<0307>> 16440000
             (LOGICAL(NX)-1)**LOGICAL(FLEXTSIZE) +             <<0307>> 16442000
         DOUBLE(LOGICAL(FLLASTEXTSIZE));                                16444000
   RIGHTDNUM (*, SECTPOS);                                              16446000
   END;                                                                 16448000
IF DETAIL >= 1 THEN                                                     16450000
   BEGIN                                                                16452000
   IF FLOPENED THEN BBUF(OPPOS) := "*";<<OPENED FLAG>>                  16454000
   IF FLCODE < 0 THEN   << PRIVILEGED FILE >>                  <<01454>>16456000
      MOVE BBUF(CODEPOS) := PRIV,(4)                           <<01454>>16458000
   ELSE IF > THEN   << FILE CODE > 0     >>                    <<01454>>16460000
      BEGIN         << CHECK FOR HP CODE >>                    <<01454>>16462000
      GET'FILEMNEMONIC(FLCODE,BBUF(CODEPOS),LEN);              <<01454>>16464000
      IF <> THEN    << NOT HP MNEMONIC CODE >>                 <<01454>>16466000
         ASCII(FLCODE,10,BBUF(CODEPOS));                       <<01454>>16468000
      END                                                      <<01454>>16470000
   ELSE   << FILE CODE = 0, TRY KSAM >>                        <<01454>>16472000
      IF FLKSAM THEN MOVE BBUF(CODEPOS) := "KSAM ";            <<01454>>16474000
   TOS := FLRECSIZE;                   <<REC SIZE>>                     16476000
   IF = THEN TOS := TOS +128;                                           16478000
   IF > THEN TOS := "W"                                                 16480000
   ELSE                                                                 16482000
      BEGIN                                                             16484000
      TOS := -TOS;                                                      16486000
      IF FLASCII THEN TOS:="B" ELSE                                     16488000
         BEGIN                                                          16490000
         TOS:=TOS&ASR(1);                                               16492000
         TOS:="W";                                                      16494000
         END;                                                           16496000
      END;                                                              16498000
   IF FLRECFORMAT = 1 AND NOT FLMSGFILE THEN                   <<01549>>16500000
      BEGIN                                                             16502000
      ASSEMBLE (DECB, DECB);                                            16504000
      IF S0 = "B" THEN ASSEMBLE (DECB, DECB);                           16506000
      END;                                                              16508000
   BBUF (RSIZEPOS) := TOS;                                              16510000
   RIGHTNUM (*, X -1);                                                  16512000
   CASE FLRECFORMAT OF                 <<REC TYP>>                      16514000
      BEGIN                                                             16516000
      TOS := "F";                                                       16518000
      TOS := "V";                                                       16520000
      TOS := "U";                                                       16522000
                                                               <<01724>>16524000
   << UNDEFINED VALUE (3) -- BAD FILE LABEL >>                 <<01724>>16526000
      BEGIN                                                    <<01724>>16528000
      BADFLABEL := TRUE;                                       <<01724>>16530000
      TOS := "*";                                              <<01724>>16532000
      END;                                                     <<01724>>16534000
                                                               <<01724>>16536000
      END;                                                              16538000
   BBUF (RTYPPOS) := TOS;                                               16540000
   BBUF (RTYPPOS +1) := IF FLASCII THEN "A" ELSE "B";                   16542000
   IF FLCNTRL THEN BBUF (RTYPPOS +2) := "C";                            16544000
   BBUF(RTYPPOS+(IF FLCNTRL THEN 3 ELSE 2)) :=                 <<01549>>16546000
      BYTE(FILETYPE(FLFILETYPE));                              <<01549>>16548000
   RIGHTDNUM (FLEOF, REOFPOS);         <<FILE EOF>>                     16550000
   RIGHTDNUM (FLFLIM, RLIMPOS);        <<FILE LIMIT>>                   16552000
   END;                                                                 16554000
                                                               <<01724>>16556000
   << IF BAD FILE LABEL, STAR OUT BUFFER. >>                   <<01724>>16558000
   IF BADFLABEL THEN                                           <<01724>>16560000
      BEGIN                                                    <<01724>>16562000
      BUF := "**";                                             <<01724>>16564000
      MOVE BUF(1) := BUF,(MDLWORDSM1);                         <<01724>>16566000
      END;                                                     <<01724>>16568000
                                                               <<01724>>16570000
   MOVE BUF := FNAME, (4);             <<FILENAME>>                     16572000
                                                                        16574000
   END    <<FORMATINFO>>;                                               16576000
   IF DETAIL > 0 THEN                                                   16578000
      BEGIN    <<READ IN FILE LABLE>>                                   16580000
      TOS := FINFOSIZE;                                                 16582000
      @BFLGA := (@FLGA := (@FLABEL := @S0) +4) & LSL(1);                16584000
      @FLEXTMAP := @S0 +44;                                             16586000
      ASSEMBLE (ADDS 0);                                                16588000
      TOS := 0D;  <<RETURN FOR ATTACHIO>>                      <<RV.PV>>16590000
      TOS := LUN (FPNTR1.(0:8),GLINKAGEW.(MVTABXF));           <<RV.PV>>16592000
      TOS := ATTACHIO (*,0,0,@FLABEL,0,128,FPNTR1.(8:8),FPNTR2,1);      16594000
      ASSEMBLE (DEL);                                                   16596000
      IF TOS.(13:3) <> 1 THEN                                           16598000
         BEGIN                         <<FILE LABEL I/O ERROR>>         16600000
         TOS:=SIRS;                                                     16602000
         IF<>THEN RELSIR(*,*);                                          16604000
         CIERR(-LISTFFLABIOERR);                               <<U.RAO>>16606000
         TOS := 1;                                                      16608000
         GOTO EXIT;                                                     16610000
         END;                                                           16612000
      END;                                                              16614000
   TOS := SIRS;                                                         16616000
   IF <> THEN RELSIR (*, *);                                            16618000
                                                                        16620000
   <<GOT ALL THE INFO.  NOW FORMAT AND PRINT>>                          16622000
   IF LINENO<0 THEN                                            <<05.KM>>16624000
      BEGIN                                                    <<05.KM>>16626000
      LINENO:=-LINENO;                                         <<05.KM>>16628000
      FIRSTFILE:=TRUE;                                         <<05.KM>>16630000
      END;                                                     <<05.KM>>16632000
   IF LINENO = 61 THEN EJECT;                                           16634000
   IF DETAIL>0 AND FIRSTFILE THEN                              <<06.KM>>16636000
      BEGIN                                                             16638000
      MOVE CURRENTGA := FLGA, (8);                                      16640000
      IF LINENO <> 1 THEN                                               16642000
         IF LINENO <= 52 THEN DSPACE                                    16644000
         ELSE EJECT;                                                    16646000
      PRINTAG (20);                                                     16648000
      END                                                               16650000
   ELSE                                                                 16652000
      BEGIN                                                             16654000
      IF LINENO <> 1 THEN                                               16656000
         BEGIN                                                          16658000
         IF LINENO <= 58 THEN GOTO PRINTINFOL;                          16660000
         EJECT;                                                         16662000
         END;                                                           16664000
      IF DETAIL > 0 THEN PRINTAG (25);                                  16666000
      END;                                                              16668000
   PRINTTITLE;                                                          16670000
PRINTINFOL:                                                             16672000
   FORMATINFO;                                                          16674000
    PRINTLINE;                                                          16676000
   TOS := 0;                                                            16678000
                                                                        16680000
EXIT:                                                                   16682000
   LISTFILE := TOS;                                                     16684000
   IF DETAIL > 0 THEN                                         <<01.02>> 16686000
     BEGIN                                                    <<01.02>> 16688000
       DFLABEL(8):=0D; <<WIPE OUT LOCKWORD>>                  <<01.02>> 16690000
       DFLABEL(9):=0D;                                        <<01.02>> 16692000
     END;                                                     <<01.02>> 16694000
   END    <<LISTFILE>>;                                                 16696000
INTEGER PROCEDURE LISTSAVEFILES (ELEMENT, LEVEL, PARMS, SIRS);          16698000
   VALUE LEVEL, PARMS, SIRS;                                            16700000
   INTEGER ARRAY ELEMENT;                                               16702000
   INTEGER LEVEL, PARMS;                                                16704000
   DOUBLE SIRS;                                                         16706000
   OPTION PRIVILEGED, UNCALLABLE;                                       16708000
BEGIN                                                                   16710000
   DEFINE P'FNAME=      RPARMS #,                              <<03.KM>>16712000
          P'FNAME1=     RPARMS(1) #,                           <<03.KM>>16714000
          P'GANAME=     RPARMS(2) #,                           <<03.KM>>16716000
          P'GNAME=      RPARMS(2) #,                           <<03.KM>>16718000
          P'GNAME1=     RPARMS(3) #,                           <<03.KM>>16720000
          P'ANAME=      RPARMS(4) #,                           <<03.KM>>16722000
          P'ANAME1=     RPARMS(5) #,                           <<03.KM>>16724000
          P'FPNTR=      RPARMS(7) #,                           <<03.KM>>16726000
          P'SIRS=       RPARMS(8) #,                           <<03.KM>>16728000
          P'LINENO=     RPARMSW(20) #,                         <<06.KM>>16730000
          P'GLINKAGEW=  RPARMSW(23) #,                         <<03.KM>>16732000
          P'GOTENTRY=   RPARMSW(24) #,                         <<03.KM>>16734000
          P'IMPMNTDST=  RPARMSW(25) #,                         <<03.KM>>16736000
          P'IMPMNTERR=  RPARMSW(26) #,                         <<03.KM>>16738000
          P'IMPMNTNAME= RPARMSW(27) #,                         <<03.KM>>16740000
          P'IMPMNTGRP=  RPARMSW(27) #,                         <<03.KM>>16742000
          P'IMPMNTACCT= RPARMSW(31) #;                         <<03.KM>>16744000
   DEFINE PVGROUP=    LOGICAL(P'GLINKAGEW.(PVF)) #,            <<03.KM>>16746000
          RELEASESIR=                                          <<03.KM>>16748000
            BEGIN                                              <<03.KM>>16750000
            TOS:=SIRS;                                         <<03.KM>>16752000
            IF <> THEN RELSIR(*,*) ELSE DDEL;                  <<03.KM>>16754000
            END #;                                             <<03.KM>>16756000
   INTEGER PVINFO'ERROR;                                       <<10.KM>>16758000
   EQUATE NOMOUNT= 0;                                          <<03.KM>>16760000
   ARRAY LEAFNAME(*)=S-6;                                      <<04.KM>>16762000
   DOUBLE ARRAY DELEMENT(*)=ELEMENT,RPARMS(*);                          16764000
   INTEGER S1= S-1,                                           <<00.GEN>>16766000
           S2= S-2;                                           <<00.GEN>>16768000
   INTEGER POINTER PPRESULT;                                  <<00.GEN>>16770000
   INTEGER ARRAY RPARMSW (*) = RPARMS;                         <<06.KM>>16772000
   INTEGER           XTYPE             = DB+%201;              <<RV.PV>>16774000
   EQUATE            DIRDST            = 20;                            16776000
                                                                        16778000
<<   ********************************************    >>        <<U.RAO>>16780000
<<   *   A RECIP procedure for CXLISTF          *    >>        <<U.RAO>>16782000
<<   ********************************************    >>        <<U.RAO>>16784000
                                                               <<U.RAO>>16786000
   IF REQUESTSERVICE THEN                                               16788000
      BEGIN                                                             16790000
      LISTSAVEFILES:=ABORTSCAN'SIR;                            <<03.KM>>16792000
      RETURN;                                                  <<03.KM>>16794000
      END;                                                              16796000
   TOS:=DELEMENT;                                             <<00.GEN>>16798000
   TOS:=DELEMENT(1);                                          <<00.GEN>>16800000
   TOS:=DELEMENT(2);                                          <<01.GEN>>16802000
   TOS:=ELEMENT(GLINKAGE);                                    <<00.GEN>>16804000
   EXCHANGEDB(0);                                             <<00.GEN>>16806000
   @RPARMS:=@ARRQ0(PARMS-DELTAQ);                             <<00.GEN>>16808000
                                                              <<00.GEN>>16810000
   @PPRESULT:=@RPARMS+SYSL'PPRINX;                            <<00.GEN>>16812000
   IF LOGICAL(D'TYPE.(ALLFLAG)) THEN                          <<00.GEN>>16814000
   BEGIN                                                      <<00.GEN>>16816000
     COMMENT:                                                 <<00.GEN>>16818000
       (S-6,S-3) = LEAF NAME                                   <<04.KM>>16820000
       (S-2,S-0) = MISC ENTRY INFO;                            <<04.KM>>16822000
                                                              <<00.GEN>>16824000
     CASE *LEVEL OF BEGIN                                     <<00.GEN>>16826000
       TOS:=DIRMATCH(G'FNAME,LEAFNAME);                       <<00.GEN>>16828000
       TOS:=DIRMATCH(G'GNAME,LEAFNAME);                       <<00.GEN>>16830000
       TOS:=DIRMATCH(G'ANAME,LEAFNAME);                       <<00.GEN>>16832000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>16834000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>16836000
     END;                                                     <<00.GEN>>16838000
     IF TOS<>0 THEN                                           <<00.GEN>>16840000
     BEGIN                                                    <<00.GEN>>16842000
       LISTSAVEFILES:=IF < THEN NEXTUNCLE'SIR                  <<03.KM>>16844000
                      ELSE NEXTBROTHER'SIR;                    <<03.KM>>16846000
       EXCHANGEDB(DIRDST);                                     <<03.KM>>16848000
       RETURN;                                                 <<03.KM>>16850000
     END;                                                     <<00.GEN>>16852000
   END;                                                       <<00.GEN>>16854000
                                                              <<00.GEN>>16856000
   CASE *LEVEL OF                                              <<04.KM>>16858000
     BEGIN                                                     <<04.KM>>16860000
     COMMENT:                                                  <<04.KM>>16862000
       (S-6,S-3)= LEAF NAME                                    <<04.KM>>16864000
       (S-2,S-1)= FPNTR (VALID IFF FILE LEVEL)                 <<04.KM>>16866000
       S-0=       GLINKAGEW (VALID IFF GROUP LEVEL).           <<04.KM>>16868000
                                                               <<04.KM>>16870000
       EACH CASE LEAVES "LISTSAVEFILES" VALUE ON TOS;          <<04.KM>>16872000
                                                               <<04.KM>>16874000
     <<0>> BEGIN <<FILE>>                                      <<04.KM>>16876000
           DEL;                                                <<04.KM>>16878000
           P'FPNTR:=TOS;                                       <<04.KM>>16880000
           P'FNAME1:=TOS;                                      <<04.KM>>16882000
           P'FNAME:=TOS;                                       <<04.KM>>16884000
           P'SIRS:=SIRS;                                       <<04.KM>>16886000
           P'GOTENTRY:=TRUE;                                   <<04.KM>>16888000
           IF LISTFILE(RPARMS)<=1 THEN TOS:=NEXTSON            <<04.KM>>16890000
           ELSE                                                <<04.KM>>16892000
             BEGIN                                             <<04.KM>>16894000
             RPARMSW(1):=-1;                                   <<04.KM>>16896000
             TOS:=ABORTSCAN;                                   <<04.KM>>16898000
             END;                                              <<04.KM>>16900000
           END;                                                <<04.KM>>16902000
                                                               <<04.KM>>16904000
     <<1>> BEGIN <<GROUP>>                                     <<04.KM>>16906000
           P'GLINKAGEW:=TOS;                                   <<04.KM>>16908000
           DDEL;                                               <<04.KM>>16910000
           P'GNAME1:=TOS;                                      <<04.KM>>16912000
           P'GNAME:=TOS;                                       <<04.KM>>16914000
           IF P'LINENO>0 THEN P'LINENO:=-P'LINENO;             <<10.KM>>16916000
           RELEASESIR;                                         <<04.KM>>16918000
           IF NOT PVGROUP THEN TOS:=NEXTSON                    <<04.KM>>16920000
           ELSE IF IMPLICITMNT(P'GNAME,P'ANAME,P'IMPMNTDST,    <<04.KM>>16922000
                               PVINFO'ERROR) THEN              <<10.KM>>16924000
             BEGIN                                             <<04.KM>>16926000
             P'GLINKAGEW.(MVTABXF):=PVINFO'ERROR.(PVMVTABXF);  <<10.KM>>16928000
             TOS:=REVISIT;                                     <<04.KM>>16930000
             END                                               <<04.KM>>16932000
           ELSE IF PVINFO'ERROR=NOMOUNT THEN                   <<10.KM>>16934000
             BEGIN                                             <<04.KM>>16936000
             P'IMPMNTERR:=PVINFO'ERROR;                        <<10.KM>>16938000
             TOS:=REVISIT;             <<DDS USED BY "MOUNT">> <<05.KM>>16940000
             END                                               <<04.KM>>16942000
           ELSE                                                <<04.KM>>16944000
             BEGIN                                             <<04.KM>>16946000
             P'IMPMNTERR:=PVINFO'ERROR;                        <<10.KM>>16948000
             MOVE P'IMPMNTNAME:=P'GANAME,(8);                  <<04.KM>>16950000
             TOS:=ABORTSCAN;                                   <<04.KM>>16952000
             END;                                              <<04.KM>>16954000
           END;                                                <<04.KM>>16956000
                                                               <<04.KM>>16958000
     <<2>> BEGIN <<ACCOUNT>>                                   <<04.KM>>16960000
           DEL;                                                <<04.KM>>16962000
           DDEL;                                               <<04.KM>>16964000
           P'ANAME1:=TOS;                                      <<04.KM>>16966000
           P'ANAME:=TOS;                                       <<04.KM>>16968000
           TOS:=NEXTSON'SIR;                                   <<04.KM>>16970000
           END;                                                <<04.KM>>16972000
                                                               <<05.KM>>16974000
     <<3>> TOS:=ABORTSCAN'SIR;         <<SHOULDN'T HAPPEN>>    <<10.KM>>16976000
     <<4>> TOS:=ABORTSCAN'SIR;         <<SHOULDN'T HAPPEN>>    <<10.KM>>16978000
     END <<CASE>>;                                             <<04.KM>>16980000
   EXCHANGEDB(DIRDST);                                         <<04.KM>>16982000
   LISTSAVEFILES:=TOS;                                         <<04.KM>>16984000
   END;                                                                 16986000
                                                              <<00.GEN>>16988000
                                                              <<00.GEN>>16990000
PROCEDURE GETDIRINFO(STARTINX,DEFLEVEL,PPRESULT);             <<00.GEN>>16992000
                    VALUE STARTINX,DEFLEVEL;                  <<00.GEN>>16994000
                    INTEGER STARTINX,                         <<00.GEN>>16996000
                            DEFLEVEL;                         <<00.GEN>>16998000
                    INTEGER ARRAY PPRESULT;                   <<00.GEN>>17000000
                    OPTION PRIVILEGED,UNCALLABLE;              <<01.KM>>17002000
BEGIN                                                         <<00.GEN>>17004000
  COMMENT:                                                    <<00.GEN>>17006000
    ACQUIRES THE GROUP OR ACCOUNT INDEX AND LOG-ON            <<00.GEN>>17008000
    GROUP AND ACCOUNT NAMES FROM THE JIT.  THESE              <<00.GEN>>17010000
    ARE STORED INTO "D'INX", "G'GNAME" AND "G'ANAME"          <<00.GEN>>17012000
    OF "PPRESULT";                                            <<00.GEN>>17014000
                                                              <<00.GEN>>17016000
  DEFINE MVF= 1:1 #;                                          <<00.GEN>>17018000
  EQUATE PXGLOB= -1,                                          <<00.GEN>>17020000
         JITLAN= 16,                                          <<05.GEN>>17022000
         JITLGN= 24,                                          <<05.GEN>>17024000
         JITAIP= 32;                                          <<05.GEN>>17026000
  DOUBLE QJITIPS;                                             <<00.GEN>>17028000
  DOUBLE ARRAY DPPRESULT(*)=PPRESULT;                         <<00.GEN>>17030000
  INTEGER JITDST=  S-0,                                       <<00.GEN>>17032000
          QJITAIP= QJITIPS,                                   <<00.GEN>>17034000
          QJITGIP= QJITIPS+1;                                 <<00.GEN>>17036000
  INTEGER POINTER PS0= S-0;                                   <<00.GEN>>17038000
  SWITCH DEFAULT:= NODEFAULT,ADEFAULT,GDEFAULT;               <<00.GEN>>17040000
                                                              <<00.GEN>>17042000
  SUBROUTINE DEF'MOVEFROMDSEG;                                <<00.GEN>>17044000
                                                              <<00.GEN>>17046000
                                                              <<00.GEN>>17048000
                                                              <<00.GEN>>17050000
  PUSH(DL);                                                   <<00.GEN>>17052000
  TOS:=TOS-PS0(PXGLOB)+PXGWJIT;      <<@JITDST WORD>>         <<00.GEN>>17054000
  TOS:=PS0.(6:10);                   <<JITDST>>               <<00.GEN>>17056000
  MOVEFROMDSEG(@QJITIPS,JITDST,JITAIP,2);                     <<00.GEN>>17058000
  CASE *STARTINX OF BEGIN                                     <<00.GEN>>17060000
    <<0>> D'INX:=0D;                                          <<00.GEN>>17062000
    <<1>> MOVEFROMDSEG(@D'INX,JITDST,QJITAIP,2);              <<00.GEN>>17064000
    <<2>> BEGIN                                               <<00.GEN>>17066000
            MOVEFROMDSEG(@D'INX,JITDST,                       <<00.GEN>>17068000
                         QJITGIP.(8:8)+2*QJITGIP.(MVF),2);    <<00.GEN>>17070000
            D'INX1.(PVF):=QJITGIP.(PVF);                      <<00.GEN>>17072000
          END;                                                <<00.GEN>>17074000
  END;                                                        <<00.GEN>>17076000
  GOTO *DEFAULT(DEFLEVEL);                                    <<00.GEN>>17078000
                                                              <<00.GEN>>17080000
GDEFAULT:                                                     <<00.GEN>>17082000
  MOVEFROMDSEG(@G'GNAME,JITDST,JITLGN,4);                     <<00.GEN>>17084000
  MOVE D'GNAME:=G'GNAME,(4);                                   <<01.KM>>17086000
                                                              <<00.GEN>>17088000
ADEFAULT:                                                     <<00.GEN>>17090000
  MOVEFROMDSEG(@G'ANAME,JITDST,JITLAN,4);                     <<00.GEN>>17092000
  MOVE D'ANAME:=G'ANAME,(4);                                   <<01.KM>>17094000
                                                              <<00.GEN>>17096000
NODEFAULT:                                                    <<00.GEN>>17098000
                                                              <<00.GEN>>17100000
END <<PROCEDURE GETDIRINFO>>;                                 <<00.GEN>>17102000
                                                              <<00.GEN>>17104000
                                                              <<00.GEN>>17106000
INTEGER PROCEDURE GETGENNAME(QNAME,ERRBASE,LEAFNAME,NAMEFOUND,<<01.GEN>>17108000
                             GENERIC);                        <<01.GEN>>17110000
                            VALUE ERRBASE,LEAFNAME,GENERIC;   <<01.GEN>>17112000
                            BYTE POINTER QNAME;               <<00.GEN>>17114000
                            INTEGER ERRBASE;                  <<00.GEN>>17116000
                            BYTE POINTER LEAFNAME;            <<00.GEN>>17118000
                            LOGICAL NAMEFOUND;                <<01.GEN>>17120000
                            INTEGER POINTER GENERIC;          <<01.GEN>>17122000
                            OPTION VARIABLE,UNCALLABLE;       <<00.GEN>>17124000
BEGIN                                                         <<00.GEN>>17126000
  COMMENT:                                                    <<00.GEN>>17128000
    SCAN "QNAME" FOR DIRECTORY NAME, VIZ:  UP TO 8 ALPHA-     <<00.GEN>>17130000
    NUMERIC CHARACTERS STARTING WITH ALPHABETIC, DELIMITED BY <<00.GEN>>17132000
    SPECIAL (ULTIMATELY A 'CR').  IF ERROR IS DETECTED,       <<00.GEN>>17134000
    OFFSET IS ADDED TO "ERRBASE" TO DETERMINE ERROR CODE.     <<00.GEN>>17136000
    "GETGENNAME" RETURNS THE ERROR CODE (>0) OR A NO-ERROR    <<00.GEN>>17138000
    INDICATION (=0).  ROUTINE MOVES DIRECTORY NAME INTO       <<00.GEN>>17140000
    "LEAFNAME" AND, IN "QNAME", RETURNS POINTER TO DELIMITER. <<00.GEN>>17142000
    "GENERIC" IS NONZERO IF DIRECTORY NAME CONTAINED "@",     <<00.GEN>>17144000
    "?" OR "#".                                               <<00.GEN>>17146000
                                                              <<00.GEN>>17148000
    NOTE THAT "@@" AND "@?" ARE AMBIGUOUS.  THESE ARE AUTO-   <<00.GEN>>17150000
    MATICALLY CORRECTED TO "@" AND "?@".  (ON THE OTHER HAND, <<00.GEN>>17152000
    "@#" IS MEANINGFUL AND IS NOT EQUIVALENT TO "#@".)        <<00.GEN>>17154000
                                                              <<00.GEN>>17156000
    ON ENTRY, "NAMEFOUND" INDICATES WHETHER A LEAFNAME        <<01.GEN>>17158000
    HAD BEEN FOUND PREVIOUSLY.  ON EXIT, "NAMEFOUND" IS       <<01.GEN>>17160000
    TRUE IF LEAFNAME WAS FOUND.  IF NO LEAFNAME IS FOUND      <<01.GEN>>17162000
    AND "NAMEFOUND" WAS TRUE ON ENTRY, THEN WE FLAG AN        <<01.GEN>>17164000
    ERROR.                                                    <<01.GEN>>17166000
                                                              <<01.GEN>>17168000
    NOTE THAT WE ASSUME THAT TRAPS ARE OFF ON ENTRY.  ALSO    <<00.GEN>>17170000
    NOTE THAT NAME IS UPSHIFTED IN "QNAME" ITSELF.  CALLER    <<00.GEN>>17172000
    SHOULD BLANK-FILL "LEAFNAME" BEFORE CALL;                 <<00.GEN>>17174000
                                                               <<01.KM>>17176000
  LABEL EXITINSTR;                                             <<01.KM>>17178000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<01.KM>>17180000
                                                              <<00.GEN>>17182000
  DEFINE SKIPWILDCARD=                                        <<00.GEN>>17184000
           BEGIN                                              <<00.GEN>>17186000
             BPS1:=BPS0;               <<MOVE "?" OR "@">>    <<00.GEN>>17188000
             ASSEMBLE(INCB,INCA);      <<AND SKIP IT    >>    <<00.GEN>>17190000
             GENERIC:=GENERIC+1;                              <<00.GEN>>17192000
           END #,                                             <<00.GEN>>17194000
         SKIPALL'AT=                                          <<00.GEN>>17196000
           BEGIN                                              <<00.GEN>>17198000
             BPS1:="@";                <<MOVE "@" AND   >>    <<00.GEN>>17200000
             GENERIC:=GENERIC+1;       <<SKIP SUBSEQUENT>>    <<00.GEN>>17202000
             IGNOREALL'AT;                                    <<00.GEN>>17204000
           END #,                                             <<00.GEN>>17206000
         IGNOREALL'AT=                                        <<00.GEN>>17208000
           BEGIN                                              <<00.GEN>>17210000
             ASSEMBLE(INCB,INCA);                             <<00.GEN>>17212000
             SCAN * WHILE CR'AT,1;                            <<00.GEN>>17214000
           END #,                                              <<00608>>17216000
         IGNORE'WILDCARD=                                      <<00608>>17218000
           BEGIN                                               <<00608>>17220000
             ASSEMBLE(INCB,INCA);                              <<00608>>17222000
           END #;                                              <<00608>>17224000
                                                              <<00.GEN>>17226000
  DEFINE NOGENERIC= NOT PARMMASK #;                           <<01.GEN>>17228000
                                                              <<00.GEN>>17230000
  EQUATE EXPECTALPHA=  FILEEXPECTALPHA-FFNAMEBASE,            <<00.GEN>>17232000
         NAMEMISSING=  FILENAMEMISSING-FFNAMEBASE,            <<00.GEN>>17234000
         NAMETOOLONG=  FILENAMETOOLONG-FFNAMEBASE,            <<00.GEN>>17236000
         MISSINGDELIM= FILEMISSINGDELIM-FFNAMEBASE,           <<00.GEN>>17238000
         NOGENNAME=    FILENOGENNAME-FFNAMEBASE;              <<00.GEN>>17240000
                                                              <<00.GEN>>17242000
  EQUATE CR=%15,                                              <<00.GEN>>17244000
         CRBLANK= [8/CR,8/" "],                               <<00.GEN>>17246000
         CR'AT=   [8/CR,8/"@"];                               <<00.GEN>>17248000
                                                              <<00.GEN>>17250000
  BYTE POINTER BPS0=S-0,                                      <<00.GEN>>17252000
               BPS1=S-1,                                      <<00.GEN>>17254000
               BUF,                                            <<00608>>17256000
               DELIM:=@QNAME;                                 <<00.GEN>>17258000
  INTEGER DUMGEN,                                             <<00.GEN>>17260000
          LENGTH;                                             <<01.GEN>>17262000
  LOGICAL PARMMASK=Q-4;                                       <<00.GEN>>17264000
                                                              <<00.GEN>>17266000
                                                              <<00.GEN>>17268000
  SUBROUTINE ERROR(OFFSET); VALUE OFFSET; INTEGER OFFSET;     <<00.GEN>>17270000
  BEGIN                                                       <<00.GEN>>17272000
    CIERR((GETGENNAME:=ERRBASE+OFFSET),QNAME);                <<00.GEN>>17274000
    @QNAME:=@DELIM;                                           <<00.GEN>>17276000
    EXITPROC;                                                  <<01.KM>>17278000
  END <<SUBROUTINE ERROR>>;                                   <<00.GEN>>17280000
                                                              <<00.GEN>>17282000
                                                              <<00.GEN>>17284000
  GETGENNAME:=0;                                              <<00.GEN>>17286000
  IF NOGENERIC THEN @GENERIC:=@DUMGEN;                        <<00.GEN>>17288000
  SCAN QNAME WHILE CRBLANK,1;          <<SKIP LEAD BLANKS>>   <<00.GEN>>17290000
  @QNAME:=TOS;                                                <<00.GEN>>17292000
  IF > THEN ERROR(EXPECTALPHA);                               <<00.GEN>>17294000
  IF QNAME="#" THEN ERROR(IF NOGENERIC THEN NOGENNAME         <<00.GEN>>17296000
                          ELSE EXPECTALPHA);                  <<00.GEN>>17298000
                                                              <<00.GEN>>17300000
  GENERIC:=0;                                                 <<00.GEN>>17302000
  TOS:=TOS:=@QNAME;                    <<FIND LEN OF NAME>>    <<00608>>17304000
  DO BEGIN                                                     <<00608>>17306000
    MOVE * := * WHILE ANS,0;                                   <<00608>>17308000
    WHILE BPS0="?" OR BPS0="#" OR BPS0="@" DO                  <<00608>>17310000
      IGNORE'WILDCARD;                                         <<00608>>17312000
  END UNTIL BPS0=SPECIAL;                                      <<00608>>17314000
  @DELIM := TOS;                                               <<00608>>17316000
  LENGTH := TOS-@QNAME;                                        <<00608>>17318000
  COMMENT:                                                     <<00608>>17320000
    ALLOCATE SPACE FOR BUF & USE BUF AS A WORK-                <<00608>>17322000
    SPACE AS WE MAY                                            <<00608>>17324000
      1) NEED TO MODIFY THE NAME IN QNAME                      <<00608>>17326000
      2) FIND THAT THE NAME IS LONGER THAN 8                   <<00608>>17328000
         CHAR. (IE TOO LONG FOR LEAFNAME)                      <<00608>>17330000
    BUF MUST BE ABLE TO HOLD 'LENGTH' BYTES OF DATA            <<00608>>17332000
    PLUS A CR.;                                                <<00608>>17334000
  TOS := (LENGTH+2)/2;                 <<# OF WORDS IN BUF>>   <<00608>>17336000
  @BUF := @S0 & LSL(1);                                        <<00608>>17338000
  ASSEMBLE(ADDS 0);                                            <<00608>>17340000
  BUF(LENGTH) := CR;                                           <<00608>>17342000
  MOVE BUF := QNAME,(LENGTH);                                  <<00608>>17344000
                                                               <<00608>>17346000
  TOS:=TOS:=@BUF;                      <<SCAN GENERIC NAME>>   <<00608>>17348000
  DO BEGIN                                                    <<00.GEN>>17350000
    MOVE * := * WHILE ANS,0;                                  <<00.GEN>>17352000
    WHILE BPS0="?" OR BPS0="#" DO SKIPWILDCARD;               <<00.GEN>>17354000
    IF BPS0="@" THEN                                          <<00.GEN>>17356000
    BEGIN                                                     <<00.GEN>>17358000
      SKIPALL'AT;                      <<"@...@" ==> "@">>    <<00.GEN>>17360000
      WHILE BPS0="?" DO                <<"@?...?" ==> >>      <<00.GEN>>17362000
      BEGIN                            <<"?...?@"     >>      <<00.GEN>>17364000
        BPS1(-1):="?";                                        <<00.GEN>>17366000
        BPS1:="@";                                            <<00.GEN>>17368000
        IGNOREALL'AT;                  <<"@...@" ==> "@">>    <<00.GEN>>17370000
      END;                                                    <<00.GEN>>17372000
    END;                                                      <<00.GEN>>17374000
  END UNTIL BPS0=SPECIAL AND BPS0<>"#";                       <<00.GEN>>17376000
  DEL;                                                         <<00608>>17378000
  LENGTH:=TOS-@BUF;                                            <<00608>>17380000
                                                              <<00.GEN>>17382000
  IF <> THEN NAMEFOUND:=TRUE                                  <<01.GEN>>17384000
  ELSE IF NAMEFOUND THEN ERROR(NAMEMISSING);                  <<01.GEN>>17386000
  IF GENERIC>0 AND NOGENERIC THEN ERROR(NOGENNAME);           <<00.GEN>>17388000
  IF LENGTH>8 THEN ERROR(NAMETOOLONG);                        <<00.GEN>>17390000
  MOVE LEAFNAME:=BUF,(LENGTH);                                 <<00608>>17392000
  SCAN DELIM WHILE CRBLANK,1;          <<SKIP TRAIL BLANKS>>  <<00.GEN>>17394000
  @QNAME:=TOS;                                                <<00.GEN>>17396000
  IF >= THEN ERROR(MISSINGDELIM);      <<ALPHANUMERIC>>       <<00.GEN>>17398000
                                                               <<01.KM>>17400000
EXITINSTR:                                                     <<01.KM>>17402000
END <<PROCEDURE GETGENNAME>>;                                 <<00.GEN>>17404000
                                                              <<00.GEN>>17406000
                                                              <<00.GEN>>17408000
LOGICAL PROCEDURE PRODUCEPARMS(LEAFLEVEL,QNAME,PPRESULT,      <<00.GEN>>17410000
                               DELIM,ERRNUM);                 <<00.GEN>>17412000
                              VALUE LEAFLEVEL,QNAME;          <<00.GEN>>17414000
                              INTEGER LEAFLEVEL;              <<00.GEN>>17416000
                              BYTE POINTER QNAME;             <<00.GEN>>17418000
                              ARRAY PPRESULT;                 <<00.GEN>>17420000
                              BYTE POINTER DELIM;             <<00.GEN>>17422000
                              INTEGER ERRNUM;                 <<00.GEN>>17424000
                              OPTION PRIVILEGED,UNCALLABLE;   <<00.GEN>>17426000
BEGIN                                                         <<00.GEN>>17428000
  COMMENT:                                                    <<00.GEN>>17430000
    PARSES FULLY-QUALIFIED "LEAFLEVEL" NAME IN "QNAME" AND    <<00.GEN>>17432000
    SETS UP DIRECSCAN PARAMETERS IN "PPRESULT".  RETURNS      <<00.GEN>>17434000
    FINAL DELIMITER IN "DELIM".  NAMES IN "QNAME" MAY CONTAIN <<00.GEN>>17436000
    BLANKS AROUND DELIMITERS.  IF NO NAME IS PRESENT, WE       <<01.KM>>17438000
    RETURN ONE OF THE FOLLOWING DEFAULTS:                      <<01.KM>>17440000
                                                              <<05.GEN>>17442000
    LEAFLEVEL = 0, FILE F[.G[.A]]:  @.LGN.LAN                 <<05.GEN>>17444000
     (INPUT)    1, GROUP G[.A]:  @.LAN                        <<05.GEN>>17446000
                2, ACCOUNT A:  @                              <<05.GEN>>17448000
                3, USER U[.A]:  @.LAN                         <<05.GEN>>17450000
                4, VOL SET DEFN V[.G[.A]]:  @.LGN.LAN         <<05.GEN>>17452000
                                                              <<00.GEN>>17454000
    OTHER OUTPUTS ARE:                                        <<05.GEN>>17456000
                                                              <<05.GEN>>17458000
    STARTLEVEL = 0: GLOBAL SEARCH FOR F.G.A, V.G.A, U[.A], A  <<00.GEN>>17460000
     (OUTPUT)    1: USE ACCT INX PTR FOR F.G, V[.G]           <<05.GEN>>17462000
                 2: USE GROUP INX PTR FOR F                   <<00.GEN>>17464000
                                                              <<00.GEN>>17466000
    ENDLEVEL = 0: F[.G[.A]], @[.G[.A]]                        <<00.GEN>>17468000
    (OUTPUT)   1: G[.A], @[.A]                                <<05.GEN>>17470000
               2: @.@.@, A                                    <<00.GEN>>17472000
               3: U[.A], @[.A]                                <<00.GEN>>17474000
               4: V[.G[.A]], @[.G[.A]]                        <<00.GEN>>17476000
                                                              <<00.GEN>>17478000
    RESULT IS RETURNED IN "PPRESULT" IN THE FORM:             <<00.GEN>>17480000
                                                              <<00.GEN>>17482000
      ********************                                    <<00.GEN>>17484000
      * D'INX      (2WD) * 0                                  <<00.GEN>>17486000
      *------------------*                                    <<00.GEN>>17488000
      * D'TYPE     (1WD) * 2                                  <<00.GEN>>17490000
      *------------------*                                    <<00.GEN>>17492000
      * D'FNAME    (4WD) * 3   "D'XXX" CONTAIN THE NAMES USED <<00.GEN>>17494000
      * D'VNAME          *     FOR THE DIRECTORY SEARCH.  THE <<00.GEN>>17496000
      *------------------*     NAMES MUST BE IN ONE OF THE    <<00.GEN>>17498000
      * D'GNAME    (4WD) * 7   FOLLOWING FORMS:               <<00.GEN>>17500000
      * D'UNAME          *       F.G.A     @.@.A              <<00.GEN>>17502000
      *------------------*       @.G.A     @.@.@              <<00.GEN>>17504000
      * D'ANAME    (4WD) * 11                                 <<00.GEN>>17506000
      *                  *                                    <<00.GEN>>17508000
      *------------------*                                    <<00.GEN>>17510000
      * D'LOCKWORD (4WD) * 15                                 <<00.GEN>>17512000
      *                  *                                    <<00.GEN>>17514000
      *------------------*                                    <<00.GEN>>17516000
      * G'FNAME    (4WD) * 19  "G'XXX" CONTAIN THE GENERIC    <<00.GEN>>17518000
      * G'VNAME          *     NAMES ACTUALLY SPECIFIED.      <<00.GEN>>17520000
      *------------------*     THESE ARE USED BY THE "RECIP"  <<00.GEN>>17522000
      * G'GNAME    (4WD) * 23  PROCEDURE TO DETERMINE A MATCH <<00.GEN>>17524000
      * G'UNAME          *     DURING THE DIRECTORY SEARCH.   <<00.GEN>>17526000
      *------------------*                                    <<00.GEN>>17528000
      * G'ANAME    (4WD) * 27                                 <<00.GEN>>17530000
      *                  *                                    <<00.GEN>>17532000
      ********************                                    <<00.GEN>>17534000
    ;                                                         <<00.GEN>>17536000
                                                               <<01.KM>>17538000
  LABEL EXITINSTR;                                             <<01.KM>>17540000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<01.KM>>17542000
                                                              <<00.GEN>>17544000
  DEFINE TURNOFFTRAPS=                                        <<00.GEN>>17546000
           BEGIN                                              <<00.GEN>>17548000
             PUSH(STATUS);                                    <<00.GEN>>17550000
             TOS.(2:1):=0;                                    <<00.GEN>>17552000
             SET(STATUS);                                     <<00.GEN>>17554000
           END #;                                             <<00.GEN>>17556000
  DEFINE NAMEMISSING= ERRBASE+FILENAMEMISSING-FFNAMEBASE #;   <<05.GEN>>17558000
  EQUATE NOINX=    0,                                         <<00.GEN>>17560000
         ACCTINX=  1,                                         <<00.GEN>>17562000
         GROUPINX= 2;                                         <<00.GEN>>17564000
  INTEGER ARRAY INITPARMS(*)=PB:=                             <<02.GEN>>17566000
    3(0),3("@       "),4("  "),3("@       ");                 <<05.GEN>>17568000
  INTEGER ARRAY INITSTART(*)=PB:=                             <<00.GEN>>17570000
    GROUPINX,ACCTINX,NOINX,NOINX,ACCTINX;                     <<00.GEN>>17572000
  INTEGER ARRAY INITDEF(*)=PB:=                               <<00.GEN>>17574000
    GROUPINX,ACCTINX,NOINX,ACCTINX,GROUPINX;                  <<00.GEN>>17576000
  INTEGER ARRAY INITBASE(*)=PB:=                              <<00.GEN>>17578000
    FFNAMEBASE,FGNAMEBASE,FANAMEBASE,USERNAMEBASE,VSDNAMEBASE;<<00.GEN>>17580000
  INTEGER ARRAY INITALL(*)=PB:= 1,2,3,2,1;                    <<03.GEN>>17582000
                                                              <<00.GEN>>17584000
  DOUBLE ARRAY DPPRESULT(*)=PPRESULT;                         <<00.GEN>>17586000
  INTEGER STARTINX,                                           <<00.GEN>>17588000
          DEFLEVEL,                                           <<00.GEN>>17590000
          ERRBASE,                                            <<00.GEN>>17592000
          GENERIC,                                            <<00.GEN>>17594000
          ALLLEVEL:= 0;                                       <<05.GEN>>17596000
  LOGICAL NAMEFOUND:=FALSE;                                   <<01.GEN>>17598000
  SWITCH PARSER:= FILES,GROUPS,ACCOUNTS,USERS,VSDS;           <<00.GEN>>17600000
                                                              <<00.GEN>>17602000
                                                              <<00.GEN>>17604000
  SUBROUTINE ERROR(MSGNUM); VALUE MSGNUM; INTEGER MSGNUM;     <<00.GEN>>17606000
  BEGIN                                                       <<00.GEN>>17608000
    CIERR((ERRNUM:=MSGNUM),QNAME);                            <<00.GEN>>17610000
    EXITPROC;                                                  <<01.KM>>17612000
  END <<SUBROUTINE ERROR>>;                                   <<00.GEN>>17614000
                                                              <<00.GEN>>17616000
                                                              <<00.GEN>>17618000
  PRODUCEPARMS:=FALSE;                                        <<00.GEN>>17620000
  TURNOFFTRAPS;                        <<FOR BYTE ADR ARITH>> <<00.GEN>>17622000
  MOVE PPRESULT:=INITPARMS,(31);       <<F.G.A="@.@.@">>      <<02.GEN>>17624000
  STARTINX:=INITSTART(LEAFLEVEL);                             <<05.GEN>>17626000
  DEFLEVEL:=INITDEF(LEAFLEVEL);                               <<05.GEN>>17628000
  ERRBASE:=INITBASE(LEAFLEVEL);                               <<00.GEN>>17630000
  GOTO *PARSER(LEAFLEVEL);                                    <<00.GEN>>17632000
                                                              <<00.GEN>>17634000
  <<**********************>>                                  <<00.GEN>>17636000
  << PARSE QUALIFIED NAME >>                                  <<00.GEN>>17638000
  <<**********************>>                                  <<00.GEN>>17640000
                                                              <<00.GEN>>17642000
FILES:                                                        <<00.GEN>>17644000
VSDS:                                                         <<00.GEN>>17646000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'FNAME,NAMEFOUND,     <<01.GEN>>17648000
                         GENERIC))<>0                         <<01.GEN>>17650000
     THEN RETURN;                                             <<00.GEN>>17652000
  IF GENERIC>0 THEN ALLLEVEL:=1;                              <<00.GEN>>17654000
  IF QNAME="/" THEN                                           <<00.GEN>>17656000
  BEGIN                                                       <<00.GEN>>17658000
    IF LEAFLEVEL=VSDEFLEVEL THEN ERROR(VSDNOLOCKWORD);        <<00.GEN>>17660000
    IF NOT NAMEFOUND THEN ERROR(NAMEMISSING);                 <<04.GEN>>17662000
    @QNAME:=@QNAME+1;                                         <<00.GEN>>17664000
    IF (ERRNUM:=GETGENNAME(QNAME,FLWORDBASE,D'LOCKWORD,       <<02.GEN>>17666000
                           NAMEFOUND))<>0                     <<02.GEN>>17668000
       THEN RETURN;                                           <<00.GEN>>17670000
  END;                                                        <<00.GEN>>17672000
  IF NOT NAMEFOUND OR QNAME<>"." THEN GO COMPLETEPARMS;       <<04.GEN>>17674000
  @QNAME:=@QNAME+1;                                           <<00.GEN>>17676000
  ERRBASE:=FGNAMEBASE;                                        <<00.GEN>>17678000
  STARTINX:=DEFLEVEL:=ACCTINX;                                <<00.GEN>>17680000
                                                              <<00.GEN>>17682000
GROUPS:                                                       <<00.GEN>>17684000
USERS:                                                        <<00.GEN>>17686000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'GNAME,NAMEFOUND,     <<02.GEN>>17688000
                         GENERIC))<>0                         <<01.GEN>>17690000
     THEN RETURN;                                             <<00.GEN>>17692000
  IF GENERIC>0 THEN ALLLEVEL:=2;                              <<00.GEN>>17694000
  IF NOT NAMEFOUND OR QNAME<>"." THEN GO COMPLETEPARMS;       <<01.GEN>>17696000
  @QNAME:=@QNAME+1;                                           <<00.GEN>>17698000
  ERRBASE:=FANAMEBASE;                                        <<00.GEN>>17700000
  STARTINX:=DEFLEVEL:=NOINX;                                  <<00.GEN>>17702000
                                                              <<00.GEN>>17704000
ACCOUNTS:                                                     <<00.GEN>>17706000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'ANAME,NAMEFOUND,     <<02.GEN>>17708000
                         GENERIC))<>0                         <<01.GEN>>17710000
     THEN RETURN;                                             <<00.GEN>>17712000
  IF GENERIC>0 THEN ALLLEVEL:=3;                              <<00.GEN>>17714000
                                                              <<00.GEN>>17716000
COMPLETEPARMS:                                                <<00.GEN>>17718000
  IF NOT NAMEFOUND THEN                                       <<04.GEN>>17720000
  BEGIN                                                       <<04.GEN>>17722000
    IF QNAME="." THEN ERROR(NAMEMISSING);                     <<04.GEN>>17724000
    ALLLEVEL:=INITALL(LEAFLEVEL);                             <<04.GEN>>17726000
  END;                                                        <<04.GEN>>17728000
  @DELIM:=@QNAME;                                             <<00.GEN>>17730000
  D'TYPE.(STARTLEVELF):=STARTINX;                             <<00.GEN>>17732000
  D'TYPE.(TOLEVELF):=LEAFLEVEL;                               <<00.GEN>>17734000
                                                              <<00.GEN>>17736000
  <<***************************>>                             <<00.GEN>>17738000
  << SET UP GROUP/ACCT INDEX & >>                             <<00.GEN>>17740000
  << DEFAULT GROUP/ACCT NAMES  >>                             <<00.GEN>>17742000
  <<***************************>>                             <<00.GEN>>17744000
                                                              <<00.GEN>>17746000
  IF STARTINX<>NOINX OR DEFLEVEL<>NOINX THEN                  <<00.GEN>>17748000
  BEGIN                                                       <<00.GEN>>17750000
    GETDIRINFO(STARTINX,DEFLEVEL,PPRESULT);                   <<00.GEN>>17752000
  END;                                                        <<00.GEN>>17754000
                                                              <<00.GEN>>17756000
  <<*****************>>                                       <<00.GEN>>17758000
  << SET UP ENDLEVEL >>                                       <<00.GEN>>17760000
  <<*****************>>                                       <<00.GEN>>17762000
                                                              <<00.GEN>>17764000
  CASE *ALLLEVEL OF BEGIN              <<SET ENDLEVELFX>>     <<00.GEN>>17766000
    <<0>> BEGIN                                               <<00.GEN>>17768000
            MOVE D'FNAME:=G'FNAME,(12);                       <<00.GEN>>17770000
            D'TYPE.(ENDLEVELFX):=LEAFLEVEL;                   <<00.GEN>>17772000
          END;                                                <<00.GEN>>17774000
    <<1>> BEGIN                                               <<00.GEN>>17776000
            MOVE D'GNAME:=G'GNAME,(8);                        <<00.GEN>>17778000
            D'TYPE.(ENDLEVELFX):=ALLXXX+LEAFLEVEL;            <<00.GEN>>17780000
          END;                                                <<00.GEN>>17782000
    <<2>> BEGIN                                               <<00.GEN>>17784000
            MOVE D'ANAME:=G'ANAME,(4);                        <<00.GEN>>17786000
            D'TYPE.(ENDLEVELFX):=                             <<00.GEN>>17788000
              IF LEAFLEVEL=USERLEVEL THEN ALLUSERS            <<00.GEN>>17790000
              ELSE ALLGROUPS;                                 <<00.GEN>>17792000
          END;                                                <<00.GEN>>17794000
    <<3>> D'TYPE.(ENDLEVELFX):=ALLACCTS;                      <<00.GEN>>17796000
  END;                                                        <<00.GEN>>17798000
  PRODUCEPARMS:=TRUE;                                         <<01.GEN>>17800000
                                                               <<01.KM>>17802000
EXITINSTR:                                                     <<01.KM>>17804000
END  <<PROCEDURE PRODUCEPARMS>>;                              <<00.GEN>>17806000
                                                              <<00.GEN>>17808000
                                                              <<00.GEN>>17810000
PROCEDURE CXLISTF EXECUTORHEAD;                                <<U.RAO>>17812000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>17814000
BEGIN                                                          <<U.RAO>>17816000
                                                               <<03.KM>>17818000
DEFINE P'GANAME=     RECIPPARMS(4) #,                          <<04.KM>>17820000
       P'GNAME=      RECIPPARMS(4) #,                          <<04.KM>>17822000
       P'ANAME=      RECIPPARMS(8) #,                          <<03.KM>>17824000
       P'GOTENTRY=   RECIPPARMS(24) #,                         <<03.KM>>17826000
       P'IMPMNTDST=  RECIPPARMS(25) #,                         <<03.KM>>17828000
       P'IMPMNTERR=  RECIPPARMS(26) #,                         <<03.KM>>17830000
       P'IMPMNTNAME= RECIPPARMS(27) #,                         <<03.KM>>17832000
       P'IMPMNTGRP=  RECIPPARMS(27) #,                         <<03.KM>>17834000
       P'IMPMNTACCT= RECIPPARMS(31) #;                         <<03.KM>>17836000
DEFINE PAGEEJECT = FWRITE(FNUM,DATEBUF,0,%61) #;               <<09.MM>>17838000
EQUATE NOMNTERR= -1,                                           <<03.KM>>17840000
       NOMOUNT=  0;                                            <<03.KM>>17842000
EQUATE F'STDLIST      = 1,                                     <<00852>>17844000
       NEW'FILE       = 0,                                     <<00852>>17846000
       TEMP'DOMAIN    = 2,                                     <<00852>>17848000
       CURRENT'DOMAIN = 0;                                     <<00852>>17850000
DOUBLE DL := COMMASEMICR;                                      <<U.RAO>>17852000
INTEGER NUMPARMS;                                              <<U.RAO>>17854000
DOUBLE ARRAY PARMS(0:3)=Q;                                     <<U.RAO>>17856000
INTEGER ARRAY RECIPPARMS(0:SYSL'PARMLEN-1);                   <<00.GEN>>17858000
INTEGER ARRAY PPRESULT(*)=RECIPPARMS(SYSL'PPRINX);            <<00.GEN>>17860000
DOUBLE ARRAY DPPRESULT(*)=PPRESULT;                           <<00.GEN>>17862000
BYTE POINTER LEAFNAME = PARMS;                                 <<U.RAO>>17864000
INTEGER LEAFNAMECHAR = PARMS+1;                                <<U.RAO>>17866000
BYTE LEAFNAMELEN = PARMS+1;                                    <<U.RAO>>17868000
BYTE POINTER LISTLEVEL = PARMS+2;                              <<U.RAO>>17870000
INTEGER LISTLEVELCHAR = PARMS+3;                               <<U.RAO>>17872000
BYTE LISTLEVELLEN = PARMS+3;                                   <<U.RAO>>17874000
BYTE POINTER LISTFILE = PARMS+2;  <<TRICKY BIT>>               <<U.RAO>>17876000
INTEGER LISTFILECHAR = PARMS+3;                                <<U.RAO>>17878000
BYTE LISTFILELEN = PARMS+3;                                    <<U.RAO>>17880000
BYTE POINTER EXTRAPARM = PARMS+6;                              <<U.RAO>>17882000
BYTE EXTRAPARMLEN = PARMS+7;                                   <<U.RAO>>17884000
EQUATE COMMA = 0, SEMI = 1, CR = 2;                            <<U.RAO>>17886000
BYTE POINTER DELIM;                                           <<00.GEN>>17888000
INTEGER FOPTIONS := %2504;                                     <<U.RAO>>17890000
INTEGER FCLOSE'FOPTIONS := 0;                                  <<00852>>17892000
LOGICAL STDLIST := TRUE;                                       <<U.RAO>>17894000
INTEGER FNUM := 2;  <<DEFAULT TO $STDLIST>>                    <<U.RAO>>17896000
ARRAY DATEBUF(0:13);  <<USED FOR TIME STAMP OF OUTPUT>>        <<02.RO>>17898000
INTEGER DEV := 0;  <<DEVICE TYPE OF LIST FILE>>                <<03.RO>>17900000
LOGICAL INTERACTIVE;                                           <<09.MM>>17902000
                                                               <<U.RAO>>17904000
<<INITIALIZE PARMS ARRAY>>                                     <<U.RAO>>17906000
PARMS := 0D;                                                   <<U.RAO>>17908000
TOS := @PARMS+2;                                               <<U.RAO>>17910000
TOS := @PARMS+1;                                               <<U.RAO>>17912000
TOS := 6;                                                      <<U.RAO>>17914000
ASSEMBLE(MOVE);                                                <<U.RAO>>17916000
MYCOMMAND(PARMSP,DL,4,NUMPARMS,PARMS);                         <<U.RAO>>17918000
PARMNUM := 1;                                                  <<U.RAO>>17920000
IF NOT PRODUCEPARMS(0,PARMSP,PPRESULT,DELIM,ERRNUM) THEN      <<00.GEN>>17922000
    RETURN;  <<ERROR IN PARSING LEAFNAME>>                     <<U.RAO>>17924000
IF (NUMPARMS > 0) AND  <<NOT JUST A CR>>                       <<U.RAO>>17926000
   (@DELIM < @LEAFNAME+INTEGER(LEAFNAMELEN)) THEN             <<00.GEN>>17928000
   BEGIN  <<EXTRANEOUS STUFF IN LEAFNAME>>                     <<U.RAO>>17930000
   TOS := ERRNUM := LISTFEXTRANEOUS;                           <<U.RAO>>17932000
   TOS := @DELIM;                                             <<00.GEN>>17934000
   CIERR(*,*);                                                 <<U.RAO>>17936000
   RETURN                                                      <<U.RAO>>17938000
   END;                                                        <<U.RAO>>17940000
                                                               <<U.RAO>>17942000
IF NUMPARMS=0 THEN LEAFNAMECHAR := CR;                         <<U.RAO>>17944000
                                                               <<U.RAO>>17946000
<<CHECK FOR LISTLEVEL, IF ANY>>                                <<U.RAO>>17948000
IF LEAFNAMECHAR.(11:5)=COMMA THEN  <<LISTLEVEL PRESENT>>       <<U.RAO>>17950000
   BEGIN                                                       <<U.RAO>>17952000
   PARMNUM := 2;                                               <<U.RAO>>17954000
   TOS := BINARY(LISTLEVEL,INTEGER(LISTLEVELLEN));             <<U.RAO>>17956000
   IF <> OR NOT(-1 <= S0 <= 2) THEN                            <<U.RAO>>17958000
      BEGIN   <<BAD CONVERSION OR BAD NUMBER>>                 <<U.RAO>>17960000
      CIERR(-LISTFBADLEVEL, LISTLEVEL);                        <<U.RAO>>17962000
      IF TOS < -1 THEN    <<GIVE LISTF,-1>>                    <<U.RAO>>17964000
         TOS := -1                                             <<U.RAO>>17966000
      ELSE                <<GIVE LISTF,2>>                     <<U.RAO>>17968000
         TOS := 2;                                             <<U.RAO>>17970000
      END;                                                     <<U.RAO>>17972000
   IF S0 > 2 THEN TOS := 2;  <<MAX LEVEL>>                     <<U.RAO>>17974000
   IF S0 < 0 THEN  <<LISTF -1 CASE?>>                          <<U.RAO>>17976000
      BEGIN  <<CHECK CAPABILITY>>                              <<U.RAO>>17978000
      IF D'TYPE.(STARTLEVELF) = 0 THEN  <<SYSTEM LEVEL FILE>> <<00.GEN>>17980000
         BEGIN                                                 <<U.RAO>>17982000
         SETXPXGLOB;  <<FOR CAPABILITY CHECK>>                 <<04.RO>>17984000
         IF NOT SMCAP AND                                      <<00450>>17986000
            NOT (AMCAP LAND CHECKHOMEACCT(PPRESULT)=0) THEN    <<00450>>17988000
            BEGIN << NOT (SMCAP OR AMCAP AND HOMEACCT =     >> <<00450>>17990000
                  <<                         REQUESTEDACCT) >> <<00450>>17992000
            IF CHECKHOMEACCT(PPRESULT)=0 THEN                  <<00450>>17994000
               CIERR(ERRNUM := LISTFAMCAP)                     <<00450>>17996000
            ELSE CIERR(ERRNUM := LISTFSMCAP);                  <<00450>>17998000
            RETURN                                             <<U.RAO>>18000000
            END;                                               <<U.RAO>>18002000
         END                                                   <<U.RAO>>18004000
      ELSE   <<CHECK FOR ACCOUNT MANAGER CAPABILITY>>          <<04.RO>>18006000
         BEGIN                                                 <<04.RO>>18008000
         SETXPXGLOB;                                           <<04.RO>>18010000
         IF NOT AMCAP AND NOT SMCAP THEN                       <<04.RO>>18012000
            BEGIN                                              <<04.RO>>18014000
            CIERR(ERRNUM := LISTFAMCAP);                       <<04.RO>>18016000
            RETURN                                             <<04.RO>>18018000
            END;                                               <<04.RO>>18020000
         END;                                                  <<04.RO>>18022000
      RECIPPARMS(13) := 0;                                     <<U.RAO>>18024000
      END;  <<LISTF -1 CASE>>                                  <<U.RAO>>18026000
   PARMS := PARMS(1);                                          <<U.RAO>>18028000
   PARMS(1) := PARMS(2);  <<FIXUP FOR MISSING LISTLEVEL>>      <<U.RAO>>18030000
   END                                                         <<U.RAO>>18032000
ELSE                                                           <<U.RAO>>18034000
   TOS := 0;   <<LISTLEVEL DEFAULT>>                           <<U.RAO>>18036000
RECIPPARMS(12) := S0;  <<LISTLEVEL IN BINARY>>                 <<U.RAO>>18038000
CASE TOS OF                                                    <<U.RAO>>18040000
   BEGIN   <<SET WIDTH OF ENTRY IN WORDS>>                     <<U.RAO>>18042000
   RECIPPARMS(13) := 4;                                        <<U.RAO>>18044000
   RECIPPARMS(13) := 25;                                       <<U.RAO>>18046000
   RECIPPARMS(13) := 34;                                       <<U.RAO>>18048000
   END;                                                        <<U.RAO>>18050000
<<WE HAVE NOW PROCESSED THE LISTLEVEL. NOW DO LISTFILE>>       <<U.RAO>>18052000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>18054000
IF LEAFNAMECHAR.(11:5)=SEMI THEN  <<PROBABLY IS ONE>>         <<U.RAO>>18056000
   BEGIN                                                       <<U.RAO>>18058000
   IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN RETURN;              <<U.RAO>>18060000
   STDLIST := FALSE;  <<USER SPECIFIED A FILE >>               <<U.RAO>>18062000
   END                                                         <<U.RAO>>18064000
ELSE IF LEAFNAMECHAR.(11:5)=COMMA THEN  <<ERROR>>              <<U.RAO>>18066000
   BEGIN                                                       <<U.RAO>>18068000
   CIERR(ERRNUM := LISTFEXPECTFILE, LISTFILE);                 <<U.RAO>>18070000
   RETURN                                                      <<U.RAO>>18072000
   END;                                                        <<U.RAO>>18074000
                                                               <<U.RAO>>18076000
IF (LISTFILECHAR.(11:5) <> CR) AND (EXTRAPARMLEN<>0) THEN      <<U.RAO>>18078000
   BEGIN                                                       <<U.RAO>>18080000
   PARMNUM := PARMNUM+1;                                       <<U.RAO>>18082000
   CIERR(ERRNUM := LISTF2MP,EXTRAPARM);                        <<U.RAO>>18084000
   RETURN                                                      <<U.RAO>>18086000
   END;                                                        <<U.RAO>>18088000
PARMNUM := 0;                                                  <<U.RAO>>18090000
                                                               <<U.RAO>>18092000
IF NOT STDLIST THEN   <<OPEN USER DEFINED FILE>>               <<U.RAO>>18094000
FNUM := FOPEN(LISTFILE, FOPTIONS, %101);                       <<00267>>18096000
IF CARRY THEN                                                  <<U.RAO>>18098000
   BEGIN                                                       <<U.RAO>>18100000
   FERROR'(FNUM, PARMNUM);                                     <<U.RAO>>18102000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>18104000
   RETURN                                                      <<U.RAO>>18106000
   END;                                                        <<U.RAO>>18108000
RECIPPARMS(18) := FNUM;                                        <<U.RAO>>18110000
                                                               <<U.RAO>>18112000
FGETINFO(FNUM,,FOPTIONS,,RECIPPARMS(19),DEV);                  <<09.MM>>18114000
<< DETERMINE FINAL DOMAIN OF LIST FILE >>                      <<00852>>18116000
FCLOSE'FOPTIONS.(13:3) := IF FOPTIONS.(14:2) = NEW'FILE        <<00852>>18118000
                             THEN TEMP'DOMAIN                  <<00852>>18120000
                          ELSE CURRENT'DOMAIN;                 <<00852>>18122000
TOS := RECIPPARMS(19);                                         <<U.RAO>>18124000
IF < THEN TOS := -TOS                                          <<U.RAO>>18126000
ELSE TOS := TOS&LSL(1);  <<CONVERT TO BYTE COUNT>>             <<U.RAO>>18128000
RECIPPARMS(19) := TOS;  <<LINE LENGTH>>                        <<U.RAO>>18130000
                                                               <<U.RAO>>18132000
<<SET OTHER FILE ATTRIBUTES>>                                  <<U.RAO>>18134000
RECIPPARMS(20):=-1;                    <<1ST-TIME LINE# FLAG>> <<05.KM>>18136000
RECIPPARMS(21) := 0;                                           <<U.RAO>>18138000
RECIPPARMS := FNUM;                                            <<U.RAO>>18140000
RECIPPARMS(1) := 0;                                            <<U.RAO>>18142000
                                                               <<U.RAO>>18144000
<<PUT OUT TIME STAMP IF JOB OR LIST FILE>>                     <<02.RO>>18146000
INTERACTIVETEST;                                               <<02.RO>>18148000
INTERACTIVE:=TOS;                                              <<09.MM>>18150000
IF NOT INTERACTIVE AND STDLIST OR                              <<09.MM>>18152000
   NOT STDLIST AND DEV.(8:8) >= 8  <<NOT DISC>> THEN           <<03.RO>>18154000
   BEGIN                                                       <<02.RO>>18156000
   <<IF JOB AND (STDLIST OF USERFILE IS STDLIST) DO PAGEEJECT>><<09.MM>>18158000
   IF NOT INTERACTIVE AND FOPTIONS.(10:3)=F'STDLIST            <<09.MM>>18160000
      THEN PAGEEJECT;                                          <<09.MM>>18162000
   DATE'LINE(DATEBUF);                                         <<02.RO>>18164000
   FWRITE(FNUM, DATEBUF, -27, %60);                            <<02.RO>>18166000
   RECIPPARMS(20):=-3;                 <<1ST-TIME LINE# FLAG>> <<05.KM>>18168000
   END;                                                        <<02.RO>>18170000
                                                               <<02.RO>>18172000
P'GOTENTRY:=FALSE;                                             <<03.KM>>18174000
P'IMPMNTDST:=0;                                                <<03.KM>>18176000
P'IMPMNTERR:=NOMNTERR;                                         <<03.KM>>18178000
IF LOGICAL(D'INX1.(PVF)) THEN                                  <<03.KM>>18180000
   BEGIN                                                       <<03.KM>>18182000
   COMMENT:                                                    <<03.KM>>18184000
     FORCE ACCT-LEVEL SEARCH TO ENSURE THAT WE VISIT           <<03.KM>>18186000
     GROUP ENTRY AND FORCE IMPLICIT MOUNT;                     <<03.KM>>18188000
                                                               <<03.KM>>18190000
   D'TYPE.(STARTLEVELF):=1;                                    <<03.KM>>18192000
   GETDIRINFO(1,2,PPRESULT);                                   <<03.KM>>18194000
   END;                                                        <<03.KM>>18196000
MOVE P'GANAME:=D'GNAME,(4),2; <<IN CASE WE DON'T VISIT NODE>>  <<06.KM>>18198000
MOVE * := D'ANAME,(4);                                         <<06.KM>>18200000
RECIPPARMS (22) := D'TYPE;                                    <<00.GEN>>18202000
RECIPPARMS (23) := D'INX1;  <<GLINKAGE INITIALIZATION>>       <<00.GEN>>18204000
RECIPPARMS(SAVEBUFFINDEX) := 0; << see syslist >>              <<04178>>18206000
RECIPPARMS(SAVEBUFFINDEX + ASIZE + 1) := 0;                    <<04178>>18208000
                                                               <<RV.PV>>18210000
<<NOW SET UP COMMON DIRECSCAN STUFF ON STACK>>                 <<RV.PV>>18212000
TOS := 0D;  <<RETURN VALUE>>                                   <<U.RAO>>18214000
TOS := D'TYPE;                                                <<00.GEN>>18216000
TOS.(HITFLAG) := 1;                                            <<RV.PV>>18218000
TOS := D'INX1.(MVTABXF);               <<LINKAGE>>            <<04.GEN>>18220000
TOS := D'INX2;                         <<INDEXP>>             <<05.GEN>>18222000
TOS := @D'ANAME;                                              <<00.GEN>>18224000
TOS := @D'GNAME;                                              <<00.GEN>>18226000
TOS := @D'FNAME;                                              <<00.GEN>>18228000
IF RECIPPARMS(12)<0 THEN  <<LISTF ,-1>>                        <<U.RAO>>18230000
   TOS := DIRECSCAN(*,*,*,*,*,SYSLIST,RECIPPARMS)              <<U.RAO>>18232000
ELSE                                                           <<U.RAO>>18234000
   TOS := DIRECSCAN(*,*,*,*,*,LISTSAVEFILES,RECIPPARMS);       <<U.RAO>>18236000
                                                               <<04.KM>>18238000
PUSH(STATUS);                                                  <<04.KM>>18240000
IF LOGICAL(P'GOTENTRY) THEN FWRITE(FNUM,RECIPPARMS,0,0);       <<04.KM>>18242000
IF P'IMPMNTDST<>0 OR P'IMPMNTERR<>NOMNTERR THEN                <<04.KM>>18244000
  BEGIN                                                        <<04.KM>>18246000
  LISTFDISMNT(P'IMPMNTDST,P'IMPMNTERR,P'IMPMNTGRP,P'IMPMNTACCT,<<04.KM>>18248000
              ERRNUM);                                         <<04.KM>>18250000
  IF P'IMPMNTERR>NOMOUNT AND                                   <<04.KM>>18252000
     JOBSESSIONMAIN THEN GENMSG(CIERRMSGSET,LISTFSTOPPED);     <<04.KM>>18254000
  END;                                                         <<04.KM>>18256000
SET(STATUS);                                                   <<04.KM>>18258000
                                                               <<04.KM>>18260000
IF <> THEN   <<DIRECTORY ERROR>>                               <<U.RAO>>18262000
   BEGIN                                                       <<U.RAO>>18264000
   IF NOT STDLIST THEN   <<CLOSE USER DEFINED FILE>>           <<U.RAO>>18266000
      FCLOSE(FNUM, FCLOSE'FOPTIONS, 0);                        <<00852>>18268000
   CYDIRERR'(*,%120000,ERRNUM);                                <<U.RAO>>18270000
   RETURN;                                                     <<U.RAO>>18272000
   END;                                                        <<U.RAO>>18274000
DDEL;                                                          <<U.RAO>>18276000
IF RECIPPARMS(1) < 0 THEN                                      <<U.RAO>>18278000
   BEGIN                                                       <<U.RAO>>18280000
   FERROR'(FNUM,PARMNUM);                                      <<U.RAO>>18282000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>18284000
   RETURN                                                      <<U.RAO>>18286000
   END;                                                        <<U.RAO>>18288000
IF LOGICAL(P'GOTENTRY) THEN FWRITE(FNUM,RECIPPARMS,0,0)        <<03.KM>>18290000
ELSE CIERR(-NOFILESLISTED);                                    <<03.KM>>18292000
             <<XPARENT TO PROGRAMMATIC CALL FOR UPWARD COMPAT>><<03.KM>>18294000
IF NOT STDLIST THEN  <<CLOSE USER DEFINED FILE>>               <<U.RAO>>18296000
   FCLOSE(FNUM, FCLOSE'FOPTIONS, 0);                           <<00852>>18298000
IF CARRY THEN                                                  <<U.RAO>>18300000
   BEGIN                                                       <<U.RAO>>18302000
   FERROR'(FNUM,PARMNUM);                                      <<U.RAO>>18304000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>18306000
   END;                                                        <<U.RAO>>18308000
END;  <<CXLISTF>>                                              <<U.RAO>>18310000
                                                               <<01.KM>>18312000
                                                               <<01.KM>>18314000
$CONTROL  SEGMENT=CISYSMGR                                     <<01.KM>>18316000
                                                               <<01.KM>>18318000
INTEGER PROCEDURE LISTVSDEFN(PARMS);                           <<RH.PV>>18320000
   INTEGER ARRAY PARMS;                                        <<RH.PV>>18322000
   OPTION PRIVILEGED, UNCALLABLE;                              <<RH.PV>>18324000
BEGIN                                                          <<RH.PV>>18326000
   EQUATE NOERROR=  0,                                         <<03.KM>>18328000
          IOERROR=  1,                                         <<03.KM>>18330000
          NOVOLSET= 2;                                         <<03.KM>>18332000
   INTEGER ELEMADDR = Q-8;                                     <<RH.PV>>18334000
   INTEGER I,GEN,LEN,LOC,CNTRL,STYPE,MVTABX;                   <<RH.PV>>18336000
   LOGICAL VMASK,TMASK,STATUS,VCLASS;                          <<RH.PV>>18338000
   LOGICAL                                                     <<03513>>18340000
          FLOPPY'FLAG;                                         <<03513>>18342000
   DOUBLE DIRESULT;                                            <<RH.PV>>18344000
   DOUBLE VTABINFO = DIRESULT;                                 <<RH.PV>>18346000
   INTEGER                                                     <<RH.PV>>18348000
        VTABINFO1 = VTABINFO,                                  <<RH.PV>>18350000
        VTABINFO2 = VTABINFO+1;                                <<RH.PV>>18352000
   INTEGER                                                     <<RH.PV>>18354000
        DIRESULT1 = DIRESULT,                                  <<RH.PV>>18356000
        DIRESULT2 = DIRESULT+1;                                <<RH.PV>>18358000
   EQUATE VSDEFNSIZE = 56;                                     <<07.KM>>18360000
   ARRAY WNAME(0:4);                                           <<03.KM>>18362000
   BYTE ARRAY NAME(*)= WNAME;                                  <<03.KM>>18364000
   ARRAY VSDEFN(0:VSDEFNSIZE-1);                               <<RH.PV>>18366000
   BYTE ARRAY VSDEFNB(*) = VSDEFN;                             <<RH.PV>>18368000
   EQUATE MAXVOLNUM = 8;  <<MEMBERS PER VOLUME SET>>           <<RH.PV>>18370000
   INTEGER ARRAY LDEV(0:MAXVOLNUM);                            <<RH.PV>>18372000
   INTEGER ARRAY STATN(0:MAXVOLNUM);                           <<RH.PV>>18374000
   ARRAY BUF(0:35);                                            <<RH.PV>>18376000
   BYTE ARRAY BUFB(*) = BUF;                                   <<RH.PV>>18378000
   ARRAY BUF7902(0:16);                                        <<03513>>18380000
   BYTE ARRAY BUFB7902(*) = BUF7902; << FOR HP7902 SPECI.>>    <<03513>>18382000
   DOUBLE ARRAY DPARMS(*) = PARMS;                             <<RH.PV>>18384000
   INTEGER ARRAY                                               <<RH.PV>>18386000
        VSNAME(*)    = PARMS,                                  <<RH.PV>>18388000
        CURRENTG(*)  = PARMS(4),                               <<RH.PV>>18390000
        CURRENTA(*)  = PARMS(8);                               <<RH.PV>>18392000
   BYTE ARRAY                                                  <<RH.PV>>18394000
        VSID(*)      = VSNAME,                                 <<RH.PV>>18396000
        VSNAMEB(*)   = VSNAME,                                 <<RH.PV>>18398000
        CURRENTGA(*) = CURRENTG;                               <<RH.PV>>18400000
   ARRAY MASTER(0:11);  <<MASTER REFERENCE>>                   <<RH.PV>>18402000
   BYTE ARRAY MASTERB(*) = MASTER;                             <<RH.PV>>18404000
   ARRAY TITLE1(*)=PB:=                                        <<RH.PV>>18406000
     " VOLSET        MEMBERS      TYPE    LDEV    STATUS   ";  <<04576>>18408000
   ARRAY TITLE2(*)=PB:=                                        <<RH.PV>>18410000
     " --------      --------   --------  ----   --------  ";  <<04576>>18412000
   ARRAY TITLE3(*)=PB:=                                        <<RH.PV>>18414000
     " VOLCLASS      MASTER REFERENCE           ";             <<RH.PV>>18416000
   ARRAY TITLE4(*)=PB:=                                        <<RH.PV>>18418000
     " --------      --------------------       ";             <<RH.PV>>18420000
   ARRAY AGTITLE (*)=PB:=                                      <<RH.PV>>18422000
       " ACCOUNT=              GROUP=              (CONT.)";   <<RH.PV>>18424000
   DEFINE                                                      <<RH.PV>>18426000
        AVAILF   = ( 3:1)#,                                    <<RH.PV>>18428000
        CLASSF   = ( 0:1)#,                                    <<RH.PV>>18430000
        VMASKF   = ( 8:8)#;                                    <<RH.PV>>18432000
   EQUATE  << VOLUME SET DEFINITION INFORMATION >>             <<RH.PV>>18434000
        VDMISC  =  4,  << MVTAB INDEX >>                       <<RH.PV>>18436000
        VDINFO  =  5;  << NUM. VOLS., VOL. MASK >>             <<RH.PV>>18438000
   EQUATE                                                      <<RH.PV>>18440000
        ACCTPOS  =  5,                                         <<RH.PV>>18442000
        GROUPPOS = 15;                                         <<RH.PV>>18444000
   EQUATE                                                      <<RH.PV>>18446000
        DIRDST     =  20,                                      <<RH.PV>>18448000
        LONGDEV    = 128,                                      <<RH.PV>>18450000
        VDVENTSIZE =   6;  <<VOL. ENTRY IN VS DEFINITION>>     <<RH.PV>>18452000
                                                               <<RH.PV>>18454000
   EQUATE TYPELEN = 8;                                         <<RH.PV>>18456000
   BYTE ARRAY TYPEKEY(*)=PB:=                                  <<RH.PV>>18458000
        "FIXED HD",                                            <<RH.PV>>18460000
        "7900(U) ",                                            <<03513>>18462000
        "7900(L) ",                                            <<03513>>18464000
        "7900    ",                                            <<RH.PV>>18466000
        "ISS     ",                                            <<RH.PV>>18468000
        "HP7905  ",                                            <<RH.PV>>18470000
        "7905(F) ",                                            <<RH.PV>>18472000
        "7905(T) ",                                            <<RH.PV>>18474000
        "7905(SD)",                                            <<RH.PV>>18476000
        "HP7920  ",                                            <<03.KM>>18478000
        "HP7925  ",                                            <<00263>>18480000
        "HP7906  ",                                            <<00263>>18482000
    21 ("        "), <<UNASSIGNED PSEUDO SUBTYPES 12-31>>      <<00263>>18484000
        "HP9895/ ",                                            <<03513>>18486000
    23 ("        "),                                           <<03513>>18488000
        "HP7933  ";                                                     18490000
      EQUATE STATLEN = 9;                                      <<04576>>18492000
      EQUATE NOTMOUNTED = 8;                                   <<04576>>18494000
   EQUATE                                                      <<03513>>18496000
        FLOPPYLEN   = 17,                                      <<03513>>18498000
        FLOPPY      = 33;                                      <<03513>>18500000
   BYTE ARRAY STATKEY(*)=PB:=                                  <<RH.PV>>18502000
        "SYSTEM   ",                                           <<04576>>18504000
        "OFF-LINE ",                                           <<04576>>18506000
        "SERIAL   ",                                           <<04576>>18508000
        "RESERVED ",                                           <<04576>>18510000
        "DOWNED   ",                                           <<04576>>18512000
        "DOWN-PND ",                                           <<04576>>18514000
        "MOUNTED  ",                                           <<04576>>18516000
        "PV-AVAIL ",                                           <<04576>>18518000
        "UNMOUNTED";                                           <<04576>>18520000
   DEFINE                                                      <<RH.PV>>18522000
        P'GANAME   = PARMS ( 4) #,                             <<03.KM>>18524000
        SIRS       = DPARMS( 8) #,                             <<RH.PV>>18526000
        DETAIL     = PARMS (12) #,                             <<RH.PV>>18528000
        DETAILEN   = PARMS (13) #,                             <<RH.PV>>18530000
        NEWAG      = PARMS (14) #,                             <<RH.PV>>18532000
        ENTADDR    = PARMS (15) #,                             <<RH.PV>>18534000
        FILENUM    = PARMS (18) #,                             <<RH.PV>>18536000
        DEVSIZE    = PARMS (19) #,   <<BYTES>>                 <<RH.PV>>18538000
        LINENUM    = PARMS (20) #,                             <<RH.PV>>18540000
        NUMPERLINE = PARMS (21) #,                             <<RH.PV>>18542000
        TYPEW      = PARMS (22) #,                             <<04.KM>>18544000
        P'VCNAME   = PARMS (27) #,                             <<03.KM>>18546000
        P'VSNAME   = PARMS (31) #;                             <<03.KM>>18548000
   DEFINE                                                      <<RH.PV>>18550000
        PAGEJECT = BEGIN                                       <<RH.PV>>18552000
                   FWRITE(FILENUM,BUF,0,%61);                  <<01.RO>>18554000
                   IF <> THEN CXEXIT(IOERROR);                 <<03.KM>>18556000
                   LINENUM:=1;                                 <<RH.PV>>18558000
                   END#,                                       <<RH.PV>>18560000
                                                               <<RH.PV>>18562000
        SPACE    = BEGIN                                       <<RH.PV>>18564000
                   FWRITE(FILENUM,BUF,0,%40);                  <<01.RO>>18566000
                   IF <> THEN CXEXIT(IOERROR);                 <<03.KM>>18568000
                   LINENUM:=LINENUM+1;                         <<RH.PV>>18570000
                   END#,                                       <<RH.PV>>18572000
                                                               <<RH.PV>>18574000
        DBLSPACE = BEGIN                                       <<RH.PV>>18576000
                   FWRITE(FILENUM,BUF,0,%60);                  <<01.RO>>18578000
                   IF <> THEN CXEXIT(IOERROR);                 <<03.KM>>18580000
                   LINENUM:=LINENUM+2;                         <<RH.PV>>18582000
                   END#;                                       <<RH.PV>>18584000
                                                               <<RH.PV>>18586000
   SUBROUTINE CXEXIT(EXITYPE);                                 <<RH.PV>>18588000
   VALUE EXITYPE; INTEGER EXITYPE;                             <<RH.PV>>18590000
   BEGIN                                                       <<RH.PV>>18592000
      LISTVSDEFN:=EXITYPE;                                     <<RH.PV>>18594000
      ASSEMBLE(EXIT 1);                                        <<RH.PV>>18596000
   END <<CXEXIT>>;                                             <<RH.PV>>18598000
                                                               <<RH.PV>>18600000
   SUBROUTINE MOVEFDS(TOADDR,FRADDR,LEN);                      <<RH.PV>>18602000
   VALUE TOADDR,FRADDR,LEN;                                    <<RH.PV>>18604000
   INTEGER TOADDR,FRADDR,LEN;                                  <<RH.PV>>18606000
   BEGIN                                                       <<RH.PV>>18608000
      TOS:=TOADDR;                                             <<RH.PV>>18610000
      TOS:=DIRDST;                                             <<RH.PV>>18612000
      TOS:=S4;                                                 <<RH.PV>>18614000
      TOS:=S4;                                                 <<RH.PV>>18616000
      ASSEMBLE(MFDS 4);                                        <<RH.PV>>18618000
   END <<MOVEFDS>>;                                            <<RH.PV>>18620000
                                                               <<RH.PV>>18622000
   SUBROUTINE GETINFO;                                         <<RH.PV>>18624000
   BEGIN                                                       <<RH.PV>>18626000
      MOVEFDS(@VSDEFN,ENTADDR,VSDEFNSIZE);                     <<RH.PV>>18628000
      TOS := SIRS;                                             <<RH.PV>>18630000
      RELSIR (*, *);                                           <<RH.PV>>18632000
      VMASK:=VSDEFN(VDINFO).VMASKF;                            <<RH.PV>>18634000
      IF (VCLASS:=VSDEFN(VDMISC).CLASSF) THEN                  <<RH.PV>>18636000
         BEGIN                                                 <<RH.PV>>18638000
         MVTABX:=0;  <<CLASS AREN'T MARKED AS MOUNTED>>        <<RH.PV>>18640000
         MOVE NAME:=VSDEFNB,(8);  <<SAVE CLASS NAME>>          <<RH.PV>>18642000
         MOVE MASTER:=VSDEFN(6),(12);                          <<RH.PV>>18644000
         DIRESULT:=DIRECFIND(%40,0D,VSDEFN(6),VSDEFN(10),      <<38.PV>>18646000
                             VSDEFN(14),VSDEFN);               <<RH.PV>>18648000
         IF <> THEN                                            <<RH.PV>>18650000
            BEGIN                                              <<RH.PV>>18652000
            MOVE P'VCNAME:=WNAME,(4);                          <<03.KM>>18654000
            MOVE P'GANAME:=MASTER,(8);                         <<03.KM>>18656000
            MOVE P'VSNAME:=MASTER(8),(4);                      <<03.KM>>18658000
            CXEXIT(NOVOLSET);                                  <<03.KM>>18660000
            END;                                               <<RH.PV>>18662000
         END                                                   <<RH.PV>>18664000
      ELSE                                                     <<RH.PV>>18666000
         MVTABX:=VSDEFN(VDMISC).(MVTABXF);                     <<RH.PV>>18668000
      IF DETAIL = 0 THEN RETURN;  <<NAMES ONLY>>               <<RH.PV>>18670000
      IF DETAIL = 2 AND MVTABX <> 0 THEN                       <<RH.PV>>18672000
         BEGIN                                                 <<RH.PV>>18674000
         I:=0;                                                 <<RH.PV>>18676000
         TMASK:=VMASK;  <<USE TEMPORARY COPY OF VMASK>>        <<RH.PV>>18678000
         WHILE TMASK <> 0 DO                                   <<RH.PV>>18680000
            BEGIN                                              <<RH.PV>>18682000
            I:=I+1;                                            <<RH.PV>>18684000
            IF TMASK THEN                                      <<RH.PV>>18686000
               BEGIN                                           <<RH.PV>>18688000
               LDEV:=0; GEN:=-1;  <<FOR VTABINDEX PROC.>>      <<RH.PV>>18690000
               TOS:=VTABINDEX(VSDEFNB((I*6) & LSL(1)),         <<RH.PV>>18692000
                              VSID,LDEV,GEN);                  <<RH.PV>>18694000
               IF (VTABINFO:=TOS) <> 0D THEN <<MOUNTED MEMBER>><<RH.PV>>18696000
                  BEGIN                                        <<RH.PV>>18698000
                  STATN(I):=15;                                <<RH.PV>>18700000
                  LDEV(I):=VTABINFO1.(0:8);                    <<RH.PV>>18702000
                  CHECKDISC(LDEV(I),STATUS);                   <<RH.PV>>18704000
                  STATUS.AVAILF:=1; <<ASSUME PV AVAIL>>        <<07.KM>>18706000
                  WHILE NOT STATUS DO                          <<RH.PV>>18708000
                     BEGIN                                     <<RH.PV>>18710000
                     STATN(I):=STATN(I)-1;                     <<RH.PV>>18712000
                     STATUS:=STATUS & LSR(1);                  <<RH.PV>>18714000
                     END;                                      <<RH.PV>>18716000
                  STATN(I):=10-STATN(I);                       <<RH.PV>>18718000
                     END                                       <<04576>>18720000
                  ELSE                                         <<04576>>18722000
                     BEGIN                                     <<04576>>18724000
                     LDEV(I) := 0;                             <<04576>>18726000
                     STATN(I) := NOTMOUNTED;                   <<04576>>18728000
                     END;                                      <<04576>>18730000
               END;                                            <<RH.PV>>18732000
            TMASK:=TMASK & LSR(1);                             <<RH.PV>>18734000
            END;                                               <<RH.PV>>18736000
         END;                                                  <<RH.PV>>18738000
   END <<GETINFO>>;                                            <<RH.PV>>18740000
                                                               <<RH.PV>>18742000
   SUBROUTINE PRINTAG(LENGTH);                                 <<RH.PV>>18744000
   VALUE LENGTH;                                               <<RH.PV>>18746000
   INTEGER LENGTH;                                             <<RH.PV>>18748000
   << PRINT "ACCOUNT/GROUP" TITLE >>                           <<RH.PV>>18750000
   BEGIN                                                       <<RH.PV>>18752000
      MOVE BUF := AGTITLE,(LENGTH);                            <<RH.PV>>18754000
      MOVE BUF (ACCTPOS) := CURRENTA, (4);                     <<RH.PV>>18756000
      MOVE BUF (GROUPPOS) := CURRENTG, (4);                    <<RH.PV>>18758000
      FWRITE(FILENUM,BUF,LENGTH,0);                            <<RH.PV>>18760000
      IF <> THEN CXEXIT(IOERROR);                              <<03.KM>>18762000
      LINENUM:=LINENUM+1;                                      <<RH.PV>>18764000
      SPACE;                                                   <<RH.PV>>18766000
   END <<PRINTAG>>;                                            <<RH.PV>>18768000
                                                               <<RH.PV>>18770000
   SUBROUTINE PRINTITLE;                                       <<RH.PV>>18772000
   BEGIN                                                       <<RH.PV>>18774000
      IF DETAIL <> 3 THEN                                      <<RH.PV>>18776000
         MOVE BUF:=TITLE1,(DETAILEN)                           <<RH.PV>>18778000
      ELSE                                                     <<RH.PV>>18780000
         MOVE BUF:=TITLE3,(DETAILEN);                          <<RH.PV>>18782000
      FWRITE(FILENUM,BUF,DETAILEN,0);                          <<RH.PV>>18784000
      IF DETAIL <> 3 THEN                                      <<RH.PV>>18786000
         MOVE BUF:=TITLE2,(DETAILEN)                           <<RH.PV>>18788000
      ELSE                                                     <<RH.PV>>18790000
         MOVE BUF:=TITLE4,(DETAILEN);                          <<RH.PV>>18792000
      FWRITE(FILENUM,BUF,DETAILEN,0);                          <<RH.PV>>18794000
      NUMPERLINE:=0;                                           <<RH.PV>>18796000
      SPACE;                                                   <<RH.PV>>18798000
   END <<PRINTITLE>>;                                          <<RH.PV>>18800000
                                                               <<RH.PV>>18802000
   SUBROUTINE FILLNAME;                                        <<RH.PV>>18804000
   BEGIN                                                       <<RH.PV>>18806000
      BUF := "  ";                                             <<04576>>18808000
      MOVE BUF(1) := BUF,(27);                                 <<04576>>18810000
      NAME(8):=" ";                                            <<RH.PV>>18812000
      IF NOT VCLASS THEN MOVE NAME:=VSDEFNB,(8);               <<RH.PV>>18814000
      MOVE BUFB(1):=NAME WHILE AN,1;                           <<RH.PV>>18816000
      IF VCLASS AND DETAIL <> 3 THEN MOVE * :="(C)",2;         <<RH.PV>>18818000
      IF MVTABX <> 0 THEN  << MOUNTED >>                       <<RH.PV>>18820000
         MOVE * :="*"                                          <<RH.PV>>18822000
      ELSE                                                     <<RH.PV>>18824000
         MOVE * :=" ";                                         <<RH.PV>>18826000
      IF (NUMPERLINE:=NUMPERLINE-1) < 0 THEN                   <<RH.PV>>18828000
      NUMPERLINE:=IF DETAIL = 0 THEN                           <<RH.PV>>18830000
                  IF DEVSIZE >= LONGDEV THEN 8 ELSE 5 ELSE 0;  <<RH.PV>>18832000
      CNTRL:=IF NUMPERLINE = 0 THEN 0 ELSE %320;               <<RH.PV>>18834000
      IF VCLASS AND DETAIL = 3 THEN  <<LOOK AT CLASS DEFN>>    <<RH.PV>>18836000
      BEGIN                                                    <<RH.PV>>18838000
           I:=3;                                               <<RH.PV>>18840000
           TOS:=@BUFB(15);  <<MASTER NAME LOCATION>>           <<RH.PV>>18842000
           WHILE (I:=I-1) >= 0 DO  <<FORMAT NAME FOR PRINT>>   <<RH.PV>>18844000
           BEGIN                                               <<RH.PV>>18846000
                MOVE NAME:=MASTERB(I*8),(8);                   <<RH.PV>>18848000
                MOVE * :=NAME WHILE AN,1;                      <<RH.PV>>18850000
                IF I > 0 THEN                                  <<RH.PV>>18852000
                   MOVE * :=".",2                              <<RH.PV>>18854000
                ELSE                                           <<RH.PV>>18856000
                   MOVE * :=" ";                               <<RH.PV>>18858000
           END;                                                <<RH.PV>>18860000
      END;                                                     <<RH.PV>>18862000
   END <<FILLNAME>>;                                           <<RH.PV>>18864000
                                                               <<RH.PV>>18866000
   SUBROUTINE PRINTINFO;                                       <<RH.PV>>18868000
   BEGIN                                                       <<RH.PV>>18870000
        MOVE BUF := "  ";                                      <<03513>>18872000
        MOVE BUF(1) := BUF,(35);                               <<03513>>18874000
        MOVE BUF7902 := "  ";                                  <<03513>>18876000
        MOVE BUF7902(1) := BUF7902,(16);                       <<03513>>18878000
      IF DETAIL = 3 AND NOT VCLASS THEN RETURN;                <<RH.PV>>18880000
      IF NEWAG <> 0 THEN  <<NEW GROUP/ACCOUNT>>                <<RH.PV>>18882000
         BEGIN                                                 <<RH.PV>>18884000
         NEWAG:=0;                                             <<RH.PV>>18886000
         IF (2<=LINENUM<=52) THEN DBLSPACE ELSE                <<RH.PV>>18888000
         IF (53<=LINENUM<=61) THEN PAGEJECT;                   <<RH.PV>>18890000
         PRINTAG(19);                                          <<RH.PV>>18892000
         PRINTITLE;                                            <<RH.PV>>18894000
         END                                                   <<RH.PV>>18896000
      ELSE                                                     <<RH.PV>>18898000
         IF (59<=LINENUM<=61) THEN                             <<RH.PV>>18900000
            BEGIN                                              <<RH.PV>>18902000
            PAGEJECT;                                          <<RH.PV>>18904000
            PRINTAG(25);                                       <<RH.PV>>18906000
            PRINTITLE;                                         <<RH.PV>>18908000
            END;                                               <<RH.PV>>18910000
      I:=0;  <<VOLUME MEMBER COUNT>>                           <<RH.PV>>18912000
      FILLNAME;                                                <<RH.PV>>18914000
      IF (1<=DETAIL<=2) THEN                                   <<RH.PV>>18916000
      WHILE VMASK <> 0 DO                                      <<RH.PV>>18918000
         BEGIN                                                 <<RH.PV>>18920000
         IF (I:=I+1) = 2 THEN MOVE BUFB(1):=BUFB,(12);         <<RH.PV>>18922000
         IF VMASK THEN                                         <<RH.PV>>18924000
            BEGIN                                              <<RH.PV>>18926000
            LOC:=I * VDVENTSIZE;                               <<RH.PV>>18928000
        << THE SUBTYPE IS STORED IN VSDEF ENTRY AS A PSEUDO >> <<03513>>18930000
        << SUBTYPE.  THE ALGORITHM IS AS FOLLOWS.           >> <<03513>>18932000
        << [PSEUDO SUB-TYPE] = ([ACTUAL TYPE]  * 16) +      >> <<03513>>18934000
        <<                     [ACTUAL SUBTYPE]             >> <<03513>>18936000
        <<                                                  >> <<03513>>18938000
        << STYPE = PSEUDO SUBTYPE + 1                       >> <<03513>>18940000
            STYPE:=VSDEFN(LOC+VDINFO).(0:8)+1;                 <<RH.PV>>18942000
            MOVE BUFB(15):=VSDEFNB(LOC & LSL(1)),(8);          <<RH.PV>>18944000
        <<**************************************************>> <<03513>>18946000
        <<               K L U D G E                        >> <<03513>>18948000
        << THE FOLLOWING IS A KLUDGE TO ACCOMODATE BOTH THE >> <<03513>>18950000
        << HP9895 AND HP7902 FLOPPY DRIVES.  BOTH DEVICES   >> <<03513>>18952000
        << HAVE THE SAME TYPE AND SUBTYPE WHICH CAUSES THE  >> <<03513>>18954000
        << ALGORITHM TO INDEX TO THE SAME PLACE IN THE ARRAY>> <<03513>>18956000
        << TYPEKEY.  WHEN THE HP7902 IS NO LONGER SUPPORTED >> <<03513>>18958000
        << THIS KLUDGE SHOULD BE REMOVED.  AFTER THE KLUDGE >> <<03513>>18960000
        << IS REMOVED THE CODE SHOULD READ AS FOLLOWS:      >> <<03513>>18962000
        << MOVE BUFB(26) := TYPEKEY(STYPE * TYPELEN),       >> <<03513>>18964000
        <<                  (TYPELEN);                      >> <<03513>>18966000
        <<**************************************************>> <<03513>>18968000
                                                               <<03513>>18970000
        IF STYPE = FLOPPY THEN                                 <<03513>>18972000
           FLOPPY'FLAG := TRUE;                                <<03513>>18974000
            MOVE BUFB(26):=TYPEKEY(STYPE * TYPELEN),           <<RH.PV>>18976000
                           (TYPELEN);                          <<RH.PV>>18978000
            IF DETAIL = 2 AND MVTABX <> 0 THEN                 <<RH.PV>>18980000
               BEGIN                                           <<RH.PV>>18982000
            IF LDEV(I) <> 0 THEN                               <<04576>>18984000
               ASCII(LDEV(I),-10,BUFB(39))                     <<04576>>18986000
            ELSE                                               <<04576>>18988000
               MOVE BUFB(36) := "    "; <<BLANK LDEV FOR   >>  <<04576>>18990000
                                        <<UNMOUNTED VOLUME>>   <<04576>>18992000
               MOVE BUFB(44):=STATKEY(STATN(I) * STATLEN),     <<RH.PV>>18994000
                              (STATLEN);                       <<RH.PV>>18996000
               END;                                            <<RH.PV>>18998000
        IF VMASK&LSR(1) <> 0 THEN                              <<03513>>19000000
           BEGIN                                               <<03513>>19002000
           FWRITE(FILENUM,BUF,DETAILEN,0);                     <<03513>>19004000
           IF FLOPPY'FLAG THEN                                 <<03513>>19006000
              BEGIN                                            <<03513>>19008000
              MOVE BUFB7902(26):= "HP7902  ";                  <<03513>>19010000
              FWRITE(FILENUM,BUF7902,FLOPPYLEN,0);             <<03513>>19012000
              FLOPPY'FLAG := FALSE;                            <<03513>>19014000
              END;                                             <<03513>>19016000
         END;                                                  <<03513>>19018000
            END;                                               <<RH.PV>>19020000
         VMASK:=VMASK&LSR(1);                                  <<07.KM>>19022000
         END;                                                  <<RH.PV>>19024000
      FWRITE(FILENUM,BUF,DETAILEN,CNTRL);                      <<RH.PV>>19026000
         IF FLOPPY'FLAG THEN                                   <<03513>>19028000
            BEGIN                                              <<03513>>19030000
            MOVE BUFB7902(26) := "HP7902  ";                   <<03513>>19032000
            FWRITE(FILENUM,BUF7902,FLOPPYLEN,CNTRL);           <<03513>>19034000
            FLOPPY'FLAG := FALSE;                              <<03513>>19036000
            END;                                               <<03513>>19038000
   END <<PRINTINFO>>;                                          <<RH.PV>>19040000
                                                               <<RH.PV>>19042000
   GETINFO;  <<OBTAIN DEFINITION INFORMATION>>                 <<RH.PV>>19044000
   PRINTINFO;                                                  <<RH.PV>>19046000
   CXEXIT(NOERROR);                                            <<03.KM>>19048000
END <<PROCEDURE LISTVSDEFN>>;                                  <<03.KM>>19050000
                                                               <<01.KM>>19052000
                                                               <<01.KM>>19054000
$CONTROL  SEGMENT=CISYSMGR                                     <<01.KM>>19056000
                                                               <<01.KM>>19058000
                                                               <<RH.PV>>19060000
INTEGER PROCEDURE LISTVSINFO(ELEMENT,LEVEL,PARMS,SIRS);        <<RH.PV>>19062000
   VALUE LEVEL, PARMS, SIRS;                                   <<RH.PV>>19064000
   INTEGER ARRAY ELEMENT;                                      <<RH.PV>>19066000
   INTEGER LEVEL, PARMS;                                       <<RH.PV>>19068000
   DOUBLE SIRS;                                                <<RH.PV>>19070000
   OPTION PRIVILEGED, UNCALLABLE;                              <<RH.PV>>19072000
BEGIN                                                          <<RH.PV>>19074000
   DEFINE P'GOTENTRY= LPARMS(24) #;                            <<03.KM>>19076000
   ARRAY LEAFNAME(*)= S-3;                                    <<00.GEN>>19078000
   DOUBLE DS3= S-3;                                           <<00.GEN>>19080000
   INTEGER X=X;                                               <<00.GEN>>19082000
   INTEGER POINTER PPRESULT;                                  <<00.GEN>>19084000
                                                              <<00.GEN>>19086000
   LOGICAL NEWMASK := 0;                                       <<RH.PV>>19088000
   DEFINE                                                      <<RH.PV>>19090000
        NEWACCNT = NEWMASK.(15:1)#,                            <<RH.PV>>19092000
        NEWGROUP   = NEWMASK.(14:1)#;                          <<RH.PV>>19094000
   INTEGER ELEMENTADDR = Q-8;                                  <<RH.PV>>19096000
   INTEGER ARRAY RPARMS(*);                                    <<RH.PV>>19098000
   LOGICAL ARRAY LPARMS(*) = RPARMS;                           <<RH.PV>>19100000
   DOUBLE ARRAY                                                <<RH.PV>>19102000
        PARMSD(*) = RPARMS,                                    <<RH.PV>>19104000
        DELEMENT(*) = ELEMENT;                                 <<RH.PV>>19106000
   EQUATE DIRDST = 20;                                         <<RH.PV>>19108000
                                                               <<RH.PV>>19110000
   IF REQUESTSERVICE THEN                                      <<RH.PV>>19112000
      BEGIN                                                    <<RH.PV>>19114000
      TOS := 5;                                                <<RH.PV>>19116000
      GO TO EXIT2;                                             <<RH.PV>>19118000
      END;                                                     <<RH.PV>>19120000
   TOS := DELEMENT (1);                                       <<00.GEN>>19122000
   TOS := DELEMENT;                                           <<00.GEN>>19124000
   EXCHANGEDB(0);                                             <<00.GEN>>19126000
   @RPARMS := @ARRQ0(PARMS - DELTAQ);                         <<00.GEN>>19128000
                                                              <<00.GEN>>19130000
   @PPRESULT:=@RPARMS(SYSL'PPRINX);                           <<00.GEN>>19132000
   IF LOGICAL(D'TYPE.(ALLFLAG)) THEN                          <<00.GEN>>19134000
   BEGIN                                                      <<00.GEN>>19136000
     COMMENT:                                                 <<00.GEN>>19138000
       (S-3,S-2) = LAST 4 BYTES OF LEAF NAME                  <<00.GEN>>19140000
       (S-1,S-0) = FIRST 4 BYTES OF LEAF NAME;                <<00.GEN>>19142000
                                                              <<00.GEN>>19144000
     TOS:=DS3;                         <<CORRECT STR ORDER>>   <<03.KM>>19146000
     CASE *LEVEL OF BEGIN                                     <<00.GEN>>19148000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>19150000
       TOS:=DIRMATCH(G'GNAME,LEAFNAME);                       <<00.GEN>>19152000
       TOS:=DIRMATCH(G'ANAME,LEAFNAME);                       <<00.GEN>>19154000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>19156000
       TOS:=DIRMATCH(G'VNAME,LEAFNAME);                       <<00.GEN>>19158000
     END;                                                     <<00.GEN>>19160000
     X:=TOS;                           <<SET CC ON TOS>>      <<00.GEN>>19162000
     DDEL;                                                    <<00.GEN>>19164000
     IF <> THEN                        <<DIRMATCH<>0>>        <<00.GEN>>19166000
     BEGIN                                                    <<00.GEN>>19168000
       TOS:=IF < THEN NEXTUNCLE'SIR ELSE NEXTBROTHER'SIR;      <<03.KM>>19170000
       GO EXIT1;                                              <<00.GEN>>19172000
     END;                                                     <<00.GEN>>19174000
   END;                                                       <<00.GEN>>19176000
                                                              <<00.GEN>>19178000
   IF LEVEL <> VSDEFLEVEL THEN                                 <<RH.PV>>19180000
      BEGIN                                                    <<RH.PV>>19182000
      IF LEVEL = ACCOUNTLEVEL THEN NEWACCNT:=TRUE;             <<RH.PV>>19184000
      IF LEVEL = GROUPLEVEL THEN NEWGROUP := TRUE;             <<RH.PV>>19186000
      END;                                                     <<RH.PV>>19188000
   IF NEWMASK <> 0 THEN  <<NEW ACCOUNT/GROUP>>                 <<RH.PV>>19190000
      BEGIN                                                    <<RH.PV>>19192000
      LPARMS (14) := LPARMS (14) LOR NEWMASK;                  <<RH.PV>>19194000
      PARMSD (2 + (2 * NEWMASK.(15:1))) := TOS;                <<RH.PV>>19196000
      PARMSD(X+1) := TOS;                                      <<RH.PV>>19198000
      TOS := 1;                                                <<RH.PV>>19200000
      GO TO EXIT1;                                             <<RH.PV>>19202000
      END                                                      <<RH.PV>>19204000
   ELSE                                                        <<RH.PV>>19206000
      BEGIN                                                    <<RH.PV>>19208000
      PARMSD:=TOS;                                             <<RH.PV>>19210000
      PARMSD(1):=TOS;                                          <<RH.PV>>19212000
      END;                                                     <<RH.PV>>19214000
   PARMSD (8) := SIRS;                                         <<RH.PV>>19216000
   RPARMS (15) := ELEMENTADDR;                                 <<RH.PV>>19218000
   P'GOTENTRY:=TRUE;                                           <<03.KM>>19220000
   TOS := LISTVSDEFN(RPARMS);                                  <<RH.PV>>19222000
   IF S0=0 THEN TOS:=TOS+NEXTSON                               <<06.KM>>19224000
   ELSE                                                        <<03.KM>>19226000
      BEGIN                                                    <<03.KM>>19228000
      RPARMS(1):=-TOS;                                         <<03.KM>>19230000
      TOS:=ABORTSCAN;                                          <<03.KM>>19232000
      END;                                                     <<03.KM>>19234000
EXIT1:                                                         <<RH.PV>>19236000
   EXCHANGEDB(DIRDST);                                         <<RH.PV>>19238000
EXIT2:                                                         <<RH.PV>>19240000
   LISTVSINFO := TOS;                                          <<RH.PV>>19242000
END << LISTVSINFO >>;                                          <<RH.PV>>19244000
                                                               <<01.KM>>19246000
                                                               <<01.KM>>19248000
$CONTROL  SEGMENT=CISYSMGR                                     <<01.KM>>19250000
                                                               <<01.KM>>19252000
                                                               <<RH.PV>>19254000
PROCEDURE CXLISTVS EXECUTORHEAD;                               <<RH.PV>>19256000
OPTION PRIVILEGED, UNCALLABLE;                                 <<RH.PV>>19258000
BEGIN                                                          <<RH.PV>>19260000
DOUBLE DL := COMMASEMICR;                                      <<RH.PV>>19262000
INTEGER NUMPARMS;                                              <<RH.PV>>19264000
DOUBLE ARRAY PARMS(0:3)=Q;                                     <<RH.PV>>19266000
INTEGER ARRAY RECIPPARMS(0:SYSL'PARMLEN-1);                   <<00.GEN>>19268000
INTEGER ARRAY PPRESULT(*)=RECIPPARMS(SYSL'PPRINX);            <<00.GEN>>19270000
DEFINE P'GNAME=    RECIPPARMS(4) #,                            <<03.KM>>19272000
       P'ANAME=    RECIPPARMS(8) #,                            <<03.KM>>19274000
       P'FILENUM=  RECIPPARMS(18) #,                           <<04.KM>>19276000
       P'GOTENTRY= RECIPPARMS(24) #,                           <<03.KM>>19278000
       P'VCNAME=   RECIPPARMS(27) #,                           <<03.KM>>19280000
       P'VSNAME=   RECIPPARMS(31) #;                           <<03.KM>>19282000
EQUATE NOVOLSET= -2,                                           <<03.KM>>19284000
       IOERROR=  -1;                                           <<03.KM>>19286000
ARRAY WBUF(0:17);                                              <<03.KM>>19288000
BYTE ARRAY BUF(*)= WBUF;                                       <<03.KM>>19290000
BYTE POINTER NEXT,                                             <<03.KM>>19292000
             LAST;                                             <<03.KM>>19294000
BYTE POINTER LEAFNAME = PARMS;                                 <<RH.PV>>19296000
INTEGER LEAFNAMECHAR = PARMS+1;                                <<RH.PV>>19298000
BYTE LEAFNAMELEN = PARMS+1;                                    <<RH.PV>>19300000
BYTE POINTER LISTLEVEL = PARMS+2;                              <<RH.PV>>19302000
INTEGER LISTLEVELCHAR = PARMS+3;                               <<RH.PV>>19304000
BYTE LISTLEVELLEN = PARMS+3;                                   <<RH.PV>>19306000
BYTE POINTER LISTVILE = PARMS+2;  <<TRICKY BIT>>               <<RH.PV>>19308000
INTEGER LISTVILECHAR = PARMS+3;                                <<RH.PV>>19310000
BYTE LISTVILELEN = PARMS+3;                                    <<RH.PV>>19312000
BYTE POINTER EXTRAPARM = PARMS+6;                              <<RH.PV>>19314000
BYTE EXTRAPARMLEN = PARMS+7;                                   <<RH.PV>>19316000
EQUATE COMMA = 0, SEMI = 1, CR = 2;                            <<RH.PV>>19318000
BYTE POINTER DELIM;                                           <<00.GEN>>19320000
DOUBLE ARRAY DPPRESULT(*)=PPRESULT;                           <<00.GEN>>19322000
INTEGER LEV := VSDEFLEVEL;  <<ASSUME VS DEFINITION>>           <<RH.PV>>19324000
INTEGER FNUM := 2;  <<DEFAULT TO $STDLIST>>                    <<U.RAO>>19326000
LOGICAL STDLIST := TRUE;  <<DEFAULT TO $STDLIST>>              <<U.RAO>>19328000
ARRAY DATEBUF(0:13);  <<FOR TIME STAMP FOR OUTPUT>>            <<02.RO>>19330000
INTEGER DEV := 0;  <<LIST FILE DEVICE TYPE>>                   <<03.RO>>19332000
                                                               <<03.KM>>19334000
                                                               <<03.KM>>19336000
  <<*******************>>                                      <<03.KM>>19338000
  << SUBROUTINE APPEND >>                                      <<03.KM>>19340000
  <<*******************>>                                      <<03.KM>>19342000
                                                               <<03.KM>>19344000
  LOGICAL SUBROUTINE APPEND(NAME,SUFFIX,BUF);                  <<03.KM>>19346000
    VALUE SUFFIX; BYTE ARRAY NAME,BUF; INTEGER SUFFIX;         <<03.KM>>19348000
  BEGIN                                                        <<03.KM>>19350000
    IF NAME(7)=" " THEN MOVE BUF:=NAME WHILE ANS,1             <<03.KM>>19352000
    ELSE MOVE BUF:=NAME,(8),2;                                 <<03.KM>>19354000
    @LAST:=TOS;                                                <<03.KM>>19356000
    LAST:=SUFFIX;                                              <<03.KM>>19358000
    APPEND:=@LAST(1);                                          <<03.KM>>19360000
  END <<SUBROUTINE APPEND>>;                                   <<03.KM>>19362000
                                                               <<03.KM>>19364000
                                                               <<03.KM>>19366000
  <<***********************>>                                  <<03.KM>>19368000
  << SUBROUTINE CLASSERROR >>                                  <<03.KM>>19370000
  <<***********************>>                                  <<03.KM>>19372000
                                                               <<03.KM>>19374000
  SUBROUTINE CLASSERROR;                                       <<03.KM>>19376000
  BEGIN                                                        <<03.KM>>19378000
    IF LOGICAL(P'GOTENTRY) THEN FWRITE(FNUM,WBUF,0,0);         <<03.KM>>19380000
    @NEXT:=APPEND(P'VSNAME,".",BUF);                           <<03.KM>>19382000
    @NEXT:=APPEND(P'GNAME,".",NEXT);                           <<03.KM>>19384000
    @NEXT:=APPEND(P'ANAME,0,NEXT);                             <<03.KM>>19386000
    APPEND(P'VCNAME,0,NEXT);                                   <<03.KM>>19388000
    CIERR((ERRNUM:=VSDNOVOLSET),,2,@BUF);                      <<03.KM>>19390000
  END <<SUBROUTINE CLASSERROR>>;                               <<03.KM>>19392000
                                                               <<03.KM>>19394000
                                                               <<03.KM>>19396000
  <<*********************>>                                    <<03.KM>>19398000
  << MAIN PROCEDURE BODY >>                                    <<03.KM>>19400000
  <<*********************>>                                    <<03.KM>>19402000
                                                                        19404000
<<INITIALIZE PARMS ARRAY>>                                     <<RH.PV>>19406000
PARMS := 0D;                                                   <<RH.PV>>19408000
TOS := @PARMS+2;                                               <<RH.PV>>19410000
TOS := @PARMS+1;                                               <<RH.PV>>19412000
TOS := 6;                                                      <<RH.PV>>19414000
ASSEMBLE(MOVE);                                                <<RH.PV>>19416000
MYCOMMAND(PARMSP,DL,4,NUMPARMS,PARMS);                         <<RH.PV>>19418000
PARMNUM := 1;                                                  <<RH.PV>>19420000
IF NOT PRODUCEPARMS(LEV,PARMSP,PPRESULT,DELIM,ERRNUM) THEN    <<00.GEN>>19422000
    RETURN;  <<ERROR IN PARSING LEAFNAME>>                     <<RH.PV>>19424000
IF (NUMPARMS > 0) AND  <<NOT JUST A CR>>                       <<RH.PV>>19426000
   (@DELIM < @LEAFNAME+INTEGER(LEAFNAMELEN)) THEN             <<00.GEN>>19428000
   BEGIN  <<EXTRANEOUS STUFF IN LEAFNAME>>                     <<RH.PV>>19430000
   TOS := ERRNUM := LISTVEXTRANEOUS;                           <<RH.PV>>19432000
   TOS := @DELIM;                                             <<00.GEN>>19434000
   CIERR(*,*);                                                 <<RH.PV>>19436000
   RETURN                                                      <<RH.PV>>19438000
   END;                                                        <<RH.PV>>19440000
                                                               <<RH.PV>>19442000
IF NUMPARMS=0 THEN LEAFNAMECHAR := CR;                         <<RH.PV>>19444000
                                                               <<RH.PV>>19446000
<<CHECK FOR LISTLEVEL, IF ANY>>                                <<RH.PV>>19448000
IF LEAFNAMECHAR.(11:5)=COMMA THEN  <<LISTLEVEL PRESENT>>       <<RH.PV>>19450000
   BEGIN                                                       <<RH.PV>>19452000
   PARMNUM := 2;                                               <<RH.PV>>19454000
   TOS := BINARY(LISTLEVEL,INTEGER(LISTLEVELLEN));             <<RH.PV>>19456000
   IF < THEN   <<BAD CHAR IN CONVERT>>                         <<RH.PV>>19458000
      BEGIN                                                    <<RH.PV>>19460000
      CIERR(ERRNUM := LISTVBADINT, LISTLEVEL);                 <<RH.PV>>19462000
      RETURN                                                   <<RH.PV>>19464000
      END;                                                     <<RH.PV>>19466000
   IF > THEN  <<INTEGER OUT OF BOUNDS>>                        <<RH.PV>>19468000
      BEGIN                                                    <<RH.PV>>19470000
      CIERR(ERRNUM := LISTVINTOVFL,LISTLEVEL);                 <<RH.PV>>19472000
      RETURN                                                   <<RH.PV>>19474000
      END;                                                     <<RH.PV>>19476000
   IF S0 > 3 THEN TOS := 3;  <<MAX LEVEL>>                     <<RH.PV>>19478000
   IF S0 < 0 THEN  <<LISTVS, -1 CASE?>>                        <<RH.PV>>19480000
      BEGIN  <<CHECK CAPABILITY>>                              <<RH.PV>>19482000
      IF D'TYPE.(STARTLEVELF) = 0 THEN  <<SYSTEM LEVEL FILE>> <<00.GEN>>19484000
         BEGIN                                                 <<RH.PV>>19486000
         SETXPXGLOB;                                           <<03.KM>>19488000
         IF NOT SMCAP THEN                                     <<RH.PV>>19490000
            BEGIN                                              <<RH.PV>>19492000
            CIERR(ERRNUM := LISTVSMCAP);                       <<RH.PV>>19494000
            RETURN                                             <<RH.PV>>19496000
            END;                                               <<RH.PV>>19498000
         END                                                   <<RH.PV>>19500000
      ELSE                                                     <<03.KM>>19502000
         BEGIN                                                 <<03.KM>>19504000
         SETXPXGLOB;                                           <<03.KM>>19506000
         IF NOT AMCAP AND NOT SMCAP THEN                       <<03.KM>>19508000
            BEGIN                                              <<03.KM>>19510000
            CIERR(ERRNUM:=LISTVAMCAP);                         <<03.KM>>19512000
            RETURN;                                            <<03.KM>>19514000
            END;                                               <<03.KM>>19516000
         END;                                                  <<03.KM>>19518000
      RECIPPARMS(13) := 0;                                     <<RH.PV>>19520000
      END;  <<LISTVS, -1 CASE>>                                <<RH.PV>>19522000
   PARMS := PARMS(1);                                          <<RH.PV>>19524000
   PARMS(1) := PARMS(2);  <<FIXUP FOR MISSING LISTLEVEL>>      <<RH.PV>>19526000
   END                                                         <<RH.PV>>19528000
ELSE                                                           <<RH.PV>>19530000
   TOS := 0;   <<LISTLEVEL DEFAULT>>                           <<RH.PV>>19532000
RECIPPARMS(12) := S0;  <<LISTLEVEL IN BINARY>>                 <<RH.PV>>19534000
CASE TOS OF                                                    <<RH.PV>>19536000
   BEGIN                                                       <<RH.PV>>19538000
   RECIPPARMS(13) := 7;                                        <<RH.PV>>19540000
   RECIPPARMS(13) := 17;                                       <<RH.PV>>19542000
   RECIPPARMS(13) := 27;                                       <<04576>>19544000
   RECIPPARMS(13) := 21;                                       <<RH.PV>>19546000
   END;                                                        <<RH.PV>>19548000
<<WE HAVE NOW PROCESSED THE LISTLEVEL. NOW DO LISTVILE>>       <<RH.PV>>19550000
PARMNUM := PARMNUM+1;                                          <<RH.PV>>19552000
IF LEAFNAMECHAR.(11:5)=SEMI THEN  <<PROBABLY IS ONE>>          <<RH.PV>>19554000
   BEGIN                                                       <<RH.PV>>19556000
   IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN RETURN;              <<RH.PV>>19558000
   STDLIST := FALSE;   <<VALID LIST FILE NAME PROVIDED>>       <<U.RAO>>19560000
   END                                                         <<RH.PV>>19562000
ELSE IF LEAFNAMECHAR.(11:5)=COMMA THEN  <<ERROR>>              <<RH.PV>>19564000
   BEGIN                                                       <<RH.PV>>19566000
   CIERR(ERRNUM := LISTVEXPECTFILE, LISTVILE);                 <<RH.PV>>19568000
   RETURN                                                      <<RH.PV>>19570000
   END;                                                        <<U.RAO>>19572000
                                                               <<RH.PV>>19574000
IF (LISTVILECHAR.(11:5) <> CR) AND (EXTRAPARMLEN<>0) THEN      <<RH.PV>>19576000
   BEGIN                                                       <<RH.PV>>19578000
   PARMNUM := PARMNUM+1;                                       <<RH.PV>>19580000
   CIERR(ERRNUM := LISTV2MP,EXTRAPARM);                        <<RH.PV>>19582000
   RETURN                                                      <<RH.PV>>19584000
   END;                                                        <<RH.PV>>19586000
PARMNUM := 0;                                                  <<RH.PV>>19588000
                                                               <<RH.PV>>19590000
IF NOT STDLIST THEN                                            <<U.RAO>>19592000
   BEGIN   <<OPEN LIST FILE FOR RECIPPARMS>>                   <<U.RAO>>19594000
   FNUM := FOPEN(LISTVILE, %2504, %101);                       <<00267>>19596000
   IF CARRY THEN  <<OPEN FAILED ON USER DEFINED LIST FILE>>    <<U.RAO>>19598000
      BEGIN                                                    <<U.RAO>>19600000
      FERROR'(FNUM, PARMNUM);                                  <<U.RAO>>19602000
      CIERR(ERRNUM := LISTVFSERR);                             <<U.RAO>>19604000
      RETURN;                                                  <<U.RAO>>19606000
      END;                                                     <<U.RAO>>19608000
   END;                                                        <<U.RAO>>19610000
P'FILENUM:=FNUM;                                               <<04.KM>>19612000
                                                               <<RH.PV>>19614000
FGETINFO(FNUM,,,,RECIPPARMS(19),DEV);                          <<03.RO>>19616000
TOS := RECIPPARMS(19);                                         <<RH.PV>>19618000
IF < THEN TOS := -TOS                                          <<RH.PV>>19620000
ELSE TOS := TOS&LSL(1);  <<CONVERT TO BYTE COUNT>>             <<RH.PV>>19622000
RECIPPARMS(19) := TOS;  <<LINE LENGTH>>                        <<RH.PV>>19624000
                                                               <<RH.PV>>19626000
<<SET OTHER FILE ATTRIBUTES>>                                  <<RH.PV>>19628000
RECIPPARMS(20) := 1;                                           <<RH.PV>>19630000
RECIPPARMS(21) := 0;                                           <<RH.PV>>19632000
MOVE RECIPPARMS := D'FNAME,(4),2;                             <<00.GEN>>19634000
MOVE * := D'GNAME,(4),2;                                      <<00.GEN>>19636000
MOVE * := D'ANAME,(4);                                        <<00.GEN>>19638000
RECIPPARMS(14) := 3;  <<NEW ACCOUNT/GROUP FLAG>>               <<RH.PV>>19640000
RECIPPARMS(15) := 0;  <<CALL TO LISTVSDEFN>>                   <<RH.PV>>19642000
<<SET UP TYPE>>                                                <<RH.PV>>19644000
RECIPPARMS (22) := D'TYPE;                                    <<00.GEN>>19646000
RECIPPARMS(SAVEBUFFINDEX) := 0;  << see syslist >>             <<04178>>19648000
RECIPPARMS(SAVEBUFFINDEX + ASIZE + 1) := 0;                    <<04178>>19650000
                                                               <<RH.PV>>19652000
<<TIME STAMP LIST FILE IF NOT INTERACTIVE OR IF LIST >>        <<02.RO>>19654000
<<FILE NAME WAS SUPPLIED.>>                                    <<02.RO>>19656000
INTERACTIVETEST;                                               <<02.RO>>19658000
IF NOT TOS <<NOT INTERACTIVE>> AND STDLIST OR                  <<03.RO>>19660000
   NOT STDLIST AND DEV.(8:8) >= 8 THEN                         <<03.RO>>19662000
   BEGIN                                                       <<02.RO>>19664000
   DATE'LINE(DATEBUF);                                         <<02.RO>>19666000
   FWRITE(FNUM, DATEBUF, -27, %60);                            <<02.RO>>19668000
   END;                                                        <<02.RO>>19670000
                                                               <<02.RO>>19672000
<<NOW SET UP COMMON DIRECSCAN STUFF ON STACK>>                 <<RH.PV>>19674000
TOS := 0D;  <<RETURN VALUE>>                                   <<RH.PV>>19676000
TOS := D'TYPE;                                                <<00.GEN>>19678000
TOS.(HITFLAG) := 1;                                            <<RH.PV>>19680000
TOS := D'INX1.(MVTABXF);               <<LINKAGE>>            <<04.GEN>>19682000
TOS := D'INX2;                         <<INDEXP>>             <<05.GEN>>19684000
TOS := @D'ANAME;                                              <<00.GEN>>19686000
TOS := @D'GNAME;                                              <<00.GEN>>19688000
TOS := @D'FNAME;                                              <<00.GEN>>19690000
IF RECIPPARMS(12)<0 THEN  <<LISTVS , -1>>                      <<RH.PV>>19692000
   TOS := DIRECSCAN(*,*,*,*,*,SYSLIST,RECIPPARMS)              <<RH.PV>>19694000
ELSE                                                           <<RH.PV>>19696000
   TOS := DIRECSCAN(*,*,*,*,*,LISTVSINFO,RECIPPARMS);          <<RH.PV>>19698000
IF <> THEN   <<DIRECTORY ERROR>>                               <<RH.PV>>19700000
   BEGIN                                                       <<RH.PV>>19702000
   IF NOT STDLIST THEN FCLOSE(FNUM, 0, 0);                     <<U.RAO>>19704000
   CYDIRERR'(*,%120000,ERRNUM);                                <<RH.PV>>19706000
   RETURN;                                                     <<RH.PV>>19708000
   END;                                                        <<RH.PV>>19710000
DDEL;                                                          <<RH.PV>>19712000
IF RECIPPARMS(1)<=IOERROR THEN                                 <<03.KM>>19714000
   BEGIN                                                       <<RH.PV>>19716000
   IF < THEN CLASSERROR                                        <<03.KM>>19718000
   ELSE                                                        <<03.KM>>19720000
      BEGIN                                                    <<03.KM>>19722000
      FERROR'(FNUM,PARMNUM);                                   <<03.KM>>19724000
      CIERR(ERRNUM := LISTVFSERR,,%10000,PARMNUM);             <<03.KM>>19726000
      END;                                                     <<03.KM>>19728000
   RETURN                                                      <<RH.PV>>19730000
   END;                                                        <<RH.PV>>19732000
IF LOGICAL(P'GOTENTRY) THEN FWRITE(FNUM,RECIPPARMS,0,0)        <<03.KM>>19734000
ELSE CIERR(-NOVSDSLISTED);                                     <<03.KM>>19736000
             <<XPARENT TO PROGRAMMATIC CALL FOR UPWARD COMPAT>><<03.KM>>19738000
IF NOT STDLIST THEN                                            <<U.RAO>>19740000
   BEGIN                                                       <<U.RAO>>19742000
   FCLOSE(FNUM, 0, 0);                                         <<U.RAO>>19744000
   IF CARRY THEN                                               <<U.RAO>>19746000
      BEGIN                                                    <<U.RAO>>19748000
      FERROR'(FNUM, PARMNUM);  <<REPORT REASON FOR CLOSE FAILUR<<U.RAO>>19750000
      CIERR(ERRNUM := LISTVFSERR);                             <<U.RAO>>19752000
      END;                                                     <<U.RAO>>19754000
   END;                                                        <<U.RAO>>19756000
END;  <<CXLISTVS>>                                             <<RH.PV>>19758000
                                                               <<RH.PV>>19760000
$PAGE    "SUBSYSTEM EXECUTORS"                                          19762000
<<    IMPLEMENTATION DETAILS ON THE COMMANDS                   <<03.RO>>19764000
<<            RUN, PREPRUN OR PREP                             <<03.RO>>19766000
<<               OR SUBSYSTEMS                                 <<03.RO>>19768000
<<                                                             <<03.RO>>19770000
<<        RUN, PREPRUN AND PREP COMMANDS                       <<03.RO>>19772000
<<                                                             <<03.RO>>19774000
<<There is really nothing very unusual or interesting about    <<03.RO>>19776000
<<these particular commands.  In essence they parse the user's <<03.RO>>19778000
<<request and translate it almost verbatim into requests to    <<03.RO>>19780000
<<the segmenter and the CREATE and AWAKE intrinsics.  The only <<03.RO>>19782000
<<information needed to understand these commands is the       <<03.RO>>19784000
<<details on the segmenter and create functions.               <<03.RO>>19786000
<<                                                             <<03.RO>>19788000
<<                   SUBSYSTEMS                                <<03.RO>>19790000
<<                                                             <<03.RO>>19792000
<<The subsystem commands are mildly interesting but mostly     <<03.RO>>19794000
<<just complicated.  I will use :SPL, :SPLPREP and :SPLGO as   <<03.RO>>19796000
<<examples.  All of the rest follow the same general pattern   <<03.RO>>19798000
<<with minor deviations for special problems.                  <<03.RO>>19800000
<<                                                             <<03.RO>>19802000
<<The major problem in the subsystem commands is to handle     <<03.RO>>19804000
<<the file names passed as parameters.  Since the subsystems   <<03.RO>>19806000
<<cannot be passed strings as parameters, the communication    <<03.RO>>19808000
<<is done through the job global file equate table. In         <<03.RO>>19810000
<<general the executor sets up file equates for each of        <<03.RO>>19812000
<<the parameters according to an agreed upon scheme.  For      <<03.RO>>19814000
<<example, in the case of SPL the first parameter, if          <<03.RO>>19816000
<<present, is equated to SPLTEXT, the second to SPLUSL and     <<03.RO>>19818000
<<so forth.  The presence or absence of a given parameter      <<03.RO>>19820000
<<is indicated to the subsystem through a bit map in the       <<03.RO>>19822000
<<PARM parameter in the CREATE intrinsic call.  The            <<03.RO>>19824000
<<correspondence typically is                                  <<03.RO>>19826000
<<          bit 15 = xxxTEXT                                   <<03.RO>>19828000
<<          bit 14 = xxxLIST                                   <<03.RO>>19830000
<<          bit 13 = xxxUSL                                    <<03.RO>>19832000
<<          bit 12 = xxxMAST                                   <<03.RO>>19834000
<<          bit 11 = xxxNEW                                    <<03.RO>>19836000
<<The file equate itself is done by procedure CYIMPLCTFILE'.   <<03.RO>>19838000
<<On completion of the command the file equate is              <<03.RO>>19840000
<<deleted by procedure DELIMPFILE.  Final cleanup is usually   <<03.RO>>19842000
<<done by procedure CISUBSYSFINISH.                            <<03.RO>>19844000
<<                                                             <<03.RO>>19846000
$CONTROL SEGMENT = CIPREPRUN                                   <<U.RAO>>19848000
LOGICAL PROCEDURE CISUBSYSFINISH(MESSAGETYPE, ERRNUM, PARMNUM);<<U.RAO>>19850000
VALUE MESSAGETYPE;                                             <<U.RAO>>19852000
INTEGER MESSAGETYPE, ERRNUM, PARMNUM;                          <<U.RAO>>19854000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>19856000
<<This procedure is called by all subsystem executors and the>><<U.RAO>>19858000
<<executor for the RUN command.  It cleans up various job>>    <<U.RAO>>19860000
<<related parameters and put out any appropriate termination>> <<U.RAO>>19862000
<<message.>>                                                   <<U.RAO>>19864000
<<MESSAGETYPE = 0 => NO MESSAGE.                            >> <<U.RAO>>19866000
<<            = 1 => "END OF PROGRAM"                       >> <<U.RAO>>19868000
<<            = 2 => "END OF PREPARE"                       >> <<U.RAO>>19870000
<<            = 3 => "END OF SUBSYSTEM"                     >> <<U.RAO>>19872000
<<            = 4 => "END OF COMPILE"                       >> <<U.RAO>>19874000
<<            = 5 => "END OF REMOTE PROGRAM"                >> <<U.RAO>>19876000
BEGIN                                                          <<U.RAO>>19878000
LOGICAL RESULT = CISUBSYSFINISH;                               <<U.RAO>>19880000
LOGICAL LEN;                                                   <<U.RAO>>19882000
EQUATE JITJNUMOFFSET = 9;  <<OFFSET FROM START OF JIT>>        <<U.RAO>>19884000
INTEGER JITJNUM;  <<HOLDS VALUE OF JITJNUM>>                   <<U.RAO>>19886000
EQUATE JITEOFOFFSET = 11;                                      <<U.RAO>>19888000
INTEGER JITEOF;  <<HOLDS VALUE OF JITEOF>>                     <<U.RAO>>19890000
INTEGER JITDSTN;  <<HOLDS DATASEG NUMBER OF JIT>>              <<U.RAO>>19892000
INTEGER NEWJITEOF := 0;  <<ALMOST A DUMMY>>                    <<U.RAO>>19894000
LOGICAL FCONTROLDUMMY;                                         <<01033>>19896000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>19898000
SUBROUTINE DEF'MOVETODSEG;                                     <<U.RAO>>19900000
                                                               <<U.RAO>>19902000
NEXTLINE;  <<LINE FEED>>                                       <<U.RAO>>19904000
<<FIRST DEAL WITH JIT, GETTING AND RESETING EOF AND JNUM>>     <<U.RAO>>19906000
SETJIT;                                                        <<U.RAO>>19908000
JITDSTN := TOS;  << SAVE JIT DST NUMBER>>                      <<U.RAO>>19910000
MOVEFROMDSEG(@JITJNUM, JITDSTN, JITJNUMOFFSET, 1);             <<U.RAO>>19912000
MOVEFROMDSEG(@JITEOF, JITDSTN, JITEOFOFFSET, 1);               <<U.RAO>>19914000
<<CLEAR OLD EOF FLAGS>>                                        <<U.RAO>>19916000
MOVETODSEG(JITDSTN, JITEOFOFFSET, @NEWJITEOF, 1);              <<U.RAO>>19918000
<<SET RETURN VALUE FOR SUBSYSFINISH>>                          <<U.RAO>>19920000
CISUBSYSFINISH := NOT GETJCW.(0:1);                            <<U.RAO>>19922000
<<FLUSH TO EOD AS NECESSARY>>                                  <<U.RAO>>19924000
IF (JITJNUM.(0:2)=2) <<JOB>> AND (JITEOF.(0:2)<>0)             <<02.RO>>19926000
      AND (UDC4.NESTLEVEL = 0) <<NOT IN UDC>> THEN             <<02.RO>>19928000
   BEGIN   <<FLUSH REQUIRED - READ TO :>>                      <<U.RAO>>19930000
   DO LEN := FREAD(1, WCOMIMAGE, -255)                         <<U.RAO>>19932000
      UNTIL <> OR BCOMIMAGE = ":";                             <<U.RAO>>19934000
   <<CCE => FOUND SOMETHING, CCL/CCG => FREAD ERROR OR EOF>>   <<U.RAO>>19936000
   <<MPE USED TO LOOK FOR : IF $STDIN OR :EOD IF $STDINX, >>   <<U.RAO>>19938000
   <<BUT THE COMPLEXITY AND THE IMCOMPATIBILITY WITH THE  >>   <<U.RAO>>19940000
   <<SERIES I FORCED US TO LOOK FOR JUST A : IN COLUMN 1. >>   <<U.RAO>>19942000
   IF = AND LEN>1 THEN   <<SUCCESS>>                           <<U.RAO>>19944000
      PENDINGCOMLEN := LEN;  <<FLAG COMMAND ALREADY READ>>     <<U.RAO>>19946000
   END;                                                        <<U.RAO>>19948000
<< RESET THE TERMINAL TO THE DESIRED STATE >>                  <<00851>>19950000
INTERACTIVETEST;                                               <<00851>>19952000
IF TOS THEN RESET'TERMINALMODE;                                <<00851>>19954000
<<IN ANY CASE, SEND MESSAGE ABOUT PROCESS TERMINATION>>        <<U.RAO>>19956000
IF (MESSAGETYPE <> 0) AND RESULT  <<PGM SUCCESSFUL>> THEN      <<U.RAO>>19958000
   GENMSG(CIGENERALMSGSET, ENDOFPROG + MESSAGETYPE -1);        <<U.RAO>>19960000
<<FINALLY, IF APPROPRIATE, RETURN ABNORMAL TERM MESSAGE>>      <<U.RAO>>19962000
IF NOT RESULT THEN   <<FATAL ERROR SOMEWHERE>>                 <<U.RAO>>19964000
   BEGIN                                                       <<U.RAO>>19966000
   PARMNUM := 0;                                               <<U.RAO>>19968000
   IF GETJCW = %140000 THEN  <<:ABORT>>                        <<U.RAO>>19970000
      CIERR(ERRNUM := PGMABORT)                                <<U.RAO>>19972000
   ELSE   <<REGULAR ERROR>>                                    <<U.RAO>>19974000
      CIERR(ERRABTERM);                                        <<U.RAO>>19976000
   END;                                                        <<U.RAO>>19978000
END;   <<CISUBSYSFINISH>>                                      <<U.RAO>>19980000
PROCEDURE RESET'TERMINALMODE;                                  <<00851>>19982000
OPTION UNCALLABLE;                                             <<00851>>19984000
BEGIN                                                          <<00851>>19986000
   COMMENT:                                                    <<00851>>19988000
      THIS PROCEDURE RESETS THE TERMINAL TO THE STATE          <<00851>>19990000
      DESIRED BY THE CI.  IN PARTICULAR IT:                    <<00851>>19992000
         1) DISABLES BREAK IF IN A NOBREAK UDC ELSE            <<00851>>19994000
            ENABLES BREAK                                      <<00851>>19996000
         2) CANCELLS ANY PREVIOUSLY ESTABLISHED TIME-          <<00851>>19998000
            OUTS FOR FREADS.;                                  <<00851>>20000000
   LOGICAL                                                     <<00851>>20002000
      PARM;  << FCONTROL PARARMETER >>                         <<00851>>20004000
                                                               <<00851>>20006000
   IF UDC3.OPTNOBREAK THEN FCONTROL(1,DISABLEBREAK,PARM)       <<00851>>20008000
   ELSE FCONTROL(1,ENABLEBREAK,PARM);                          <<00851>>20010000
                                                               <<00851>>20012000
   << RESET TIMED READ >>                                      <<00851>>20014000
   PARM := 0;                                                  <<00851>>20016000
   FCONTROL(1,TIMEOUT,PARM);                                   <<00851>>20018000
                                                               <<00851>>20020000
END; << PROCEDURE RESET'TERMINALMODE >>                        <<00851>>20022000
                                                               <<00851>>20024000
                                                               <<00851>>20026000
PROCEDURE CXPREPRUN EXECUTORHEAD;                              <<U.RAO>>20028000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>20030000
BEGIN                                                          <<U.RAO>>20032000
  COMMENT                                                      <<U.RAO>>20034000
    HANDLES :PREP, :RUN, :PREPRUN.                             <<U.RAO>>20036000
                                                               <<U.RAO>>20038000
ALGORITHM: CRASH THROUGH IN OBVIOUS FASHION.  PRIMARILY DRIVEN <<U.RAO>>20040000
   BY "NEXT DELIMITER" AND SECONDARILY DRIVEN BY THE KEYWORDS; <<U.RAO>>20042000
                                                               <<U.RAO>>20044000
ENTRY CXPREP, CXRUN;                                           <<U.RAO>>20046000
                                                               <<U.RAO>>20048000
BYTE ARRAY PKEYLIST(*)=PB:=                                    <<U.RAO>>20050000
   5, 3, "LIB",                                                <<U.RAO>>20052000
   9, 7, "MAXDATA",                                            <<U.RAO>>20054000
   6, 4, "PARM",                                               <<U.RAO>>20056000
   6, 4, "PMAP",                                               <<U.RAO>>20058000
   7, 5, "DEBUG",                                              <<U.RAO>>20060000
   7, 5, "STACK",                                              <<U.RAO>>20062000
   4, 2, "RL",                                                 <<U.RAO>>20064000
   6, 4, "LMAP",                                               <<U.RAO>>20066000
   4, 2, "DL",                                                 <<U.RAO>>20068000
   8, 6, "ZERODB",                                             <<U.RAO>>20070000
   8, 6, "NOPRIV",                                             <<U.RAO>>20072000
   6, 4, "NOCB",                                               <<U.RAO>>20074000
   5, 3, "CAP",                                                <<U.RAO>>20076000
   7, 5, "PATCH",                                              <<00629>>20078000
   7, 5, "STDIN",                                              <<01200>>20080000
   9, 7, "STDLIST",                                            <<01200>>20082000
   6, 4, "INFO",                                               <<01200>>20084000
   7, 5, "NOSYM",                                              <<04103>>20086000
   7, 5, "FPMAP",                                              <<04103>>20088000
   9, 7, "NOFPMAP",                                            <<04103>>20090000
  10, 8, "CHECKSUM",                                           <<04103>>20092000
   0;                                                          <<U.RAO>>20094000
EQUATE PKEYLISTL = 144;                                        <<04103>>20096000
BYTE ARRAY KEYLIST(0:PKEYLISTL-1);                             <<U.RAO>>20098000
BYTE ARRAY PCAPLIST(0:24)=PB:=                                 <<U.RAO>>20100000
   4, 2, "PH",                                                 <<U.RAO>>20102000
   4, 2, "DS",                                                 <<U.RAO>>20104000
   4, 2, "MR",                                                 <<U.RAO>>20106000
   4, 2, "PM",                                                 <<U.RAO>>20108000
   4, 2, "IA",                                                 <<U.RAO>>20110000
   4, 2, "BA",                                                 <<U.RAO>>20112000
   0;                                                          <<U.RAO>>20114000
EQUATE PCAPLISTL = 25;                                         <<U.RAO>>20116000
BYTE ARRAY CAPLIST(0:PCAPLISTL-1);                             <<U.RAO>>20118000
                                                               <<U.RAO>>20120000
<<OPERATIONAL LOCAL VARIABLES>>                                <<U.RAO>>20122000
INTEGER PREPRUNFLAG;                                           <<U.RAO>>20124000
DEFINE PREPCOM = (PREPRUNFLAG>0)#,                             <<U.RAO>>20126000
       RUNCOM  = (PREPRUNFLAG<0)#,                             <<U.RAO>>20128000
       PREPRUNCOM = (PREPRUNFLAG=0)#;                          <<U.RAO>>20130000
EQUATE COMMA=0, EQUALSIGN=1, SEMICOLON=2, CR=3;  <<DELIMITERS>><<U.RAO>>20132000
                                                               <<01426>>20134000
<< MAX LENGTH FOR A STRING COMES AFTER A 'RUN X;INFO="' >>     <<01426>>20136000
EQUATE MAXSTRINGLEN = BCOMMANDBUFLEN - 12;                     <<01426>>20138000
<< NOTE THAT THE CURRENT TRUE MAXIMUM ON STRING LENGTH IS   >> <<01709>>20140000
<< 253 CHARACTERS DUE TO THE LIMITATION OF MYCOMMAND.       >> <<01709>>20142000
                                                               <<01426>>20144000
INTEGER NUMPARMS;                                              <<U.RAO>>20146000
DOUBLE ARRAY PARMS(0:MAXSTRINGLEN+3-1);                        <<01426>>20148000
INTEGER ARRAY IPARMS(*)=PARMS;                                 <<U.RAO>>20150000
INTEGER DELIMITER;                                             <<U.RAO>>20152000
DOUBLE TEMPPARM,DUSERCAP;                                      <<04172>>20154000
LOGICAL USERCAP = DUSERCAP + 1;                                <<04172>>20156000
BYTE POINTER PPNTR=TEMPPARM;                                   <<U.RAO>>20158000
BYTE POINTER TEMPPARMPTR = TEMPPARM;                           <<02324>>20160000
LOGICAL DUMMY;                                                 <<02324>>20162000
BYTE POINTER ERRPTR;                                           <<02324>>20164000
LOGICAL LERRPTR' = ERRPTR;                                     <<02324>>20166000
LOGICAL PARMWORD2=TEMPPARM+1;                                  <<U.RAO>>20168000
LONG                                                           <<04172>>20170000
   IA := [16/"IA",48/0]L,                                      <<04172>>20172000
   BA := [16/"BA",48/0]L,                                      <<04172>>20174000
   IB := [16/"IA",16/",B",16/"A ",16/0]L;                      <<04172>>20176000
BYTE X1=PARMWORD2;  <<JUST A DUMMY FOR THE FOLLOWING DEFINE>>  <<U.RAO>>20178000
DEFINE PARMLEN = INTEGER(X1)#;                                 <<U.RAO>>20180000
INTEGER MAXPARAM;                                              <<U.RAO>>20182000
INTEGER ERR;                                                   <<U.RAO>>20184000
INTEGER NAMELEN;          << LENGTH OF FILE NAME >>            <<01200>>20186000
BYTE POINTER SPTR;        << TARGET STRING >>                  <<01200>>20188000
BYTE ARRAY STRING(0:MAXSTRINGLEN-1); << SOURCE STRING >>       <<01426>>20190000
BYTE ARRAY SAVEDCOMIMAGE(0:BCOMMANDBUFLEN-1);                  <<01426>>20192000
INTEGER T'IX,             << OFFSET IN TARGET STR >>           <<01200>>20194000
        S'IX;             << OFFSET IN SOURCE STR >>           <<01200>>20196000
LOGICAL STOP := FALSE;    << FLAG TO STOP SCANNING >>          <<01200>>20198000
                          << IF 'CR' OR 'QUOTECHAR' >>         <<01200>>20200000
                          << IS ENCOUNTERED. >>                <<01200>>20202000
BYTE CHAR,                                                     <<01200>>20204000
     QUOTECHAR;<< CHOSEN STRING DELIMITER, CAN BE >>           <<01200>>20206000
               << SINGLE OR DOUBLE QUOTE.         >>           <<01200>>20208000
                                                               <<U.RAO>>20210000
EQUATE C'QUOTE = %47,                                          <<01200>>20212000
       C'DQUOTE = %42,                                         <<01200>>20214000
       C'COMMA =  %54,                                         <<01200>>20216000
       C'EQUAL =  %75,                                         <<01200>>20218000
       C'SEMICOLON = %73,                                      <<01200>>20220000
       C'CR = %15;                                             <<01200>>20222000
<<PARSED PARAMETER HOLDERS.  THE ACTUAL VALUES ARE    >>       <<U.RAO>>20224000
<<ENTERED IN THE SECTION WHERE THE KEYWORDS ARE PARSED>>       <<U.RAO>>20226000
BYTE ARRAY PROGNAME(0:35);  <<PROGRAM FILE NAME>>              <<U.RAO>>20228000
LOGICAL BLANK := "  ";                                         <<U.RAO>>20230000
BYTE ARRAY ENTRYNAME(0:35);    <<ENTRY POINT NAME>>            <<U.RAO>>20232000
BYTE POINTER RL := @BLANK;                                     <<U.RAO>>20234000
BYTE ARRAY TFILENAME(0:8);  <<HOLDS TEMP FILE NAMES>>          <<U.RAO>>20236000
BYTE ARRAY FULLFILENAME(*) = KEYLIST;                          <<U.RAO>>20238000
LOGICAL PARM := 0;                                             <<U.RAO>>20240000
INTEGER STACKSIZE := -1;                                       <<U.RAO>>20242000
INTEGER DLSIZE := -1;                                          <<U.RAO>>20244000
LOGICAL FLAGS := 1;                                            <<U.RAO>>20246000
LOGICAL FLAGS'EXT1 := 0;     << EXTENSION #1 TO FLAGS - FOR >> <<01200>>20248000
                             << NOTING DUPLICATE KEYWORDS   >> <<01200>>20250000
BYTE ARRAY STDIN(0:39);            << STDIN STRING >>          <<01200>>20252000
BYTE ARRAY STDLIST(0:70);          << STDLIST STRING >>        <<01200>>20254000
INTEGER MAXDATA := -1;                                         <<U.RAO>>20256000
INTEGER PATCHSIZE := -1;                                       <<00629>>20258000
BYTE LIB := "S";                                               <<U.RAO>>20260000
INTEGER ERROR;          << ERROR RETURN FROM CREATEPROCESS >>  <<01200>>20262000
INTEGER PIN := 0;       << PIN RETURNED FROM CREATEPROCESS >>  <<01200>>20264000
LOGICAL CAPWORD := 0;                                          <<U.RAO>>20266000
LOGICAL PFLAGS := 0;                                           <<U.RAO>>20268000
INTEGER ARRAY OPTNNUMS(0:12);   << OPTIONS FOR CREATEPROCESS >><<01200>>20270000
LOGICAL ARRAY OPTNS(0:12);                                     <<01200>>20272000
INTEGER FSERR;          << FILESYSTEM ERROR DURING PROG LOAD >><<01200>>20274000
LOGICAL OPTIONS := 0;          << OPTIONS FOR PROCESS CREATE >><<01200>>20276000
                                                               <<U.RAO>>20278000
DEFINE                                                         <<01200>>20280000
  STACK'OPTION    = OPTIONS.(15:1)#,                           <<01200>>20282000
  DL'OPTION       = OPTIONS.(14:1)#,                           <<01200>>20284000
  MAXDATA'OPTION  = OPTIONS.(13:1)#,                           <<01200>>20286000
  STDIN'OPTION    = OPTIONS.(12:1)#,                           <<01200>>20288000
  STDLIST'OPTION  = OPTIONS.(11:1)#,                           <<01200>>20290000
  STRING'OPTION   = OPTIONS.(10:1)#;                           <<01200>>20292000
                                                               <<01200>>20294000
DEFINE                                                         <<U.RAO>>20296000
  CHECKRUNCOM=IF RUNCOM THEN ERRNUM:=CONTXTPRPNOTRUN#,         <<U.RAO>>20298000
  CHECKPREPCOM=IF PREPCOM THEN ERRNUM:=CONTXTRUNNOTPRP#,       <<U.RAO>>20300000
  CHECKEQSIGN=IF DELIMITER<>EQUALSIGN THEN                     <<U.RAO>>20302000
     BEGIN                                                     <<U.RAO>>20304000
     @PPNTR := @PPNTR+PARMLEN;                                 <<U.RAO>>20306000
     ERRNUM := REQEQUALSIGN;                                   <<U.RAO>>20308000
     END#,                                                     <<U.RAO>>20310000
  CHECKSEGERR=                                                 <<U.RAO>>20312000
     IF <> AND (ERR<>1) <<WARNING PRINTED>> THEN               <<U.RAO>>20314000
         BEGIN                                                 <<U.RAO>>20316000
         SEGMENTER(PIN,8,DELIMITER); <<EXIT>>                  <<U.RAO>>20318000
         ERRNUM := SEGMENTERERROR;                             <<U.RAO>>20320000
         PARMNUM := ERR;                                       <<U.RAO>>20322000
         CIERR(ERRNUM,,%10000,ERR);                            <<U.RAO>>20324000
         RETURN;                                               <<U.RAO>>20326000
         END #,                                                <<01200>>20328000
   CHECKNEW=                                                   <<01200>>20330000
      IF PARMLEN <> 3 OR PPNTR <> "NEW" THEN                   <<01200>>20332000
       ERRNUM := INVALIDSTDLIST#,                              <<01709>>20334000
                                                               <<01200>>20336000
   DELIM'CHAR=                                                 <<01709>>20338000
       IF DELIMITER = COMMA THEN C'COMMA                       <<01709>>20340000
       ELSE IF DELIMITER = EQUALSIGN THEN C'EQUAL              <<01709>>20342000
       ELSE IF DELIMITER = SEMICOLON THEN  C'SEMICOLON         <<01709>>20344000
       ELSE C'CR#;                                             <<01709>>20346000
EQUATE                                                         <<01200>>20348000
  FATHERWAIT      = 1,           << FOR CALLING AWAKE >>       <<01200>>20350000
  SONWAIT         = 2;           << FOR CALLING AWAKE >>       <<01200>>20352000
                                                               <<U.RAO>>20354000
EQUATE                                                         <<01452>>20356000
  UNKNOWN'PROG    =  6;   << CREATEPROC. CAN'T FIND PROGRAM >> <<01452>>20358000
                                                               <<01200>>20360000
INTEGER SUBROUTINE NEXT;                                       <<U.RAO>>20362000
BEGIN  <<GET NEXT PARAMETER>>                                  <<U.RAO>>20364000
TEMPPARM := PARMS(PARMNUM);                                    <<U.RAO>>20366000
NEXT := PARMWORD2.(13:3);  <<RETURN DELIMITER>>                <<U.RAO>>20368000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>20370000
END;  <<SUBROUTINE NEXT>>                                      <<U.RAO>>20372000
                                                               <<01200>>20374000
LOGICAL SUBROUTINE DELIM(CHAR);                                <<01200>>20376000
COMMENT                                                        <<01200>>20378000
   THE FOLLOWING SUBROUTINE DETERMINES IF CHAR IS              <<01200>>20380000
   A DELIMITER. ;                                              <<01200>>20382000
BYTE CHAR;                                                     <<01200>>20384000
BEGIN                                                          <<01200>>20386000
   DELIM := FALSE;                                             <<01200>>20388000
   IF CHAR = C'COMMA OR                                        <<01200>>20390000
      CHAR = C'EQUAL OR                                        <<01200>>20392000
      CHAR = C'SEMICOLON THEN                                  <<01200>>20394000
      DELIM := TRUE;                                           <<01200>>20396000
END;                                                           <<01200>>20398000
                                                               <<U.RAO>>20400000
<<*** MAIN BODY OF PROCEDURE ***>>                             <<U.RAO>>20402000
                                                               <<U.RAO>>20404000
PREPRUNFLAG := 0;                                              <<U.RAO>>20406000
MAXPARAM := 29;                                                <<U.RAO>>20408000
GO TO START;                                                   <<U.RAO>>20410000
                                                               <<U.RAO>>20412000
CXPREP:                                                        <<U.RAO>>20414000
PREPRUNFLAG := 1;                                              <<U.RAO>>20416000
MAXPARAM := 21;                                                <<U.RAO>>20418000
GO TO START;                                                   <<U.RAO>>20420000
                                                               <<U.RAO>>20422000
CXRUN:                                                         <<U.RAO>>20424000
PREPRUNFLAG := -1;                                             <<U.RAO>>20426000
<< MAKE MAXPARAM LARGE SO STRING OF DELIMITERS (I.E. ; , CR) >><<01426>>20428000
<< WILL BE ACCEPTED BY MYCOMMAND.                            >><<01426>>20430000
MAXPARAM := MAXSTRINGLEN + 3;                                  <<01426>>20432000
                                                               <<U.RAO>>20434000
START:                                                         <<U.RAO>>20436000
MOVE SAVEDCOMIMAGE := BCOMIMAGE, (BCOMMANDBUFLEN);             <<01426>>20438000
MYCOMMAND(PARMSP,,MAXPARAM,NUMPARMS,PARMS);                    <<U.RAO>>20440000
IF CARRY THEN                                                  <<01709>>20442000
   BEGIN  << AN ERROR FROM MYCOMMAND >>                        <<01709>>20444000
   << SOME PARAMETER EXCEEDS 255 CHARACTERS >>                 <<01709>>20446000
   ERRNUM := PARAMTOOBIG;                                      <<01709>>20448000
   CIERR(ERRNUM);                                              <<01709>>20450000
   RETURN;                                                     <<01709>>20452000
   END;                                                        <<01709>>20454000
DELIMITER := NEXT;                                             <<U.RAO>>20456000
IF NUMPARMS=0 THEN  <<MISSING FIRST FILE NAME>>                <<U.RAO>>20458000
   BEGIN                                                       <<U.RAO>>20460000
   ERRNUM := IF RUNCOM THEN ERRNOPROGF                         <<U.RAO>>20462000
      ELSE IF PREPRUNCOM THEN ERRNOPORUF                       <<U.RAO>>20464000
      ELSE ERRNOUSLF;                                          <<U.RAO>>20466000
   CIERR(ERRNUM,PARMSP(1));                                    <<U.RAO>>20468000
   RETURN;                                                     <<U.RAO>>20470000
   END;                                                        <<U.RAO>>20472000
                                                               <<U.RAO>>20474000
<<CHECK FIRST FILE NAME>>                                      <<U.RAO>>20476000
ERRNUM := CHECKFILENAME'(TEMPPARM&LSR(8),DUMMY,DUMMY,LERRPTR');<<02324>>20478000
IF < THEN    <<CCL RETURNED , ERROR IN NAME >>                 <<02324>>20480000
    BEGIN                                                      <<02324>>20482000
    CIERR(ERRNUM,ERRPTR);   <<ERRPTR POINTING AT ERROR LOC. >> <<02324>>20484000
    RETURN;                                                    <<02324>>20486000
    END                                                        <<02324>>20488000
ELSE IF > AND ERRNUM <> 0 AND ERRNUM <> 3 THEN                 <<02324>>20490000
    BEGIN                                                      <<02324>>20492000
    CIERR(ERRNUM := INVALIDSYSDEFFL,TEMPPARMPTR);              <<02324>>20494000
    RETURN;                                                    <<02324>>20496000
    END                                                        <<02324>>20498000
ELSE                                                           <<02324>>20500000
    IF ERRNUM = 3 THEN <<  $OLDPASS IS ALLOWED  >>             <<02324>>20502000
        ERRNUM := 0;                                           <<02324>>20504000
MOVE PROGNAME := PPNTR,(PARMLEN);                              <<U.RAO>>20506000
PROGNAME(PARMLEN) := " ";                                      <<U.RAO>>20508000
                                                               <<U.RAO>>20510000
<<NEXT HANDLE SECOND FILE NAME, IF ANY>>                       <<U.RAO>>20512000
ENTRYNAME := " ";                                              <<U.RAO>>20514000
IF DELIMITER = COMMA THEN  <<ENTRY OR PROGFILE>>               <<U.RAO>>20516000
   BEGIN                                                       <<U.RAO>>20518000
   DELIMITER := NEXT;                                          <<U.RAO>>20520000
   IF PREPCOM THEN  <<CHECK PROGFILE NAME>>                    <<U.RAO>>20522000
      IF CIBADFILENAME(ERRNUM,TEMPPARM) THEN  <<BAD NAME!>>    <<U.RAO>>20524000
         BEGIN                                                 <<U.RAO>>20526000
         PARMNUM := 2;                                         <<U.RAO>>20528000
         RETURN;                                               <<U.RAO>>20530000
         END                                                   <<U.RAO>>20532000
      ELSE                                                     <<U.RAO>>20534000
   ELSE IF PARMLEN>15 THEN  <<ENTRY NAME TOO LONG>>            <<U.RAO>>20536000
      BEGIN                                                    <<U.RAO>>20538000
      CIERR(ERRNUM := ERRENTRYTOOBIG,PPNTR);                   <<U.RAO>>20540000
      PARMNUM := 2;                                            <<U.RAO>>20542000
      RETURN                                                   <<U.RAO>>20544000
      END;                                                     <<U.RAO>>20546000
   MOVE ENTRYNAME := PPNTR,(PARMLEN);                          <<U.RAO>>20548000
   ENTRYNAME(PARMLEN) := " ";                                  <<U.RAO>>20550000
   END                                                         <<U.RAO>>20552000
ELSE IF PREPCOM THEN  <<MISSING REQUIRED PROG FILE>>           <<U.RAO>>20554000
   BEGIN                                                       <<U.RAO>>20556000
   ERRNUM := ERRNOPREPTARGET;                                  <<U.RAO>>20558000
   PARMNUM := 2;                                               <<U.RAO>>20560000
   CIERR(ERRNUM,PPNTR(PARMLEN));                               <<U.RAO>>20562000
   RETURN                                                      <<U.RAO>>20564000
   END;                                                        <<U.RAO>>20566000
                                                               <<U.RAO>>20568000
<<NEXT WE DO A CASE ON THE DELIMITER FOLLOWING THE FILE>>      <<U.RAO>>20570000
<<NAMES.  CARRIAGE RETURN FALLS THROUGH>>                      <<U.RAO>>20572000
CASE DELIMITER OF                                              <<U.RAO>>20574000
   BEGIN                                                       <<U.RAO>>20576000
      BEGIN  <<COMMA, QUITE UNEXPECTED>>                       <<U.RAO>>20578000
         ERRNUM := CMAXPCTSEMIORCR;                            <<U.RAO>>20580000
         CIERR(ERRNUM,PPNTR(PARMLEN));                         <<U.RAO>>20582000
         RETURN;                                               <<U.RAO>>20584000
      END;                                                     <<U.RAO>>20586000
      BEGIN  <<EQUAL SIGN, SIMILARLY UNEXPECTED>>              <<U.RAO>>20588000
         ERRNUM := EQXPCTSEMIORCR;                             <<U.RAO>>20590000
         CIERR(ERRNUM,PPNTR(PARMLEN));                         <<U.RAO>>20592000
         RETURN;                                               <<U.RAO>>20594000
      END;                                                     <<U.RAO>>20596000
      BEGIN  <<SEMICOLON - KEYWORD(S) FOLLOW>>                 <<U.RAO>>20598000
      MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                    <<U.RAO>>20600000
      TOS := FLAGS;                                            <<U.RAO>>20602000
      DO    <<PARSE KEYWORD LIST>>                             <<U.RAO>>20604000
         BEGIN                                                 <<U.RAO>>20606000
         DELIMITER := NEXT;                                    <<U.RAO>>20608000
         IF PARMLEN=0 THEN                                     <<U.RAO>>20610000
               CIERR(-EXTRNDELIMIGNRD,PPNTR(-1))               <<U.RAO>>20612000
            ELSE                                               <<U.RAO>>20614000
               BEGIN   <<KEYWORD PROCESSING>>                  <<U.RAO>>20616000
               CASE SEARCH(PPNTR,PARMLEN,KEYLIST) OF           <<U.RAO>>20618000
                  BEGIN                                        <<U.RAO>>20620000
                                                               <<U.RAO>>20622000
                     <<THE TOMB OF THE UNKNOWN KEYWORD>>       <<U.RAO>>20624000
                  ERRNUM := (IF PREPCOM THEN UNKNOWNKEYPREP    <<U.RAO>>20626000
                     ELSE IF RUNCOM THEN UNKNOWNKEYRUN         <<U.RAO>>20628000
                     ELSE UNKNOWNKEYPRPRN);                    <<U.RAO>>20630000
                                                               <<U.RAO>>20632000
                     <<LIB = SL>>                              <<U.RAO>>20634000
                  CHECKPREPCOM                                 <<U.RAO>>20636000
                  ELSE CHECKEQSIGN                             <<U.RAO>>20638000
                  ELSE                                         <<U.RAO>>20640000
                     BEGIN  <<CHECK THE VALUE>>                <<U.RAO>>20642000
                     DELIMITER := NEXT;                        <<U.RAO>>20644000
                     IF (PARMLEN=1) AND ((PPNTR="G")           <<U.RAO>>20646000
                        OR (PPNTR="P") OR (PPNTR="S")) THEN    <<U.RAO>>20648000
                        BEGIN  <<VALID LIB>>                   <<U.RAO>>20650000
                        LIB := PPNTR;                          <<U.RAO>>20652000
                        ASSEMBLE(TSBC 4);                      <<U.RAO>>20654000
                        END                                    <<U.RAO>>20656000
                     ELSE                                      <<U.RAO>>20658000
                        ERRNUM := INVALIDLIB;                  <<U.RAO>>20660000
                     END;                                      <<U.RAO>>20662000
                                                               <<U.RAO>>20664000
                     <<MAXDATA = SEGSIZE>>                     <<U.RAO>>20666000
                  CHECKEQSIGN                                  <<U.RAO>>20668000
                  ELSE                                         <<U.RAO>>20670000
                     BEGIN                                     <<U.RAO>>20672000
                     DELIMITER := NEXT;                        <<U.RAO>>20674000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>20676000
                        BEGIN                                  <<U.RAO>>20678000
                        MAXDATA := BINARY(PPNTR,PARMLEN);      <<U.RAO>>20680000
                        IF <> THEN                             <<U.RAO>>20682000
                           ERRNUM := INVALIDMAXDATA            <<U.RAO>>20684000
                        ELSE                                   <<U.RAO>>20686000
                           BEGIN                               <<U.RAO>>20688000
                           MAXDATA'OPTION := 1;                <<01200>>20690000
                           ASSEMBLE(TSBC 0);                   <<U.RAO>>20692000
                           END;                                <<U.RAO>>20694000
                        END                                    <<U.RAO>>20696000
                     ELSE                                      <<U.RAO>>20698000
                        ERRNUM := INVALIDMAXDATA;              <<U.RAO>>20700000
                     END;                                      <<U.RAO>>20702000
                                                               <<U.RAO>>20704000
                     <<PARM = PARM>>                           <<U.RAO>>20706000
                  CHECKPREPCOM                                 <<U.RAO>>20708000
                  ELSE CHECKEQSIGN                             <<U.RAO>>20710000
                  ELSE                                         <<U.RAO>>20712000
                     BEGIN                                     <<U.RAO>>20714000
                     DELIMITER := NEXT;                        <<U.RAO>>20716000
                     IF PARMLEN>0 THEN                         <<U.RAO>>20718000
                        BEGIN                                  <<U.RAO>>20720000
                        PARM := BINARY(PPNTR,PARMLEN);         <<U.RAO>>20722000
                        IF <> THEN                             <<U.RAO>>20724000
                           ERRNUM := INVALIDPARM               <<U.RAO>>20726000
                        ELSE                                   <<U.RAO>>20728000
                           ASSEMBLE(TSBC 1);                   <<U.RAO>>20730000
                        END                                    <<U.RAO>>20732000
                     ELSE                                      <<U.RAO>>20734000
                        ERRNUM := INVALIDPARM;                 <<U.RAO>>20736000
                     END;                                      <<U.RAO>>20738000
                                                               <<U.RAO>>20740000
                     <<PMAP>>                                  <<U.RAO>>20742000
                  CHECKRUNCOM ELSE ASSEMBLE(TSBC 6);           <<U.RAO>>20744000
                                                               <<U.RAO>>20746000
                     <<DEBUG>>                                 <<U.RAO>>20748000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 13);         <<U.RAO>>20750000
                                                               <<U.RAO>>20752000
                     <<STACK = STACKSIZE>>                     <<U.RAO>>20754000
                  CHECKEQSIGN                                  <<U.RAO>>20756000
                  ELSE                                         <<U.RAO>>20758000
                     BEGIN                                     <<U.RAO>>20760000
                     DELIMITER := NEXT;                        <<U.RAO>>20762000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>20764000
                        BEGIN                                  <<U.RAO>>20766000
                        STACKSIZE := BINARY(PPNTR,PARMLEN);    <<U.RAO>>20768000
                        IF <> OR (STACKSIZE<511) THEN          <<U.RAO>>20770000
                           ERRNUM := INVALIDSTAKSIZE           <<U.RAO>>20772000
                        ELSE                                   <<U.RAO>>20774000
                           BEGIN                               <<U.RAO>>20776000
                           STACK'OPTION := 1;                  <<01200>>20778000
                           ASSEMBLE(TSBC 2);                   <<U.RAO>>20780000
                           END                                 <<U.RAO>>20782000
                        END                                    <<U.RAO>>20784000
                     ELSE                                      <<U.RAO>>20786000
                        ERRNUM := INVALIDSTAKSIZE;             <<U.RAO>>20788000
                  END;                                         <<U.RAO>>20790000
                                                               <<U.RAO>>20792000
                     <<RL = FILENAME>>                         <<U.RAO>>20794000
                  CHECKRUNCOM                                  <<U.RAO>>20796000
                  ELSE CHECKEQSIGN                             <<U.RAO>>20798000
                  ELSE                                         <<U.RAO>>20800000
                     BEGIN                                     <<U.RAO>>20802000
                     DELIMITER := NEXT;                        <<U.RAO>>20804000
                     TOS := CHECKFILENAME'(TEMPPARM&LSR(8),    <<U.RAO>>20806000
                        MAXPARAM,MAXPARAM,ERR);                <<U.RAO>>20808000
                     IF >= THEN                                <<U.RAO>>20810000
                        BEGIN                                  <<U.RAO>>20812000
                        DEL;                                   <<U.RAO>>20814000
                        @RL := @PPNTR;                         <<U.RAO>>20816000
                        ASSEMBLE(TSBC 8)                       <<U.RAO>>20818000
                        END                                    <<U.RAO>>20820000
                     ELSE  <<CORRECT CARET PTR FOR CIERR>>     <<U.RAO>>20822000
                        BEGIN                                  <<U.RAO>>20824000
                        @PPNTR := ERR;                         <<U.RAO>>20826000
                        ERRNUM := TOS;                         <<U.RAO>>20828000
                        END;                                   <<U.RAO>>20830000
                     END;                                      <<U.RAO>>20832000
                                                               <<U.RAO>>20834000
                     <<LMAP>>                                  <<U.RAO>>20836000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 14);         <<U.RAO>>20838000
                                                               <<U.RAO>>20840000
                     <<DL = DLSIZE>>                           <<U.RAO>>20842000
                  CHECKEQSIGN                                  <<U.RAO>>20844000
                  ELSE                                         <<U.RAO>>20846000
                     BEGIN                                     <<U.RAO>>20848000
                     DELIMITER := NEXT;                        <<U.RAO>>20850000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>20852000
                        BEGIN                                  <<U.RAO>>20854000
                        DLSIZE := BINARY(PPNTR,PARMLEN);       <<U.RAO>>20856000
                        IF <> THEN                             <<U.RAO>>20858000
                           ERRNUM := INVALIDDLSIZE             <<U.RAO>>20860000
                        ELSE                                   <<U.RAO>>20862000
                           BEGIN                               <<U.RAO>>20864000
                           DL'OPTION := 1;                     <<01200>>20866000
                           ASSEMBLE(TSBC 3);                   <<U.RAO>>20868000
                           END                                 <<U.RAO>>20870000
                        END                                    <<U.RAO>>20872000
                     ELSE                                      <<U.RAO>>20874000
                        ERRNUM := INVALIDDLSIZE;               <<U.RAO>>20876000
                     END;                                      <<U.RAO>>20878000
                                                               <<U.RAO>>20880000
                     <<ZERODB>>                                <<U.RAO>>20882000
                  CHECKRUNCOM ELSE ASSEMBLE(TSBC 11);          <<U.RAO>>20884000
                                                               <<U.RAO>>20886000
                     <<NOPRIV>>                                <<U.RAO>>20888000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 12);         <<U.RAO>>20890000
                                                               <<U.RAO>>20892000
                     <<NOCB>>                                  <<U.RAO>>20894000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 9);          <<U.RAO>>20896000
                                                               <<U.RAO>>20898000
                     <<CAP>>                                   <<U.RAO>>20900000
                  CHECKRUNCOM                                  <<U.RAO>>20902000
                  ELSE CHECKEQSIGN                             <<U.RAO>>20904000
                  ELSE                                         <<U.RAO>>20906000
                     BEGIN                                     <<U.RAO>>20908000
                     MOVE CAPLIST := PCAPLIST,(PCAPLISTL);     <<U.RAO>>20910000
                     TOS := 0;  <<FUTURE CAPABILITIES WORD>>   <<U.RAO>>20912000
                     DO BEGIN                                  <<U.RAO>>20914000
                        DELIMITER := NEXT;                     <<U.RAO>>20916000
                        IF PARMLEN = 0 THEN                    <<U.RAO>>20918000
                           ERRNUM := MISSINGCAP                <<U.RAO>>20920000
                        ELSE                                   <<U.RAO>>20922000
                           CASE SEARCH(PPNTR,PARMLEN,CAPLIST)OF<<U.RAO>>20924000
                              BEGIN                            <<U.RAO>>20926000
                              BEGIN ERRNUM := UNKNOWNCAP;      <<U.RAO>>20928000
                                 @PPNTR:=@PPNTR-1;END;         <<U.RAO>>20930000
                              ASSEMBLE(TSBC 15);  <<PH>>       <<U.RAO>>20932000
                              ASSEMBLE(TSBC 14);  <<DS>>       <<U.RAO>>20934000
                              ASSEMBLE(TSBC 12);  <<MR>>       <<U.RAO>>20936000
                              ASSEMBLE(TSBC 9);   <<PM>>       <<U.RAO>>20938000
                              ASSEMBLE(TSBC 8);   <<IA>>       <<U.RAO>>20940000
                              ASSEMBLE(TSBC 7);   <<BA>>       <<U.RAO>>20942000
                              END;                             <<U.RAO>>20944000
                        END                                    <<U.RAO>>20946000
                           UNTIL (DELIMITER <> COMMA) OR       <<U.RAO>>20948000
                              (ERRNUM <> 0);                   <<U.RAO>>20950000
                     CAPWORD := TOS;                           <<U.RAO>>20952000
                     IF (CAPWORD.(7:2)=0) AND (ERRNUM=0) THEN <<*alt*>> 20954000
                        BEGIN                                  <<04172>>20956000
                        WHO(,DUSERCAP);                        <<04172>>20958000
                        CAPWORD.(7:2) := USERCAP.(7:2);        <<04172>>20960000
                        CASE USERCAP.(7:2) OF                  <<04172>>20962000
                           BEGIN                               <<04172>>20964000
                           ;                                   <<04172>>20966000
                           CIERR(-IMPIABA,,0,@IA&LSL(1));      <<04172>>20968000
                           CIERR(-IMPIABA,,0,@BA&LSL(1));      <<04172>>20970000
                           CIERR(-IMPIABA,,0,@IB&LSL(1));      <<04172>>20972000
                           END;                                <<04172>>20974000
                        END;                                   <<04172>>20976000
                     ASSEMBLE(TSBC 7);                         <<U.RAO>>20978000
                     END;                                      <<U.RAO>>20980000
                                                               <<00629>>20982000
                     <<PATCH = PATCHSIZE>>                     <<00629>>20984000
                  CHECKRUNCOM                                  <<00629>>20986000
                  ELSE CHECKEQSIGN                             <<00629>>20988000
                  ELSE                                         <<00629>>20990000
                     BEGIN                                     <<00629>>20992000
                     DELIMITER := NEXT;                        <<00629>>20994000
                     IF PARMLEN > 0 THEN                       <<00629>>20996000
                        BEGIN                                  <<00629>>20998000
                        PATCHSIZE := BINARY(PPNTR,PARMLEN);    <<00629>>21000000
                        IF <> THEN                             <<00629>>21002000
                           ERRNUM := INVALIDPATCH              <<00629>>21004000
                        ELSE                                   <<00629>>21006000
                           BEGIN                               <<00629>>21008000
                           IF NOT(-1<= PATCHSIZE <=16380) THEN <<00629>>21010000
                              ERRNUM := INVALIDPATCH;          <<00629>>21012000
                           ASSEMBLE(TSBC 5);                   <<00629>>21014000
                           END;                                <<00629>>21016000
                        END                                    <<00629>>21018000
                     ELSE                                      <<00629>>21020000
                        ERRNUM := INVALIDPATCH;                <<00629>>21022000
                     END;                                      <<00629>>21024000
                                                               <<00629>>21026000
                     << STDIN = FILE >>                        <<01200>>21028000
                  CHECKPREPCOM                                 <<01200>>21030000
                  ELSE CHECKEQSIGN                             <<01200>>21032000
                  ELSE                                         <<01200>>21034000
                     BEGIN                                     <<01200>>21036000
                     STDIN'OPTION := 0;                        <<01200>>21038000
                     DELIMITER := NEXT;                        <<01200>>21040000
                     IF PARMLEN > 0 THEN                       <<01200>>21042000
                        BEGIN  << STDIN REALLY SPECIFIED >>    <<01200>>21044000
                        STDIN'OPTION := 1;                     <<01200>>21046000
                        TOS := CHECKFILENAME'(TEMPPARM&LSR(8), <<01200>>21048000
                                              MAXPARAM,        <<01200>>21050000
                                              MAXPARAM,        <<01200>>21052000
                                              ERR);            <<01200>>21054000
                        IF = THEN                              <<01200>>21056000
                           BEGIN  << SIMPLE FILE NAME >>       <<01200>>21058000
                           DEL;   << RETURN VALUE >>           <<01200>>21060000
                           MOVE STDIN := PPNTR,(PARMLEN),2;    <<01200>>21062000
                           MOVE * := ",OLD";                   <<01200>>21064000
                           STDIN(PARMLEN+4) := C'CR;           <<01200>>21066000
                           END                                 <<01200>>21068000
                        ELSE IF > THEN                         <<01200>>21070000
                           BEGIN  << SPECIAL FILE >>           <<01200>>21072000
                           IF S0 = 0 OR S0 = 6 THEN            <<01200>>21074000
                              BEGIN  << BACKREF OR $NULL >>    <<01200>>21076000
                              DEL;   << RETURN VALUE >>        <<01200>>21078000
                              MOVE STDIN := PPNTR,(PARMLEN);   <<01200>>21080000
                              STDIN(PARMLEN) := C'CR;          <<01200>>21082000
                              END                              <<01200>>21084000
                           ELSE                                <<01200>>21086000
                              BEGIN  << NOT BACKREF/$NULL >>   <<01200>>21088000
                              DEL;   << RETURN VALUE >>        <<01200>>21090000
                              ERRNUM := INVALIDSTDIN;          <<01200>>21092000
                              END;                             <<01200>>21094000
                           END                                 <<01200>>21096000
                        ELSE                                   <<01200>>21098000
                           BEGIN  << BAD FILE NAME >>          <<01200>>21100000
                           @PPNTR := ERR;                      <<01200>>21102000
                           ERRNUM := TOS;                      <<01200>>21104000
                           END;                                <<01200>>21106000
                        END;                                   <<01200>>21108000
                     TOS := FLAGS'EXT1;                        <<01200>>21110000
                     ASSEMBLE (TSBC 15);                       <<01200>>21112000
                     FLAGS'EXT1 := TOS;                        <<01200>>21114000
                     END << STDIN = FILENAME >>;               <<01200>>21116000
                                                               <<01200>>21118000
                     << STDLIST = FILE >>                      <<01200>>21120000
                  CHECKPREPCOM                                 <<01200>>21122000
                  ELSE CHECKEQSIGN                             <<01200>>21124000
                  ELSE                                         <<01200>>21126000
                     BEGIN                                     <<01200>>21128000
                     STDLIST'OPTION := 0;                      <<01200>>21130000
                     DELIMITER := NEXT;                        <<01200>>21132000
                     IF PARMLEN > 0 THEN                       <<01200>>21134000
                        BEGIN  << STDLIST REALLY SPECIFIED >>  <<01200>>21136000
                        STDLIST'OPTION := 1;                   <<01200>>21138000
                        TOS := CHECKFILENAME'(TEMPPARM&LSR(8), <<01200>>21140000
                                              MAXPARAM,        <<01200>>21142000
                                              MAXPARAM,        <<01200>>21144000
                                              ERR);            <<01200>>21146000
                        IF < THEN                              <<01200>>21148000
                           BEGIN  << BAD FILE NAME >>          <<01200>>21150000
                           @PPNTR := ERR;                      <<01200>>21152000
                           ERRNUM := TOS;                      <<01200>>21154000
                           END                                 <<01200>>21156000
                        ELSE IF > THEN                         <<01200>>21158000
                           BEGIN  << SPECIAL FILE >>           <<01200>>21160000
                           IF S0 = 0 OR S0 = 6 THEN            <<01200>>21162000
                              BEGIN  << BACKREF OR $NULL >>    <<01200>>21164000
                              DEL;   << RETURN VALUE >>        <<01200>>21166000
                              MOVE STDLIST := PPNTR,(PARMLEN); <<01200>>21168000
                              STDLIST(PARMLEN) := C'CR;        <<01200>>21170000
                              END                              <<01200>>21172000
                           ELSE                                <<01200>>21174000
                              BEGIN  << NOT BACKREF/$NULL >>   <<01200>>21176000
                              DEL;   << RETURN VALUE >>        <<01200>>21178000
                              ERRNUM := INVALIDSTDLIST;        <<01200>>21180000
                              END;                             <<01200>>21182000
                           END                                 <<01200>>21184000
                        ELSE                                   <<01200>>21186000
                           BEGIN  << SIMPLE FILE NAME >>       <<01200>>21188000
                           DEL;   << RETURN VALUE >>           <<01200>>21190000
                           MOVE STDLIST := PPNTR,(PARMLEN),2;  <<01200>>21192000
                           IF DELIMITER <> COMMA THEN          <<01200>>21194000
                              BEGIN  << MUST BE OLD FILE >>    <<01200>>21196000
                              MOVE * := ",OLD";                <<01200>>21198000
                              STDLIST(PARMLEN+4) := C'CR;      <<01200>>21200000
                              END                              <<01200>>21202000
                           ELSE                                <<01200>>21204000
                              BEGIN  << POSSIBLY NEW FILE >>   <<01200>>21206000
                              NAMELEN := PARMLEN;              <<01200>>21208000
                              DELIMITER := NEXT;               <<01200>>21210000
                              CHECKNEW                         <<01200>>21212000
                              ELSE                             <<01200>>21214000
                                 BEGIN  << A NEW FILE >>       <<01200>>21216000
                                 MOVE * := (",NEW;REC=-132",   <<01200>>21218000
                                            ",,F,ASCII;",      <<01200>>21220000
                                            "ACC=OUT;TEMP");   <<01200>>21222000
                                 STDLIST(NAMELEN+35) := C'CR;  <<01200>>21224000
                                 END;                          <<01200>>21226000
                              END;                             <<01200>>21228000
                           END << VALID FILE NAME >>;          <<01200>>21230000
                        END << $STDLIST SPECIFIED >>;          <<01200>>21232000
                     TOS := FLAGS'EXT1;                        <<01200>>21234000
                     ASSEMBLE (TSBC 14);                       <<01200>>21236000
                     FLAGS'EXT1 := TOS;                        <<01200>>21238000
                     END << STDLIST = FILE >>;                 <<01200>>21240000
                                                               <<01200>>21242000
                     << INFO = STRING >>                       <<01200>>21244000
                  CHECKPREPCOM                                 <<01200>>21246000
                  ELSE CHECKEQSIGN                             <<01200>>21248000
                  ELSE                                         <<01200>>21250000
                     BEGIN                                     <<01200>>21252000
                     DELIMITER := NEXT;                        <<01200>>21254000
                     IF PPNTR<>C'QUOTE AND PPNTR<>C'DQUOTE     <<01200>>21256000
                        THEN ERRNUM := EXPCTQUOTE              <<01200>>21258000
                     ELSE                                      <<01200>>21260000
                        BEGIN                                  <<01200>>21262000
                        STRING'OPTION := 1;                    <<01200>>21264000
                        QUOTECHAR := PPNTR;                    <<01200>>21266000
                        X := @PPNTR - @BCOMIMAGE + 1;          <<01426>>21268000
                        @SPTR := @SAVEDCOMIMAGE(X);            <<01426>>21270000
                        T'IX := S'IX := -1;                    <<01200>>21272000
                        DO                                     <<01200>>21274000
                           BEGIN                               <<01200>>21276000
                           WHILE SPTR(S'IX:=S'IX+1)<>QUOTECHAR <<01200>>21278000
                               AND INTEGER(SPTR(S'IX))<>C'CR DO<<01200>>21280000
                              BEGIN                            <<01200>>21282000
                              IF DELIM(SPTR(S'IX)) THEN        <<01200>>21284000
                                 DELIMITER := NEXT;            <<01200>>21286000
                              STRING(T'IX:=T'IX+1):=SPTR(S'IX);<<01200>>21288000
                              END;                             <<01200>>21290000
                           IF SPTR(S'IX) = C'CR THEN           <<01200>>21292000
                              BEGIN                            <<01200>>21294000
                              << FORCE PTR TO END OF STRING >> <<01200>>21296000
                              @PPNTR := @PPNTR(PARMLEN);       <<01200>>21298000
                              ERRNUM := EXPCTCLOSEQUOTE;       <<01200>>21300000
                              STOP := TRUE;                    <<01200>>21302000
                              END                              <<01200>>21304000
                           ELSE IF SPTR(S'IX:=S'IX+1)=QUOTECHAR<<01709>>21306000
                              THEN STRING(T'IX:=T'IX+1):=      <<01709>>21308000
                                      QUOTECHAR                <<01709>>21310000
                           ELSE                                <<01709>>21312000
                              BEGIN  << SHOULD BE END OF STR >><<01709>>21314000
                              STOP := TRUE;                    <<01709>>21316000
                              << MAKE SURE THERE'S NOTHING  >> <<01709>>21318000
                              << BETWEEN QUOTE & DELIMITER  >> <<01709>>21320000
                              TOS := "  ";                     <<01709>>21322000
                              TOS.(0:8) := DELIM'CHAR;         <<01709>>21324000
                              SCAN SPTR(S'IX) WHILE *;         <<01709>>21326000
                              IF NOCARRY THEN                  <<01709>>21328000
                                 BEGIN  <<SOMETHING UNEXPCTD>> <<01709>>21330000
                                 ERRNUM := XPCTSEMIORCR;       <<01709>>21332000
                                 @PPNTR := @PPNTR(S'IX+1);     <<01709>>21334000
                                 END;                          <<01709>>21336000
                              END;                             <<01709>>21338000
                           END                                 <<01200>>21340000
                              UNTIL STOP;                      <<01200>>21342000
                        T'IX := T'IX + 1;                      <<01200>>21344000
                        IF T'IX > 253 AND ERRNUM = 0 THEN      <<01709>>21346000
                           ERRNUM := STRINGTOOBIG;             <<01709>>21348000
                        END;                                   <<01200>>21350000
                     TOS := FLAGS'EXT1;                        <<01200>>21352000
                     ASSEMBLE (TSBC 13);                       <<01200>>21354000
                     FLAGS'EXT1 := TOS;                        <<01200>>21356000
                     END << INFO = STRING >>;                  <<01200>>21358000
                     <<NOSYM>>                                 <<04103>>21360000
                  CHECKRUNCOM                                  <<04103>>21362000
                  ELSE                                         <<04103>>21364000
                     BEGIN                                     <<04103>>21366000
                     TOS := FLAGS'EXT1;                        <<04103>>21368000
                     ASSEMBLE (TSBC 12);                       <<04103>>21370000
                     FLAGS'EXT1 := TOS;                        <<04103>>21372000
                     END;                                      <<04103>>21374000
                                                               <<04103>>21376000
   <<**********   FPMAP   ******************>>                 <<04103>>21378000
                  CHECKRUNCOM                                  <<04103>>21380000
                  ELSE                                         <<04103>>21382000
                     BEGIN                                     <<04103>>21384000
                     TOS := FLAGS'EXT1;                        <<04103>>21386000
                     ASSEMBLE (TSBC 11);                       <<04103>>21388000
                     FLAGS'EXT1 := TOS;                        <<04103>>21390000
                     END;                                      <<04103>>21392000
    <<*********   NOFPMAP  *****************>>                 <<04103>>21394000
                  CHECKRUNCOM                                  <<04103>>21396000
                  ELSE                                         <<04103>>21398000
                     BEGIN                                     <<04103>>21400000
                     TOS := FLAGS'EXT1;                        <<04103>>21402000
                     ASSEMBLE (TSBC 10);                       <<04103>>21404000
                     FLAGS'EXT1 := TOS;                        <<04103>>21406000
                     END;                                      <<04103>>21408000
     <<**********  CHECKSUM   **************>>                 <<04103>>21410000
                  CHECKRUNCOM                                  <<04103>>21412000
                  ELSE                                         <<04103>>21414000
                     BEGIN                                     <<04103>>21416000
                     TOS := FLAGS'EXT1;                        <<04103>>21418000
                     ASSEMBLE (TSBC 9 );                       <<04103>>21420000
                     FLAGS'EXT1 := TOS;                        <<04103>>21422000
                     END;    <<CHECKSUM>>                      <<04103>>21424000
                  END;  <<OF CASE ON KEYWORDS>>                <<U.RAO>>21426000
               IF <> AND (ERRNUM=0) THEN                       <<U.RAO>>21428000
                  BEGIN                                        <<U.RAO>>21430000
                  TOS:=-WARNDUPLKEY;                           <<U.RAO>>21432000
                  TOS:=PARMS(PARMNUM-2);                       <<U.RAO>>21434000
                  IF TOS.(14:2)<>EQUALSIGN THEN                <<U.RAO>>21436000
                     BEGIN                                     <<U.RAO>>21438000
                     DEL;                                      <<U.RAO>>21440000
                     TOS := @PPNTR;                            <<U.RAO>>21442000
                     END;                                      <<U.RAO>>21444000
                  CIERR(*,*);                                  <<U.RAO>>21446000
                  END;                                         <<U.RAO>>21448000
               IF ERRNUM <> 0 THEN                             <<U.RAO>>21450000
                  BEGIN                                        <<U.RAO>>21452000
                  CIERR(ERRNUM,PPNTR);                         <<U.RAO>>21454000
                  RETURN                                       <<U.RAO>>21456000
                  END;                                         <<U.RAO>>21458000
               END                                             <<U.RAO>>21460000
            END                                                <<U.RAO>>21462000
               UNTIL DELIMITER <> SEMICOLON;                   <<U.RAO>>21464000
                                                               <<U.RAO>>21466000
         <<NOW CLEANUP AFTER KEYWORD PROCESSING>>              <<U.RAO>>21468000
         FLAGS := TOS;                                         <<U.RAO>>21470000
         IF DELIMITER <> CR THEN                               <<U.RAO>>21472000
            BEGIN                                              <<U.RAO>>21474000
            IF DELIMITER = COMMA THEN                          <<U.RAO>>21476000
               ERRNUM := CMAXPCTSEMIORCR                       <<U.RAO>>21478000
            ELSE                                               <<U.RAO>>21480000
               ERRNUM := EQXPCTSEMIORCR;                       <<U.RAO>>21482000
            CIERR(ERRNUM,PPNTR(PARMLEN));                      <<01426>>21484000
            RETURN                                             <<U.RAO>>21486000
            END;                                               <<U.RAO>>21488000
         END;  <<KEYWORD PROCESSING>>                          <<U.RAO>>21490000
      END;  <<CASE ON DELIMITERS>>                             <<U.RAO>>21492000
                                                               <<U.RAO>>21494000
                                                               <<U.RAO>>21496000
<<THE COMMAND HAS NOW BEEN ENTIRELY PARSED.  IT SIMPLY >>      <<U.RAO>>21498000
<<REMAINS TO EXECUTE IT IF POSSIBLE>>                          <<U.RAO>>21500000
                                                               <<00830>>21502000
IF PREPRUNCOM THEN  <<ESTABLISH PASSED FILE AS PROG FILE>>     <<U.RAO>>21504000
   MOVE TFILENAME := "$NEWPASS "                               <<U.RAO>>21506000
ELSE IF PREPCOM THEN                                           <<U.RAO>>21508000
   @TFILENAME := @ENTRYNAME;                                   <<U.RAO>>21510000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>21512000
IF NOT RUNCOM THEN  <<DO PREP STAGE>>                          <<U.RAO>>21514000
   BEGIN                                                       <<U.RAO>>21516000
   IF FLAGS'EXT1.(10:2) = 3 THEN <<FPMAP/NOFPMAP BOTH >>       <<04103>>21518000
   BEGIN                         <<HAVE BEEN SPECIFIED >>      <<04103>>21520000
      ERRNUM := BOTHFPMAPNOFPMAP;                              <<04103>>21522000
      CIERR(ERRNUM,PPNTR(PARMLEN));                            <<04103>>21524000
      RETURN;                                                  <<04103>>21526000
   END;                                                        <<04103>>21528000
   PFLAGS := FLAGS.(6:1); <<PMAP>>                             <<U.RAO>>21530000
   PFLAGS.(14:1) := FLAGS.(11:1);  <<ZERODB>>                  <<U.RAO>>21532000
   PFLAGS.(9:1) := FLAGS'EXT1.(12:1); <<NOSYM>>                <<04103>>21534000
   PFLAGS.(8:1) := FLAGS'EXT1.(11:1);  << FPMAP >>             <<04103>>21536000
   PFLAGS.(7:1) := FLAGS'EXT1.(10:1);  << NOFPMAP >>           <<04103>>21538000
   PFLAGS.(6:1) := FLAGS'EXT1.(9:1);   <<CHECKSUM >>           <<04103>>21540000
   ERR := 0;  <<REINITIALIZE>>                                 <<U.RAO>>21544000
   SEGMENTER(PIN,22,ERR,,,,,,,,,PROGNAME); <<CREATE SEGMENTER>><<00629>>21546000
   CHECKSEGERR;                                                <<U.RAO>>21548000
   SEGMENTER(PIN,14,ERR,STACKSIZE,DLSIZE,PFLAGS,MAXDATA,       <<00629>>21550000
      CAPWORD,PATCHSIZE,,,TFILENAME,RL);                       <<00629>>21552000
   CHECKSEGERR;                                                <<U.RAO>>21554000
   SEGMENTER(PIN,8,ERR);  <<EXIT>>                             <<U.RAO>>21556000
   IF PREPCOM THEN   <<JUST A PREPARE, EXIT>>                  <<U.RAO>>21558000
      BEGIN                                                    <<U.RAO>>21560000
      CISUBSYSFINISH(2, ERRNUM, PARMNUM);                      <<U.RAO>>21562000
      RETURN                                                   <<U.RAO>>21564000
      END;                                                     <<U.RAO>>21566000
                                                               <<U.RAO>>21568000
   <<NOW CLEAN UP AFTER SEGMENTER>>                            <<U.RAO>>21570000
   IF NOT CISUBSYSFINISH(2, ERRNUM, PARMNUM) THEN              <<U.RAO>>21572000
      RETURN;                                                  <<U.RAO>>21574000
   MOVE TFILENAME := "$OLD";                                   <<U.RAO>>21576000
   @PROGNAME := @TFILENAME;                                    <<U.RAO>>21578000
   END;  <<OF PREPARE PHASE>>                                  <<U.RAO>>21580000
                                                               <<U.RAO>>21582000
<<NOW DO RUN PHASE>>                                           <<U.RAO>>21584000
FLAGS := FLAGS LAND %117;  <<ELIMINATE PREP FLAGS>>            <<U.RAO>>21586000
IF LIB="P" THEN FLAGS.(11:1):=1                                <<U.RAO>>21588000
ELSE IF LIB="G" THEN FLAGS.(10:1):=1;                          <<U.RAO>>21590000
TOS := TOS+0;  <<CLEAR CARRY>>                                 <<U.RAO>>21592000
<< SET UP TO CREATE THE NEW PROCESS TO RUN THE PROGRAM >>      <<01200>>21594000
OPTNNUMS(0) := 1;   OPTNS(0) := @ENTRYNAME;                    <<01200>>21596000
OPTNNUMS(1) := 2;   OPTNS(1) := PARM;                          <<01200>>21598000
OPTNNUMS(2) := 3;   OPTNS(2) := FLAGS;                         <<01200>>21600000
X := 3;                                                        <<01200>>21602000
IF STACK'OPTION THEN                                           <<01200>>21604000
   BEGIN  << STACKSIZE WAS SPECIFIED >>                        <<01200>>21606000
   OPTNNUMS(X) := 4;   OPTNS(X) := STACKSIZE;                  <<01200>>21608000
   X := X + 1;                                                 <<01200>>21610000
   END;                                                        <<01200>>21612000
IF DL'OPTION THEN                                              <<01200>>21614000
   BEGIN  << DLSIZE WAS SPECIFIED >>                           <<01200>>21616000
   OPTNNUMS(X) := 5;   OPTNS(X) := DLSIZE;                     <<01200>>21618000
   X := X + 1;                                                 <<01200>>21620000
   END;                                                        <<01200>>21622000
IF MAXDATA'OPTION THEN                                         <<01200>>21624000
   BEGIN  << MAXDATA WAS SPECIFIED >>                          <<01200>>21626000
   OPTNNUMS(X) := 6;   OPTNS(X) := MAXDATA;                    <<01200>>21628000
   X := X + 1;                                                 <<01200>>21630000
   END;                                                        <<01200>>21632000
IF STDIN'OPTION THEN                                           <<01200>>21634000
   BEGIN  << STDIN WAS SPECIFIED >>                            <<01200>>21636000
   OPTNNUMS(X) := 8;   OPTNS(X) := @STDIN;                     <<01200>>21638000
   X := X + 1;                                                 <<01200>>21640000
   END;                                                        <<01200>>21642000
IF STDLIST'OPTION THEN                                         <<01200>>21644000
   BEGIN  << STDLIST WAS SPECIFIED >>                          <<01200>>21646000
   OPTNNUMS(X) := 9;   OPTNS(X) := @STDLIST;                   <<01200>>21648000
   X := X + 1;                                                 <<01200>>21650000
   END;                                                        <<01200>>21652000
IF STRING'OPTION THEN                                          <<01200>>21654000
   BEGIN  << A STRING TO PASS WAS SPECIFIED >>                 <<01200>>21656000
   OPTNNUMS(X) := 11;   OPTNS(X) := @STRING;                   <<01200>>21658000
   X := X + 1;                                                 <<01200>>21660000
   OPTNNUMS(X) := 12;   OPTNS(X) := T'IX;                      <<01200>>21662000
   X := X + 1;                                                 <<01200>>21664000
   END;                                                        <<01200>>21666000
OPTNNUMS(X) := 0;     << END OF OPTION LIST >>                 <<01200>>21668000
                                                               <<01200>>21670000
CREATEPROCESS (ERROR, PIN, PROGNAME, OPTNNUMS, OPTNS);         <<01200>>21672000
                                                               <<01452>>21674000
IF < THEN                                                      <<01452>>21676000
   BEGIN  << PROCESS CREATION FAILED - DETERMINE WHY >>        <<01452>>21678000
   IF ERROR = UNKNOWN'PROG THEN                                <<01452>>21680000
      BEGIN  << NON-EXISTENT PROGRAM FILE >>                   <<01452>>21682000
      QUALIFYFILENAME (PROGNAME, FULLFILENAME);                <<01452>>21684000
      ERRNUM := NOSUCHPROGFILE;                                <<01452>>21686000
      PARMNUM := 1;                                            <<01452>>21688000
      TOS := ERRNUM;                                           <<01452>>21690000
      TOS := IPARMS;                                           <<01452>>21692000
      CIERR (*, *, 0, @FULLFILENAME);                          <<01452>>21694000
      END                                                      <<01452>>21696000
   ELSE                                                        <<01452>>21698000
      IF NOT CREATEPROC'ERR( ERROR, ERRNUM )  THEN             <<01452>>21700000
         CIERR( ERRNUM := PRPRNNOLOAD );                       <<01452>>21702000
   END                                                         <<01452>>21704000
ELSE                                                           <<01452>>21706000
   BEGIN  << PROCESS CREATION SUCCEEDED >>                     <<01452>>21708000
                                                               <<01452>>21710000
   << CHECK FOR CREATEPROCESS WARNING. >>                      <<01452>>21712000
   IF > THEN CREATEPROC'ERR( -ERROR, ERRNUM );                 <<01452>>21714000
                                                               <<01452>>21716000
   NEXTLINE;                                                   <<01452>>21718000
   AWAKE (PIN * PCBSIZE, FATHERWAIT, SONWAIT);                 <<01452>>21720000
                                                               <<01452>>21722000
   CISUBSYSFINISH (1, ERRNUM, PARMNUM);                        <<01452>>21724000
   END;                                                        <<01452>>21726000
END;                                                           <<U.RAO>>21728000
$CONTROL SEGMENT = CISUBS                                      <<U.RAO>>21730000
      PROCEDURE CXSEGMENTER EXECUTORHEAD;                               21732000
      OPTION PRIVILEGED, UNCALLABLE;                                    21734000
      BEGIN                                                             21736000
      COMMENT                                                           21738000
      CXSEGMENTER IS THE EXECUTOR FOR THE SEGMENTER &EDITOR COMMANDS    21740000
      ;                                                                 21742000
      ENTRY CXEDITOR;                                                   21744000
      ENTRY CXVINIT;                                           <<RH.PV>>21746000
      BYTE ARRAY PROG(0:14),LISTFILE(0:7);                     <<U.RAO>>21748000
      LOGICAL PIN;                                             <<U.RAO>>21750000
      INTEGER NUMPARMS,FLAG:=0;                                <<U.RAO>>21752000
      DOUBLE DDL:=[8/";",8/",",8/%15,8/0]D;                    <<U.RAO>>21754000
      BYTE ARRAY DL(*)=DDL;                                    <<U.RAO>>21756000
      DOUBLE PARMS;                                            <<U.RAO>>21758000
      BYTE POINTER PPNTR=PARMS;                                <<U.RAO>>21760000
      BYTE SL=PARMS+1;                                         <<U.RAO>>21762000
      INTEGER PARMWORD2=PARMS+1;                               <<U.RAO>>21764000
      LOGICAL SEGFLAG := FALSE;                                <<U.RAO>>21766000
                                                               <<U.RAO>>21768000
      MOVE LISTFILE:="SEGLIST ";                               <<U.RAO>>21770000
      MOVE PROG:="SEGDVR.PUB.SYS ";                            <<U.RAO>>21772000
      SEGFLAG := TRUE;                                         <<U.RAO>>21774000
      GO TO PROCESS;                                           <<U.RAO>>21776000
CXVINIT:   <<PVINIT EXECUTOR>>                                 <<RH.PV>>21778000
      MOVE LISTFILE := "VINLIST ";                             <<RH.PV>>21780000
      MOVE PROG := "PVINIT.PUB.SYS ";                          <<RH.PV>>21782000
      GO TO PROCESS;                                           <<RH.PV>>21784000
CXEDITOR:                                                      <<U.RAO>>21786000
      MOVE LISTFILE:="EDTLIST ";                               <<U.RAO>>21788000
      MOVE PROG:="EDITOR.PUB.SYS ";                            <<U.RAO>>21790000
PROCESS:                                                       <<U.RAO>>21792000
      MYCOMMAND(PARMSP,DL,1,NUMPARMS,PARMS);<<CHECK COMMAND>>  <<U.RAO>>21794000
      IF <> THEN  <<BEGIN -- TOO MANY PARAMETERS>>             <<U.RAO>>21796000
         BEGIN                                                 <<U.RAO>>21798000
         ERRNUM := ERR2MPLISTONLY;  <<ONLY LIST FILE ALLOWED>> <<U.RAO>>21800000
         PARMNUM := 2;                                         <<U.RAO>>21802000
         TOS := ERRNUM;                                        <<U.RAO>>21804000
         TOS := @PPNTR(SL);  <<POINT TO DELIMITER>>            <<U.RAO>>21806000
         TOS := DL(PARMWORD2.(14:2));  <<GET DELIMITER>>       <<U.RAO>>21808000
         SCAN * UNTIL *,1;                                     <<U.RAO>>21810000
         TOS := TOS+1;                                         <<U.RAO>>21812000
         CIERR(*,*);                                           <<U.RAO>>21814000
         RETURN;                                               <<U.RAO>>21816000
         END;                                                  <<U.RAO>>21818000
      IF NUMPARMS <> 0 THEN                                    <<U.RAO>>21820000
         BEGIN<<PARAMETERS INPUTTED>>                          <<U.RAO>>21822000
         FLAG:=2;<<SET LISTFILE INDICATOR>>                    <<U.RAO>>21824000
         ERRNUM := CYIMPLCTFILE'(LISTFILE,PPNTR,SL);   <<ENTER <<U.RAO>>21826000
         IF <> THEN BEGIN PARMNUM:=1;RETURN END; <<FATAL ERROR<<U.RAO>> 21828000
         END;                                                  <<U.RAO>>21830000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>21832000
      TOS := TOS + 0;<<CLEAR CARRY>>                           <<U.RAO>>21834000
      CREATE(PROG,,PIN,FLAG,1); <<CREATE PROCESS>>             <<U.RAO>>21836000
      IF CARRY THEN                                            <<U.RAO>>21838000
         BEGIN                                                 <<U.RAO>>21840000
         DELIMPFILE(FLAG,LISTFILE); <<DELETE THE FILE>>        <<U.RAO>>21842000
         PROG(6) := 0;                                         <<U.RAO>>21844000
         IF CREATEERROR THEN                                   <<U.RAO>>21846000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@PROG)          <<U.RAO>>21848000
         ELSE                                                  <<U.RAO>>21850000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@PROG);           <<U.RAO>>21852000
         RETURN;                                               <<U.RAO>>21854000
         END;                                                  <<U.RAO>>21856000
      IF < THEN                                                <<U.RAO>>21858000
         BEGIN                                                 <<U.RAO>>21860000
         DELIMPFILE(FLAG,LISTFILE);  <<DELETE FILE>>           <<U.RAO>>21862000
         PROG(6) := 0;                                         <<U.RAO>>21864000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@PROG);               <<U.RAO>>21866000
         RETURN                                                <<U.RAO>>21868000
         END;                                                  <<U.RAO>>21870000
      AWAKE(PIN*PCBSIZE,1,2); <<START PROCESS >>               <<U.RAO>>21872000
      DELIMPFILE(FLAG,LISTFILE); <<DELETE THE FILE>>           <<U.RAO>>21874000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>21876000
      END ; <<CXSEGMENTER>>                                             21878000
                                                               <<01453>>21880000
PROCEDURE CXFCOPY EXECUTORHEAD;                                <<01453>>21882000
   OPTION PRIVILEGED, UNCALLABLE;                              <<01453>>21884000
                                                               <<01453>>21886000
<< This procedure creates the FCOPY "subsystem" and passes >>  <<01453>>21888000
<< any "INFO" specified with the FCOPY command with the    >>  <<01453>>21890000
<< INFO parameter in the CREATEPROCESS call.               >>  <<01453>>21892000
                                                               <<01453>>21894000
BEGIN                                                          <<01453>>21896000
                                                               <<01453>>21898000
   ARRAY NAME'(0:6);        << Holds name of process.      >>  <<01453>>21900000
   BYTE ARRAY NAME(*) = NAME';                                 <<01453>>21902000
   BYTE POINTER TEMPBP;                                        <<01453>>21904000
   INTEGER PIN,                                                <<01453>>21906000
           LEN,                                                <<01453>>21908000
           ERROR;                                              <<01453>>21910000
   ARRAY ITEMCODES(0:10);                                      <<01453>>21912000
   ARRAY ITEMS(0:10);                                          <<01453>>21914000
   DEFINE UNKNOWN'PROG'FILE = ( ERROR = 6 )#;                  <<01453>>21916000
                                                               <<01453>>21918000
   SCAN PARMSP WHILE %6440, 1;                                 <<01453>>21920000
   IF CARRY THEN   << Found nothing but blanks for parms.  >>  <<01453>>21922000
   BEGIN                                                       <<01453>>21924000
      LEN := 0;                                                <<01453>>21926000
      @TEMPBP := @PARMSP;                                      <<01453>>21928000
      DEL;                                                     <<01453>>21930000
   END                                                         <<01453>>21932000
   ELSE                                                        <<01453>>21934000
   BEGIN                                                       <<01453>>21936000
      @TEMPBP := TOS;                                          <<01453>>21938000
      SCAN TEMPBP UNTIL %15, 1;                                <<01453>>21940000
      LEN := TOS - @TEMPBP;                                    <<01453>>21942000
   END;                                                        <<01453>>21944000
   MOVE NAME := "FCOPY.PUB.SYS ";                              <<01453>>21946000
                                                               <<01453>>21948000
   MOVE ITEMCODES := (  3,   << FLAGS                      >>  <<01453>>21950000
                       11,   << INFO STRING ADDRESS.       >>  <<01453>>21952000
                       12,   << INFO STRING LENGTH.        >>  <<01453>>21954000
                        0  );                                  <<01453>>21956000
                                                               <<01453>>21958000
   ITEMS    := 1;                                              <<01453>>21960000
   ITEMS(1) := @TEMPBP;                                        <<01453>>21962000
   ITEMS(2) := LEN;                                            <<01453>>21964000
   ITEMS(3) := 0;                                              <<01453>>21966000
                                                               <<01453>>21968000
   SETJCW( GETJCW LAND %37777 );                               <<01453>>21970000
   CREATEPROCESS( ERROR, PIN, NAME, ITEMCODES, ITEMS );        <<01453>>21972000
   IF < THEN                                                   <<01453>>21974000
   BEGIN                                                       <<01453>>21976000
      NAME(5) := 0;                                            <<01453>>21978000
      IF UNKNOWN'PROG'FILE THEN                                <<01453>>21980000
         CIERR( ERRNUM := SUBSNOTFOUND, , 0, @NAME )           <<01453>>21982000
      ELSE                                                     <<01453>>21984000
      BEGIN                                                    <<01453>>21986000
         CREATEPROC'ERR( ERROR,ERRNUM );                       <<01453>>21988000
         CIERR( ERRNUM := SUBSNOTCREATE, , 0, @NAME );         <<01453>>21990000
      END;                                                     <<01453>>21992000
   END                                                         <<01453>>21994000
   ELSE                                                        <<01453>>21996000
   BEGIN                                                       <<01453>>21998000
      IF > THEN CREATEPROC'ERR( -ERROR, ERRNUM );              <<01453>>22000000
      AWAKE( PIN * PCBSIZE, 1, 2 );                            <<01453>>22002000
      CISUBSYSFINISH( 3, ERRNUM, PARMNUM );                    <<01453>>22004000
   END;                                                        <<01453>>22006000
                                                               <<01453>>22008000
                                                               <<01453>>22010000
END;  << CXFCOPY >>                                            <<01453>>22012000
                                                               <<01453>>22014000
                                                               <<01453>>22016000
PROCEDURE CXSPL EXECUTORHEAD;                                           22018000
   OPTION PRIVILEGED, UNCALLABLE;                                       22020000
BEGIN ENTRY CXSPLPREP, CXSPLGO;                                         22022000
      ENTRY CXFORTRAN, CXFORTPREP, CXFORTGO;                            22024000
      ENTRY CXCOBOL, CXCOBOLPREP, CXCOBOLGO;                            22026000
      ENTRY CXBASICOMP,CXBASICPREP,CXBASICGO;                           22028000
      ENTRY CXRPG,CXRPGPREP,CXRPGGO;                                    22030000
      ENTRY CXPASCAL,CXPASCALPREP,CXPASCALGO;                  <<02844>>22032000
      INTEGER WHICHFLG,X,NEXTDELIM,ERROR,                      <<02844>>22034000
              PARMLEN,STRINGLEN := 0;                          <<02844>>22036000
      EQUATE MAXSTRINGLEN = BCOMMANDBUFLEN - 12,               <<02844>>22038000
             PKEYLISTL = 7,                                    <<02844>>22040000
             COMMA = 0,                                        <<02844>>22042000
             EQUALS = 1,                                       <<02844>>22044000
             SEMICOLON = 2,                                    <<02844>>22046000
             CR = 3;                                           <<02844>>22048000
      DEFINE DELIMTYPE = (13:3)#,                              <<02844>>22050000
             UNKNOWN'PROG'FILE = (ERROR = 6)#;                 <<02844>>22052000
      LOGICAL PROGFLAG := FALSE;                                        22054000
      BYTE ARRAY SPLNAME(0:2) = PB := "SPL";                            22056000
      BYTE ARRAY FTNNAME(0:2) = PB := "FTN";                            22058000
      BYTE ARRAY COBNAME(0:2) = PB := "COB";                            22060000
      BYTE ARRAY BSCNAME(0:2) = PB := "BSC";                            22062000
      BYTE ARRAY RPGNAME(0:2) = PB := "RPG";                            22064000
      BYTE ARRAY PASCNAME(0:2) = PB := "PAS";                  <<02844>>22066000
      BYTE ARRAY TEXT(0:4) = PB := "TEXT ";                             22068000
      BYTE ARRAY LIST(0:4) = PB := "LIST ";                             22070000
      BYTE ARRAY USL(0:3) = PB := "USL ";                               22072000
      BYTE ARRAY PROG(0:35);                                  <<A01.01>>22074000
      BYTE ARRAY MAST(0:4) = PB := "MAST ";                             22076000
      BYTE ARRAY NEW(0:3)  = PB := "NEW ";                              22078000
      BYTE ARRAY SYSFILENAME(0:16);                                     22080000
      BYTE ARRAY BUILDNAME(0:8);                               <<02844>>22082000
      INTEGER NUMPARMS,MAXPARMS := 6;                          <<02844>>22084000
      INTEGER ARRAY OPTNUMS(0:12);                             <<02844>>22086000
      LOGICAL ARRAY OPTNS(0:12);                               <<02844>>22088000
      DOUBLE ARRAY PARMS(0:MAXSTRINGLEN);                      <<02844>>22090000
      LBPARMDECS;                                                       22092000
      LOGICAL COMCR := %26015;                                          22094000
      BYTE POINTER FNAME,SPTR,PARMPTR;                         <<02844>>22096000
      LOGICAL T2,T3;                                           <<U.RAO>>22098000
      LOGICAL PARM := 0;                                                22100000
      LOGICAL PIN,STOP,SCAN'STOP'TEST := %6400,INFO := FALSE;  <<02844>>22102000
      INTEGER PCNT := 0;                                                22104000
      SWITCH USLPROGLIST := US,PR,LT;                                   22106000
      BYTE ARRAY STRING(0:MAXSTRINGLEN - 1);                   <<02844>>22108000
      BYTE ARRAY SAVEDCOMIMAGE(0:BCOMMANDBUFLEN - 1);          <<02844>>22110000
      BYTE ARRAY PKEYLIST(0:PKEYLISTL - 1) = PB :=             <<02844>>22112000
         6,4,"INFO",                                           <<02844>>22114000
         0;                                                    <<02844>>22116000
      BYTE ARRAY KEYLIST(0:PKEYLISTL - 1);                     <<02844>>22118000
DEFINE CHECKSEGERR =                                           <<U.RAO>>22120000
   IF <> AND (T2<>1) THEN   <<WARNING WAS PRINTED>>            <<U.RAO>>22122000
      BEGIN                                                    <<U.RAO>>22124000
      SEGMENTER(PIN,8,T3);  <<EXIT SEGMENTER>>                 <<U.RAO>>22126000
      PARMNUM := T2;                                           <<U.RAO>>22128000
      DELIMPFILE(PARM,BUILDNAME);                              <<U.RAO>>22130000
      CIERR(ERRNUM := SEGMENTERERROR);                         <<U.RAO>>22132000
      RETURN;                                                  <<U.RAO>>22134000
      END#;                                                    <<U.RAO>>22136000
                                                               <<U.RAO>>22138000
SUBROUTINE BLDIMPFILE;                                         <<U.RAO>>22140000
BEGIN                                                          <<U.RAO>>22142000
ERRNUM := CYIMPLCTFILE'(BUILDNAME,FNAME,T3);                   <<U.RAO>>22144000
IF <> THEN  <<ERROR OCCURRED>>                                 <<U.RAO>>22146000
   BEGIN                                                       <<U.RAO>>22148000
   DELIMPFILE(PARM,BUILDNAME);                                 <<U.RAO>>22150000
   PARMNUM := PCNT+1;                                          <<U.RAO>>22152000
   ASSEMBLE(EXIT 3);                                           <<U.RAO>>22154000
   END;                                                        <<U.RAO>>22156000
END;                                                           <<U.RAO>>22158000
SUBROUTINE GETNEXT;                                            <<02844>>22160000
<< Sets PARMPTR to current parameter, gets parameter length >> <<02844>>22162000
<< establishes the delimiter type, and advances parameter   >> <<02844>>22164000
<< count.                                                   >> <<02844>>22166000
   BEGIN                                                       <<02844>>22168000
   TOS := PARMS(PARMNUM);                                      <<02844>>22170000
   NEXTDELIM := S0.DELIMTYPE;                                  <<02844>>22172000
   PARMLEN := TOS&LSR(8);                                      <<02844>>22174000
   @PARMPTR := LOGICAL(TOS);                                   <<02844>>22176000
   PARMNUM := PARMNUM + 1;                                     <<02844>>22178000
   END; << GETNEXT >>                                          <<02844>>22180000
LOGICAL SUBROUTINE PROCINFO;                                   <<02844>>22182000
<< processing for the INFO parameter >>                                 22184000
   BEGIN                                                       <<02844>>22186000
   PROCINFO := FALSE;                                          <<02844>>22188000
   IF NEXTDELIM <> EQUALS THEN                                 <<02844>>22190000
      BEGIN                                                    <<02844>>22192000
      CIERR(ERRNUM := REQEQUALSIGN,PARMPTR);                   <<02844>>22194000
      RETURN;                                                  <<02844>>22196000
      END;                                                     <<02844>>22198000
   IF INFO THEN << specified more than once >>                 <<02844>>22200000
      CIERR(ERRNUM := -INFOOVERIDE,PARMPTR);                   <<02844>>22202000
   INFO := TRUE;                                               <<02844>>22204000
   STRINGLEN := 0;                                             <<02844>>22206000
   GETNEXT;                                                    <<02844>>22208000
   IF PARMPTR <> """" AND PARMPTR <> "'" THEN                  <<02844>>22210000
      BEGIN                                                    <<02844>>22212000
      CIERR(ERRNUM := EXPCTQUOTE,PARMPTR);                     <<02844>>22214000
      RETURN;                                                  <<02844>>22216000
      END;                                                     <<02844>>22218000
   SCAN'STOP'TEST.(8:8) := PARMPTR; << set up word for scan >> <<02844>>22220000
   << set up SPTR to point into the string copy, >>            <<02844>>22222000
   << because MYCOMMAND upshifts.                >>            <<02844>>22224000
   X := LOGICAL(@PARMPTR) - LOGICAL(@BCOMIMAGE) + 1;           <<02844>>22226000
   @SPTR := LOGICAL(@SAVEDCOMIMAGE(X));                        <<02844>>22228000
   STOP := FALSE;                                              <<02844>>22230000
   WHILE NOT STOP DO                                           <<02844>>22232000
      BEGIN                                                    <<02844>>22234000
      SCAN SPTR UNTIL SCAN'STOP'TEST,1;                        <<02844>>22236000
      IF CARRY THEN << missing closing quote, found CR >>      <<02844>>22238000
         BEGIN                                                 <<02844>>22240000
         X := TOS - LOGICAL(@SAVEDCOMIMAGE);                   <<02844>>22242000
         @PARMPTR := LOGICAL(@BCOMIMAGE(X));                   <<02844>>22244000
         CIERR(ERRNUM := EXPCTCLOSEQUOTE,PARMPTR);             <<02844>>22246000
         STOP := TRUE;                                         <<02844>>22248000
         END                                                   <<02844>>22250000
      ELSE                                                     <<02844>>22252000
         BEGIN                                                 <<02844>>22254000
         X := LS0 - LOGICAL(@SPTR);                            <<02844>>22256000
         @SPTR := LOGICAL(TOS);                                <<02844>>22258000
         IF SPTR = SPTR(1) THEN << found double qoute >>       <<02844>>22260000
            BEGIN                                              <<02844>>22262000
            X := X + 1;                                        <<02844>>22264000
            @SPTR := LOGICAL(@SPTR) + 1;                       <<02844>>22266000
            END                                                <<02844>>22268000
         ELSE << found closing quote >>                        <<02844>>22270000
            STOP := TRUE;                                      <<02844>>22272000
         << move into STRING, note that if we had >>           <<02844>>22274000
         << a double qoute, one is moved in.      >>           <<02844>>22276000
         MOVE STRING(STRINGLEN) := SPTR(-X),(X);               <<02844>>22278000
         STRINGLEN := STRINGLEN + X;                           <<02844>>22280000
         << set SPTR to next character after    >>             <<02844>>22282000
         << quote or double quote.              >>             <<02844>>22284000
         @SPTR := LOGICAL(@SPTR) + 1;                          <<02844>>22286000
         END;                                                  <<02844>>22288000
      END; << WHILE LOOP >>                                    <<02844>>22290000
   << since string can contain delimiters and    >>            <<02844>>22292000
   << MYCOMMAND will parse them, advance PARMPTR >>            <<02844>>22294000
   << to the right place.                        >>            <<02844>>22296000
   X := STRINGLEN;                                             <<02844>>22298000
   WHILE (X := X - 1) >= 0 DO                                  <<02844>>22300000
      IF STRING(X) = ";" OR STRING(X) = "," OR                 <<02844>>22302000
         STRING(X) = "=" THEN                                  <<02844>>22304000
         GETNEXT;                                              <<02844>>22306000
   << check for extra chars. between closing qoute >>          <<02844>>22308000
   << and next delimiter which can be semi or cr.  >>          <<02844>>22310000
   IF ERRNUM <= 0 THEN                                         <<02844>>22312000
      BEGIN                                                    <<02844>>22314000
      SCAN SPTR WHILE %6440,1;                                 <<02844>>22316000
      IF CARRY THEN << FOUND CR >>                             <<02844>>22318000
         DEL                                                   <<02844>>22320000
      ELSE                                                     <<02844>>22322000
         BEGIN                                                 <<02844>>22324000
         IF BPS0 <> ";" THEN                                   <<02844>>22326000
            BEGIN                                              <<02844>>22328000
            X := TOS - LOGICAL(@SAVEDCOMIMAGE);                <<02844>>22330000
            @PARMPTR := LOGICAL(@BCOMIMAGE(X));                <<02844>>22332000
            CIERR(ERRNUM := XPCTSEMIORCR,PARMPTR);             <<02844>>22334000
            END                                                <<02844>>22336000
         ELSE                                                  <<02844>>22338000
            DEL;                                               <<02844>>22340000
         END;                                                  <<02844>>22342000
      END;                                                     <<02844>>22344000
   IF ERRNUM <= 0 THEN                                         <<02844>>22346000
      PROCINFO := TRUE;                                        <<02844>>22348000
   END; << PROCINFO >>                                         <<02844>>22350000
                                                               <<U.RAO>>22352000
      TOS := 0;                                                         22354000
      GO TO PRESPL;                                                     22356000
CXSPLPREP:                                                              22358000
      TOS := 1;                                                         22360000
      GO TO PRESPL;                                                     22362000
CXSPLGO:                                                                22364000
      TOS := 2;                                                         22366000
PRESPL:                                                                 22368000
      MOVE SYSFILENAME := "SPL.PUB.SYS ";                               22370000
      MOVE BUILDNAME := SPLNAME , (3);                                  22372000
      GO TO PROCESS;                                                    22374000
CXRPG:                                                                  22376000
      TOS:=0;                                                           22378000
      GO TO PRERPG;                                                     22380000
CXRPGPREP:                                                              22382000
      TOS:=1;                                                           22384000
      GO TO PRERPG;                                                     22386000
CXRPGGO:                                                                22388000
      TOS:=2;                                                           22390000
PRERPG:                                                                 22392000
      MOVE SYSFILENAME:="RPG.PUB.SYS ";                                 22394000
      MOVE BUILDNAME:=RPGNAME,(3);                                      22396000
      GO TO PROCESS;                                                    22398000
CXFORTRAN:                                                              22400000
      TOS := 0;                                                         22402000
      GO TO PREFORT;                                                    22404000
CXFORTPREP:                                                             22406000
      TOS := 1;                                                         22408000
      GO TO PREFORT;                                                    22410000
CXFORTGO:                                                               22412000
      TOS := 2;                                                         22414000
PREFORT:                                                                22416000
      MOVE SYSFILENAME := "FORTRAN.PUB.SYS ";                           22418000
      MOVE BUILDNAME := FTNNAME , (3);                                  22420000
      GO TO PROCESS;                                                    22422000
CXBASICOMP:                                                             22424000
      TOS:=0;                                                           22426000
      GO TO PREBSC;                                                     22428000
CXBASICPREP:                                                            22430000
      TOS:=1;                                                           22432000
      GO TO PREBSC;                                                     22434000
CXBASICGO:                                                              22436000
      TOS:=2;                                                           22438000
PREBSC:                                                                 22440000
      MOVE SYSFILENAME:="BASICOMP.PUB.SYS ";                            22442000
      MOVE BUILDNAME:=BSCNAME,(3);                                      22444000
      MAXPARMS := 4;  <<BASIC COMPILER HAS NO NEW OR MASTER>>  <<U.RAO>>22446000
      GO TO PROCESS;                                                    22448000
CXCOBOL:                                                                22450000
      TOS := 0;                                                         22452000
      GO TO PRECOB;                                                     22454000
CXCOBOLPREP:                                                            22456000
      TOS := 1;                                                         22458000
      GO TO PRECOB;                                                     22460000
CXCOBOLGO:                                                              22462000
      TOS := 2;                                                         22464000
PRECOB:                                                                 22466000
      MOVE SYSFILENAME := "COBOL.PUB.SYS ";                             22468000
      MOVE BUILDNAME := COBNAME , (3);                                  22470000
      GO TO PROCESS;                                           <<02844>>22472000
CXPASCAL:                                                      <<02844>>22474000
      TOS := 0;                                                <<02844>>22476000
      GO TO PREPASC;                                           <<02844>>22478000
CXPASCALPREP:                                                  <<02844>>22480000
      TOS := 1;                                                <<02844>>22482000
      GO TO PREPASC;                                           <<02844>>22484000
CXPASCALGO:                                                    <<02844>>22486000
      TOS := 2;                                                <<02844>>22488000
PREPASC:                                                       <<02844>>22490000
      MOVE SYSFILENAME := "PASCAL.PUB.SYS ";                   <<02844>>22492000
      MOVE BUILDNAME := PASCNAME,(3);                          <<02844>>22494000
      MAXPARMS := 4; << NO NEW, NO MASTER >>                   <<02844>>22496000
PROCESS:                                                                22498000
      WHICHFLG := TOS;                                                  22500000
      << check for parameters, semi marks start >>             <<02844>>22502000
      << keywords and positional parameters are >>             <<02844>>22504000
      << parsed separately.                     >>             <<02844>>22506000
      SCAN PARMSP UNTIL %6473,1; << cr,semicolon >>            <<02844>>22508000
      IF CARRY THEN                                            <<02844>>22510000
         DEL                                                   <<02844>>22512000
      ELSE                                                     <<02844>>22514000
         BEGIN << FOUND KEYWORD >>                             <<02844>>22516000
         BPS0 := %15;                                          <<02844>>22518000
         @SPTR := LOGICAL(TOS) + 1;                            <<02844>>22520000
         MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                 <<02844>>22522000
         << save string's original form >>                     <<02844>>22524000
         MOVE SAVEDCOMIMAGE := BCOMIMAGE,(BCOMMANDBUFLEN);     <<02844>>22526000
         MYCOMMAND(SPTR,,MAXSTRINGLEN + 1,NUMPARMS,PARMS);     <<02844>>22528000
         IF CARRY THEN << too many parameters in string >>     <<02844>>22530000
            BEGIN                                              <<02844>>22532000
            CIERR(ERRNUM := PARAMTOOBIG);                      <<02844>>22534000
            RETURN;                                            <<02844>>22536000
            END;                                               <<02844>>22538000
         IF NUMPARMS = 0 THEN                                  <<02844>>22540000
            CIERR(-EXTRNDELIMIGNRD,SPTR)                       <<02844>>22542000
         ELSE                                                  <<02844>>22544000
         DO << loop on keywords >>                             <<02844>>22546000
            BEGIN                                              <<02844>>22548000
            GETNEXT;                                           <<02844>>22550000
            IF PARMLEN = 0 THEN                                <<02844>>22552000
               CIERR(ERRNUM := -EXTRNDELIMIGNRD,PARMPTR)       <<02844>>22554000
            ELSE                                               <<02844>>22556000
               BEGIN                                           <<02844>>22558000
               TOS := SEARCH(PARMPTR,PARMLEN,KEYLIST);         <<02844>>22560000
               CASE *TOS OF                                    <<02844>>22562000
                  BEGIN                                        <<02844>>22564000
                  << 0 >> << NO SUCH KEYWORD >>                <<02844>>22566000
                  BEGIN                                        <<02844>>22568000
                  CIERR(ERRNUM := UNKNWNKWRD,PARMPTR);         <<02844>>22570000
                  RETURN;                                      <<02844>>22572000
                  END;                                         <<02844>>22574000
                  << 1 >> << INFO >>                           <<02844>>22576000
                  IF NOT PROCINFO THEN                         <<02844>>22578000
                     RETURN;                                   <<02844>>22580000
                  END; << CASE >>                              <<02844>>22582000
               END;                                            <<02844>>22584000
            END                                                <<02844>>22586000
         UNTIL NEXTDELIM = CR                                  <<02844>>22588000
         END;                                                  <<02844>>22590000
      T3 := 1;                                                          22592000
      IF WHICHFLG=2 THEN MAXPARMS := MAXPARMS-1; <<XXXGO>>     <<U.RAO>>22594000
      MYCOMMAND(PARMSP,COMCR,MAXPARMS,NUMPARMS,PARMS);                  22596000
      IF NUMPARMS = MAXPARMS THEN   <<TOO MANY PARAMETERS>>    <<U.RAO>>22598000
         BEGIN                                                 <<U.RAO>>22600000
         PARMNUM := MAXPARMS;                                  <<U.RAO>>22602000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>22604000
         TOS := PARMS(MAXPARMS-1);                             <<U.RAO>>22606000
         DEL;                                                  <<U.RAO>>22608000
         CIERR(*,*,%10000,MAXPARMS-1);                         <<U.RAO>>22610000
         RETURN;                                               <<U.RAO>>22612000
         END;                                                  <<U.RAO>>22614000
      IF NUMPARMS = 0 THEN GO TO DOIT;                                  22616000
      IF (T3 := BPARM(2)) = 0 THEN GO TO NEXT;                          22618000
      @FNAME := LPARM;                                                  22620000
      MOVE BUILDNAME(3) := TEXT , (5);                                  22622000
      BLDIMPFILE;                                              <<U.RAO>>22624000
      PARM := PARM + 1;                                                 22626000
NEXT:                                                                   22628000
      PCNT := PCNT + 1;                                                 22630000
      IF NUMPARMS = 1 THEN GO TO DOIT;                                  22632000
      IF (T3 := BPARM (6)) = 0 THEN                                     22634000
         IF WHICHFLG = 2 THEN GOTO NEXT2                                22636000
         ELSE GOTO NEXT1;                                               22638000
      @FNAME := LPARM(2);                                               22640000
      TOS := @BUILDNAME(3);                                             22642000
      GO TO USLPROGLIST(WHICHFLG);                                      22644000
US:   TOS := @USL;                                                      22646000
      PARM := PARM + 4;                                                 22648000
      TOS := 4;                                                         22650000
      GO TO PACK;                                                       22652000
PR:     <<PROGRAM FILE NAME>>                                 <<A01.01>>22654000
      IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN                   <<U.RAO>>22656000
         BEGIN  <<PROGFILE NAME IS BAD>>                       <<U.RAO>>22658000
         PARMNUM := 2;                                         <<U.RAO>>22660000
         RETURN                                                <<U.RAO>>22662000
         END;                                                  <<U.RAO>>22664000
      PROG := " ";                                            <<A01.01>>22666000
      MOVE PROG(1) := PROG,(35);                              <<A01.01>>22668000
      TOS := @PROG;                                           <<A01.01>>22670000
      TOS := PARMS(1)&LSR(8);  <<STACK ADDRESS AND LENGTH>>   <<A01.01>>22672000
      MOVE * := *,(TOS);                                      <<A01.01>>22674000
      PROGFLAG := TRUE;                                                 22676000
      GOTO NEXT1;                                                       22678000
PACK:                                                                   22680000
      ASSEMBLE(MVB PB);                                                 22682000
      BLDIMPFILE;                                              <<U.RAO>>22684000
NEXT1:                                                                  22686000
      PCNT := PCNT + 1;                                                 22688000
      IF NUMPARMS = 2 THEN GO TO DOIT;                                  22690000
      IF (T3 := BPARM(10)) = 0 THEN GO TO NEXT2;                        22692000
      @FNAME := LPARM(4);                                               22694000
      TOS := @BUILDNAME(3);                                             22696000
LT:   TOS := @LIST;                                                     22698000
      TOS := 5;                                                         22700000
      ASSEMBLE(MVB PB);                                                 22702000
      BLDIMPFILE;                                              <<U.RAO>>22704000
      PARM := PARM + 2;                                                 22706000
NEXT2:                                                                  22708000
      PCNT := PCNT + 1;                                                 22710000
      IF NUMPARMS = PCNT THEN GO TO DOIT;                               22712000
      IF (T3 := BPARM(4*PCNT + 2))= 0 THEN GO TO NEXT3;                 22714000
      @FNAME := LPARM(2*PCNT);                                          22716000
      MOVE BUILDNAME(3) := MAST ,(5);                                   22718000
      BLDIMPFILE;                                              <<U.RAO>>22720000
      PARM := PARM LOR %10;                                             22722000
NEXT3:                                                                  22724000
      PCNT := PCNT + 1;                                                 22726000
      IF NUMPARMS = PCNT THEN GO TO DOIT;                               22728000
      IF (T3 := BPARM(4*PCNT+2)) = 0 THEN GO TO DOIT;          <<U.RAO>>22730000
      @FNAME := LPARM(2*PCNT);                                          22732000
      MOVE BUILDNAME(3) := NEW , (4);                                   22734000
      BLDIMPFILE;                                              <<U.RAO>>22736000
      PARM := PARM LOR %20;                                             22738000
DOIT:                                                                   22740000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>22742000
      OPTNUMS(0) := 3; OPTNS(0) := 1; << FLAGS >>              <<02844>>22744000
      OPTNUMS(1) := 2; OPTNS(1) := PARM; << PARM WORD >>       <<02844>>22746000
      X := 1;                                                  <<02844>>22748000
      IF INFO THEN                                             <<02844>>22750000
         BEGIN                                                 <<02844>>22752000
         OPTNUMS(X := X + 1) := 11;                            <<02844>>22754000
         OPTNS(X) := @STRING;                                  <<02844>>22756000
         OPTNUMS(X := X + 1) := 12;                            <<02844>>22758000
         OPTNS(X) := STRINGLEN;                                <<02844>>22760000
         END;                                                  <<02844>>22762000
      OPTNUMS(X := X + 1) := 0;                                <<02844>>22764000
      OPTNS(X) := 0;                                           <<02844>>22766000
      CREATEPROCESS(ERROR,PIN,SYSFILENAME,OPTNUMS,OPTNS);      <<02844>>22768000
      IF < THEN                                                <<02844>>22772000
      BEGIN                                                    <<U.RAO>>22774000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>22776000
         SCAN SYSFILENAME UNTIL "..",1;                        <<U.RAO>>22778000
         BPS0 := 0;                                            <<U.RAO>>22780000
         DEL;                                                  <<U.RAO>>22782000
         IF UNKNOWN'PROG'FILE THEN                             <<02844>>22784000
            CIERR(ERRNUM :=SUBSNOTFOUND,,0,@SYSFILENAME)       <<02844>>22786000
         ELSE                                                  <<02844>>22788000
            BEGIN                                              <<02844>>22790000
            CREATEPROC'ERR(ERROR,ERRNUM);                      <<02844>>22792000
            CIERR(ERRNUM := SUBSNOTCREATE,,0,@SYSFILENAME);    <<02844>>22794000
            END;                                               <<02844>>22796000
         RETURN;                                               <<U.RAO>>22798000
      END;                                                              22800000
      IF > THEN                                                <<02844>>22802000
         CREATEPROC'ERR(-ERROR,ERRNUM);                        <<02844>>22804000
      NEXTLINE;                                                         22808000
      AWAKE(PIN*PCBSIZE,1,2);                                           22810000
      IF WHICHFLG = 0 THEN                                              22812000
         BEGIN    <<JUST COMPILE>>                                      22814000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>22816000
         CISUBSYSFINISH(4, ERRNUM, PARMNUM);                   <<U.RAO>>22818000
         RETURN;                                               <<U.RAO>>22820000
         END;                                                           22822000
      IF NOT CISUBSYSFINISH(4, ERRNUM, PARMNUM) THEN           <<U.RAO>>22824000
         BEGIN    <<ERROR IN COMPILE OF MULTI-STEP>>                    22826000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>22828000
         CIERR(ERRNUM := COMPFAILEDNOPRP);                     <<U.RAO>>22830000
         RETURN;                                               <<U.RAO>>22832000
         END;                                                           22834000
      PIN := 0;                                                         22836000
      MOVE SYSFILENAME := "$OLDPASS ";                                  22838000
      SEGMENTER(PIN,22,T2,,,,,,,,,SYSFILENAME);                <<00629>>22840000
      CHECKSEGERR;                                             <<U.RAO>>22842000
      IF (WHICHFLG = 2)  OR NOT (PROGFLAG)  THEN                        22844000
         MOVE PROG := "$NEWPASS ";                                      22846000
      SEGMENTER (PIN, 14, T2, -1, -1, 0, -1, 0, -1, , , PROG); <<00629>>22848000
      CHECKSEGERR;                                             <<U.RAO>>22850000
      SEGMENTER (PIN, 8, T2);                                           22852000
      DELIMPFILE(PARM,BUILDNAME);                              <<U.RAO>>22854000
      IF WHICHFLG = 1 THEN   <<JUST COMPILE & PREP>>           <<U.RAO>>22856000
         BEGIN                                                 <<U.RAO>>22858000
         CISUBSYSFINISH(2, ERRNUM, PARMNUM);                   <<U.RAO>>22860000
         RETURN                                                <<U.RAO>>22862000
         END;                                                  <<U.RAO>>22864000
      IF NOT CISUBSYSFINISH(2, ERRNUM, PARMNUM) THEN           <<U.RAO>>22866000
         BEGIN                                                 <<U.RAO>>22868000
         CIERR(ERRNUM := PREPFAILEDNORUN);                     <<U.RAO>>22870000
         RETURN;                                               <<U.RAO>>22872000
         END;                                                  <<U.RAO>>22874000
      TOS := TOS + 0;            <<CLEAR CARRY>>                        22876000
      CREATE(SYSFILENAME,,PIN,,1);                                      22878000
      IF CARRY THEN   <<CREATE FAILED>>                        <<U.RAO>>22880000
         BEGIN                                                 <<U.RAO>>22882000
         IF CREATEERROR THEN                                   <<U.RAO>>22884000
            CIERR(ERRNUM := COMPILEDCREATE)                    <<U.RAO>>22886000
         ELSE                                                  <<U.RAO>>22888000
            CIERR(ERRNUM := COMPILEDLOAD);                     <<U.RAO>>22890000
         RETURN                                                <<U.RAO>>22892000
         END;                                                  <<U.RAO>>22894000
      IF < THEN                                                <<U.RAO>>22896000
         BEGIN                                                 <<U.RAO>>22898000
         CIERR(ERRNUM := INVALIDPROGFILE);                     <<U.RAO>>22900000
         RETURN                                                <<U.RAO>>22902000
         END;                                                  <<U.RAO>>22904000
      IF > THEN CIERR(-DEFVAL);                                <<U.RAO>>22906000
      NEXTLINE;                                                         22908000
      AWAKE(PIN*PCBSIZE,1,2);                                           22910000
      CISUBSYSFINISH(1, ERRNUM, PARMNUM);                      <<U.RAO>>22912000
END;  <<CXSPL ET AL>>                                          <<U.RAO>>22914000
PROCEDURE CXBASIC EXECUTORHEAD;                                         22916000
   OPTION PRIVILEGED, UNCALLABLE;                                       22918000
BEGIN LOGICAL X1 := %26015;                                             22920000
      INTEGER NUMPARMS;                                                 22922000
      DOUBLE ARRAY PARMS(0:3);                                 <<U.RAO>>22924000
      LBPARMDECS;                                                       22926000
      BYTE ARRAY BASINPT(0:6) = PB := "BASIN ";                         22928000
      BYTE ARRAY BLIST(0:7) = PB := "BASLIST ";                         22930000
      BYTE ARRAY BCOM (0:6) = PB := "BASCOM ";                          22932000
      BYTE ARRAY FNAME(0:7);                                            22934000
      BYTE POINTER FREF;                                                22936000
      LOGICAL T3;                                              <<U.RAO>>22938000
      LOGICAL PIN , PARM := 0;                                          22940000
      BYTE ARRAY SYSFILENAME(0:14);                                     22942000
      BYTE BLANK := " ";                                                22944000
      INTEGER PCNT := 1;                                                22946000
SUBROUTINE CLEANUP;                                                     22948000
BEGIN                                                                   22950000
      TOS := PARM;                                                      22952000
      IF < THEN                                                         22954000
      BEGIN MOVE FNAME := BCOM , (7);                                   22956000
            XREMJTENTRY(FNAME,BLANK,BLANK,3)                            22958000
      END;                                                              22960000
      ASSEMBLE(TBC 1);                                                  22962000
      IF <> THEN                                                        22964000
      BEGIN MOVE FNAME := BASINPT , (7);                                22966000
            XREMJTENTRY(FNAME,BLANK,BLANK,3)                            22968000
      END;                                                              22970000
      DELIMPFILE(*,FNAME);                                              22972000
END;                                                                    22974000
                                                               <<U.RAO>>22976000
SUBROUTINE BLDIMPFILE;                                         <<U.RAO>>22978000
BEGIN                                                          <<U.RAO>>22980000
ERRNUM := CYIMPLCTFILE'(FNAME,FREF,T3);                        <<U.RAO>>22982000
IF <> THEN  <<ERROR OCCURRED>>                                 <<U.RAO>>22984000
   BEGIN                                                       <<U.RAO>>22986000
   CLEANUP;                                                    <<U.RAO>>22988000
   PARMNUM := PCNT;                                            <<U.RAO>>22990000
   ASSEMBLE(EXIT 3);                                           <<U.RAO>>22992000
   END;                                                        <<U.RAO>>22994000
END;                                                           <<U.RAO>>22996000
                                                               <<U.RAO>>22998000
      MOVE SYSFILENAME := "BASIC.PUB.SYS ";                             23000000
      T3 := 1;                                                          23002000
      MYCOMMAND(PARMSP,X1,4,NUMPARMS,PARMS);                   <<U.RAO>>23004000
      IF NUMPARMS >= 4 THEN  <<T00 MANY PARAMETERS>>           <<U.RAO>>23006000
         BEGIN                                                 <<U.RAO>>23008000
         PARMNUM := 4;                                         <<U.RAO>>23010000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>23012000
         TOS := LPARM(6);                                      <<U.RAO>>23014000
         CIERR(*,*,%10000,3);                                  <<U.RAO>>23016000
         RETURN;                                               <<U.RAO>>23018000
         END;                                                  <<U.RAO>>23020000
      IF NUMPARMS = 0 THEN GO TO DOIT;                                  23022000
      IF (T3 := BPARM(2)) = 0 THEN GO TO TFILE;                         23024000
      MOVE FNAME := BCOM , (7);                                         23026000
      @FREF := LPARM;                                                   23028000
      BLDIMPFILE;                                              <<U.RAO>>23030000
      PARM.(0:1) := 1;   <<COMMAND FILE PRESENT>>              <<U.RAO>>23032000
TFILE:                                                                  23034000
      IF NUMPARMS = 1 THEN GO TO DOIT;                                  23036000
      PCNT := PCNT + 1;                                                 23038000
      IF (T3 := BPARM(6)) = 0 THEN GO TO LFILE;                         23040000
      MOVE FNAME := BASINPT , (7);                                      23042000
      @FREF := LPARM(2);                                                23044000
      BLDIMPFILE;                                              <<U.RAO>>23046000
      PARM.(1:1) := 1;  <<BASIC INPUT FILE PRESENT>>           <<U.RAO>>23048000
LFILE:                                                                  23050000
      IF NUMPARMS = 2 THEN GO TO DOIT;                                  23052000
      PCNT := PCNT + 1;                                                 23054000
      IF (T3 := BPARM(10)) = 0 THEN GO TO DOIT;                <<U.RAO>>23056000
      MOVE FNAME := BLIST , (8);                                        23058000
      @FREF := LPARM(4);                                                23060000
      BLDIMPFILE;                                              <<U.RAO>>23062000
      PARM := PARM + 2;                                                 23064000
DOIT:                                                                   23066000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>23068000
      TOS := TOS + 0;            <<CLEAR CARRY>>                        23070000
      CREATE(SYSFILENAME,,PIN,PARM,1);                                  23072000
      IF CARRY THEN                                                     23074000
      BEGIN CLEANUP;                                                    23076000
            IF CREATEERROR THEN                                <<U.RAO>>23078000
               CIERR(ERRNUM := BASICCREATEERR)                 <<U.RAO>>23080000
            ELSE                                               <<U.RAO>>23082000
               CIERR(ERRNUM := BASICLOADERR);                  <<U.RAO>>23084000
            RETURN;                                            <<U.RAO>>23086000
      END;                                                              23088000
      IF < THEN                                                         23090000
      BEGIN CLEANUP;                                                    23092000
         SYSFILENAME(5) := 0;                                  <<U.RAO>>23094000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@SYSFILENAME);        <<U.RAO>>23096000
         RETURN;                                               <<U.RAO>>23098000
      END;                                                              23100000
      NEXTLINE;                                                         23102000
      AWAKE(PIN*PCBSIZE,1,2);                                           23104000
                                                                        23106000
      CLEANUP;                                                          23108000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>23110000
END;  <<CXBASIC>>                                              <<U.RAO>>23112000
$CONTROL SEGMENT = CIPREPRUN                                   <<U.RAO>>23114000
PROCEDURE CXAPL EXECUTORHEAD;                                 <<A00.04>>23116000
   OPTION PRIVILEGED, UNCALLABLE;                             <<A00.04>>23118000
BEGIN                                                         <<A00.04>>23120000
BYTE ARRAY SYSFILENAME(0:11);                                 <<A00.04>>23122000
DOUBLE ARRAY PARMS(0:1) = Q;  <<FOR MYCOMMAND RESULTS>>        <<02.RO>>23124000
BYTE POINTER APLWSFNAME = PARMS;  <<NAME OF WORKSPACE>>        <<02.RO>>23126000
BYTE WSFNAMELEN = PARMS+1;                                     <<02.RO>>23128000
BYTE POINTER EXTRAPARM = PARMS+2; <<EXTRANEOUS PARM>>          <<02.RO>>23130000
INTEGER NUMPARMS;                                              <<02.RO>>23132000
LOGICAL PIN;  <<PIN OF CREATED APL PROCESS>>                   <<02.RO>>23134000
BYTE ARRAY FORMALDES(0:5);  << "APLWS ">>                      <<02.RO>>23136000
                                                               <<02.RO>>23138000
MYCOMMAND(PARMSP, , 2, NUMPARMS, PARMS);                       <<02.RO>>23140000
IF NUMPARMS >= 2 THEN  <<TOO MANY PARMS>>                      <<02.RO>>23142000
   BEGIN                                                       <<02.RO>>23144000
   PARMNUM := 2;                                               <<02.RO>>23146000
   CIERR(ERRNUM := APLXPCTJUSTWS, EXTRAPARM);                  <<02.RO>>23148000
   END                                                         <<02.RO>>23150000
ELSE   <<LEGAL NUMBER OF PARMS>>                               <<02.RO>>23152000
   BEGIN                                                       <<02.RO>>23154000
   IF NUMPARMS = 1 THEN  <<SET UP FILE EQUATE>>                <<02.RO>>23156000
      BEGIN                                                    <<02.RO>>23158000
      PARMNUM.(7:1) := 1;  <<SET FLAG FOR APL>>                <<02.RO>>23160000
      MOVE FORMALDES := "APLWS ";                              <<02.RO>>23162000
      ERRNUM := CYIMPLCTFILE'(FORMALDES, APLWSFNAME,           <<02.RO>>23164000
                    WSFNAMELEN);  <<DO EQUATE>>                <<02.RO>>23166000
      IF <> THEN PARMNUM := 1;  <<NAME PROBLEM>>               <<02.RO>>23168000
      END;  <<HANDLING OF FILE NAME, IF ANY>>                  <<02.RO>>23170000
   IF ERRNUM = 0 THEN  <<GOOD SO FAR, TRY LAUNCH>>            <<02.RO>>23172000
      BEGIN                                                    <<02.RO>>23174000
      MOVE SYSFILENAME := "APL.PUB.SYS ";                      <<02.RO>>23176000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>23178000
      CREATE(SYSFILENAME, , PIN, PARMNUM, 1);                  <<02.RO>>23180000
      IF CARRY THEN   <<CREATE FAILED>>                        <<02.RO>>23182000
         BEGIN                                                 <<02.RO>>23184000
         SYSFILENAME(3) := 0;                                  <<02.RO>>23186000
         IF CREATEERROR THEN                                   <<02.RO>>23188000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)   <<02.RO>>23190000
         ELSE   <<LOADER ERROR>>                               <<02.RO>>23192000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);    <<02.RO>>23194000
         END                                                   <<02.RO>>23196000
      ELSE IF < THEN  <<APL.PUB.SYS NOT FOUND>>                <<02.RO>>23198000
         BEGIN                                                 <<02.RO>>23200000
         SYSFILENAME(3) := 0;                                  <<02.RO>>23202000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@SYSFILENAME);        <<02.RO>>23204000
         END                                                   <<02.RO>>23206000
      ELSE   <<CREATE WENT F	INE>>                             <<02.RO>>23208000
         BEGIN                                                 <<02.RO>>23210000
         AWAKE(PIN*PCBSIZE, 1, 2);  <<FIRE UP SUBSYSTEM>>      <<02.RO>>23212000
         CISUBSYSFINISH(0, ERRNUM, PARMNUM);                   <<02.RO>>23214000
         END;                                                  <<02.RO>>23216000
      END;                                                     <<02.RO>>23218000
   END;                                                        <<02.RO>>23220000
END;   <<CXAPL>>                                               <<02.RO>>23222000
PROCEDURE APLTRANSLATEOUT(MESSAGE,LENGTH,TRANSTYPE);          <<A00.04>>23224000
  VALUE LENGTH,TRANSTYPE;                                     <<A00.04>>23226000
  INTEGER LENGTH,TRANSTYPE;                                   <<A00.04>>23228000
  BYTE ARRAY MESSAGE;                                         <<A00.04>>23230000
  <<TRANSTYPE = 2 => APL-ASCII BIT PAIRING CODES                        23232000
    TRANSTYPE = 3 => APL-ASCII TYPEWRITER PAIRING CODES                 23234000
                                                                        23236000
    LENGTH IS THE LENGTH IN BYTES OF ARRAY MESSAGE                      23238000
    MESSAGE IS A BYTE ARRAY CONTAINING THE MESSAGE TO BE TRANSLATED.    23240000
       THIS ARRAY WILL BE ENTIRELY CONVERTED.                           23242000
>>                                                            <<A00.04>>23244000
BEGIN                                                         <<A00.04>>23246000
ENTRY APLTRANSLATEIN;  <<ENTRY POINT FOR EXTERNAL TO INTERNAL><<A00.04>>23248000
EQUATE FIRSTCHAR = %41,  <<ALL PRECEEDING CHARS ARE THE SAME>><<A00.04>>23250000
       LASTCHAR = %176,                                       <<A00.04>>23252000
       NUMCHARS = LASTCHAR-FIRSTCHAR+1;  <<94 IN THIS INSTANCE<<A00.04>>23254000
BYTE ARRAY TRANSARRAY(FIRSTCHAR:LASTCHAR);  <<HOLDS TRANS CODE<<A00.04>>23256000
BYTE ARRAY BITPAIROUT(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY><<A00.04>>23258000
   %131, %41, " ",%174, " ",%120,%113,                        <<A00.04>>23260000
    %53, %52,%120, %55, ",", %75, ".", "/",                   <<A00.04>>23262000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>23264000
    "8", "9", %76, %74, %43, %45, %47,%121,                   <<A00.04>>23266000
   %101, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>23268000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>23270000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>23272000
    "x", "y", "z", %73, %77, %72,%137,%106,                   <<A00.04>>23274000
   %113, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>23276000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>23278000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>23280000
    "x", "y", "z",%135,%115, "}",%124;                        <<A00.04>>23282000
BYTE ARRAY TYPEWRITEROUT(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>      23284000
   %131, %41, " ",%176, " ",%120,%113,                        <<A00.04>>23286000
    %72, %42,%120, %55, ",",%137, ".", "/",                   <<A00.04>>23288000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>23290000
    "8", "9", %76, %74, %43, %45, %46,%121,                   <<A00.04>>23292000
   %101, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>23294000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>23296000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>23298000
    "x", "y", "z", %73, %77, %47, %51,%106,                   <<A00.04>>23300000
   %113, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>23302000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>23304000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>23306000
    "x", "y", "z", "{",%115, "}",%124;                        <<A00.04>>23308000
BYTE ARRAY BITPAIRIN(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>          23310000
    %42, %42, "<", %44, "=", %46, ">",                        <<A00.04>>23312000
    %50, %51, ")", "(", ",", "+", ".", "/",                   <<A00.04>>23314000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>23316000
    "8", "9", "]", "[", ";", "-", ":", "\",                   <<A00.04>>23318000
    "_", "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>23320000
    "H", "I", "J", "'", "L",%174, "N", "O",                   <<A00.04>>23322000
    "*", "?", "R", "S", %176, "U", "V", "W",                  <<A00.04>>23324000
    "X", "^", "Z",%133,%134,%173,%136,%137,                   <<A00.04>>23326000
   %140, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>23328000
    "H", "I", "J", "K", "L", "M", "N", "O",                   <<A00.04>>23330000
    "P", "Q", "R", "S", "T", "U", "V", "W",                   <<A00.04>>23332000
    "X", "Y", "Z",%173, "$",%175,%176;                        <<A00.04>>23334000
BYTE ARRAY TYPEWRITERIN(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>       23336000
    %42, ")", "<", %44, "=", ">", "]",                        <<A00.04>>23338000
    %50, %51, %52, %53, ",", "+", ".", "/",                   <<A00.04>>23340000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>23342000
    "8", "9", "(", "[", ";", %75, ":", "\",                   <<A00.04>>23344000
   %100, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>23346000
    "H", "I", "J", "'", "L",%174, "N", "O",                   <<A00.04>>23348000
    "*", "?", "R", "S", %176, "U", "V", "W",                  <<A00.04>>23350000
    "X", "^", "Z", "_",%134,%135,%136, "-",                   <<A00.04>>23352000
   %140, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>23354000
    "H", "I", "J", "K", "L", "M", "N", "O",                   <<A00.04>>23356000
    "P", "Q", "R", "S", "T", "U", "V", "W",                   <<A00.04>>23358000
    "X", "Y", "Z",%173,%174,%175, "$";                        <<A00.04>>23360000
IF NOT(2<=TRANSTYPE<=3) THEN RETURN;                          <<A00.04>>23362000
TRANSTYPE := TRANSTYPE-2;                                     <<A00.04>>23364000
GO TO DOIT;                                                   <<A00.04>>23366000
APLTRANSLATEIN:                                               <<A00.04>>23368000
  IF NOT(2<=TRANSTYPE<=3) THEN RETURN;                        <<A00.04>>23370000
DOIT:                                                         <<A00.04>>23372000
  CASE TRANSTYPE OF                                           <<A00.04>>23374000
    BEGIN                                                     <<A00.04>>23376000
    MOVE TRANSARRAY(FIRSTCHAR):=BITPAIROUT,(NUMCHARS);        <<A00.04>>23378000
    MOVE TRANSARRAY(FIRSTCHAR):=TYPEWRITEROUT,(NUMCHARS);     <<A00.04>>23380000
    MOVE TRANSARRAY(FIRSTCHAR):=BITPAIRIN,(NUMCHARS);         <<A00.04>>23382000
    MOVE TRANSARRAY(FIRSTCHAR):=TYPEWRITERIN,(NUMCHARS);      <<A00.04>>23384000
    END;                                                      <<A00.04>>23386000
WHILE (LENGTH:=LENGTH-1) >= 0 DO  <<WORK FROM END TO BEGINNING>>        23388000
   IF FIRSTCHAR<=INTEGER(MESSAGE(LENGTH))<=LASTCHAR THEN  <<IN RANGE>>  23390000
      MESSAGE(LENGTH):=TRANSARRAY(INTEGER(MESSAGE(LENGTH)));  <<A00.04>>23392000
END;                                                          <<A00.04>>23394000
PROCEDURE CXMRJE EXECUTORHEAD;                                <<<<MRJE>>23396000
   OPTION PRIVILEGED,UNCALLABLE;                              <<<<MRJE>>23398000
BEGIN                                                         <<<<MRJE>>23400000
BYTE ARRAY SYSFILENAME(0:13);                                  <<03058>>23402000
DOUBLE PARMS;  <<DUMMY FOR ERRORS FOUND BY MYCOMMAND>>        <<<<MRJE>>23404000
BYTE POINTER BPARM = PARMS;   <<POINTER FOR ERROR>>             <<MRJE>>23406000
INTEGER NUMPARMS;  <<LIKEWISE>>                               <<<<MRJE>>23408000
LOGICAL PIN;  <<PIN FROM CREATE OF MRJE SUBSYS>>              <<<<MRJE>>23410000
MOVE SYSFILENAME:="MRJE.PUB.SYS ";                            <<<<MRJE>>23412000
MYCOMMAND(PARMSP,,1,NUMPARMS,PARMS);  <<CHECK FOR PARMS>>     <<<<MRJE>>23414000
IF NUMPARMS > 0 THEN   <<EXTRANEOUS PARAMETER>>                 <<MRJE>>23416000
   CIERR(-WARNXPARMSIGNORED, BPARM);                            <<MRJE>>23418000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>23420000
CREATE(SYSFILENAME,,PIN,PARMNUM,1);                           <<<<MRJE>>23422000
IF CARRY THEN   <<CREATE OF MRJE FAILED>>                       <<MRJE>>23424000
   BEGIN                                                        <<MRJE>>23426000
   SYSFILENAME(4) := 0;   <<FOR ERROR MESSAGE>>                 <<MRJE>>23428000
   IF CREATEERROR THEN                                          <<MRJE>>23430000
      CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)          <<MRJE>>23432000
   ELSE   <<LOAD FAILED>>                                       <<MRJE>>23434000
      CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);           <<MRJE>>23436000
   END                                                          <<MRJE>>23438000
ELSE IF < THEN   <<MRJE.PUB.SYS NOT FOUND>>                     <<MRJE>>23440000
   BEGIN                                                        <<MRJE>>23442000
   SYSFILENAME(4) := 0;   <<FOR ERROR MESSAGE>>                 <<MRJE>>23444000
   CIERR(ERRNUM := SUBSNOTFOUND, , 0,@SYSFILENAME);             <<MRJE>>23446000
   END                                                          <<MRJE>>23448000
ELSE   <<EVERYTHING OK, DO IT>>                                 <<MRJE>>23450000
   BEGIN                                                        <<MRJE>>23452000
   AWAKE(PIN*PCBSIZE,1,2);   <<FIRE UP SUBSYSTEM>>              <<MRJE>>23454000
   CISUBSYSFINISH(0, ERRNUM, PARMNUM);                          <<MRJE>>23456000
   END;                                                         <<MRJE>>23458000
END;   <<CXMRJE>>                                               <<MRJE>>23460000
PROCEDURE CX3270 EXECUTORHEAD;                                 <<00184>>23462000
   OPTION PRIVILEGED,UNCALLABLE;                               <<00184>>23464000
BEGIN                                                          <<00184>>23466000
<< Fire up the IML/3000 subsystem (also known in   >>          <<01165>>23468000
<< some circles as the IBM 3270).                  >>          <<01165>>23470000
<<                                                 >>          <<01165>>23472000
<< The IML subsystem can now be invoked via four  >>           <<02845>>23474000
<< commands, IML and IMF for regular use, and     >>           <<02845>>23476000
<< IMLMGR or IMFMGR for manager. The syntax was   >>           <<02845>>23478000
<< changed to include the FORMAT and PRIORITY key->>           <<02845>>23480000
<< words. The complete syntax is as follows:      >>           <<02845>>23482000
<<                                                >>           <<02845>>23484000
<< IMF [;][E[NHANCE] = 0|1|2|3] [;][B[LANKS]]     >>           <<02845>>23486000
<<     [;][F[ORMAT] = 1|2|3|4]                    >>           <<02845>>23488000
<<     [;][P[RIORITY] =1|2|3|4|5|6|7|8|9|11|12|13]>>           <<02845>>23490000
<<                                                >>           <<02845>>23492000
<<                                                >>           <<02845>>23494000
<<  The parameters may be in either sequence or    >>          <<01165>>23496000
<<  may be omitted entirely.                       >>          <<01165>>23498000
                                                               <<01165>>23500000
LOGICAL MANAGER;                                               <<00184>>23502000
BYTE ARRAY SYSFILENAME(0:17),ENTRYNAME(0:9);                   <<00184>>23504000
Integer enhance'parm := 0;                                     <<01165>>23506000
LOGICAL FLAG := 0,PROG'PARM := [4/0,3/2,1/0,4/8,4/0];          <<02845>>23508000
EQUATE                                                         <<02845>>23510000
   PKEYLISTL = 56,                                             <<02845>>23512000
   MAXPARMS = 7,                                               <<02845>>23514000
   EQUALS = 1,                                                 <<02845>>23516000
   SEMICOLON = 0,                                              <<02845>>23518000
   CR = 2;                                                     <<02845>>23520000
BYTE ARRAY PKEYLIST(0:PKEYLISTL - 1) = PB :=                   <<02845>>23522000
   10,7,"ENHANCE",0,                                           <<02845>>23524000
   9,6,"FORMAT",1,                                             <<02845>>23526000
   11,8,"PRIORITY",2,                                          <<02845>>23528000
   9,6,"BLANKS",3,                                             <<02845>>23530000
   4,1,"E",0,                                                  <<02845>>23532000
   4,1,"F",1,                                                  <<02845>>23534000
   4,1,"P",2,                                                  <<02845>>23536000
   4,1,"B",3,                                                  <<02845>>23538000
   0;                                                          <<02845>>23540000
BYTE ARRAY KEYLIST(0:PKEYLISTL - 1);                           <<02845>>23542000
DOUBLE DELIM := [8/";",8/"=",8/%15,8/0]D;                      <<02845>>23544000
BYTE ARRAY DELIMS(*) = DELIM;                                  <<02845>>23546000
INTEGER PARMLEN,NEXTDELIM,NUMPARMS,RESULT;                     <<02845>>23548000
DOUBLE ARRAY PARMS(0:MAXPARMS - 1);                            <<02845>>23550000
BYTE POINTER PARMPTR,DICTPTR;                                  <<02845>>23552000
DEFINE                                                         <<02845>>23554000
   ENHANCE = (12:4)#,                                          <<02845>>23556000
   FORMAT = (4:3)#,                                            <<02845>>23558000
   PRIORITY = (8:4)#,                                          <<02845>>23560000
   BLANKS = (7:1)#,                                            <<02845>>23562000
   ENH = (0:1)#,                                               <<02845>>23564000
   FMT = (1:1)#,                                               <<02845>>23566000
   PRI = (2:1)#,                                               <<02845>>23568000
   DELIMTYPE = (13:3)#;                                        <<02845>>23570000
                                                               <<01165>>23572000
LOGICAL PIN;  <<PIN FROM CREATE OF 3270 SUBSYS>>               <<00184>>23574000
ENTRY CX3270MGR;                                               <<01165>>23576000
                                                               <<00184>>23578000
                                                               <<01165>>23582000
SUBROUTINE GETNEXT;                                            <<02845>>23584000
<< Sets PARMPTR to appropriate parameter, gets parameter >>    <<02845>>23586000
<< length and delimiter type. Called upon advancing to   >>    <<02845>>23588000
<< next parameter.                                       >>    <<02845>>23590000
BEGIN                                                          <<02845>>23592000
   TOS := PARMS(PARMNUM);                                      <<02845>>23594000
   NEXTDELIM := S0.DELIMTYPE;                                  <<02845>>23596000
   PARMLEN := TOS&LSR(8);                                      <<02845>>23598000
   @PARMPTR := TOS;                                            <<02845>>23600000
   PARMNUM := PARMNUM + 1;                                     <<02845>>23602000
END; << SUBROUTINE GETNEXT >>                                  <<02845>>23604000
                                                               <<02845>>23606000
                                                               <<02845>>23608000
LOGICAL SUBROUTINE PROCENHANCE;                                <<02845>>23610000
BEGIN                                                          <<02845>>23612000
   PROCENHANCE := FALSE;                                       <<02845>>23614000
   IF FLAG.ENH THEN                                            <<02845>>23616000
      CIERR(ERRNUM := -REDNDENH,PARMPTR);                      <<02845>>23618000
   FLAG.ENH := TRUE;                                           <<02845>>23620000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>23622000
      BEGIN                                                    <<02845>>23624000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>23626000
         RETURN;                                               <<02845>>23628000
      END;                                                     <<02845>>23630000
   GETNEXT;                                                    <<02845>>23632000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>23634000
   IF <> OR NOT (0 <= RESULT <= 3) THEN                        <<02845>>23636000
      CIERR(ERRNUM := ILLVALENH,PARMPTR)                       <<02845>>23638000
   ELSE                                                        <<02845>>23640000
      BEGIN                                                    <<02845>>23642000
         PROG'PARM.ENHANCE := RESULT;                          <<02845>>23644000
         PROCENHANCE := TRUE;                                  <<02845>>23646000
      END;                                                     <<02845>>23648000
END; << SUBROUTINE PROCENHANCE >>                              <<02845>>23650000
                                                               <<02845>>23652000
                                                               <<02845>>23654000
LOGICAL SUBROUTINE PROCFORMAT;                                 <<02845>>23656000
BEGIN                                                          <<02845>>23658000
   PROCFORMAT := FALSE;                                        <<02845>>23660000
   IF FLAG.FMT THEN                                            <<02845>>23662000
      CIERR(ERRNUM := -REDNDFMT,PARMPTR);                      <<02845>>23664000
   FLAG.FMT := TRUE;                                           <<02845>>23666000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>23668000
      BEGIN                                                    <<02845>>23670000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>23672000
         RETURN;                                               <<02845>>23674000
      END;                                                     <<02845>>23676000
   GETNEXT;                                                    <<02845>>23678000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>23680000
   IF <> OR NOT (1 <= RESULT <= 4) THEN                        <<02845>>23682000
      CIERR(ERRNUM := ILLVALFMT,PARMPTR)                       <<02845>>23684000
   ELSE                                                        <<02845>>23686000
      BEGIN                                                    <<02845>>23688000
         PROG'PARM.FORMAT := RESULT;                           <<02845>>23690000
         PROCFORMAT := TRUE;                                   <<02845>>23692000
      END;                                                     <<02845>>23694000
END; << SUBROUTINE PROCFORMAT >>                               <<02845>>23696000
                                                               <<02845>>23698000
                                                               <<02845>>23700000
LOGICAL SUBROUTINE PROCPRIORITY;                               <<02845>>23702000
BEGIN                                                          <<02845>>23704000
   PROCPRIORITY := FALSE;                                      <<02845>>23706000
   IF FLAG.PRI THEN                                            <<02845>>23708000
      CIERR(ERRNUM := -REDNDPRI,PARMPTR);                      <<02845>>23710000
   FLAG.PRI := TRUE;                                           <<02845>>23712000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>23714000
      BEGIN                                                    <<02845>>23716000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>23718000
         RETURN;                                               <<02845>>23720000
      END;                                                     <<02845>>23722000
   GETNEXT;                                                    <<02845>>23724000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>23726000
   IF <> OR NOT (1 <= RESULT <= 13) THEN                       <<02845>>23728000
      CIERR(ERRNUM := ILLVALPRI,PARMPTR)                       <<02845>>23730000
   ELSE                                                        <<02845>>23732000
      BEGIN                                                    <<02845>>23734000
         PROG'PARM.PRIORITY := RESULT;                         <<02845>>23736000
         PROCPRIORITY := TRUE;                                 <<02845>>23738000
      END;                                                     <<02845>>23740000
END; << SUBROUTINE PROCPRIORITY >>                             <<02845>>23742000
                                                               <<02845>>23744000
                                                               <<02845>>23746000
IF (MANAGER := FALSE) THEN                                     <<02845>>23748000
CX3270MGR: MANAGER := TRUE;                                    <<02845>>23750000
MYCOMMAND(PARMSP,DELIMS,MAXPARMS,NUMPARMS,PARMS);              <<02845>>23752000
IF <> THEN                                                     <<02845>>23754000
   BEGIN                                                       <<02845>>23756000
      CIERR(ERRNUM := TOOMANYPARMS);                           <<02845>>23758000
      RETURN;                                                  <<02845>>23760000
   END;                                                        <<02845>>23762000
IF NUMPARMS <> 0 THEN << evidently found some >>               <<02845>>23764000
   BEGIN                                                       <<02845>>23766000
      MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                    <<02845>>23768000
      DO                                                       <<02845>>23770000
         BEGIN                                                 <<02845>>23772000
            GETNEXT;                                           <<02845>>23774000
            IF PARMLEN = 0 THEN << empty parameter >>          <<02845>>23776000
               CIERR(ERRNUM := -FILEEXTRANDELIM,PARMPTR)       <<02845>>23778000
            ELSE                                               <<02845>>23780000
               BEGIN << look for a keyword >>                  <<02845>>23782000
                  TOS := SEARCH(PARMPTR,PARMLEN,KEYLIST        <<02845>>23784000
                                ,DICTPTR);                     <<02845>>23786000
                  IF TOS <> 0 THEN                             <<02845>>23788000
                     CASE INTEGER(DICTPTR) OF                  <<02845>>23790000
                        BEGIN                                  <<02845>>23792000
                           << 0 >>                             <<02845>>23794000
                           IF NOT PROCENHANCE THEN             <<02845>>23796000
                              RETURN;                          <<02845>>23798000
                           << 1 >>                             <<02845>>23800000
                           IF NOT PROCFORMAT THEN              <<02845>>23802000
                              RETURN;                          <<02845>>23804000
                           << 2 >>                             <<02845>>23806000
                           IF NOT PROCPRIORITY THEN            <<02845>>23808000
                              RETURN;                          <<02845>>23810000
                           << 3 >>                             <<02845>>23812000
                           PROG'PARM.BLANKS := 1;              <<02845>>23814000
                        END                                    <<02845>>23816000
                  ELSE << unknown keyword >>                   <<02845>>23818000
                     BEGIN                                     <<02845>>23820000
                        CIERR(ERRNUM := UNKNOWNKEY,PARMPTR);   <<02845>>23822000
                        RETURN;                                <<02845>>23824000
                     END;                                      <<02845>>23826000
               END;                                            <<02845>>23828000
         END << keyword loop >>                                <<02845>>23830000
      UNTIL NEXTDELIM <> SEMICOLON;                            <<02845>>23832000
      IF NEXTDELIM <> CR THEN                                  <<02845>>23834000
         BEGIN                                                 <<02845>>23836000
            CIERR(ERRNUM := EXPECTSEMIC,PARMPTR(PARMLEN));     <<02845>>23838000
            RETURN;                                            <<02845>>23840000
         END;                                                  <<02845>>23842000
   END; << PARAMETERS EXIST >>                                 <<02845>>23844000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>23848000
                                                               <<00184>>23850000
IF MANAGER                                                     <<00184>>23852000
  THEN MOVE ENTRYNAME := "TTSMGR "                             <<00184>>23854000
  ELSE MOVE ENTRYNAME := "  ";                                 <<00184>>23856000
                                                               <<00184>>23858000
MOVE SYSFILENAME := "TTSUSER.PUB.SYS ";                        <<01165>>23862000
CREATE(SYSFILENAME,ENTRYNAME,PIN,PROG'PARM,1);                 <<02845>>23864000
IF CARRY THEN   <<CREATE OF IML SUBSYSTEM FAILED>>             <<01424>>23866000
   BEGIN                                                       <<00184>>23868000
   SCAN SYSFILENAME UNTIL "..",1;                              <<00184>>23870000
   BPS0 := 0;       << DELIMIT STRING >>                       <<00184>>23872000
   DEL;                                                        <<00184>>23874000
   IF CREATEERROR THEN                                         <<00184>>23876000
      CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)         <<00184>>23878000
   ELSE   <<LOAD FAILED>>                                      <<00184>>23880000
      CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);          <<00184>>23882000
   END                                                         <<00184>>23884000
ELSE IF < THEN   <<TTSUSER.PUB.SYS NOT FOUND>>                 <<00184>>23886000
   BEGIN                                                       <<00184>>23888000
   SCAN SYSFILENAME UNTIL "..",1;                              <<00184>>23890000
   BPS0 := 0;       << DELIMIT STRING >>                       <<00184>>23892000
   DEL;                                                        <<00184>>23894000
   CIERR(ERRNUM := SUBSNOTFOUND, , 0,@SYSFILENAME);            <<00184>>23896000
   END                                                         <<00184>>23898000
ELSE   <<EVERYTHING OK, DO IT>>                                <<00184>>23900000
   BEGIN                                                       <<00184>>23902000
   AWAKE(PIN*PCBSIZE,1,2);   <<FIRE UP SUBSYSTEM>>             <<00184>>23904000
   CISUBSYSFINISH(0, ERRNUM, PARMNUM);                         <<00184>>23906000
   END;                                                        <<00184>>23908000
END;   <<CX3270, CX3270MGR>>                                   <<00184>>23910000
PROCEDURE CX3270CONTROL EXECUTORHEAD;                          <<01165>>23912000
  OPTION PRIVILEGED,UNCALLABLE;                                <<01165>>23914000
BEGIN                                                          <<01165>>23916000
  BYTE ARRAY PROC'NAME(0:17);                                  <<01424>>23918000
  BYTE ARRAY ERRMSG(0:4);                                      <<01538>>23920000
  INTEGER MSG'LEN;                                             <<01538>>23922000
  INTEGER PROC'ID, PLABEL, X=X;                                <<01424>>23924000
  DEFINE ASMB = ASSEMBLE#;                                     <<01424>>23926000
  INTRINSIC LOADPROC,UNLOADPROC;                               <<01424>>23928000
                                                               <<01424>>23930000
  SUBROUTINE CXIMLCONTROL EXECUTORHEAD;                        <<01424>>23932000
    BEGIN                                                      <<01424>>23934000
    X := TOS;  << SAVE RETURN ADDRESS >>                       <<01424>>23936000
    TOS := PLABEL;                                             <<01424>>23938000
    ASMB( PCAL 0 );                                            <<01424>>23940000
    TOS := X;                                                  <<01424>>23942000
    RETURN 0;  << PROCEDURE DELETED PARMS >>                   <<01424>>23944000
    END;                                                       <<01424>>23946000
                                                               <<01424>>23948000
  MOVE PROC'NAME := "CXIMLCONTROL ";                           <<01424>>23950000
  PROC'ID := LOADPROC(PROC'NAME,0,PLABEL);                     <<01424>>23952000
  IF <> THEN                                                   <<01424>>23954000
    BEGIN                                                      <<01424>>23956000
    MOVE ERRMSG := "IML",2;                                    <<01538>>23958000
    MSG'LEN :=TOS - @ERRMSG;                                   <<01538>>23960000
    ERRMSG(MSG'LEN) := 0;                                      <<01538>>23962000
    CIERR(ERRNUM := SUBSNOTFOUND,,0,@ERRMSG);                  <<01538>>23964000
    RETURN;                                                    <<01424>>23966000
    END;                                                       <<01424>>23968000
                                                               <<01424>>23970000
  CXIMLCONTROL(PARMSP,ERRNUM,PARMNUM);                         <<01424>>23972000
                                                               <<01424>>23974000
  UNLOADPROC(PROC'ID);                                         <<01424>>23976000
                                                               <<01424>>23978000
END;  <<CX3270CONTROL>>                                        <<01424>>23980000
$CONTROL SEGMENT = CISYSMGR                                    <<U.RAO>>23982000
PROCEDURE CXSYSDUMP EXECUTORHEAD;                                       23984000
   OPTION PRIVILEGED, UNCALLABLE;                                       23986000
BEGIN                                                                   23988000
   BYTE POINTER FNAME;                                                  23990000
   LOGICAL DL := %26015;                                                23992000
   INTEGER NUMPARMS;                                                    23994000
   DOUBLE ARRAY PARMS(0:2);                                    <<U.RAO>>23996000
   LBPARMDECS;                                                          23998000
   LOGICAL TEMP;                                                        24000000
   BYTE ARRAY LHS(0:15);                                                24002000
   INTEGER PARM := 0, PIN;                                              24004000
   BYTE ARRAY TAPFIL(0:8) = PB := "DUMPTAPE ";                          24006000
   BYTE ARRAY AUXLIST(0:8) = PB := "SYSDLIST ";                         24008000
   BYTE BLANK := " ";                                                   24010000
SUBROUTINE CLEANUP;                                                     24012000
BEGIN MOVE LHS := TAPFIL , (9);                                         24014000
      XREMJTENTRY(LHS,BLANK,BLANK,3);                                   24016000
      IF PARM = 0 THEN RETURN;                                          24018000
      MOVE LHS := AUXLIST , (9);                                        24020000
      XREMJTENTRY(LHS,BLANK,BLANK,3)                                    24022000
END;                                                                    24024000
   MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                      <<U.RAO>>24026000
   IF NUMPARMS > 2 THEN  <<TOO MANY PARAMETERS>>               <<U.RAO>>24028000
      BEGIN                                                    <<U.RAO>>24030000
      PARMNUM := 3;                                            <<U.RAO>>24032000
      TOS := ERRNUM := SUBS2MP;                                <<U.RAO>>24034000
      TOS := LPARM(4);  <<ADDRESS OF 3RD PARM>>                <<U.RAO>>24036000
      CIERR(*,*,%10000,2);                                     <<U.RAO>>24038000
      RETURN                                                   <<U.RAO>>24040000
      END;                                                     <<U.RAO>>24042000
   IF (NUMPARMS=0) OR ((TEMP := LOGICAL(BPARM(2)))=0) THEN     <<U.RAO>>24044000
      BEGIN  <<DUMP FILE SPECIFICATION MISSING>>               <<U.RAO>>24046000
      PARMNUM := 1;                                            <<U.RAO>>24048000
      CIERR(ERRNUM := DUMPFILENOTOPT,PARMSP);                  <<U.RAO>>24050000
      RETURN;                                                  <<U.RAO>>24052000
      END;                                                     <<U.RAO>>24054000
   @FNAME := LPARM;                                                     24056000
   IF FNAME <> "*" AND FNAME<>"$NULL" THEN <<MUST BE BACKREF>> <<U.RAO>>24058000
      BEGIN                                                    <<U.RAO>>24060000
      PARMNUM := 1;                                            <<U.RAO>>24062000
      CIERR(ERRNUM := DUMPFILENOTBACKREF, FNAME);              <<U.RAO>>24064000
      RETURN                                                   <<U.RAO>>24066000
      END;                                                     <<U.RAO>>24068000
   MOVE LHS := TAPFIL , (9);                                            24070000
   ERRNUM := CYIMPLCTFILE'(LHS,FNAME,TEMP);                    <<U.RAO>>24072000
   IF <> THEN   <<ERROR IN NAME>>                              <<U.RAO>>24074000
      BEGIN                                                    <<U.RAO>>24076000
      PARMNUM :=1;                                             <<U.RAO>>24078000
      RETURN                                                   <<U.RAO>>24080000
      END;                                                     <<U.RAO>>24082000
   IF (NUMPARMS=1) OR ((TEMP := LOGICAL(BPARM(6)))=0) THEN     <<U.RAO>>24084000
      GO TO SKIP;  <<NO AUXILIARY LIST FILE>>                  <<U.RAO>>24086000
   @FNAME := LPARM(2);                                                  24088000
   MOVE LHS := AUXLIST , (9);                                           24090000
   ERRNUM := CYIMPLCTFILE'(LHS,FNAME,TEMP);                    <<U.RAO>>24092000
   IF <> THEN   <<ERROR IN NAME>>                              <<U.RAO>>24094000
      BEGIN                                                    <<U.RAO>>24096000
      CLEANUP;                                                 <<U.RAO>>24098000
      PARMNUM :=2;                                             <<U.RAO>>24100000
      RETURN                                                   <<U.RAO>>24102000
      END;                                                     <<U.RAO>>24104000
   PARM := 2;                                                           24106000
SKIP:                                                                   24108000
   MOVE LHS := "SYSDUMP.PUB.SYS ";                                      24110000
   SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>       <<02.MM>>24112000
      TOS := TOS + 0;            <<CLEAR CARRY>>                        24114000
   CREATE(LHS,,PIN,PARM,1);                                             24116000
      IF CARRY THEN                                                     24118000
            BEGIN                                              <<U.RAO>>24120000
            LHS(7) := 0;    <<SET UP AS PARM TO GENMSG>>       <<U.RAO>>24122000
            IF CREATEERROR THEN                                <<U.RAO>>24124000
               CIERR(ERRNUM := SUBSYSCREATEERR,,0,@LHS)        <<U.RAO>>24126000
            ELSE                                               <<U.RAO>>24128000
               CIERR(ERRNUM := SUBSYSLOADERR,,0,@LHS);         <<U.RAO>>24130000
            CLEANUP;                                           <<U.RAO>>24132000
            RETURN                                             <<U.RAO>>24134000
      END;                                                              24136000
      IF < THEN                                                         24138000
            BEGIN                                              <<U.RAO>>24140000
         LHS(7) := 0;                                          <<U.RAO>>24142000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@LHS);                <<U.RAO>>24144000
         CLEANUP;                                                       24146000
         RETURN;                                               <<U.RAO>>24148000
      END;                                                              24150000
   NEXTLINE;                                                            24152000
   AWAKE(PIN*PCBSIZE,1,2);                                              24154000
                                                                        24156000
      CLEANUP;                                                          24158000
CISUBSYSFINISH(3, ERRNUM, PARMNUM);                            <<U.RAO>>24160000
END;                                                                    24162000
$CONTROL SEGMENT = CISUBS                                      <<U.RAO>>24164000
      PROCEDURE CXRJE EXECUTORHEAD;                                     24166000
      OPTION PRIVILEGED,UNCALLABLE;                                     24168000
      BEGIN                                                             24170000
      BYTE ARRAY PROGFILE(0:11);                                        24172000
      BYTE ARRAY BUILDNAME(0:7);                                        24174000
      INTEGER NUMPARMS,PCNT:=-1;                                        24176000
      DOUBLE ARRAY PARMS(0:4);                                 <<U.RAO>>24178000
      LBPARMDECS;                                                       24180000
      LOGICAL COMCR:=%26015,T:=1,PARM:=0,PIN;                           24182000
      BYTE POINTER FNAME;                                               24184000
      SUBROUTINE CLEANUP;                                               24186000
         BEGIN                                                          24188000
         DELIMPFILE(PARM,BUILDNAME);                                    24190000
         END;<<CLEAN UP>>                                               24192000
      MOVE PROGFILE:="RJE.PUB.SYS ";                                    24194000
      MOVE BUILDNAME:="RJE";                                            24196000
      MYCOMMAND(PARMSP,COMCR,5,NUMPARMS,PARMS);                <<U.RAO>>24198000
      IF NUMPARMS>4 THEN  <<TOO MANY PARAMETERS FOR RJE>>      <<U.RAO>>24200000
         BEGIN                                                 <<U.RAO>>24202000
         PARMNUM := 5;                                         <<U.RAO>>24204000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>24206000
         TOS := LPARM(8);                                      <<U.RAO>>24208000
         CIERR(*,*,%10000,4);                                  <<U.RAO>>24210000
         RETURN                                                <<U.RAO>>24212000
         END;                                                  <<U.RAO>>24214000
      WHILE(PCNT:=PCNT+1)<NUMPARMS DO                                   24216000
      IF (T:=BPARM(2+PCNT&ASL(2)))<>0 THEN                              24218000
         BEGIN                                                          24220000
         @FNAME:=LPARM(PCNT&ASL(1));                                    24222000
         CASE PCNT OF                                                   24224000
            BEGIN                                                       24226000
               BEGIN<<COMMAND>>                                         24228000
               MOVE BUILDNAME(3):="COM ";                               24230000
               PARM.(15:1):=1;                                          24232000
               END;                                                     24234000
               BEGIN<<INPUT>>                                           24236000
               MOVE BUILDNAME(3):="IN ";                                24238000
               PARM.(13:1):=1;                                          24240000
               END;                                                     24242000
               BEGIN<<LIST>>                                            24244000
               MOVE BUILDNAME(3):="LIST ";                              24246000
               PARM.(14:1):=1;                                          24248000
               END;                                                     24250000
               BEGIN<<PUNCH>>                                           24252000
               MOVE BUILDNAME(3):="PUNCH ";                             24254000
               PARM.(12:1):=1;                                          24256000
               END;                                                     24258000
           END;                                                         24260000
           ERRNUM := CYIMPLCTFILE'(BUILDNAME,FNAME,T);         <<U.RAO>>24262000
           IF <> THEN   <<ERROR IN NAME>>                      <<U.RAO>>24264000
              BEGIN                                            <<U.RAO>>24266000
              CLEANUP;                                         <<U.RAO>>24268000
              PARMNUM :=2;                                     <<U.RAO>>24270000
              RETURN                                           <<U.RAO>>24272000
              END;                                             <<U.RAO>>24274000
         END;                                                  <<U.RAO>>24276000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>24278000
      TOS := TOS+0;  <<CLEAR CARRY BEFORE CREATE>>             <<U.RAO>>24280000
      CREATE(PROGFILE,,PIN,PARM,1);                                     24282000
      IF CARRY THEN                                                     24284000
         BEGIN                                                          24286000
         CLEANUP;                                                       24288000
         PROGFILE(3) := 0;  <<SET UP RJE AS PARM TO GENMSG>>   <<U.RAO>>24290000
         IF CREATEERROR THEN                                   <<U.RAO>>24292000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@PROGFILE)      <<U.RAO>>24294000
         ELSE                                                  <<U.RAO>>24296000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@PROGFILE);       <<U.RAO>>24298000
         RETURN;                                               <<U.RAO>>24300000
         END;                                                           24302000
      IF< THEN                                                          24304000
         BEGIN                                                          24306000
         CLEANUP;                                                       24308000
         PROGFILE(3) := 0;                                     <<U.RAO>>24310000
         CIERR(SUBSNOTFOUND,,0,@PROGFILE);                     <<U.RAO>>24312000
         RETURN;                                               <<U.RAO>>24314000
         END;                                                           24316000
      NEXTLINE;                                                         24318000
      AWAKE(PIN*PCBSIZE,1,2);                                           24320000
      CLEANUP;                                                          24322000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>24324000
END;   <<CXRJE>>                                               <<U.RAO>>24326000
   INTEGER PROCEDURE CYIMPLCTFILE'(LHS,RHS,LENR);              <<U.RAO>>24328000
   VALUE LENR;                                                 <<U.RAO>>24330000
   INTEGER LENR;                                               <<U.RAO>>24332000
   BYTE ARRAY LHS, RHS;                                        <<U.RAO>>24334000
   OPTION PRIVILEGED, UNCALLABLE;                              <<U.RAO>>24336000
                                                               <<U.RAO>>24338000
BEGIN                                                          <<U.RAO>>24340000
<< This procedure does implicit file equates for >>            <<U.RAO>>24342000
<< the subsystem commands.  For example, it does >>            <<U.RAO>>24344000
<< an equate SPLTEXT = <user supplied file name> >>            <<U.RAO>>24346000
<< for the SPL compiler, if required.  File      >>            <<U.RAO>>24348000
<< equates should only be done if the user       >>            <<U.RAO>>24350000
<< explicitly provided a file name.  The usual   >>            <<U.RAO>>24352000
<< communication path to the compilers is through>>            <<U.RAO>>24354000
<< the PARM parameter in the CREATE intrinsic.   >>            <<U.RAO>>24356000
<< See the individual subsystem for specifics.   >>            <<U.RAO>>24358000
<< Incidentally, the reader should note that     >>            <<U.RAO>>24360000
<< this routine is responsible for parsing the   >>            <<U.RAO>>24362000
<< user supplied file name and for reporting     >>            <<U.RAO>>24364000
<< errors related to the procedure's inability   >>            <<U.RAO>>24366000
<< to add the equate to the JDT.  A companion    >>            <<U.RAO>>24368000
<< procedure, DELIMPFILE, deletes the file equate>>            <<U.RAO>>24370000
<< on termination of the compiler.               >>            <<U.RAO>>24372000
                                                               <<U.RAO>>24374000
INTEGER RESULTSPACE=CYIMPLCTFILE';                             <<U.RAO>>24376000
BYTE BLANK := " ";                                             <<U.RAO>>24378000
      LOGICAL ARRAY FENTRY(0:31);                              <<U.RAO>>24380000
BYTE ARRAY BFENTRY(*) = FENTRY;                                <<U.RAO>>24382000
BYTE POINTER BGPTR := @BLANK,                                  <<U.RAO>>24384000
             BAPTR := @BLANK,                                  <<U.RAO>>24386000
             BERRPTR;                                          <<U.RAO>>24388000
LOGICAL GPTR = BGPTR,                                          <<U.RAO>>24390000
        APTR = BAPTR,                                          <<U.RAO>>24392000
        ERRPTR = BERRPTR;                                      <<U.RAO>>24394000
LOGICAL SYSFLAG := FALSE;                                      <<U.RAO>>24396000
                                                               <<U.RAO>>24398000
CC := CCE;                                                     <<U.RAO>>24400000
<<FIRST TASK IS TO CHECK VALIDITY OF FILE NAME>>               <<U.RAO>>24402000
TOS := 0;                                                      <<U.RAO>>24404000
TOS := @RHS;                                                   <<U.RAO>>24406000
TOS := LENR;                                                   <<U.RAO>>24408000
TOS := CHECKFILENAME'(*,GPTR,APTR,ERRPTR);                     <<U.RAO>>24410000
IF < THEN  <<ERROR IN PARSING NAME>>                           <<U.RAO>>24412000
   BEGIN                                                       <<U.RAO>>24414000
   CYIMPLCTFILE' := S0;                                        <<U.RAO>>24416000
   CC := CCG;                                                  <<U.RAO>>24418000
   CIERR(*,BERRPTR);                                           <<U.RAO>>24420000
   RETURN                                                      <<U.RAO>>24422000
   END                                                         <<U.RAO>>24424000
ELSE IF > THEN                                                 <<U.RAO>>24426000
   IF S0=0 THEN  <<BACK REFERENCED FILE NAME>>                 <<U.RAO>>24428000
      BEGIN                                                    <<U.RAO>>24430000
      DEL;                                                     <<U.RAO>>24432000
      FENTRY := 1;  <<NAME PRESENT BIT IN PMASK>>              <<U.RAO>>24434000
      FENTRY(1) := %1000;  <<SET POINTER BIT>>                 <<U.RAO>>24436000
      FENTRY(2) := (LENR-1)&LSL(8);  <<NAME LENGTH>>           <<U.RAO>>24438000
      MOVE BFENTRY(6) := RHS(1),(LENR-1);                      <<U.RAO>>24440000
      TOS := XADDJTENTRY(LHS,BLANK,BLANK,-3,(14+LENR&LSR(1)),  <<U.RAO>>24442000
                 FENTRY,RHS(1),BGPTR,BAPTR);                   <<U.RAO>>24444000
      CASE TOS OF                                              <<U.RAO>>24446000
         BEGIN                                                 <<U.RAO>>24448000
         ;  <<OK RETURN>>                                      <<U.RAO>>24450000
         BEGIN                                                 <<U.RAO>>24452000
            CC := CCL;                                         <<U.RAO>>24454000
            CIERR(RESULTSPACE := FEQTABFULL);                  <<U.RAO>>24456000
         END;                                                  <<U.RAO>>24458000
         ;  <<DUPLICATE NAME - CAN'T HAPPEN>>                  <<U.RAO>>24460000
         BEGIN   <<ACTUAL DESIGNATOR NOT FOUND>>               <<U.RAO>>24462000
            CC := CCL;                                         <<U.RAO>>24464000
            QUALIFYFILENAME(RHS(1),BFENTRY);                   <<U.RAO>>24466000
            CIERR(RESULTSPACE := FILEBREFMISADES,,0,@BFENTRY); <<U.RAO>>24468000
         END;                                                  <<U.RAO>>24470000
         BEGIN  <<TOO MANY BACK REFERENCES TO THIS ADESIGNATOR><<U.RAO>>24472000
            CC := CCL;                                         <<U.RAO>>24474000
            QUALIFYFILENAME(RHS(1),BFENTRY);                   <<U.RAO>>24476000
            CIERR(RESULTSPACE := TOOMANYFEQBREF,,0,@BFENTRY);  <<U.RAO>>24478000
         END;                                                  <<U.RAO>>24480000
         BEGIN  << CIRCULAR FILE EQUATION >>                   <<00834>>24482000
            CC := CCL;                                         <<00834>>24484000
            CIERR(RESULTSPACE := CIRCULARFEQ);                 <<00834>>24486000
         END;                                                  <<00834>>24488000
         END;  <<OF CASE>>                                     <<U.RAO>>24490000
      END                                                      <<U.RAO>>24492000
   ELSE                                                        <<U.RAO>>24494000
      BEGIN  <<SYSTEM DEFINED FILE>>                           <<U.RAO>>24496000
      SYSFLAG := TRUE;                                         <<U.RAO>>24498000
      FENTRY := %20;  <<DEFAULT DESIGNATOR BIT>>               <<U.RAO>>24500000
      FENTRY(1) := 0;  <<PMASK WORD 2>>                        <<U.RAO>>24502000
      FENTRY(2) := 0;  <<NAME LENGTH>>                         <<U.RAO>>24504000
      FENTRY(3) := TOS&LSL(3);  <<FOPTIONS WORD>>              <<U.RAO>>24506000
      TOS := ADDJTENTRY(LHS,BLANK,BLANK,-3,4,FENTRY);          <<U.RAO>>24508000
      IF TOS <> 0 THEN   <<ERROR RETURN FROM DIRECTORY>>       <<U.RAO>>24510000
         BEGIN                                                 <<U.RAO>>24512000
         CC := CCL;                                            <<U.RAO>>24514000
         CIERR(RESULTSPACE := FEQTABFULL);                     <<U.RAO>>24516000
         END;                                                  <<U.RAO>>24518000
      END                                                      <<U.RAO>>24520000
ELSE   <<REGULAR FILE NAME>>                                   <<U.RAO>>24522000
   BEGIN                                                       <<U.RAO>>24524000
   FENTRY := 1;  <<NAME PRESENT>>                              <<U.RAO>>24526000
   FENTRY(1) := 0;                                             <<U.RAO>>24528000
   FENTRY(2) := LENR&LSL(8); <<NAME LENGTH IN UPPER BYTE>>     <<U.RAO>>24530000
   MOVE BFENTRY(6) := RHS,(LENR);                              <<U.RAO>>24532000
   TOS := ADDJTENTRY(LHS,BLANK,BLANK,-3,(3+(LENR+1)&LSR(1)),   <<U.RAO>>24534000
                                    FENTRY);                   <<U.RAO>>24536000
   IF TOS <> 0 THEN   <<ERROR RETURN FROM DIRECTORY>>          <<U.RAO>>24538000
      BEGIN                                                    <<U.RAO>>24540000
      CC := CCL;                                               <<U.RAO>>24542000
      CIERR(RESULTSPACE := FEQTABFULL);                        <<U.RAO>>24544000
      END;                                                     <<U.RAO>>24546000
   END;                                                        <<U.RAO>>24548000
END;                                                           <<U.RAO>>24550000
PROCEDURE DELIMPFILE(PARM,FNAME);                                       24552000
   VALUE PARM;                                                          24554000
   LOGICAL PARM;                                                        24556000
   BYTE ARRAY FNAME;                                                    24558000
   OPTION PRIVILEGED, UNCALLABLE;                                       24560000
BEGIN LOGICAL BLANK := "  ";                                            24562000
      BYTE POINTER GPNTR := @BLANK;                                     24564000
      INTEGER I := 0;                                                   24566000
      BYTE ARRAY FTYPES(0:29) = PB :=                                   24568000
         "TEXT LIST USL  MAST NEW  ";                                   24570000
LOOP:                                                                   24572000
      IF PARM THEN                                                      24574000
      BEGIN MOVE FNAME(3) := FTYPES(5*I) , (5);                         24576000
            XREMJTENTRY(FNAME,GPNTR,GPNTR,3)                            24578000
      END;                                                              24580000
      PARM := PARM & LSR(1);                                            24582000
      I := I + 1;                                                       24584000
      IF I < 5 THEN GO TO LOOP;                                         24586000
END   <<DELIMPFILE>>;                                                   24588000
$PAGE   "MISC. COMMAND EXECUTORS -- JOB, HELLO,BYE ETC."                24590000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>24592000
                                                                        24594000
      PROCEDURE CXJOB EXECUTORHEAD;                                     24596000
      OPTION PRIVILEGED, UNCALLABLE;                                    24598000
      BEGIN                                                             24600000
      COMMENT                                                           24602000
      CXJOB IS THE EXECUTOR FOR JOB,EOJ,HELLO,BYE&DATA                  24604000
      COMMAND FORMAT                                                    24606000
      JOB                                                               24608000
      EOJ                                                               24610000
      DATA                                                              24612000
      BYE                                                               24614000
      HELLO                                                             24616000
      ;                                                                 24618000
      ENTRY CXEOJ,CXHELLO,CXBYE,CXDATA;                                 24620000
CXHELLO: << HELLO COMMAND >>                                   <<02329>>24622000
CXDATA:  << DATA COMMAND >>                                    <<02329>>24624000
       CIERR(ERRNUM := BADLOGONSTRING);                        <<02329>>24626000
       RETURN;                                                 <<02329>>24628000
CXEOJ:  << END OF JOB >>                                       <<02329>>24630000
CXBYE:  << END CXJOB  >>                                       <<02329>>24632000
      TERMINATE;                                                        24634000
      END;<<CXJOB>>                                                     24636000
      PROCEDURE CXEOD EXECUTORHEAD;                                     24638000
      OPTION PRIVILEGED, UNCALLABLE;                                    24640000
      BEGIN                                                             24642000
      COMMENT                                                           24644000
      CXEOD IS THE EXECUTOR FOR THE EOD COMMAND                         24646000
      COMMAND FORMAT                                                    24648000
      EOD                                                               24650000
      ;                                                                 24652000
      CIERR(-IGNORED);  <<UNIMPORTANT TO CI>>                  <<U.RAO>>24654000
      END;<<EOD>>                                                       24656000
      PROCEDURE CXPTAPE EXECUTORHEAD;                                   24658000
      OPTION PRIVILEGED, UNCALLABLE;                                    24660000
      BEGIN                                                             24662000
      COMMENT                                                           24664000
      CXPTAPE IS THE EXECUTOR FOR THE PTAPE COMMAND                     24666000
      COMMAND FORMAT                                                    24668000
      PTAPE FILENAME                                                    24670000
      ;                                                                 24672000
      DOUBLE ARRAY PARM(0:1)=Q;                                <<U.RAO>>24674000
      BYTE POINTER BADPARM=PARM+2;                             <<U.RAO>>24676000
   DOUBLE DL := COMMASEMICR;                                   <<U.RAO>>24678000
      BYTE POINTER FNAME = PARM;                                        24680000
      BYTE LEN = PARM + 1;                                              24682000
      INTEGER NUMPARMS, FN1, FN2;                                       24684000
                                                                        24686000
      MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARM);                    <<U.RAO>>24688000
      IF NUMPARMS > 1 THEN  <<TOO MANY PARAMETERS>>            <<U.RAO>>24690000
         BEGIN                                                 <<U.RAO>>24692000
         PARMNUM := 2;                                         <<U.RAO>>24694000
         CIERR(ERRNUM := PTAPE2MP,BADPARM);                    <<U.RAO>>24696000
         RETURN;                                               <<U.RAO>>24698000
         END;                                                  <<U.RAO>>24700000
      IF NUMPARMS = 0 THEN  <<REQUIRES 1 PARM>>                <<U.RAO>>24702000
         BEGIN                                                 <<U.RAO>>24704000
         PARMNUM := 1;                                         <<U.RAO>>24706000
         CIERR(ERRNUM := PTAPENOFILE, PARMSP);                 <<U.RAO>>24708000
         RETURN;                                               <<U.RAO>>24710000
         END;                                                  <<U.RAO>>24712000
      IF CIBADFILENAME(ERRNUM,PARM) THEN                       <<U.RAO>>24714000
         BEGIN                                                 <<U.RAO>>24716000
         PARMNUM := 1;                                         <<U.RAO>>24718000
         RETURN                                                <<U.RAO>>24720000
         END;                                                  <<U.RAO>>24722000
      FN1 := FOPEN(,%44);<<OPEN $STDIN,ASCII>>                          24724000
      IF CARRY THEN  <<OPEN FAILED FOR SOME REASON>>           <<U.RAO>>24726000
         BEGIN                                                 <<U.RAO>>24728000
         CIERR(ERRNUM := PTAPETERMFILE);                       <<U.RAO>>24730000
         RETURN                                                <<U.RAO>>24732000
         END;                                                  <<U.RAO>>24734000
      FN2:=FOPEN(FNAME,%2107,%101);<<DISCFILE,OLD,ASCII,VAR,NO FILE EQ>>24736000
      IF CARRY THEN<<FOPEN OK?>>                                        24738000
         BEGIN<<NO>>                                                    24740000
         FCLOSE(FN1,0,0);<<CLOSE $STDIN>>                               24742000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>24744000
         FNAME(LEN) := 0;                                      <<U.RAO>>24746000
         CIERR(ERRNUM := PTAPEOPENFAILED,,0,@FNAME);           <<U.RAO>>24748000
         RETURN;                                               <<U.RAO>>24750000
         END;                                                           24752000
      PTAPE(FN1,FN2);<<READ PAPER TAPE IN>>                             24754000
      IF < THEN    <<CCL FROM PTAPE => ERROR ON $STDIN>>       <<U.RAO>>24756000
         BEGIN                                                 <<U.RAO>>24758000
         FERROR'(FN1,PARMNUM);                                 <<U.RAO>>24760000
         CIERR(ERRNUM := PTAPEFSERR,,%10000,PARMNUM);          <<U.RAO>>24762000
         FCLOSE(FN2,0,0);                                      <<U.RAO>>24764000
         RETURN;                                               <<U.RAO>>24766000
         END;                                                  <<U.RAO>>24768000
      IF > THEN  <<CCG FROM PTAPE => ERROR ON TARGET FILE>>    <<U.RAO>>24770000
         BEGIN                                                 <<U.RAO>>24772000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>24774000
         CIERR(ERRNUM := PTAPETOFSERR,,%10000,PARMNUM);        <<U.RAO>>24776000
         FCLOSE(FN1,0,0);                                      <<U.RAO>>24778000
         RETURN                                                <<U.RAO>>24780000
         END;                                                  <<U.RAO>>24782000
      FCLOSE(FN1,0,0);                                         <<U.RAO>>24784000
      FCLOSE(FN2,0,0);                                         <<U.RAO>>24786000
      IF CARRY THEN                                            <<U.RAO>>24788000
         BEGIN                                                 <<U.RAO>>24790000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>24792000
         CIERR(ERRNUM := PTAPECLOSEERR,,%10000,PARMNUM);       <<U.RAO>>24794000
         END;                                                  <<U.RAO>>24796000
END;   <<CXPTAPE>>                                             <<U.RAO>>24798000
PROCEDURE FORMUSERID(USERID);                                  <<U.RAO>>24800000
BYTE ARRAY USERID;                                             <<U.RAO>>24802000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>24804000
<<THIS PROCEDURE FORMS A USER ID FOR THE CALLER'S USER>>       <<U.RAO>>24806000
<<OF THE FORM J/S NNN USER.ACCOUNT,LOGON GROUP>>               <<U.RAO>>24808000
BEGIN                                                          <<U.RAO>>24810000
INTEGER ARRAY JITDATA(0:22);  <<HOLDS COPY OF DATA IN JIT>>    <<U.RAO>>24812000
BYTE ARRAY UNAME(*)=JITDATA(19);                               <<U.RAO>>24814000
BYTE ARRAY LGNAME(*) = JITDATA(15);  <<LOGON GROUP NAME IN JIT><<U.RAO>>24816000
BYTE ARRAY ANAME(*)=JITDATA(7);                                <<U.RAO>>24818000
BYTE ARRAY USERSNUM(0:5);  <<J/S NNN>>                         <<U.RAO>>24820000
DEFINE JOBFIELD = (0:2)#;                                      <<U.RAO>>24822000
EQUATE SESSIONTYPE = 1,  <<BIT PATTERN IN JOB NUMBER WORD>>    <<U.RAO>>24824000
       JOBTYPE = 2;                                            <<U.RAO>>24826000
                                                               <<U.RAO>>24828000
TOS := @JITDATA;                                               <<U.RAO>>24830000
SETJIT;   <<WE ARE COPYING THE DATA FROM THE JIT>>             <<U.RAO>>24832000
TOS := 9;  <<START AT JOB TYPE/NUMBER FIELD>>                  <<U.RAO>>24834000
TOS := 23;  <<END AFTER USER'S NAME>>                          <<U.RAO>>24836000
ASSEMBLE(MFDS);                                                <<U.RAO>>24838000
<<NOW CONVERT JOB TYPE/NUMBER TO STRING>>                      <<U.RAO>>24840000
USERSNUM(2) := " ";                                            <<U.RAO>>24842000
MOVE USERSNUM(3) := USERSNUM(2),(3);                           <<00749>>24844000
IF JITDATA.JOBFIELD = SESSIONTYPE THEN                         <<U.RAO>>24846000
   USERSNUM := "S"                                             <<U.RAO>>24848000
ELSE                                                           <<U.RAO>>24850000
   USERSNUM := "J";                                            <<U.RAO>>24852000
ASCII(JITDATA.(2:14),10,USERSNUM(1));  <<SESSION NUMBER>>      <<U.RAO>>24854000
FORMNAME(3,USERID,USERSNUM,UNAME,ANAME,LGNAME);                <<U.RAO>>24856000
END;                                                           <<U.RAO>>24858000
PROCEDURE CXSHOWME EXECUTORHEAD;                               <<U.RAO>>24860000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>24862000
BEGIN                                                          <<U.RAO>>24864000
BYTE ARRAY USERID(0:24);  <<WILL HOLD J/S NN, USERNAME>>       <<U.RAO>>24866000
INTEGER ARRAY PARTNO(0:4);  <<FOR GENMSG REASONS>>             <<U.RAO>>24868000
BYTE ARRAY BPARTNO(*)=PARTNO;  <<DITTO>>                       <<U.RAO>>24870000
INTEGER CURRENTDATE;  <<THIS INSTANT IN TIME>>                 <<U.RAO>>24872000
DOUBLE CURRENTTIME;  <<THIS INSTANT IN TIME>>                  <<U.RAO>>24874000
BYTE ARRAY DATEBUF(0:27);  <<HOLDS FORMATTED DATE>>            <<U.RAO>>24876000
INTEGER ARRAY LOGON(0:2)=Q;  <<LOGON DATE & TIME>>             <<U.RAO>>24878000
INTEGER LOGONDATE = LOGON;                                     <<U.RAO>>24880000
DOUBLE LOGONTIME = LOGON+1;                                    <<U.RAO>>24882000
DOUBLE CPUTIME;  <<TOTAL CPU TIME UP TO THIS INSTANT>>         <<U.RAO>>24884000
DOUBLE CONNECTTIME;  <<TOTAL CONNECT TIME UP TO NOW>>          <<U.RAO>>24886000
INTEGER STDINLDEV;  <<LDEV FOR $STDIN>>                        <<U.RAO>>24888000
INTEGER STDLISTLDEV;  <<LDEV FOR $STDLIST>>                    <<U.RAO>>24890000
INTEGER CURRENTTIME0=CURRENTTIME;                              <<U.RAO>>24892000
INTEGER CURRENTTIME1=CURRENTTIME+1;                            <<U.RAO>>24894000
INTEGER LOGONTIMEADR;    <<ADDRESS IN JMAT OF TIME STAMP>>     <<U.RAO>>24896000
INTEGER SHOWMEMSG;  <<CPU ID MESSAGE NUMBER>>                  <<01403>>24898000
INTEGER JITDST;                                                <<U.RAO>>24900000
DEFINE                                                         <<U.RAO>>24902000
   YEAR1 = LOGONDATE.(0:7)#,                                   <<U.RAO>>24904000
   YEAR2 = CURRENTDATE.(0:7)#,                                 <<U.RAO>>24906000
   DAY1  = LOGONDATE.(7:9)#,                                   <<U.RAO>>24908000
   DAY2  = CURRENTDATE.(7:9)#,                                 <<U.RAO>>24910000
   HOUR1 = LOGON(1).(0:8)#,                                    <<U.RAO>>24912000
   HOUR2 = CURRENTTIME0.(0:8)#,                                <<U.RAO>>24914000
   MIN1  = LOGON(1).(8:8)#,                                    <<U.RAO>>24916000
   MIN2  = CURRENTTIME0.(8:8)#,                                <<U.RAO>>24918000
   SEC1  = LOGON(2).(0:8)#,                                    <<U.RAO>>24920000
   SEC2  = CURRENTTIME1.(0:8)#;                                <<U.RAO>>24922000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>24924000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>24926000
SCAN PARMSP WHILE %6440,1;  <<LOOK FOR ANY PARMS>>             <<U.RAO>>24928000
IF NOCARRY THEN                                                <<U.RAO>>24930000
   CIERR(-WARNXPARMSIGNORED, BPS0);                            <<U.RAO>>24932000
DEL;                                                           <<U.RAO>>24934000
<<FIRST LINE IS USER ID AND BREAK STATUS>>                     <<U.RAO>>24936000
FORMUSERID(USERID);                                            <<U.RAO>>24938000
SETXPXFIXED;                                                   <<U.RAO>>24940000
IF DBARRAY(XREG+PXFWBREAK) THEN                                <<U.RAO>>24942000
   GENMSG(CIGENERALMSGSET, SHOWME1BRK, 0, @USERID)             <<U.RAO>>24944000
ELSE  <<NOT IN BREAK>>                                         <<U.RAO>>24946000
   GENMSG(CIGENERALMSGSET, SHOWME1NOBRK, 0, @USERID);          <<U.RAO>>24948000
IF REQUESTSERVICE THEN RETURN;                                 <<U.RAO>>24950000
                                                               <<U.RAO>>24952000
<<NEXT LINE IS SYSTEM ID>>                                     <<U.RAO>>24954000
PARTNO := 0;                                                   <<U.RAO>>24956000
MOVE PARTNO(1) := PARTNO,(4);                                  <<U.RAO>>24958000
BPARTNO := ABSOLUTE(SYSVERSION);  <<WHOLE PROBLEM HERE IS THAT <<U.RAO>>24960000
PARTNO(1) := ABSOLUTE(SYSUPDATE);  <<THE MPE PART NUMBER IS IN <<U.RAO>>24962000
PARTNO(3) := ABSOLUTE(SYSFIX);    <<ASCII IN SYSGLOB.  WE MUST <<U.RAO>>24964000
  <<TAG THESE ASCII STRINGS WITH 0 FOR GENMSG.  THUS THE ARRAY.<<U.RAO>>24966000
CASE THISCPU OF                                                <<01403>>24968000
   BEGIN                                                       <<01403>>24970000
      SHOWMEMSG:=SHOWME6;  <<SERIES 1>>                        <<01403>>24972000
      SHOWMEMSG:=SHOWME6;  <<SERIES 2>>                        <<01403>>24974000
      SHOWMEMSG:=SHOWME33; <<SERIES 33>>                       <<01403>>24976000
      SHOWMEMSG:=SHOWME6;  <<SERIES 3>>                        <<01403>>24978000
      SHOWMEMSG:=SHOWME33; <<ICF/44>>                          <<01403>>24980000
      SHOWMEMSG:=SHOWME55; <<ICF/55>>                          <<01403>>24982000
   END;                                                        <<01403>>24984000
GENMSG (CIGENERALMSGSET, SHOWMEMSG, 0,                         <<01403>>24986000
   @BPARTNO, @BPARTNO(2), @BPARTNO(6));                        <<U.RAO>>24988000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>24990000
                                                               <<U.RAO>>24992000
<<NEXT LINE IS CURRENT DATE & TIME>>                           <<U.RAO>>24994000
CURRENTDATE := CALENDAR;                                       <<U.RAO>>24996000
CURRENTTIME := CLOCK;                                          <<U.RAO>>24998000
FMTDATE(CURRENTDATE, CURRENTTIME, DATEBUF);                    <<U.RAO>>25000000
DATEBUF(27) := 0;                                              <<U.RAO>>25002000
GENMSG(CIGENERALMSGSET, SHOWME2, 0, @DATEBUF);                 <<U.RAO>>25004000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>25006000
                                                               <<U.RAO>>25008000
<<NOW PUT OUT LOGON TIME AND DATE>>                            <<U.RAO>>25010000
SETXPXGLOB+PXGWJMATX;                                          <<U.RAO>>25012000
LOGONTIMEADR := DBARRAY(X).(0:8)*JMATLEN+JMATTIMESTAMP;        <<U.RAO>>25014000
MOVEFROMDSEG(@LOGON, JMATDST, LOGONTIMEADR, 3);                <<U.RAO>>25016000
FMTDATE(LOGONDATE,LOGONTIME,DATEBUF);                          <<U.RAO>>25018000
DATEBUF(27):=0;                                                <<02335>>25020000
GENMSG(CIGENERALMSGSET, SHOWME3, 0, @DATEBUF);                 <<U.RAO>>25022000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>25024000
                                                               <<U.RAO>>25026000
<<NEXT DO CPU AND CONNECT TIME>>                               <<U.RAO>>25028000
SETJIT;  <<CPU TIME ACCUMULATOR IS IN JIT>>                    <<U.RAO>>25030000
JITDST := TOS;                                                 <<U.RAO>>25032000
TOS := @CPUTIME;                                               <<U.RAO>>25034000
MOVEFROMDSEG( *, JITDST, JITCPUTIME, 2);                       <<U.RAO>>25036000
SETXPXFIXED + PXFCPUTIME;  <<GO FOR LOCAL PROCESS TIME>>       <<U.RAO>>25038000
TOS := DBARRAY(X);                                             <<U.RAO>>25040000
TOS := DBARRAY(X := X+1);                                      <<U.RAO>>25042000
CPUTIME := TOS + CPUTIME + 999D;                               <<U.RAO>>25044000
IF OVERFLOW THEN                                               <<U.RAO>>25046000
   CPUTIME := 2147483D  <<MAX CPU SECONDS>>                    <<U.RAO>>25048000
ELSE                                                           <<U.RAO>>25050000
   CPUTIME := CPUTIME/1000D;  <<MILLISEC TO SECONDS>>          <<U.RAO>>25052000
<<NOW COMPUTE CONNECT TIME>>                                   <<U.RAO>>25054000
<<ALGORITHM FOR COMPUTING MINUTES BETWEEN TWO TIME STAMPS:>>   <<U.RAO>>25056000
<< (M2-M1)                                                >>   <<U.RAO>>25058000
<< + 60*((H2-H1)                                          >>   <<U.RAO>>25060000
<< + 24*((D2-D1)+((Y2-1)/4*4-Y1+4)/4    (LEAP YEAR)       >>   <<U.RAO>>25062000
<< + 365*(Y2-Y1)))                                        >>   <<U.RAO>>25064000
<<                                                        >>   <<U.RAO>>25066000
TOS := ((YEAR2 - 1)&ASR(2)&ASL(2)-YEAR1+4)&ASR(2);             <<U.RAO>>25068000
TOS := 45; ASSEMBLE(MPYL);                                     <<U.RAO>>25070000
TOS := YEAR2-YEAR1;                                            <<U.RAO>>25072000
TOS := 16425;  ASSEMBLE(MPYL, DADD);                           <<U.RAO>>25074000
TOS := TOS&DASL(5);                                            <<U.RAO>>25076000
TOS := (DAY2-DAY1)*24+(HOUR2-HOUR1);                           <<U.RAO>>25078000
TOS := 60; ASSEMBLE(MPYL, DADD);                               <<U.RAO>>25080000
TOS := TOS+DOUBLE(MIN2-MIN1);                                  <<U.RAO>>25082000
IF SEC2 > SEC1 THEN TOS := TOS+1D;                             <<U.RAO>>25084000
CONNECTTIME := TOS;                                            <<U.RAO>>25086000
GENMSG(CIGENERALMSGSET, SHOWME4,                               <<U.RAO>>25088000
   %22000, @CPUTIME, @CONNECTTIME);                            <<U.RAO>>25090000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>25092000
                                                               <<U.RAO>>25094000
<<FINALLY DO $STDIN, $STDLIST>>                                <<U.RAO>>25096000
SETXPXGLOB+PXGWJOBIN;  <<POINT TO PLACE IN PXGLOB OF LDEVS>>   <<U.RAO>>25098000
STDINLDEV := DBARRAY(X).(8:8);                                 <<U.RAO>>25100000
STDLISTLDEV := DBARRAY(X := X+1).(8:8);                        <<U.RAO>>25102000
GENMSG(CIGENERALMSGSET, SHOWME5,                               <<U.RAO>>25104000
   %11000, STDINLDEV, STDLISTLDEV);                            <<U.RAO>>25106000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>25108000
TOS := ABSOLUTE(WELCOMEDST);                                   <<U.RAO>>25110000
IF > THEN  <<WELCOME MESSAGE EXISTS>>                          <<U.RAO>>25112000
   WELCOMEMES(*,0); <<SECOND PARM IS FUNNY TERMINAL>>          <<U.RAO>>25114000
END;                                                           <<U.RAO>>25116000
PROCEDURE CXSPEED EXECUTORHEAD;                                <<U.RAO>>25118000
      OPTION PRIVILEGED, UNCALLABLE;                                    25120000
      BEGIN                                                             25122000
      COMMENT                                                           25124000
      CXSPEED IS THE EXECUTOR FOR THE SPEED COMMAND                     25126000
      COMMAND FORMAT                                                    25128000
      SPEED [INSPEED],OUTSPEED OR SPEED INSPEED                         25130000
  *** NOTE: IN AND OUT SPEEDS MUST BE EQUAL ON A SERIES 33 *** <<0306>> 25132000
      ;                                                                 25134000
      DOUBLE ARRAY PARMS(0:2);                                 <<U.RAO>>25136000
      LOGICAL DL := %26015;                                             25138000
      INTEGER NUMPARMS,INSPD,OTSPD,INLDEV,OUTLDEV,LEN1,LEN2;            25140000
      INTEGER OLDINSPD;                                        <<0306>> 25142000
      LOGICAL POSTSERIES3;  <<TRUE IF RUNNING ON SERIES 33 OR  <<01403>>25144000
                            <<ICF/44 OR ICF/55>>               <<01403>>25146000
      BYTE POINTER NUMB1,NUMB2;                                         25148000
      ARRAY WOBUF (0:14),LPARM(*)=PARMS;                                25150000
      BYTE ARRAY OBUF (*) = WOBUF,BPARM(*)=PARMS;                       25152000
      ARRAY MSG(*)=PB:="CHANGE SPEED AND INPUT ""MPE"": ";              25154000
                                                                        25156000
      INTEGER SUBROUTINE CHANGEOUTSPD;                                  25158000
        <<                                                              25160000
           THIS SUBROUTINE CHANGES THE OUT SPEED TO THE VALUE SPECIFIED 25162000
          IN OTSPD AND SETS THE OLD SPEED IN OTSPD.IT RETURNS THE LAST  25164000
           3 BITS OF THE STATUS RETURNED FROM ATTACHIO.                 25166000
        >>                                                              25168000
        BEGIN                                                           25170000
          ASSEMBLE(DELB,DZRO);  << DELETE RETURN & ATTACHIO RETURN >>   25172000
          TOS := OUTLDEV;                                               25174000
          TOS := ATTACHIO(*,0,0,0,7,0,OTSPD,0,1);                       25176000
          OTSPD := TOS;  << SAVE OLD SPEED >>                           25178000
          TOS := TOS.(13:3);   << MASK TO GENERAL STATUS RETURN >>      25180000
          ASSEMBLE( XCH     );  << RETURN ADDRESS TO TOS >>             25182000
        END;   << CHANGE OUT SPEED >>                                   25184000
                                                                        25186000
                                                                        25188000
      SUBROUTINE RESTORESPEED(NP);                                      25190000
         VALUE NP; INTEGER NP;                                          25192000
      <<                                                                25194000
         THIS SUBROUTINE RESTORES THE INPUT AND OUTPUT SPEEDS TO THE    25196000
         VALUES SAVED IN INSPD AND OTSPD.                               25198000
      >>                                                                25200000
        BEGIN                                                           25202000
          IF LEN1<>0 THEN                                      <<0306>> 25204000
             ATTACHIO(INLDEV,0,0,0,6,0,OLDINSPD,0,1);          <<0306>> 25206000
          IF NP=2 THEN CHANGEOUTSPD;                                    25208000
        END;   << RESTORE SPEED >>                                      25210000
                                                                        25212000
                                                                        25214000
      POSTSERIES3 := THISCPU=2 LOR THISCPU=4 LOR THISCPU=5;    <<01403>>25216000
      MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                   <<U.RAO>>25218000
      IF NUMPARMS > 2 THEN  <<ONLY ALLOW INPUT & OUTPUT SPEEDS><<U.RAO>>25220000
         BEGIN                                                 <<U.RAO>>25222000
         PARMNUM :=3;                                          <<U.RAO>>25224000
         TOS := ERRNUM := SPEED2MP;                            <<U.RAO>>25226000
         TOS := LPARM(4);                                      <<U.RAO>>25228000
         CIERR(*,*);                                           <<U.RAO>>25230000
         RETURN                                                <<U.RAO>>25232000
         END;                                                  <<U.RAO>>25234000
      LEN1 := BPARM(2);<<SET UP POINTERS TO QUANITIES RETURNED >>       25236000
      LEN2 := BPARM(6);<<BY MYCOMMAND>>                                 25238000
      @NUMB1 := LPARM;                                                  25240000
      @NUMB2 := LPARM(2);                                               25242000
      IF (NUMPARMS=0) OR (LEN1=0) AND (LEN2=0) THEN  <<NO PARMS<<U.RAO>>25244000
         BEGIN                                                 <<U.RAO>>25246000
         PARMNUM := 1;                                         <<U.RAO>>25248000
         CIERR(ERRNUM := SPEEDNOTENUF,PARMSP);                 <<U.RAO>>25250000
         RETURN                                                <<U.RAO>>25252000
         END;                                                  <<U.RAO>>25254000
      SETXPXGLOB + PXGWJOBIN;<<SET X TO PCBX GLOBAL JOB LOCATION>>      25256000
                                                                        25258000
      INLDEV := DBARRAY(X) . (8:8);<<GET JOB INPUT LDN>>                25260000
      OUTLDEV := DBARRAY(X:=X+1) . (8:8);<<GET JOB OUTPUT LDN>>         25262000
                                                                        25264000
      IF LEN1<>0 THEN   << CHECK NEW IN SPEED >>                        25266000
        BEGIN                                                           25268000
          INSPD := BINARY(NUMB1,LEN1);                                  25270000
          IF <> THEN  <<BINARY FAILED>>                        <<U.RAO>>25272000
             BEGIN                                             <<U.RAO>>25274000
             PARMNUM := 1;                                     <<U.RAO>>25276000
             CIERR(ERRNUM := ERRINSPEED,NUMB1);                <<U.RAO>>25278000
             RETURN                                            <<U.RAO>>25280000
             END;                                              <<U.RAO>>25282000
          TOS := ATTACHIO(INLDEV,0,0,0,6,0,INSPD,0,1);                  25284000
          OLDINSPD := TOS;  << SAVE OLD IN SPEED >>            <<0306>> 25286000
          IF TOS.(13:3) <> 1 THEN  <<UNACCEPTABLE SPEED>>      <<U.RAO>>25288000
             BEGIN                                             <<U.RAO>>25290000
             PARMNUM := 1;                                     <<U.RAO>>25292000
             NUMB1(LEN1) := 0;                                 <<U.RAO>>25294000
             CIERR(ERRNUM := ERRINSPEED,NUMB1,0,@NUMB1);       <<U.RAO>>25296000
             RETURN;                                           <<U.RAO>>25298000
             END;                                              <<U.RAO>>25300000
        END;                                                            25302000
                                                                        25304000
      IF NUMPARMS=2 THEN  << CHECK OUT SPEED >>                         25306000
        BEGIN                                                           25308000
          OTSPD := BINARY(NUMB2,LEN2);                                  25310000
          IF <> THEN                                                    25312000
            BEGIN                                                       25314000
              RESTORESPEED(0);   << RESTORE IN SPEED ONLY >>            25316000
              PARMNUM := 2;                                    <<U.RAO>>25318000
             CIERR(ERRNUM := ERROUTSPEED,NUMB2);               <<U.RAO>>25320000
              RETURN                                           <<U.RAO>>25322000
            END;                                                        25324000
                                                               <<0306>> 25326000
          IF POSTSERIES3 THEN                                  <<01403>>25328000
             IF LEN1 = 0 THEN  << INPUT SPEED NOT SPECIFIED >> <<0306>> 25330000
                BEGIN                                          <<0306>> 25332000
                CIERR(-SPEEDINEQUALOUT);                       <<0306>> 25334000
                TOS := ATTACHIO(INLDEV,0,0,0,6,0,OTSPD,0,1);   <<0306>> 25336000
                OLDINSPD := TOS;                               <<0306>> 25338000
                IF TOS.(13:3) <> 1 THEN                        <<0306>> 25340000
                   BEGIN                                       <<0306>> 25342000
                   CIERR(ERRNUM:=ERRINSPEED);                  <<0306>> 25344000
                   RETURN;                                     <<0306>> 25346000
                   END;                                        <<0306>> 25348000
                END                                            <<0306>> 25350000
             ELSE                                              <<0306>> 25352000
                BEGIN    << BOTH SPECIFIED. CHECK IF EQUAL >>  <<0306>> 25354000
                IF INSPD <> OTSPD THEN                         <<0306>> 25356000
                   BEGIN                                       <<0306>> 25358000
                   RESTORESPEED(0);  <<RESTORE IN SPEED>>      <<0306>> 25360000
                   PARMNUM := 2;                               <<0306>> 25362000
                   CIERR(ERRNUM:=SPEEDNOTEQUAL);               <<0306>> 25364000
                   RETURN;                                     <<0306>> 25366000
                   END;                                        <<0306>> 25368000
                END;                                           <<0306>> 25370000
                                                                        25372000
          IF CHANGEOUTSPD<>1 THEN   << BAD SPEED >>                     25374000
            BEGIN                                                       25376000
              RESTORESPEED(0);   << RESTORE IN SPEED ONLY >>            25378000
              PARMNUM := 2;                                    <<U.RAO>>25380000
              NUMB2(LEN2) := 0;                                <<U.RAO>>25382000
              CIERR(ERRNUM := ERROUTSPEED,NUMB2,0,@NUMB2);     <<U.RAO>>25384000
              RETURN                                           <<U.RAO>>25386000
            END;                                                        25388000
                                                                        25390000
          CHANGEOUTSPD;   << RESTORE OUT SPEED FOR PRINTING >>          25392000
        END                                                    <<0306>> 25394000
      ELSE      << OUTPUT SPEED NOT SPECIFIED >>               <<0306>> 25396000
        IF POSTSERIES3 THEN                                    <<01403>>25398000
           BEGIN                                               <<0306>> 25400000
           CIERR(-SPEEDINEQUALOUT);                            <<0306>> 25402000
           OTSPD := INSPD;                                     <<0306>> 25404000
           IF CHANGEOUTSPD <> 1 THEN                           <<0306>> 25406000
              BEGIN                                            <<0306>> 25408000
              RESTORESPEED(0);                                 <<0306>> 25410000
              CIERR(ERRNUM:=ERROUTSPEED);                      <<0306>> 25412000
              RETURN;                                          <<0306>> 25414000
              END;                                             <<0306>> 25416000
           CHANGEOUTSPD;  << RESTORE OUT SPEED FOR PRINTING >> <<0306>> 25418000
           END;                                                <<0306>> 25420000
                                                                        25422000
      MOVE WOBUF:=MSG,(15);                                             25424000
      PRINT(WOBUF,15,0);                                                25426000
                                                                        25428000
      IF NUMPARMS=2 OR POSTSERIES3 THEN CHANGEOUTSPD;          <<01403>>25430000
                                                                        25432000
                                                                        25434000
      TOS:=READ(WOBUF,-3);                                              25436000
      IF<> THEN TOS:=TOS+5;                                             25438000
      MOVE OBUF:=OBUF WHILE AS;                                         25440000
      IF(TOS<>3) OR(OBUF<>"MPE") THEN                                   25442000
         BEGIN                                                          25444000
         RESTORESPEED(IF POSTSERIES3 THEN 2 ELSE NUMPARMS);    <<01403>>25446000
         NEXTLINE;                                                      25448000
         CIERR(-NOTVER);                                       <<U.RAO>>25450000
         END;                                                           25452000
                                                                        25454000
      NEXTLINE;                                                         25456000
      END;          <<CXSPEED>>                                         25458000
$CONTROL SEGMENT=CISYSMGR                                      <<U.RAO>>25460000
      PROCEDURE CXALLOCATE EXECUTORHEAD;                                25462000
      OPTION PRIVILEGED, UNCALLABLE;                                    25464000
      BEGIN                                                             25466000
      COMMENT                                                           25468000
      CXALLOCATE IS THE EXECUTOR FOR ALLOCATE AND DEALLOCATE            25470000
      COMMAND FORMAT                                                    25472000
      ALLOCATE[[PROGRAM/PROCEDURE],] NAME                               25474000
      DEALLOCATE[[PROGRAM/PROCEDURE],] NAME                             25476000
      ;                                                                 25478000
      ENTRY CXDEALLOCATE;                                               25480000
      INTEGER NUMPARMS,TEMP;                                            25482000
      LOGICAL DEALOC := FALSE;                                 <<U.RAO>>25484000
      DOUBLE ARRAY PARMS(0:2);                                 <<U.RAO>>25486000
      INTEGER ARRAY IPARM(*)=PARMS;                                     25488000
      BYTE ARRAY BPARM(*)=PARMS;                                        25490000
      BYTE POINTER NAME,PNAME;                                          25492000
      LOGICAL DUMMY;  <<USED WHEN CHECKING PROGRAM FILE NAME>> <<08.RO>>25494000
      BYTE POINTER ERRPTR;  <<RETURN FROM CHECKFILENAME'>>     <<08.RO>>25496000
      LOGICAL LERRPTR = ERRPTR;                                <<08.RO>>25498000
                                                                        25500000
      GO TO PROCESS;                                                    25502000
CXDEALLOCATE:                                                           25504000
      DEALOC:=DEALOC+1;<<DE ALLOCATE IN PROCESS>>                       25506000
PROCESS:                                                                25508000
      MYCOMMAND(PARMSP,,3,NUMPARMS,PARMS);                     <<U.RAO>>25510000
      IF NUMPARMS > 2 THEN                                     <<U.RAO>>25512000
         BEGIN                                                 <<U.RAO>>25514000
         PARMNUM := 3;                                         <<U.RAO>>25516000
         TOS := ERRNUM := ALLOC2MP;                            <<U.RAO>>25518000
         TOS := IPARM(4);                                      <<U.RAO>>25520000
         CIERR(*,*);                                           <<U.RAO>>25522000
         RETURN;                                               <<U.RAO>>25524000
         END;                                                  <<U.RAO>>25526000
      IF NUMPARMS < 1 THEN                                     <<U.RAO>>25528000
         BEGIN  <<AT LEAST ONE IS REQUIRED>>                   <<U.RAO>>25530000
         PARMNUM := 1;                                         <<U.RAO>>25532000
         CIERR(ERRNUM := ALLOCNOTENUF, PARMSP);                <<U.RAO>>25534000
         RETURN;                                               <<U.RAO>>25536000
         END;                                                  <<U.RAO>>25538000
      IF=THEN                                                           25540000
        BEGIN                                                           25542000
        @PNAME:=IPARM;<<GET NAME>>                                      25544000
        GO TO TRYPROG;<<DEFAULT CASE PROGRAM>>                          25546000
        END;                                                            25548000
      @NAME:=IPARM;<<GET PROCEDURE/PROGRAM>>                            25550000
      @PNAME:=IPARM(2);<<GET PROGRAM NAME>>                             25552000
      TEMP:=BPARM(X);<<GET LENGTH>>                                     25554000
      IF (TEMP=9) AND (NAME="PROCEDURE") THEN                           25556000
         BEGIN<<PROCEDURE ALLOCATION/DEALLOCATION>>                     25558000
         TOS:=IF DEALOC THEN DEALLOCATEPROC(PNAME)                      25560000
                        ELSE ALLOCATEPROC(PNAME);                       25562000
         IF <> THEN                                                     25564000
            BEGIN<<ERROR>>                                              25566000
            DUPLICATE;<<MAKE COPY>>                                     25568000
            TOS:= IF DEALOC THEN 86 ELSE 84;<<GET CORRECT COMPARE>>     25570000
            IF TOS=TOS THEN<<CHECK FOR ERRORS>>                         25572000
            CIERR((IF DEALOC THEN -PROCNOTALL                  <<U.RAO>>25574000
                            ELSE -PROCALLOC), PNAME)           <<U.RAO>>25576000
            ELSE                                               <<00833>>25578000
               BEGIN                                           <<00833>>25580000
               LOADERROR(*);                                   <<00833>>25582000
               CIERR(ERRNUM := IF DEALOC THEN NODEALOCPROC     <<00833>>25584000
                               ELSE NOALOCPROC);               <<00833>>25586000
               END;                                            <<00833>>25588000
            END;                                                        25590000
         END                                                            25592000
      ELSE IF (TEMP=7) AND (NAME="PROGRAM") THEN                        25594000
TRYPROG: BEGIN <<PROGRAM ALLOCATION/DEALLOCATION>>                      25596000
         ERRNUM := CHECKFILENAME'(PARMS(NUMPARMS-1) & LSR(8),  <<08.RO>>25598000
            DUMMY, DUMMY, LERRPTR);<<CHECK FOR VALID FILE NAME><<08.RO>>25600000
         IF <> THEN  <<UNACCEPTABLE FILE NAME>>                <<08.RO>>25602000
            BEGIN   <<PUT OUT APPROPRIATE ERROR, RETURN>>      <<08.RO>>25604000
            IF < THEN  <<ILLEGAL FILE NAME SPECIFICATION>>     <<08.RO>>25606000
               CIERR(ERRNUM, ERRPTR)                           <<08.RO>>25608000
            ELSE IF ERRNUM = 0 THEN  <<BACK REFERENCED FILE>>  <<08.RO>>25610000
               CIERR(ERRNUM := ALLOCNOBACKREF, PNAME)          <<08.RO>>25612000
            ELSE <<SYSTEM DEFINED FILE, AS $NULL>>             <<08.RO>>25614000
               CIERR(ERRNUM := ALLOCNOSYSDEF, PNAME);          <<08.RO>>25616000
            PARMNUM := NUMPARMS;                               <<08.RO>>25618000
            RETURN;                                            <<08.RO>>25620000
            END;                                               <<08.RO>>25622000
         TOS:= IF DEALOC THEN DEALLOCATEPROG(PNAME)                     25624000
                         ELSE ALLOCATEPROG(PNAME);                      25626000
         IF <> THEN                                                     25628000
            BEGIN<<ERROR>>                                              25630000
            DUPLICATE;<<MAKE COPY>>                                     25632000
            TOS:=IF DEALOC THEN 82 ELSE 80;<<GET CORRECT COMPARE>>      25634000
            IF TOS=TOS THEN<<CHECK FOR ERROR>>                          25636000
            CIERR((IF DEALOC THEN -PROGNOTALL                  <<U.RAO>>25638000
                            ELSE -PROGALLOC), PNAME)           <<U.RAO>>25640000
            ELSE                                               <<00833>>25642000
               BEGIN                                           <<00833>>25644000
               LOADERROR(*);                                   <<00833>>25646000
               CIERR(ERRNUM := IF DEALOC THEN NODEALOCPROG     <<00833>>25648000
                               ELSE NOALOCPROG);               <<00833>>25650000
               END;                                            <<00833>>25652000
            END;                                                        25654000
         END                                                   <<U.RAO>>25656000
      ELSE   <<UNKNOWN KEYWORD>>                               <<U.RAO>>25658000
         CIERR(ERRNUM := ALLOCXPROGPROC, NAME);                <<U.RAO>>25660000
      END;<<CXALLOCATE/CXDEALLOCATE>>                                   25662000
$CONTROL SEGMENT=CIMISC                                        <<U.RAO>>25664000
      PROCEDURE CXMOUNT EXECUTORHEAD;                          <<RH.PV>>25666000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>25668000
      BEGIN                                                    <<RH.PV>>25670000
      COMMENT                                                  <<RH.PV>>25672000
      CXMOUNT IS THE EXECUTOR FOR USER MOUNT AND DISMOUNT      <<RH.PV>>25674000
      REQUESTS;                                                <<RH.PV>>25676000
      ENTRY CXDISMOUNT;                                        <<RH.PV>>25678000
      INTEGER LEN,DELIM,NUMPARMS;                              <<RH.PV>>25680000
      INTEGER GEN:=-1,NPARM:=-1,REQTYPE:=0,ERRTYPE=REQTYPE,    <<RH.PV>>25682000
              MOUNTYPE:=0;                                     <<RH.PV>>25684000
      LOGICAL KEYWD:=FALSE,KEYPARM:=FALSE;                     <<RH.PV>>25686000
      LOGICAL PARMSPEC :=FALSE;                                <<RH.PV>>25688000
      LOGICAL BIND := FALSE;                                   <<RV.PV>>25690000
      DEFINE                                                   <<RH.PV>>25692000
         GENSPEC    = PARMSPEC.(15:1)#;                        <<RH.PV>>25694000
      INTEGER POINTER PARMVAL;                                 <<RH.PV>>25696000
      BYTE ARRAY DL(0:3);                                      <<RH.PV>>25698000
      BYTE ARRAY PDL(*)=PB:=".;=",%15;                         <<RH.PV>>25700000
      DOUBLE ARRAY PARMS(0:5);                                 <<RH.PV>>25702000
      INTEGER ARRAY IPARM(*) = PARMS;                          <<RH.PV>>25704000
      BYTE ARRAY BPARM(*) = PARMS;                             <<RH.PV>>25706000
      ARRAY VSET(0:14);                                        <<RH.PV>>25708000
      BYTE ARRAY                                               <<RH.PV>>25710000
         VSETB(*)   = VSET,                                    <<RH.PV>>25712000
         VSNAME(*)  = VSET,                                    <<RH.PV>>25714000
         VSGROUP(*) = VSET(5),                                 <<RH.PV>>25716000
         VSACCNT(*) = VSET(10);                                <<RH.PV>>25718000
      BYTE ARRAY STRING'(*) = PB :=                            <<RH.PV>>25720000
         "VSET     ",                                          <<RH.PV>>25722000
         "GROUP    ",                                          <<RH.PV>>25724000
         "ACCOUNT  ",                                          <<RH.PV>>25726000
         "MOUNT    ",                                          <<RH.PV>>25728000
         "DISMOUNT ";                                          <<RH.PV>>25730000
      BYTE ARRAY STRING(0:17);                                 <<RH.PV>>25732000
      BYTE POINTER NAME;                                       <<RH.PV>>25734000
      LOGICAL POINTER PXPNTR;                                  <<RH.PV>>25736000
      EQUATE NOSTRING = -1;                                    <<RH.PV>>25738000
      EQUATE NOHVSET  = 28;  << PVERR 28 >>                    <<RH.PV>>25740000
      EQUATE DUPBIND  = 42;  << PVERR 42 >>                    <<RV.PV>>25742000
      EQUATE INVNAME  = 43;  << PVERR 43 >>                    <<RV.PV>>25744000
      EQUATE DIRECERR = 52;  << PVERR 52 >>                    <<RH.PV>>25746000
      EQUATE  <<DELIMETERS>>                                   <<RH.PV>>25748000
         PERIOD    = 0,                                        <<RH.PV>>25750000
         SEMICOLON = 1,                                        <<RH.PV>>25752000
         EQUALSIGN = 2,                                        <<RH.PV>>25754000
         CARRETURN = 3;                                        <<RH.PV>>25756000
                                                               <<RH.PV>>25758000
                                                               <<RH.PV>>25760000
      SUBROUTINE CXEXIT(ERRN,EADDR,STRINGX);                   <<RH.PV>>25762000
      VALUE ERRN,EADDR,STRINGX;                                <<RH.PV>>25764000
      INTEGER ERRN,STRINGX;                                    <<RH.PV>>25766000
      BYTE POINTER EADDR;                                      <<RH.PV>>25768000
      BEGIN                                                    <<RH.PV>>25770000
         IF ERRN <> 0 THEN                                     <<RH.PV>>25772000
            BEGIN                                              <<RH.PV>>25774000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>25776000
            IF STRINGX = NOSTRING THEN                         <<RH.PV>>25778000
               CIERR(ERRNUM,EADDR)                             <<RH.PV>>25780000
            ELSE                                               <<RH.PV>>25782000
               BEGIN                                           <<RH.PV>>25784000
               MOVE STRING:=STRING'(STRINGX*9),(9);            <<RH.PV>>25786000
               MOVE STRING:=STRING WHILE AN,1;                 <<RH.PV>>25788000
               MOVE * :=%0;  <<GENMSG STOP>>                   <<RH.PV>>25790000
               IF (@NAME:=@EADDR) = 0 THEN  <<NO CARAT>>       <<RH.PV>>25792000
                  CIERR(ERRNUM,,0,@STRING)                     <<RH.PV>>25794000
               ELSE                                            <<RH.PV>>25796000
                  CIERR(ERRNUM,NAME,0,@STRING);                <<RH.PV>>25798000
               END;                                            <<RH.PV>>25800000
            END;                                               <<RH.PV>>25802000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>25804000
      END;<<CXEXIT>>                                           <<RH.PV>>25806000
                                                               <<RH.PV>>25808000
                                                               <<RH.PV>>25810000
      GO TO PROCESS;                                           <<RH.PV>>25812000
CXDISMOUNT:                                                    <<RH.PV>>25814000
      MOUNTYPE:=1;                                             <<RH.PV>>25816000
PROCESS:                                                       <<RH.PV>>25818000
      MOVE DL:=PDL,(4);  <<DELIMITER ARRAY>>                   <<RH.PV>>25820000
      MOVE VSNAME:="*       ";  <<ASSUME HOME VOLUME SET>>     <<RH.PV>>25822000
      VSETB(8):=VSETB(18):=VSETB(28):=" ";  <<TERM CHARS>>     <<RH.PV>>25824000
      MYCOMMAND(PARMSP,DL,6,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>25826000
      IF <> THEN                                               <<RH.PV>>25828000
         BEGIN                                                 <<RH.PV>>25830000
         CIERR(242,IPARM(12),%10000,6);                        <<RH.PV>>25832000
         RETURN;                                               <<01.RO>>25834000
         END;                                                  <<RH.PV>>25836000
      <<GET DEFAULT GROUP/ACCOUNT SPECIFIERS>>                 <<RH.PV>>25838000
      PUSH(DL);                                                <<RH.PV>>25840000
      @PXPNTR:=TOS-PS0(-1);                                    <<RH.PV>>25842000
      TOS:=@VSET(5);  <<ADDRESS OF VSGROUP>>                   <<RH.PV>>25844000
      TOS:=PXPNTR(PXGWJIT).(6:10);                             <<RH.PV>>25846000
      TOS:=24;   <<WORD LOC OF LOGON GROUP>>                   <<RH.PV>>25848000
      TOS:= 4;   <<TRANSFER COUNT - WORDS>>                    <<RH.PV>>25850000
      ASSEMBLE(MFDS 0);                                        <<RH.PV>>25852000
      S3:=@VSET(10);  <<ADDRESS OF VSACCNT>>                   <<RH.PV>>25854000
      S1:=16;    <<WORD LOC OF ACCOUNT>>                       <<RH.PV>>25856000
      S0:= 4;    <<TRANSFER COUNT - WORDS>>                    <<RH.PV>>25858000
      ASSEMBLE(MFDS 4);                                        <<RH.PV>>25860000
      <<ANALYZE COMMAND - OVERWRITE DEFAULTS IF NECESSARY>>    <<RH.PV>>25862000
      WHILE NUMPARMS <> 0 DO  <<RUN THROUGH PARM LIST>>        <<RH.PV>>25864000
         BEGIN                                                 <<RH.PV>>25866000
         NPARM:=NPARM+1;                                       <<RH.PV>>25868000
         NUMPARMS:=NUMPARMS-1;                                 <<RH.PV>>25870000
         TOS:=PARMS(NPARM);                                    <<RH.PV>>25872000
         ASSEMBLE(XCH);                                        <<RH.PV>>25874000
         @NAME:=TOS;                                           <<RH.PV>>25876000
         DELIM:=LS0.(11:5);                                    <<RH.PV>>25878000
         IF KEYWD THEN  <<ENCOUNTERED A ";">>                  <<RH.PV>>25880000
            BEGIN                                              <<RH.PV>>25882000
            LEN:=TOS.(0:8);                                    <<RH.PV>>25884000
            IF KEYPARM THEN                                    <<RH.PV>>25886000
               BEGIN                                           <<RH.PV>>25888000
               IF LEN = 0 THEN CXEXIT(865,NAME,NOSTRING);      <<RH.PV>>25890000
               KEYWD:=FALSE;                                   <<RH.PV>>25892000
               KEYPARM:=FALSE;                                 <<RH.PV>>25894000
               PARMVAL:=BINARY(NAME,LEN);                      <<RH.PV>>25896000
               IF <> THEN CXEXIT(866,NAME,NOSTRING);           <<RH.PV>>25898000
               IF GENSPEC THEN CIERR(-320,NAME);               <<RH.PV>>25900000
               GENSPEC:=TRUE;                                  <<RH.PV>>25902000
               END ELSE                                        <<RH.PV>>25904000
            IF LEN = 0 THEN CXEXIT(864,NAME,NOSTRING) ELSE     <<RH.PV>>25906000
            IF NAME = "GEN" THEN  <<GENERATION INDEX>>         <<RH.PV>>25908000
               BEGIN                                           <<RH.PV>>25910000
               IF LEN <> 3 THEN CXEXIT(860,NAME,NOSTRING);     <<RH.PV>>25912000
               IF LOGICAL(MOUNTYPE) THEN                       <<RH.PV>>25914000
                  CXEXIT(867,NAME,NOSTRING);                   <<RH.PV>>25916000
               IF DELIM <> EQUALSIGN THEN                      <<RH.PV>>25918000
                  CXEXIT(312,NAME(LEN+1),NOSTRING);            <<RH.PV>>25920000
               KEYPARM:=TRUE;                                  <<RH.PV>>25922000
               @PARMVAL:=@GEN;                                 <<RH.PV>>25924000
               END ELSE                                        <<RH.PV>>25926000
            CXEXIT(860,NAME,NOSTRING);                         <<RH.PV>>25928000
            IF DELIM=SEMICOLON THEN KEYWD:=TRUE;               <<RH.PV>>25930000
            END                                                <<RH.PV>>25932000
         ELSE                                                  <<RH.PV>>25934000
            BEGIN   <<MUST BE PART OF VOLUME SET NAME>>        <<RH.PV>>25936000
            IF (LS0.(0:8) = 0) AND NUMPARMS = 0 THEN           <<RH.PV>>25938000
               CXEXIT(-306,NAME(-1),NOSTRING);                 <<RH.PV>>25940000
            IF NPARM > 2 THEN CXEXIT(854,NAME,0);              <<RH.PV>>25942000
            IF DELIM = EQUALSIGN THEN                          <<RH.PV>>25944000
               CXEXIT(305,NAME(1),NOSTRING);                   <<RH.PV>>25946000
            IF LS0.(10:1) THEN  <<SPECIAL CHARACTER IN NAME>>  <<RH.PV>>25948000
               IF NOT (BIND := NPARM=0 LAND NAME="*") THEN     <<RV.PV>>25950000
                  CXEXIT(850,NAME,NPARM);                      <<RH.PV>>25952000
            IF LS0.( 9:1) THEN  <<NUMERIC CHARACTER IN NAME>>  <<RH.PV>>25954000
               IF NAME<>ALPHA THEN CXEXIT(851,NAME,NOSTRING);  <<RH.PV>>25956000
            IF (LEN:=TOS.(0:8)) > 8 THEN                       <<RH.PV>>25958000
               CXEXIT(852,NAME,NPARM);                         <<RH.PV>>25960000
            IF LEN = 0 THEN  <<NULL PARAMETER>>                <<RH.PV>>25962000
            IF NPARM > 0 THEN CXEXIT(853,NAME,NPARM) ELSE ELSE <<RH.PV>>25964000
               BEGIN  <<VALID PART OF VS SPECIFIER ENTERED>>   <<RH.PV>>25966000
               REQTYPE := (NOT BIND).(15:1);                   <<RV.PV>>25968000
               MOVE VSETB(NPARM*10):=NAME,(LEN);               <<RH.PV>>25970000
               IF (8-LEN) > 0 THEN <<BLANK REMAINDER OF NAME>> <<RH.PV>>25972000
                  BEGIN                                        <<RH.PV>>25974000
                  MOVE VSETB((NPARM*10)+LEN):=" ",2;           <<RH.PV>>25976000
                  ASSEMBLE(DUP,DECA);                          <<RH.PV>>25978000
                  MOVE * := *,(7-LEN);                         <<RH.PV>>25980000
                  END;                                         <<RH.PV>>25982000
               END;                                            <<RH.PV>>25984000
            END;                                               <<RH.PV>>25986000
            IF DELIM = SEMICOLON THEN KEYWD:=TRUE;             <<RH.PV>>25988000
         END;                                                  <<RH.PV>>25990000
      CASE *MOUNTYPE OF                                        <<RH.PV>>25992000
         BEGIN                                                 <<RH.PV>>25994000
         MOUNT(VSNAME,VSGROUP,VSACCNT,REQTYPE,GEN);            <<RH.PV>>25996000
         DISMOUNT(VSNAME,VSGROUP,VSACCNT,REQTYPE);             <<RH.PV>>25998000
         END;                                                  <<RH.PV>>26000000
      IF <> THEN  <<AN ERROR OF SOME SORT OCCURED>>            <<RH.PV>>26002000
         BEGIN                                                 <<RH.PV>>26004000
         IF ERRTYPE = NOHVSET OR ERRTYPE = DUPBIND OR          <<RV.PV>>26006000
            ERRTYPE = INVNAME THEN                             <<RV.PV>>26008000
            BEGIN                                              <<RH.PV>>26010000
            MOVE STRING:=VSGROUP WHILE AN,1;                   <<RH.PV>>26012000
            MOVE * :=".",2;                                    <<RH.PV>>26014000
            MOVE * :=VSACCNT WHILE AN,1;                       <<RH.PV>>26016000
            MOVE * :=%0;                                       <<RH.PV>>26018000
            GENMSG(PVERRMSGSET,ERRTYPE,0,@STRING);             <<RH.PV>>26020000
            END                                                <<RH.PV>>26022000
         ELSE                                                  <<RH.PV>>26024000
            GENMSG(PVERRMSGSET,ERRTYPE);                       <<RH.PV>>26026000
         CXEXIT(868,ARRDB0,(MOUNTYPE+3));                      <<03.KM>>26028000
         END;                                                  <<RH.PV>>26030000
      END;<<CXMOUNT/CXDISMOUNT>>                               <<RH.PV>>26032000
                                                               <<RH.PV>>26034000
      PROCEDURE CXVSUSER EXECUTORHEAD;                         <<RH.PV>>26036000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>26038000
      BEGIN                                                    <<RH.PV>>26040000
      COMMENT CXVSUSER IS THE EXECUTOR FOR DISPLAYING USERS OF <<RH.PV>>26042000
      MOUNTED VOLUME SETS;                                     <<RH.PV>>26044000
                                                               <<RH.PV>>26046000
      INTEGER NPARM:=-1;                                       <<RH.PV>>26048000
      INTEGER LEN,DELIM,NUMPARMS,ERRTYPE;                      <<RH.PV>>26050000
      LOGICAL DL:=%27015;  <<PERIOD, CARRIAGE RETURN>>         <<RH.PV>>26052000
      DOUBLE ARRAY PARMS(0:3);                                 <<RH.PV>>26054000
      INTEGER ARRAY IPARM(*) = PARMS;                          <<RH.PV>>26056000
      ARRAY VSET(0:11);                                        <<RH.PV>>26058000
      BYTE ARRAY                                               <<RH.PV>>26060000
         VSETB(*)   = VSET,                                    <<RH.PV>>26062000
         VSNAME(*)  = VSET,                                    <<RH.PV>>26064000
         VSGROUP(*) = VSET(4),                                 <<RH.PV>>26066000
         VSACCNT(*) = VSET(8);                                 <<RH.PV>>26068000
      BYTE ARRAY STRING'(*) = PB :=                            <<RH.PV>>26070000
         "VSET     ",                                          <<RH.PV>>26072000
         "GROUP    ",                                          <<RH.PV>>26074000
         "ACCOUNT  ";                                          <<RH.PV>>26076000
      BYTE ARRAY STRING(0:17);                                 <<RH.PV>>26078000
      BYTE POINTER NAME;                                       <<RH.PV>>26080000
      LOGICAL POINTER PXPNTR;                                  <<RH.PV>>26082000
      EQUATE NOSTRING = -1;                                    <<RH.PV>>26084000
      EQUATE NOHVSET  = 28;                                    <<RH.PV>>26086000
      EQUATE DIRECERR = 52;                                    <<RH.PV>>26088000
      EQUATE  <<DELIMETERS>>                                   <<RH.PV>>26090000
         PERIOD    = 0,                                        <<RH.PV>>26092000
         CARRETURN = 1;                                        <<RH.PV>>26094000
                                                               <<RH.PV>>26096000
                                                               <<RH.PV>>26098000
      SUBROUTINE CXEXIT(ERRN,EADDR,STRINGX);                   <<RH.PV>>26100000
      VALUE ERRN,EADDR,STRINGX;                                <<RH.PV>>26102000
      INTEGER ERRN,STRINGX;                                    <<RH.PV>>26104000
      BYTE POINTER EADDR;                                      <<RH.PV>>26106000
      BEGIN                                                    <<RH.PV>>26108000
         IF ERRN <> 0 THEN                                     <<RH.PV>>26110000
            BEGIN                                              <<RH.PV>>26112000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>26114000
            IF STRINGX = NOSTRING THEN                         <<RH.PV>>26116000
               CIERR(ERRNUM,EADDR)                             <<RH.PV>>26118000
            ELSE                                               <<RH.PV>>26120000
               BEGIN                                           <<RH.PV>>26122000
               MOVE STRING:=STRING'(STRINGX*9),(9);            <<RH.PV>>26124000
               MOVE STRING:=STRING WHILE AN,1;                 <<RH.PV>>26126000
               MOVE * :=%0;  <<GENMSG STOP>>                   <<RH.PV>>26128000
               IF (@NAME:=@EADDR) = 0 THEN  <<NO CARAT>>       <<RH.PV>>26130000
                  CIERR(ERRNUM,,0,@STRING)                     <<RH.PV>>26132000
               ELSE                                            <<RH.PV>>26134000
                  CIERR(ERRNUM,NAME,0,@STRING);                <<RH.PV>>26136000
               END;                                            <<RH.PV>>26138000
            END;                                               <<RH.PV>>26140000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>26142000
      END;<<CXEXIT>>                                           <<RH.PV>>26144000
                                                               <<RH.PV>>26146000
                                                               <<RH.PV>>26148000
      MOVE VSNAME:="*       ";  <<ASSUME HOME VOLUME SET>>     <<RH.PV>>26150000
      MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>26152000
      IF <> THEN                                               <<RH.PV>>26154000
         BEGIN                                                 <<RH.PV>>26156000
         CIERR(242,IPARM(6),%10000,3);                         <<RH.PV>>26158000
         RETURN;                                               <<01.RO>>26160000
         END;                                                  <<RH.PV>>26162000
      <<GET DEFAULT GROUP/ACCOUNT SPECIFIERS>>                 <<RH.PV>>26164000
      PUSH(DL);                                                <<RH.PV>>26166000
      @PXPNTR:=TOS-PS0(-1);                                    <<RH.PV>>26168000
      TOS:=@VSET(4);  <<ADDRESS OF VSGROUP>>                   <<RH.PV>>26170000
      TOS:=PXPNTR(PXGWJIT).(6:10);                             <<RH.PV>>26172000
      TOS:=24;   <<WORD LOC OF LOGON GROUP>>                   <<RH.PV>>26174000
      TOS:= 4;   <<TRANSFER COUNT - WORDS>>                    <<RH.PV>>26176000
      ASSEMBLE(MFDS 0);                                        <<RH.PV>>26178000
      S3:=@VSET(8);  <<ADDRESS OF VSACCNT>>                    <<RH.PV>>26180000
      S1:=16;    <<WORD LOC OF ACCOUNT>>                       <<RH.PV>>26182000
      S0:= 4;    <<TRANSFER COUNT - WORDS>>                    <<RH.PV>>26184000
      ASSEMBLE(MFDS 4);                                        <<RH.PV>>26186000
      <<ANALYZE COMMAND - OVERWRITE DEFAULTS IF NECESSARY>>    <<RH.PV>>26188000
      WHILE (NPARM:=NPARM+1) < NUMPARMS DO                     <<RH.PV>>26190000
         BEGIN                                                 <<RH.PV>>26192000
         TOS:=PARMS(NPARM);                                    <<RH.PV>>26194000
         ASSEMBLE(XCH);                                        <<RH.PV>>26196000
         @NAME:=TOS;                                           <<RH.PV>>26198000
         DELIM:=LS0.(11:5);                                    <<RH.PV>>26200000
         IF (LS0.(0:8) = 0) AND NUMPARMS = 0 THEN              <<RH.PV>>26202000
            CXEXIT(-306,NAME(-1),NOSTRING);                    <<RH.PV>>26204000
         IF NPARM > 2 THEN CXEXIT(854,NAME,0);                 <<RH.PV>>26206000
         IF LS0.(10:1) THEN  <<SPECIAL CHARACTER IN NAME>>     <<RH.PV>>26208000
            IF NOT(NPARM=0 LAND NAME="*") THEN                 <<RH.PV>>26210000
               CXEXIT(850,NAME,NPARM);                         <<RH.PV>>26212000
         IF LS0.( 9:1) THEN  <<NUMERIC CHARACTER IN NAME>>     <<RH.PV>>26214000
            IF NAME<>ALPHA THEN CXEXIT(851,NAME,NOSTRING);     <<RH.PV>>26216000
         IF (LEN:=TOS.(0:8)) > 8 THEN                          <<RH.PV>>26218000
            CXEXIT(852,NAME,NPARM);                            <<RH.PV>>26220000
         IF LEN = 0 THEN  <<NULL PARAMETER>>                   <<RH.PV>>26222000
         IF NPARM > 0 THEN CXEXIT(853,NAME,NPARM) ELSE ELSE    <<RH.PV>>26224000
            BEGIN  <<VALID PART OF VS SPECIFIER ENTERED>>      <<RH.PV>>26226000
            MOVE VSETB(NPARM*8):=NAME,(LEN);                   <<RH.PV>>26228000
            IF (8-LEN) > 0 THEN <<BLANK REMAINDER OF NAME>>    <<RH.PV>>26230000
               BEGIN                                           <<RH.PV>>26232000
               MOVE VSETB((NPARM*8)+LEN):=" ",2;               <<RH.PV>>26234000
               ASSEMBLE(DUP,DECA);                             <<RH.PV>>26236000
               MOVE * := *,(7-LEN);                            <<RH.PV>>26238000
               END;                                            <<RH.PV>>26240000
            END;                                               <<RH.PV>>26242000
         END;                                                  <<RH.PV>>26244000
      ERRTYPE:=VSUSERCOM(0,NUMPARMS,VSNAME);                   <<RH.PV>>26246000
      IF <> THEN  <<AN ERROR OF SOME SORT OCCURED>>            <<RH.PV>>26248000
         BEGIN                                                 <<RH.PV>>26250000
         IF ERRTYPE = NOHVSET  THEN                            <<RH.PV>>26252000
            BEGIN                                              <<RH.PV>>26254000
            MOVE STRING:=VSGROUP WHILE AN,1;                   <<RH.PV>>26256000
            MOVE * :=".",2;                                    <<RH.PV>>26258000
            MOVE * :=VSACCNT WHILE AN,1;                       <<RH.PV>>26260000
            MOVE * :=%0;                                       <<RH.PV>>26262000
            GENMSG(PVERRMSGSET,ERRTYPE,0,@STRING);             <<RH.PV>>26264000
            END                                                <<RH.PV>>26266000
         ELSE                                                  <<RH.PV>>26268000
            GENMSG(PVERRMSGSET,ERRTYPE);                       <<RH.PV>>26270000
         END;                                                  <<RH.PV>>26272000
      END;<<CXVSUSER>>                                         <<RH.PV>>26274000
                                                               <<RH.PV>>26276000
      PROCEDURE CXDSTAT EXECUTORHEAD;                          <<RH.PV>>26278000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>26280000
      BEGIN                                                    <<RH.PV>>26282000
      COMMENT CXDSTAT IS THE EXECUTOR FOR DISPLAYING THE STATUS<<RH.PV>>26284000
      OF DISC DEVICES ON THE SYSTEM;                           <<RH.PV>>26286000
                                                               <<RH.PV>>26288000
      INTEGER LDEV:=0;  <<ASSUME PV DEVICES ONLY>>             <<RH.PV>>26290000
      INTEGER LEN,DELIM,NUMPARMS,ERRTYPE;                      <<RH.PV>>26292000
      LOGICAL DL:=%15;  <<PERIOD, CARRIAGE RETURN>>            <<RH.PV>>26294000
      DOUBLE ARRAY PARMS(0:1);                                 <<RH.PV>>26296000
      INTEGER ARRAY IPARM(*) = PARMS;                          <<RH.PV>>26298000
      BYTE POINTER PARM;                                       <<RH.PV>>26300000
                                                               <<RH.PV>>26302000
                                                               <<RH.PV>>26304000
      SUBROUTINE CXEXIT(ERRN,EADDR);                           <<RH.PV>>26306000
      VALUE ERRN; INTEGER ERRN;                                <<RH.PV>>26308000
      BYTE ARRAY EADDR;                                        <<RH.PV>>26310000
      BEGIN                                                    <<RH.PV>>26312000
         IF ERRN <> 0 THEN                                     <<RH.PV>>26314000
            BEGIN                                              <<RH.PV>>26316000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>26318000
            CIERR(ERRNUM,EADDR);                               <<RH.PV>>26320000
            END;                                               <<RH.PV>>26322000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>26324000
      END;<<CXEXIT>>                                           <<RH.PV>>26326000
                                                               <<RH.PV>>26328000
                                                               <<RH.PV>>26330000
      MYCOMMAND(PARMSP,DL,1,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>26332000
      IF <> THEN                                               <<RH.PV>>26334000
         BEGIN                                                 <<RH.PV>>26336000
         CIERR(242,IPARM(2),%10000,1);                         <<RH.PV>>26338000
         RETURN;                                               <<01.RO>>26340000
         END;                                                  <<RH.PV>>26342000
      IF NUMPARMS <> 0 THEN  <<PARM ENTERED>>                  <<RH.PV>>26344000
         BEGIN                                                 <<RH.PV>>26346000
         TOS:=PARMS;                                           <<RH.PV>>26348000
         ASSEMBLE(XCH);                                        <<RH.PV>>26350000
         @PARM:=TOS; <<BYTE ADDRESS OF PARAMETER STRING>>      <<RH.PV>>26352000
         IF (LEN:=LS0.(0:8)) > 3 THEN                          <<RH.PV>>26354000
            CXEXIT(860,PARM);                                  <<RH.PV>>26356000
         IF PARM = "ALL" THEN LDEV:=-1 ELSE                    <<RH.PV>>26358000
         IF (TOS.(8:3) = %2) THEN  <<NUMERIC ONLY>>            <<RH.PV>>26360000
            BEGIN                                              <<RH.PV>>26362000
            LDEV:=BINARY(PARM,LEN);                            <<RH.PV>>26364000
            IF <> OR LDEV <= 0 THEN                            <<RH.PV>>26366000
               CXEXIT(866,PARM);                               <<RH.PV>>26368000
            END                                                <<RH.PV>>26370000
         ELSE                                                  <<RH.PV>>26372000
            CXEXIT(860,PARM);                                  <<RH.PV>>26374000
         END;                                                  <<RH.PV>>26376000
      ERRTYPE:=DSTATCOM(0,LDEV);                               <<RH.PV>>26378000
      IF <> THEN GENMSG(PVERRMSGSET,ERRTYPE,%10000,LDEV);      <<RH.PV>>26380000
      END<<CXDSTAT>>;                                          <<RH.PV>>26382000
                                                               <<RH.PV>>26384000
$CONTROL SEGMENT=CISYSMGR                                      <<U.RAO>>26386000
      PROCEDURE CXQUANTUM EXECUTORHEAD;                        <<RH.PV>>26388000
      OPTION PRIVILEGED,UNCALLABLE;                            <<RH.PV>>26390000
      BEGIN                                                    <<RH.PV>>26392000
      COMMENT                                                  <<RH.PV>>26394000
      CXQUANTUM IS THE EXECUTOR FOR THE QUANTUM COMMAND        <<RH.PV>>26396000
      COMMAND FORMAT                                           <<RH.PV>>26398000
      QUANTUM TIME SLICE,TERMINAL PRI,NORMAL PRI,CPU BOUND PRI <<RH.PV>>26400000
      ;                                                                 26402000
                                                               <<01724>>26404000
<< THIS COMMAND HAS BEEN REPLACED BY THE TUNE COMMAND. >>      <<01724>>26406000
<< (SEE MODULE OPCOMMAND, 85) >>                               <<01724>>26408000
                                                               <<01724>>26410000
CIERR(ERRNUM := QUANTUM'NOMO);                                 <<01724>>26412000
                                                               <<01724>>26414000
      END;<<QUANTUM>>                                                   26416000
      PROCEDURE CXSHOWQ EXECUTORHEAD;                                   26418000
      OPTION PRIVILEGED,UNCALLABLE;                                     26420000
      BEGIN                                                             26422000
      COMMENT                                                           26424000
      CXSHOWQ IS THE EXECUTOR FOR THE SHOW QUE COMMAND                  26426000
      COMMAND FORMAT                                                    26428000
      SHOWQUE                                                           26430000
      ;                                                                 26432000
      LOGICAL DL:=%6400;                                                26434000
      ARRAY DATEBUF(0:13);  <<FOR TIME STAMP>>                 <<02.RO>>26436000
                                                                        26438000
      MYCOMMAND(PARMSP,DL,0);<<CHECK COMMAND FOR VALIDITY>>             26440000
      IF <> THEN CIERR(-WARNXPARMSIGNORED,PARMSP);             <<U.RAO>>26442000
      INTERACTIVETEST;                                         <<02.RO>>26444000
      IF NOT TOS THEN   <<NOT INTERACTIVE, TIME STAMP>>        <<02.RO>>26446000
         BEGIN                                                 <<02.RO>>26448000
         DATE'LINE(DATEBUF);                                   <<02.RO>>26450000
         PRINT(DATEBUF, -27, %60);                             <<02.RO>>26452000
         END;                                                  <<02.RO>>26454000
      SHOWMQ;                                                  <<U.RAO>>26456000
      END;<<CXSHOWQ>>                                                   26458000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>26460000
      PROCEDURE CXCONTINUE EXECUTORHEAD;                                26462000
      OPTION PRIVILEGED,UNCALLABLE;                                     26464000
      BEGIN                                                             26466000
      COMMENT                                                           26468000
      CXCONTINUE IS THE EXECUTOR FOR THE CONTINUE,ABORT AND             26470000
      RESUME COMMANDS                                                   26472000
      COMMAND FORMAT                                                    26474000
      ABORT                                                             26476000
      CONTINUE                                                          26478000
      RESUME                                                            26480000
      ;                                                                 26482000
      ENTRY CXABORT,CXRESUME;                                  <<DS.06>>26484000
      INTEGER NUMPARMS;                                                 26486000
      DOUBLE  PARMS;                                           <<DS.06>>26488000
      LOGICAL CONTINUE:=0,ABORT:=0;                                     26490000
      LOGICAL READFLAG := FALSE;                               <<DS0.0>>26492000
      LOGICAL RMOTBRK:=FALSE;                                  <<DS.06>>26494000
      INTEGER ICONT   = CONTINUE;                              <<DS.06>>26496000
      INTEGER IABORT  = ABORT;                                 <<DS.06>>26498000
      INTEGER IRDFLAG = READFLAG;                              <<DS.06>>26500000
                                                                        26502000
      CONTINUE:=CONTINUE+1;<<SET CONTINUE FLAG>>                        26504000
CXABORT:                                                                26506000
      IABORT:=IABORT+1;                                        <<DS.06>>26508000
      IRDFLAG:=IRDFLAG-1;                                      <<DS.06>>26510000
CXRESUME:                                                               26512000
      MYCOMMAND(PARMSP,,0,NUMPARMS,PARMS);<<CHECK COMMAND>>             26514000
      IF <> THEN                                               <<01308>>26516000
      BEGIN                                                    <<01308>>26518000
         IF ABORT AND NOT CONTINUE THEN                        <<01652>>26520000
         BEGIN                                                 <<01308>>26522000
            CIERR( ERRNUM := NOABORTPARMS, PARMSP );           <<01308>>26524000
            RETURN;                                            <<01308>>26526000
         END                                                   <<01308>>26528000
         ELSE                                                  <<01308>>26530000
            CIERR( -WARNXPARMSIGNORED, PARMSP );               <<01308>>26532000
      END;                                                     <<01308>>26534000
      SETXPXFIXED;<<SET X TO PCBX FIXED>>                               26536000
      IF CONTINUE THEN                                                  26538000
         BEGIN<<CONTINUE>>                                              26540000
         CONTINUESTATE := 1;  <<FLAG CONTINUE JUST READ>>      <<U.RAO>>26542000
         RETURN;                                                        26544000
         END;                                                           26546000
      TOS:=PXFWBREAK+X;  <<SET TO BREAK>>                      <<DS.06>>26548000
      TOS:=0;                                                  <<DS.06>>26550000
      TOS:=IABORT+1;                                           <<DS.06>>26552000
      TOS:=PCBNUM;                                             <<DS.06>>26554000
      TOS:=ABSOLUTE(%1360);                                    <<DS.06>>26556000
      IF <> THEN ASSEMBLE(PCAL 0) ELSE ASSEMBLE(DDEL,DEL);     <<DS.06>>26558000
      RMOTBRK:=TOS;                                            <<DS.06>>26560000
      X:=TOS;                                                  <<DS.06>>26562000
      IF DBARRAY(X)=0 THEN<<CHECK IF IN BREAK>>                         26564000
         BEGIN<<RESUME & ABORT ALLOWED ONLY IN BREAK>>                  26566000
         IF NOT RMOTBRK THEN CIERR(-ONLYINBREAK);              <<U.RAO>>26568000
         RETURN;                                                        26570000
         END;                                                           26572000
      DBARRAY(X):=0;<<RESET BREAK>>                                     26574000
                                                               <<00835>>26576000
      << CHECK IF EXITING BREAK MODE WHILE 'IF' NESTED >>      <<00835>>26578000
      IF IFNESTING <> 0 THEN  CIERR(-IFS'NEQ'ENDIFS);          <<00835>>26580000
                                                               <<00835>>26582000
      FUNBREAK(READFLAG);                                               26584000
      IF ABORT THEN ABORTPROG;                                          26586000
      UDC4.EXITBREAK := TRUE;                                  <<09.EB>>26588000
END;  <<CXCONTINUE/CXRESUME/CXABORT>>                          <<U.RAO>>26590000
$TITLE "REDO COMMAND"                                          <<08.RO>>26592000
PROCEDURE CXREDO EXECUTORHEAD;                                 <<U.RAO>>26594000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>26596000
BEGIN  <<EXECUTOR FOR THE REDO COMMAND>>                       <<U.RAO>>26598000
<<BASIC SCHEME FOR REDO COMMAND IS AS FOLLOWS.                 <<U.RAO>>26600000
<<THE CI COMMAND BUFFER IS ACTUALLY DOUBLE BUFFERED.  AFTER    <<U.RAO>>26602000
<<EACH COMMAND IS EXECUTED, IT IS COPIED TO THE BUFFER         <<U.RAO>>26604000
<<LASTCOMIMAGE.  WHEN REDO IS INVOKED IT REACHES BACK TO THIS  <<U.RAO>>26606000
<<COPY FOR THE LAST COMMAND BEFORE REDO.                       <<U.RAO>>26608000
<<REDO ITSELF HAS A THIRD OPERATIONAL BUFFER, CALLED           <<U.RAO>>26610000
<<LOCALCOMIMAGE.  ALL OPERATIONS, EXCEPT REDO, ARE PERFORMED IN<<U.RAO>>26612000
<<THIS BUFFER, SO THAT WE CAN RECOVER FROM ERRORS AND DO THE   <<U.RAO>>26614000
<<UNDO FUNCTION.                                               <<U.RAO>>26616000
<<THE BASIC SCHEME IS VERY STRAIGHTFORWARD.  IT CONSISTS OF    <<U.RAO>>26618000
<<LOOPING, READING AND EXECUTING THE USER'S REQUESTS FOR       <<U.RAO>>26620000
<<EDITING FUNCTIONS, UNTIL THE USER DECIDES TO STOP.  EACH OF  <<U.RAO>>26622000
<<THE FUNCTIONS IS DESCRIBED IN ITS SUBROUTINE.  COMMUNICATION <<U.RAO>>26624000
<<BACK TO THE CI IS THROUGH THE "ALREADY READ" FLAG AT         <<U.RAO>>26626000
<<PXFIXED(32).  THIS COMMAND IS BREAKABLE, WITH BREAK BEING    <<U.RAO>>26628000
<<DEFINED AS "FORGET IT".  AN EDIT REQUEST LINE WITH JUST      <<U.RAO>>26630000
<<BLANKS IN IT IS IGNORED.  A REQUEST READ OF 0 SAYS "I'M      <<U.RAO>>26632000
<<FINISHED, EXECUTE IT."                                       <<U.RAO>>26634000
ARRAY LOCALCOMIMAGE(0:WCOMMANDBUFLEN);  <<LOCAL WORK SPACE>>   <<U.RAO>>26636000
BYTE ARRAY BLOCALCOMIMAGE(*) = LOCALCOMIMAGE;                  <<U.RAO>>26638000
ARRAY USERREQBUF(0:WCOMMANDBUFLEN);  <<FOR USER REQUESTS>>     <<U.RAO>>26640000
BYTE ARRAY BUSERREQBUF(*) = USERREQBUF;                        <<U.RAO>>26642000
INTEGER LOCALCOMLEN;  <<LENGTH OF COMMAND IN LOCALCOMIMAGE>>   <<U.RAO>>26644000
INTEGER COMLEN;  <<LENGTH OF COMMAND IN WCOMIMAGE (IN DB SPACE)<<U.RAO>>26646000
INTEGER LASTCOMLEN;  <<LENGTH OF COMMAND IN LASTCOMIMAGE>>     <<U.RAO>>26648000
INTEGER USERREQLEN;  <<LENGTH OF IMAGE IN USERREQBUF>>         <<U.RAO>>26650000
INTEGER DATAOFFSET;  <<DISTANCE TO DATA IN USERREQBUF>>        <<U.RAO>>26652000
INTEGER DATALEN;  <<LENGTH OF OPERATIVE FIELD IN USERREQBUF>>  <<U.RAO>>26654000
INTEGER UNDOCOUNT := 0;  <<# UNDO REQUESTS SEEN>>              <<U.RAO>>26656000
LOGICAL LOOPING := TRUE;  <<CONTROL FLAG ON WHILE LOOP>>       <<U.RAO>>26658000
LOGICAL DL := %6400;  <<FOR MYCOMMAND SEARCH FOR PARMS>>       <<U.RAO>>26660000
                                                               <<U.RAO>>26662000
<<                 *********************                   >>  <<U.RAO>>26664000
<<                 *      DOUNDO       *                   >>  <<U.RAO>>26666000
<<                 *********************                   >>  <<U.RAO>>26668000
                                                               <<U.RAO>>26670000
SUBROUTINE DOUNDO(UPTR);                                       <<U.RAO>>26672000
BYTE ARRAY UPTR;  << POINTS TO "U" IN USERREQBUF.  UNUSED.>>   <<U.RAO>>26674000
BEGIN                                                          <<U.RAO>>26676000
<<UNDO CAN DO TWO LEVELS: UNDO THE LAST COMMAND, AND, IF >>    <<U.RAO>>26678000
<<REQUESTED AGAIN, UNDO ALL THE WAY BACK TO THE ORIGINAL.>>    <<U.RAO>>26680000
<<THE ORIGINAL IS STASHED IN LASTCOMIMAGE AND IS NEVER   >>    <<U.RAO>>26682000
<<TOUCHED BY REDO.                                       >>    <<U.RAO>>26684000
<<NOTE THAT UNDOCOUNT IS CLEARED WHENEVER ANY OF THE     >>    <<U.RAO>>26686000
<<OTHER FUNCTIONS IS EXECUTED.                           >>    <<U.RAO>>26688000
IF UNDOCOUNT>0 THEN   <<SECOND OR LATER UNDO>>                 <<U.RAO>>26690000
   BEGIN                                                       <<U.RAO>>26692000
   COMLEN := LASTCOMLEN;                                       <<U.RAO>>26694000
   MOVE WCOMIMAGE := LASTCOMIMAGE,(LASTCOMLEN/2+1);            <<U.RAO>>26696000
   END;                                                        <<U.RAO>>26698000
MOVE LOCALCOMIMAGE := WCOMIMAGE,(COMLEN/2+1);                  <<U.RAO>>26700000
LOCALCOMLEN := COMLEN;                                         <<U.RAO>>26702000
UNDOCOUNT := UNDOCOUNT+1;                                      <<U.RAO>>26704000
END;  <<SUBROUTINE DOUNDO>>                                    <<U.RAO>>26706000
                                                               <<U.RAO>>26708000
<<                 *********************                   >>  <<U.RAO>>26710000
<<                 *     DOREPLACE     *                   >>  <<U.RAO>>26712000
<<                 *********************                   >>  <<U.RAO>>26714000
                                                               <<U.RAO>>26716000
SUBROUTINE DOREPLACE(RPTR);                                    <<U.RAO>>26718000
BYTE ARRAY RPTR;  <<POINTS TO "R" IN USERREQBUF>>              <<U.RAO>>26720000
BEGIN                                                          <<U.RAO>>26722000
<<STRATEGY FOR REPLACE FUNCTION:                         >>    <<U.RAO>>26724000
<<SIMPLY DO MOVE TO REPLACE OLD DATA WITH NEW DATA.      >>    <<U.RAO>>26726000
<<ONLY COMPLICATION IS IF START OF MOVE IS BEYOND END OF >>    <<U.RAO>>26728000
<<CURRENT COMMAND, MUST BLANK FILL CURRENTLY UNUSED SPACE>>    <<U.RAO>>26730000
<<NOTE THAT THE REPLACE FUNCTION IS THE DEFAULT CASE, IF >>    <<U.RAO>>26732000
<<THE FUNCTION CODE IS NOT U,R,I,D,u,r,i,d.  IN THIS CASE>>    <<U.RAO>>26734000
<<IT IS ASSUMED THAT NO FUNCTION CODE WAS SUPPLIED.      >>    <<U.RAO>>26736000
                                                               <<U.RAO>>26738000
<<ADJUST POINTER FOR "R">>                                     <<U.RAO>>26740000
DATAOFFSET := @RPTR-@BUSERREQBUF;  <<START ADDR OF REPLACE>>   <<U.RAO>>26742000
IF RPTR ="R" OR RPTR ="r" THEN                                 <<U.RAO>>26744000
   BEGIN  <<SKIP OVER "R" FOR ACTUAL DATA>>                    <<U.RAO>>26746000
   @RPTR := @RPTR+1;                                           <<U.RAO>>26748000
   USERREQLEN := USERREQLEN-1;                                 <<U.RAO>>26750000
   END;                                                        <<U.RAO>>26752000
IF USERREQLEN > MAXCOMMANDLEN THEN                             <<01455>>26754000
   CIERR(REDOITOOLONG,,%10000,MAXCOMMANDLEN)  << OVERFLOW >>   <<01455>>26756000
ELSE                                                           <<01455>>26758000
BEGIN                                                          <<01455>>26760000
IF DATAOFFSET>LOCALCOMLEN THEN                                 <<U.RAO>>26762000
   BEGIN  <<BLANK FILL SPACE BETWEEN END OF COMMAND AND DATA>> <<U.RAO>>26764000
   BLOCALCOMIMAGE(LOCALCOMLEN) := " ";                         <<U.RAO>>26766000
   MOVE BLOCALCOMIMAGE(LOCALCOMLEN+1) :=                       <<U.RAO>>26768000
       BLOCALCOMIMAGE(LOCALCOMLEN), (DATAOFFSET-1-LOCALCOMLEN);<<U.RAO>>26770000
   END;                                                        <<U.RAO>>26772000
<<NOW DO REPLACE>>                                             <<U.RAO>>26774000
MOVE BLOCALCOMIMAGE(DATAOFFSET) := RPTR,                       <<U.RAO>>26776000
      (USERREQLEN-DATAOFFSET);                                 <<U.RAO>>26778000
IF LOCALCOMLEN < USERREQLEN THEN                               <<U.RAO>>26780000
   BEGIN  <<ADJUST END OF COMMAND LINE>>                       <<U.RAO>>26782000
   LOCALCOMLEN := USERREQLEN;                                  <<U.RAO>>26784000
   BLOCALCOMIMAGE(LOCALCOMLEN) := %15;                         <<U.RAO>>26786000
   END;                                                        <<U.RAO>>26788000
END;                                                           <<01455>>26790000
END;  <<SUBROUTINE DOREPLACE>>                                 <<U.RAO>>26792000
                                                               <<U.RAO>>26794000
<<                 *********************                   >>  <<U.RAO>>26796000
<<                 *     DOINSERT      *                   >>  <<U.RAO>>26798000
<<                 *********************                   >>  <<U.RAO>>26800000
                                                               <<U.RAO>>26802000
SUBROUTINE DOINSERT(IPTR);                                     <<U.RAO>>26804000
BYTE ARRAY IPTR;  <<BYTE POINTER TO "I" IN USERREQBUF>>        <<U.RAO>>26806000
BEGIN                                                          <<U.RAO>>26808000
<<STRATEGY FOR INSERT:                               >>        <<U.RAO>>26810000
<<    CASE 1:  ENTIRE INSERT IS BEYOND CURRENT END OF>>        <<U.RAO>>26812000
<<       LINE.  DO REPLACE INSTEAD.                  >>        <<U.RAO>>26814000
<<    CASE 2:  INSERT IS WITHIN CURRENT END OF LINE. >>        <<U.RAO>>26816000
<<       MUST CHECK TO SEE THAT NEW LINE LENGTH IS   >>        <<U.RAO>>26818000
<<       GOING TO FIT OUR BUFFERS.  IF IT DOES, WE   >>        <<U.RAO>>26820000
<<       THEN OPEN A HOLE IN LOCALCOMIMAGE THE SIZE  >>        <<U.RAO>>26822000
<<       OF THE INSERT, THEN DO THE INSERT.          >>        <<U.RAO>>26824000
DATAOFFSET := @IPTR-@BUSERREQBUF;  <<DISTANCE TO INPUT DATA>>  <<U.RAO>>26826000
IF DATAOFFSET >= LOCALCOMLEN THEN                              <<U.RAO>>26828000
   BEGIN  <<ADDING BEYOND CURRENT END OF LINE>>                <<U.RAO>>26830000
   IPTR := "R";  <<SIMULATE REPLACE INSTEAD.>>                 <<U.RAO>>26832000
   DOREPLACE(IPTR)                                             <<U.RAO>>26834000
   END                                                         <<U.RAO>>26836000
ELSE  <<INSERT WITHIN CURRENT END OF LINE.>>                   <<U.RAO>>26838000
   BEGIN                                                       <<U.RAO>>26840000
   DATALEN := USERREQLEN-DATAOFFSET-1;  <<AMOUNT TO INSERT>>   <<U.RAO>>26842000
   IF LOCALCOMLEN+DATALEN > MAXCOMMANDLEN THEN                 <<00606>>26844000
      CIERR(REDOITOOLONG,,%10000,MAXCOMMANDLEN)  << OVERFLOW >><<01455>>26846000
   ELSE                                                        <<U.RAO>>26848000
      BEGIN  <<NEW LINE WILL FIT BUFFER, DO INSERT>>           <<U.RAO>>26850000
      <<FIRST ADJUST OLD LINE TO OPEN HOLE FOR INSERT>>        <<U.RAO>>26852000
      MOVE BLOCALCOMIMAGE(LOCALCOMLEN+DATALEN) <<END OF NEW CMD<<U.RAO>>26854000
           := BLOCALCOMIMAGE(LOCALCOMLEN),  <<END OF OLD CMD>> <<U.RAO>>26856000
              (DATAOFFSET-LOCALCOMLEN-1);  <<GETS CR AS WELL>> <<U.RAO>>26858000
      <<OLD LINE IS NOW ADJUSTED IN LOCALCOMIMAGE.  INSERT DATA<<U.RAO>>26860000
      MOVE BLOCALCOMIMAGE(DATAOFFSET) := IPTR(1),(DATALEN);    <<U.RAO>>26862000
      LOCALCOMLEN := LOCALCOMLEN+DATALEN;                      <<U.RAO>>26864000
      END;                                                     <<U.RAO>>26866000
   END;                                                        <<U.RAO>>26868000
END;   <<SUBROUTINE DOINSERT>>                                 <<U.RAO>>26870000
                                                               <<U.RAO>>26872000
<<                 *********************                   >>  <<U.RAO>>26874000
<<                 *     DODELETE      *                   >>  <<U.RAO>>26876000
<<                 *********************                   >>  <<U.RAO>>26878000
                                                               <<U.RAO>>26880000
SUBROUTINE DODELETE(DPTR);                                     <<U.RAO>>26882000
BYTE ARRAY DPTR;  <<POINTER TO "D" IN USERREQBUF>>             <<U.RAO>>26884000
BEGIN                                                          <<U.RAO>>26886000
<<DELETE IS THE MOST COMPLICATED OF THE EDIT FUNCTIONS.      >><<U.RAO>>26888000
<<POSSIBLE INPUTS ARE:                                       >><<U.RAO>>26890000
<<   "D", "D..D","D    D","D   ","DI...","D  DI","DDDI",D..XX>><<U.RAO>>26892000
<<THE STRATEGY IS: FIRST DEAL WITH THE DELETION PART. COMPUTE>><<U.RAO>>26894000
<<THE NUMBER OF DELETIONS TO DO AND THE LOCATION AT WHICH TO >><<U.RAO>>26896000
<<DO THEM.  THEN DO THE DELETIONS.  FINALLY, IF NECESSARY,   >><<U.RAO>>26898000
<<DEAL WITH THE INSERTION QUESTION OR THE GARBAGE BEYOND THE >><<U.RAO>>26900000
<<LAST DELETION.                                             >><<U.RAO>>26902000
DATAOFFSET := @DPTR-@BUSERREQBUF;                              <<U.RAO>>26904000
<<COUNT THE NUMBER TO DELETE.  THIS IS A COMPLICATED FUNCTION>><<U.RAO>>26906000
<<DUE TO THE NUMBER OF DIFFERENT WAYS OF SPECIFYING THIS.    >><<U.RAO>>26908000
DATALEN := 1;  <<SINCE WE KNOW WE HAVE AT LEAST ONE DELETION>> <<U.RAO>>26910000
@DPTR := @DPTR+1;  <<SKIP THE FIRST "D">>                      <<U.RAO>>26912000
IF DPTR = "D" OR DPTR = "d" THEN  <<CONTIGUOUS D'S>>           <<U.RAO>>26914000
   DO   <<COUNT OF CONTIGUOUS D'S>>                            <<U.RAO>>26916000
      BEGIN                                                    <<U.RAO>>26918000
      DATALEN := DATALEN+1;                                    <<U.RAO>>26920000
      @DPTR := @DPTR+1;  <<SKIP THIS D>>                       <<U.RAO>>26922000
      END                                                      <<U.RAO>>26924000
   UNTIL DPTR <> "D" AND DPTR <> "d"                           <<U.RAO>>26926000
ELSE  <<COULD BE "D  D" OR "D  " OR "D(CR)">>                  <<U.RAO>>26928000
   BEGIN                                                       <<U.RAO>>26930000
   SCAN DPTR WHILE %6440,1;  <<FIND NEXT NON-BLANK>>           <<U.RAO>>26932000
   S2 := TOS;  <<SAVE ITS ADDRESS IN DPTR>>                 <<U.RAO>>   26934000
   IF NOCARRY THEN   <<NOT CR, COULD BE "D">>                  <<U.RAO>>26936000
      IF DPTR = "D" OR DPTR = "d" THEN  <<FOUND D'S SEPARATED>><<U.RAO>>26938000
         BEGIN  <<BY BLANKS, COUNT THE SPACES BETWEEN.>>       <<U.RAO>>26940000
         DATALEN := @DPTR-@BUSERREQBUF-DATAOFFSET+1;           <<U.RAO>>26942000
         @DPTR := @DPTR+1;  <<SKIP TRAILING D>>                <<U.RAO>>26944000
         END;                                                  <<U.RAO>>26946000
   END;                                                        <<U.RAO>>26948000
<<DPTR = ADDR OF a) (CR), b) "I", c) NEXT CHAR BEYOND "D">>    <<U.RAO>>26950000
<<HAVE COMPLETED FIRST STEP, COUNTING THE NUMBER OF DELETIONS.><<U.RAO>>26952000
<<ALSO HAVE DISTANCE TO START OF DELETIONS IN DATAOFFSET.>>    <<U.RAO>>26954000
<<NEXT STEP IS TO PERFORM DELETION.>>                          <<U.RAO>>26956000
<<THREE CASES:                                           >>    <<U.RAO>>26958000
<< 1)  DELETION IS COMPLETELY BEYOND CURRENT END OF LINE.>>    <<U.RAO>>26960000
<<     ACTION IS DO NOTHING.                             >>    <<U.RAO>>26962000
<< 2)  DELETION CROSSES END OF CURRENT LINE.             >>    <<U.RAO>>26964000
<<     ACTION IS MOVE TRAILING CR, ADJUST LINE LENGTH.   >>    <<U.RAO>>26966000
<< 3)  DELETION IS COMPLETELY WITHIN CURRENT LINE.       >>    <<U.RAO>>26968000
<<     ACTION IS DO MOVE WITHIN LINE, DESTROYING DELETED >>    <<U.RAO>>26970000
<<     DATA.                                             >>    <<U.RAO>>26972000
IF DATAOFFSET < LOCALCOMLEN THEN  <<DELETE STARTS WITHIN LINE>><<U.RAO>>26974000
   BEGIN                                                       <<U.RAO>>26976000
   IF DATAOFFSET+DATALEN > LOCALCOMLEN THEN                    <<U.RAO>>26978000
      BEGIN  <<DELETE CROSSES END OF LINE.>>                   <<U.RAO>>26980000
      BLOCALCOMIMAGE(DATAOFFSET) := %15;                       <<U.RAO>>26982000
      LOCALCOMLEN := DATAOFFSET;                               <<U.RAO>>26984000
      END                                                      <<U.RAO>>26986000
   ELSE  <<DELETE ENTIRELY WITHIN CURRENT LINE>>               <<U.RAO>>26988000
      BEGIN                                                    <<U.RAO>>26990000
      MOVE BLOCALCOMIMAGE(DATAOFFSET) <<START ADDRESS OF DELETE<<U.RAO>>26992000
         := BLOCALCOMIMAGE(DATAOFFSET+DATALEN)  <<END ADDRESS>><<U.RAO>>26994000
            ,(LOCALCOMLEN-DATAOFFSET-DATALEN+1);<<TO END OF BUF<<U.RAO>>26996000
      LOCALCOMLEN := LOCALCOMLEN-DATALEN;                      <<U.RAO>>26998000
      END;                                                     <<U.RAO>>27000000
   END;  <<OF DELETION PHASE>>                                 <<U.RAO>>27002000
<<NOW HAVE FINISHED DOING DELETION OPERATION.  NOW JUST >>     <<U.RAO>>27004000
<<DEAL WITH ANY TRAILING GARBAGE OR INSERTION REQUEST.>>       <<U.RAO>>27006000
<<REMEMBER THAT DPTR POINTS TO THE PLACE WHERE WE LEFT>>       <<U.RAO>>27008000
<<OFF OUR SCAN.  A SIDE POINT: EVEN IF GARBAGE IS OUT THERE,>> <<U.RAO>>27010000
<<WE WILL STILL DO THE DELETION, SO WHAT IS IN LASTCOMIMAGE>>  <<U.RAO>>27012000
<<ON THE NEXT TIME THROUGH THE LOOP WILL REFLECT THE DELETE.>> <<U.RAO>>27014000
<<THIS IS PROBABLY A FEATURE.>>                                <<U.RAO>>27016000
SCAN DPTR WHILE %6440,1;  <<SKIP BLANKS TO NEXT NON-BLANK>>    <<U.RAO>>27018000
S2 := TOS;   <<SAVE ITS ADDRESS IN DPTR>>                   <<U.RAO>>   27020000
IF NOCARRY THEN   <<SOMETHING THERE.>>                         <<U.RAO>>27022000
   IF DPTR="I" OR DPTR="i" THEN                                <<U.RAO>>27024000
      BEGIN   <<DO INSERTION TRICK>>                           <<U.RAO>>27026000
      @DPTR := @DPTR-DATALEN;  <<AS IF DELETE WASN'T THERE>>   <<U.RAO>>27028000
      USERREQLEN := USERREQLEN-DATALEN;                        <<U.RAO>>27030000
      MOVE DPTR := DPTR(DATALEN)                               <<U.RAO>>27032000
            ,(USERREQLEN-DATAOFFSET+1);                        <<U.RAO>>27034000
      DOINSERT(DPTR);                                          <<U.RAO>>27036000
      END                                                      <<U.RAO>>27038000
   ELSE  <<GARBAGE THERE>>                                     <<U.RAO>>27040000
      CIERR(REDODELGARBAGE);                                   <<U.RAO>>27042000
END;   <<SUBROUTINE DODELETE>>                                 <<U.RAO>>27044000
<<**********  MAIN BODY  *************>>                       <<U.RAO>>27046000
<<STEP 1 - CHECK FOR (ILLEGAL) PARAMETERS>>                    <<U.RAO>>27048000
MYCOMMAND(PARMSP, DL, 0);                                      <<U.RAO>>27050000
IF <> THEN                                                     <<U.RAO>>27052000
   CIERR(-WARNXPARMSIGNORED, PARMSP);                          <<U.RAO>>27054000
<<STEP 2 - SET UP BUFFERS AND BUFFER LENGTHS>>                 <<U.RAO>>27056000
SCAN BLASTCOMIMAGE UNTIL %6415,1;                              <<U.RAO>>27058000
COMLEN := TOS-@BLASTCOMIMAGE;                                  <<00526>>27060000
IF COMLEN > BCOMMANDBUFLEN THEN  << ERROR. <CR> MISSING. >>    <<00526>>27062000
   BEGIN                                                       <<01455>>27064000
   COMLEN := MAXCOMMANDLEN;                                    <<01455>>27066000
   BLASTCOMIMAGE(MAXCOMMANDLEN) := %15;                        <<01455>>27068000
   END;                                                        <<01455>>27070000
LOCALCOMLEN := LASTCOMLEN := COMLEN;                           <<00526>>27072000
MOVE WCOMIMAGE := LASTCOMIMAGE,(COMLEN/2+1);                   <<U.RAO>>27074000
MOVE LOCALCOMIMAGE := LASTCOMIMAGE,(COMLEN/2+1);               <<U.RAO>>27076000
<<NOW LOOP WHILE DOING USER EDIT REQUESTS>>                    <<U.RAO>>27078000
WHILE LOOPING AND NOT REQUESTSERVICE DO                        <<U.RAO>>27080000
   BEGIN                                                       <<U.RAO>>27082000
   <<READ USER REQUEST>>                                       <<U.RAO>>27084000
   PRINT(LOCALCOMIMAGE, -LOCALCOMLEN, 0);                      <<U.RAO>>27086000
   USERREQLEN := READ(USERREQBUF, -BCOMMANDBUFLEN);            <<U.RAO>>27088000
   IF <> THEN << EOF OR IO ERROR ON  $STDIN >>                 <<00832>>27090000
      BEGIN   << ABORT REDO >>                                 <<00832>>27092000
      PENDINGCOMLEN := 0; <<SO CI WILL TRY READ >>             <<00832>>27094000
      IF < THEN CIERR(ERRSTDINIO);                             <<00832>>27096000
      RETURN;                                                  <<00832>>27098000
      END;                                                     <<00832>>27100000
   BUSERREQBUF(USERREQLEN) := %15;  <<ADD TRAILING CR>>        <<U.RAO>>27102000
   IF REQUESTSERVICE THEN <<HIT BREAK DURING READ, BAIL OUT>>  <<U.RAO>>27104000
      LOOPING := FALSE                                         <<U.RAO>>27106000
   ELSE IF USERREQLEN = 0 THEN  <<FINISHED EDITING,>>          <<U.RAO>>27108000
      BEGIN  <<SET CI "COMMAND ALREADY READ" FLAG, EXIT>>      <<U.RAO>>27110000
      MOVE WCOMIMAGE := LOCALCOMIMAGE, (LOCALCOMLEN/2+1);      <<U.RAO>>27112000
      PENDINGCOMLEN := LOCALCOMLEN;  <<FLAG FOR GETIMAGE>>     <<U.RAO>>27114000
      LINELENSTACK(1) := 0;  <<KILL ERROR CARET ROUTINE>>      <<U.RAO>>27116000
      LINELENSTACK := LOCALCOMLEN;                             <<U.RAO>>27118000
      LOOPING := FALSE;                                        <<U.RAO>>27120000
      END                                                      <<U.RAO>>27122000
   ELSE   <<REAL EDIT REQUEST (PROBABLY)>>                     <<U.RAO>>27124000
      BEGIN                                                    <<U.RAO>>27126000
      SCAN BUSERREQBUF WHILE %6440,1;  <<SCAN UNTIL NON-BLANK>><<U.RAO>>27128000
      IF CARRY THEN   <<FOUND BLANKS, CR  => NO REQUEST>>      <<U.RAO>>27130000
         DEL  <<POP POINTER, LOOP FOR ANOTHER TRY>>            <<U.RAO>>27132000
      ELSE                                                     <<U.RAO>>27134000
         BEGIN  <<CHOOSE ROUTINE BASED ON CHARACTER FOUND>>    <<U.RAO>>27136000
         XREG := BPS0;  <<STASH CHARACTER IN XREG>>            <<U.RAO>>27138000
         IF XREG = "U" OR XREG = "u" THEN                      <<U.RAO>>27140000
            DOUNDO(*)                                          <<U.RAO>>27142000
         ELSE                                                  <<U.RAO>>27144000
            BEGIN   <<NON-UNDO FUNCTION, SAVE RESULTS OF LAST E<<U.RAO>>27146000
            MOVE WCOMIMAGE := LOCALCOMIMAGE,(LOCALCOMLEN/2+1); <<U.RAO>>27148000
            COMLEN := LOCALCOMLEN;                             <<U.RAO>>27150000
            UNDOCOUNT := 0;                                    <<U.RAO>>27152000
            IF XREG = "D" OR XREG = "d" THEN                   <<U.RAO>>27154000
               DODELETE(*)                                     <<U.RAO>>27156000
            ELSE IF XREG = "I" OR XREG = "i" THEN              <<U.RAO>>27158000
               DOINSERT(*)                                     <<U.RAO>>27160000
            ELSE                                               <<U.RAO>>27162000
               DOREPLACE(*);                                   <<U.RAO>>27164000
            END;                                               <<U.RAO>>27166000
         END;                                                  <<U.RAO>>27168000
      END;                                                     <<U.RAO>>27170000
   END;                                                        <<U.RAO>>27172000
END;   <<PROCEDURE CXREDO>>                                    <<U.RAO>>27174000
$TITLE "MISCELLANEOUS COMMANDS, SECOND BLOCK"                  <<08.RO>>27176000
      PROCEDURE CXSHOWTIME EXECUTORHEAD;                                27178000
      OPTION PRIVILEGED, UNCALLABLE;                                    27180000
      BEGIN                                                             27182000
      COMMENT                                                           27184000
      CXSHOWTIME IS THE EXECUTOR FOR THE SHOWTIME COMMAND               27186000
      COMMAND FORMAT                                                    27188000
      SHOWTIME                                                          27190000
      ;                                                                 27192000
      INTEGER NUMPARMS;                                                 27194000
      DOUBLE PARMS;                                                     27196000
      ARRAY WOBUF (0:13);                                               27198000
      BYTE ARRAY OBUF (*) = WOBUF;                                      27200000
                                                                        27202000
      MYCOMMAND(PARMSP,,0,NUMPARMS,PARMS);<<CHECK COMMAND>>             27204000
      IF <> THEN CIERR(-WARNXPARMSIGNORED,PARMSP);             <<U.RAO>>27206000
      DATE'LINE(OBUF);<<GET DATE AND TIME>>                             27208000
      PRINT (WOBUF, -27, 0);<<PRINT IT>>                                27210000
      END;  <<CXSHOWTIME>>                                              27212000
      PROCEDURE CXFREERIN EXECUTORHEAD;                                 27214000
      OPTION PRIVILEGED,UNCALLABLE;                                     27216000
      BEGIN                                                             27218000
      COMMENT                                                           27220000
      CXFREERIN IS THE EXECUTOR FOR FREERIN & GETRIN                    27222000
      COMMAND FORMAT                                                    27224000
      GETRIN RINPASSWORD                                                27226000
      FREERIN RIN#                                                      27228000
      ;                                                                 27230000
      ENTRY CXGETRIN;                                                   27232000
      LOGICAL DL:=%6400,GETRIN:=0;                                      27234000
      INTEGER NUMPARMS,RIN,LEN;                                         27236000
      DOUBLE UNAME1,UNAME2,ANAME1,ANAME2;                      <<U.RAO>>27238000
      DOUBLE ARRAY PARM(0:1)=Q;                                <<U.RAO>>27240000
      BYTE POINTER BADPARM=PARM+2;                             <<U.RAO>>27242000
      BYTE LENG=PARM+1;                                                 27244000
      LOGICAL PARM'DATA = PARM + 1;                            <<02367>>27246000
      BYTE POINTER PASS=PARM;                                           27248000
      POINTER UNAME:=@UNAME1;                                           27250000
      ARRAY WOBUF(0:4),LPWORD(0:3);                                     27252000
      BYTE ARRAY PWORD(*)=LPWORD,OBUF(*)=WOBUF;                         27254000
      DEFINE SPECIAL' = (10:1)#;                               <<02367>>27256000
                                                                        27258000
      GO TO PROCESS;<<CXFREERIN ENTRY>>                                 27260000
CXGETRIN:                                                               27262000
      GETRIN:=GETRIN+1;<<GET RIN>>                                      27264000
PROCESS:                                                                27266000
      MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARM);                    <<U.RAO>>27268000
      IF NUMPARMS <> 1 THEN                                    <<U.RAO>>27270000
         BEGIN  <<EXACTLY ONE PARM IS REQUIRED>>               <<U.RAO>>27272000
         PARMNUM := (IF < THEN 1 ELSE 2);                      <<U.RAO>>27274000
         TOS := ERRNUM :=  (IF GETRIN THEN GETRINNOPASS        <<U.RAO>>27276000
                                      ELSE FREERINNORIN);      <<U.RAO>>27278000
         TOS := (IF PARMNUM=1 THEN @PARMSP ELSE @BADPARM);     <<U.RAO>>27280000
         CIERR(*,*);                                           <<U.RAO>>27282000
         RETURN                                                <<U.RAO>>27284000
         END;                                                  <<U.RAO>>27286000
      ASSEMBLE (ADDS 16);<<MAKE ROOM FOR JIT ENTRY>>                    27288000
      TOS:=@S15;<<TRANSFER ADDRESS>>                                    27290000
      SETJIT;<<GET JIT DST>>                                            27292000
      TOS:=16;<<SET INDEX INTO JIT>>                                    27294000
      TOS:=16;<<LENGTH>>                                                27296000
      ASSEMBLE(MFDS 4);<<MOVE IN DATA>>                                 27298000
      ANAME1:=DS15;<<GET ACCOUNT NAME>>                                 27300000
      ANAME2:=DS13;                                                     27302000
      UNAME1:=DS3;<<GET USER NAME>>                                     27304000
      UNAME2:=DS1;                                                      27306000
      IF GETRIN THEN                                                    27308000
         BEGIN                                                          27310000
         IF LENG > 8 THEN                                      <<02367>>27312000
            BEGIN                                              <<02367>>27314000
               CIERR(ERRNUM := RINPASS2LONG,PASS);             <<02367>>27316000
               RETURN                                          <<02367>>27318000
            END;                                               <<02367>>27320000
         IF PARM'DATA.SPECIAL' THEN                            <<02367>>27322000
            BEGIN                                              <<02367>>27324000
               CIERR(ERRNUM := RINPASSSPECHAR,PASS);           <<02367>>27326000
               RETURN                                          <<02367>>27328000
            END;                                               <<02367>>27330000
         IF PASS <> ALPHA THEN                                 <<02367>>27332000
            BEGIN                                              <<02367>>27334000
               CIERR(ERRNUM := RINPASSTALPHA,PASS);            <<02367>>27336000
               RETURN                                          <<02367>>27338000
            END;                                               <<02367>>27340000
         MOVE PWORD := "        "; <<BLANK OUT STRING>>                 27342000
         MOVE PWORD := PASS,(LENG);<<FORM STRING>>                      27344000
         RIN:=ALLORIN (2,UNAME,LPWORD);<<GET RIN>>                      27346000
         IF RIN=0 THEN   <<RIN TABLE EVIDENTLY FULL>>          <<U.RAO>>27348000
            BEGIN                                              <<U.RAO>>27350000
            CIERR(ERRNUM := RINTABFULL);                       <<U.RAO>>27352000
            RETURN                                             <<U.RAO>>27354000
            END;                                               <<U.RAO>>27356000
         MOVE OBUF:="RIN: ";<<FORM OUTPUT STRING>>                      27358000
         LEN:=ASCII(RIN,10,OBUF(5))+5;<<COMPLETE STRING>>               27360000
         PRINT(WOBUF,-LEN,0);                                           27362000
         END                                                            27364000
      ELSE                                                              27366000
         BEGIN<<FREE RIN>>                                              27368000
         TOS:=0;<<PUT CELL ON FOR RETURN>>                              27370000
         TOS:=@PASS;<<BYTE POINTER TO RIN #>>                           27372000
         RIN:=BINARY(*,LENG);<<CONVERT RIN>>                            27374000
         IF <> OR RIN<=0 THEN  <<BAD CONVERT ON RIN NUMBER>>   <<U.RAO>>27376000
            BEGIN                                              <<U.RAO>>27378000
            ERRNUM := RININVINT;  <<BAD NUMBER AS RIN NUMBER>> <<U.RAO>>27380000
            PARMNUM := 1;                                      <<U.RAO>>27382000
            PASS(LENG) := 0;                                   <<U.RAO>>27384000
            CIERR(ERRNUM,PASS,LENG,@PASS);                     <<U.RAO>>27386000
            END                                                <<U.RAO>>27388000
         ELSE                                                  <<U.RAO>>27390000
            BEGIN                                              <<U.RAO>>27392000
            DEALLORIN(RIN,UNAME);  <<ATTEMPT TO DEALLOCATE>>   <<U.RAO>>27394000
            IF < THEN CIERR(RINNOTAL)                          <<U.RAO>>27396000
            ELSE IF > THEN CIERR(RININUSE);                    <<U.RAO>>27398000
            END;                                               <<U.RAO>>27400000
         END;                                                           27402000
      END;<<CXGETRIN/CXFREERIN>>                                        27404000
PROCEDURE CXTELLOP EXECUTORHEAD;                               <<U.RAO>>27406000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>27408000
BEGIN                                                          <<U.RAO>>27410000
COMMENT                                                        <<U.RAO>>27412000
CXTELLOP IS THE EXECUTOR FOR THE TELLOP COMMAND                <<U.RAO>>27414000
COMMAND FORMAT                                                 <<U.RAO>>27416000
TELLOP [MESSAGE]                                               <<U.RAO>>27418000
;                                                              <<U.RAO>>27420000
                                                               <<U.RAO>>27422000
ARRAY NAME(0:15);                                              <<U.RAO>>27424000
BYTE ARRAY ANAME(*) = NAME;                                    <<U.RAO>>27426000
BYTE ARRAY UNAME(*) = NAME(12);                                <<U.RAO>>27428000
BYTE ARRAY DUMMY(*) = NAME; << DUMMY ARGUMENTS >>              <<U.RAO>>27430000
BYTE ARRAY USERID(0:17);                                       <<U.RAO>>27432000
BYTE POINTER MSGSTART;  <<START OF MESSAGE>>                   <<U.RAO>>27434000
BYTE POINTER MSGEND;    <<END OF MESSAGE>>                     <<U.RAO>>27436000
INTEGER MSGLEN;   <<LENGTH OF MESSAGE TO BE SENT.>>            <<U.RAO>>27438000
EQUATE CONSOLE = 0;   <<FILE NUMBER FOR GENMSG>>               <<U.RAO>>27440000
EQUATE JITHAN = 16;  <<OFFSET IN JIT OF ACCOUNT NAME ENTRY>>   <<U.RAO>>27442000
                                                               <<U.RAO>>27444000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>27446000
                                                               <<U.RAO>>27448000
SCAN PARMSP WHILE %6440,1;  <<SCAN FOR START OF MESSAGE>>      <<U.RAO>>27450000
@MSGSTART := TOS;                                              <<U.RAO>>27452000
SCAN MSGSTART UNTIL %6415,1;  <<SCAN FOR END OF MESSAGE>>      <<U.RAO>>27454000
@MSGEND := TOS;                                                <<U.RAO>>27456000
MSGLEN := @MSGEND-@MSGSTART+1;                                 <<U.RAO>>27458000
CLEAN'MESSAGE(MSGSTART, MSGLEN-1);                             <<U.RAO>>27460000
MSGEND := 0;  <<TERMINATOR FOR GENMSG>>                        <<U.RAO>>27462000
TOS := @NAME;                                                  <<U.RAO>>27464000
SETJIT;                                                        <<U.RAO>>27466000
MOVEFROMDSEG(*, *, JITHAN, 16);                                <<U.RAO>>27468000
FORMNAME(4, USERID, UNAME, ANAME, DUMMY, DUMMY);               <<U.RAO>>27470000
   <<FORMAT USER ID - "S/J nnn , USER.ACCT">>                  <<U.RAO>>27472000
GENMSG(CIGENERALMSGSET, TELLFROM, 0, @USERID, @MSGSTART,,,,    <<U.RAO>>27474000
   CONSOLE);                                                   <<U.RAO>>27476000
IF <> THEN CIERR(ERRNUM := TELLOPMSGPROBLEM);                  <<U.RAO>>27478000
MSGEND := %15;  <<RESTORE CR TERMINATOR>>                      <<U.RAO>>27480000
END;      <<CXTELLOP>>                                         <<U.RAO>>27482000
PROCEDURE CXTELL EXECUTORHEAD;                                 <<U.RAO>>27484000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>27486000
<<CXTELL IS THE EXECUTOR FOR THE TELL COMMAND>>                <<U.RAO>>27488000
<<THERE ARE THREE BASIC STEPS TO THE ALGORITHM:>>              <<U.RAO>>27490000
<<    1)  PARSE THE JOBID                      >>              <<U.RAO>>27492000
<<    2)  PREPARE THE MESSAGE FOR SENDING      >>              <<U.RAO>>27494000
<<    3)  SEND THE MESSAGE                     >>              <<U.RAO>>27496000
<<                                             >>              <<U.RAO>>27498000
BEGIN                                                          <<U.RAO>>27500000
ENTRY CXWARN;                                                  <<00552>>27502000
INTEGER ARRAY RESULT(0:16);  <<RETURN VARIABLE FROM PARSEJOBID><<U.RAO>>27504000
BYTE ARRAY BRESULT(*) = RESULT;                                <<U.RAO>>27506000
INTEGER ARRAY JMATRETURN(0:2);  <<RETURN FROM SCANJMAT>>       <<U.RAO>>27508000
INTEGER ARRAY JITDATA(0:22);  <<INFO RELATED TO THIS USER>>    <<U.RAO>>27510000
BYTE ARRAY UNAME(*) = JITDATA(19);   <<THIS USER'S NAME>>      <<U.RAO>>27512000
BYTE ARRAY ANAME(*) = JITDATA(7);    <<THIS USER'S ACCOUNT>>   <<U.RAO>>27514000
BYTE ARRAY DUMMY(*) = ANAME;                                   <<U.RAO>>27516000
BYTE ARRAY USERID(0:24);  <<HOLDS THIS USER'S NAME>>           <<U.RAO>>27518000
BYTE ARRAY USERSNUM(0:5);  <<S/J NNN>>                         <<U.RAO>>27520000
BYTE ARRAY RECIPID(0:24);  <<HOLDS OTHER USER'S NAME>>         <<U.RAO>>27522000
BYTE ARRAY RECIPSNUM(0:5);                                     <<U.RAO>>27524000
BYTE POINTER MSGADR;  <<ADDRESS OF MESSAGE TO BE SENT>>        <<U.RAO>>27526000
INTEGER MSGLEN;  <<LENGTH OF MESSAGE TO BE SENT>>              <<U.RAO>>27528000
LOGICAL FOUNDENTRY;  <<SCAN WAS SUCCESSFUL>>                   <<U.RAO>>27530000
INTEGER NEXTJMATINDEX := 1;  <<FOR SCAN THROUGH JMAT>>         <<U.RAO>>27532000
LOGICAL MSGMOVED := FALSE;  <<HAD TO ADJUST MSG TO WORD BDY>>  <<U.RAO>>27534000
LOGICAL TELLTOJOB := FALSE;  <<FOR TRYING TO TELL TO A JOB>>   <<04208>>27536000
LOGICAL WARNFLG;        <<TRUE=>DO WARN, NOT TELL>>            <<00552>>27538000
LOGICAL SENDER'IS'TARGET     << DOES SENDER QUALIFY? >>        <<01652>>27540000
           := FALSE;                                           <<01652>>27542000
BYTE SAVEDBYTE;  <<BYTE DESTROYED BY ADJUSTMENT OF MSG>>       <<U.RAO>>27544000
INTEGER ARRAY ERRTRANS(0:1) = PB :=                            <<U.RAO>>27546000
 0,TELLJOBINVALID,TELLINVSNUM,TELLXPCTJORS,TELLXPCTJSORAT,     <<04208>>27548000
TELLJXPCTJUSTAT,TELLJNAME2LONG,TELLJXPCTALPHA,USERNAMEMISSING, <<U.RAO>>27550000
USERNAMETOOLONG,USEREXPECTALPHA,TELLXPCTPERIOD,                <<U.RAO>>27552000
ACCTNAMEMISSING,ACCTEXPECTNAMENOTAT,ACCTNAMETOOLONG,           <<U.RAO>>27554000
ACCTEXPECTALPHA,TELLJOBIDMISSING;                              <<U.RAO>>27556000
DEFINE JOBFIELD = (0:2)#;  <<JOB TYPE FIELD>>                  <<U.RAO>>27558000
EQUATE SESSIONTYPE = 1,                                        <<U.RAO>>27560000
       JOBTYPE = 2;                                            <<U.RAO>>27562000
DEFINE JMATTYPE = (0:6)#;   <<JMAT ENTRY TYPE FIELD>>          <<U.RAO>>27564000
EQUATE RUNNINGJOB = 2;  <<JMAT TYPE>>                          <<U.RAO>>27566000
DEFINE QUIETBIT = (8:1)#;  <<JMAT BIT => NOT ACCEPTING MSGS>>  <<U.RAO>>27568000
                                                               <<00552>>27570000
WARNFLG:=FALSE;         <<NOT WARN>>                           <<00552>>27572000
GO TO CXTELLMAIN;                                              <<00552>>27574000
                                                               <<00552>>27576000
CXWARN:                                                        <<00552>>27578000
WARNFLG:=TRUE;          <<SET WARN FLAG>>                      <<00552>>27580000
                                                               <<00552>>27582000
CXTELLMAIN:                                                    <<00552>>27584000
<<    MAIN BODY     >>                                         <<U.RAO>>27586000
<<STEP 1 - PARSE THE JOBID>>                                   <<U.RAO>>27588000
IF NOT PARSEJOBID(PARMSP, RESULT) THEN  <<SYNTAX ERROR>>       <<U.RAO>>27590000
   BEGIN                                                       <<U.RAO>>27592000
   TOS := ERRNUM := ERRTRANS(RESULT(15));  <<GET CI ERR NO.>>  <<U.RAO>>27594000
   TOS := RESULT(14);  <<ADDRESS OF ERROR>>                    <<U.RAO>>27596000
   CIERR(*,*);                                                 <<U.RAO>>27598000
   PARMNUM := RESULT(16);                                      <<U.RAO>>27600000
   END                                                         <<U.RAO>>27602000
ELSE                                                           <<U.RAO>>27604000
   BEGIN  <<JOB NAME PARSED OK>>                               <<U.RAO>>27606000
   <<STEP 2 IS TO PREPARE THE MESSAGE FOR SENDING>>            <<U.RAO>>27608000
   <<STEP 2 PART 1 - GET SENDER'S INFO FROM JIT>>              <<U.RAO>>27610000
   TOS := @JITDATA;                                            <<U.RAO>>27612000
   SETJIT;                                                     <<U.RAO>>27614000
   TOS := 9; <<START AT JOB TYPE/NUMBER FIELD>>                <<U.RAO>>27616000
   TOS := 23;  <<END AFTER USER'S NAME>>                       <<U.RAO>>27618000
   ASSEMBLE(MFDS);                                             <<U.RAO>>27620000
   <<PART 2 - CONVERT JOB TYPE/NUMBER TO STRING>>              <<U.RAO>>27622000
   USERSNUM(2) := " ";                                         <<U.RAO>>27624000
   MOVE USERSNUM(3) := USERSNUM(2),(5);                        <<U.RAO>>27626000
   IF JITDATA.JOBFIELD = SESSIONTYPE THEN                      <<U.RAO>>27628000
      USERSNUM := "S"                                          <<U.RAO>>27630000
   ELSE                                                        <<U.RAO>>27632000
      USERSNUM := "J";                                         <<U.RAO>>27634000
   ASCII(JITDATA.(2:14), 10, USERSNUM(1));                     <<U.RAO>>27636000
   <<PART 3 - FORMAT USER NAME>>                               <<U.RAO>>27638000
   FORMNAME(5,USERID,USERSNUM,UNAME,ANAME,DUMMY);              <<U.RAO>>27640000
   <<PART 4 - ADJUST MESSAGE TO WORD BOUNDARY>>                <<U.RAO>>27642000
   IF RESULT(15) <> ";" THEN  <<ALLOW ";" EVEN THOUGH OBSOLETE><<U.RAO>>27644000
      RESULT(14) := RESULT(14)-1;  <<ACTUAL START OF MESSAGE>> <<U.RAO>>27646000
   @MSGADR := RESULT(14);                                      <<U.RAO>>27648000
   <<GET MESSAGE LENGTH>>                                      <<U.RAO>>27650000
   SCAN MSGADR UNTIL %6400, 1;   <<FIND END OF MESSAGE>>       <<U.RAO>>27652000
   MSGLEN := TOS-@MSGADR;                                      <<U.RAO>>27654000
   MSGADR(MSGLEN) := 0;  <<TERMINATOR FOR GENMSG>>             <<U.RAO>>27656000
   <<PART 5 - PURGE MESSAGE OF BAD CHARACTER SEQUENCES>>       <<U.RAO>>27658000
   CLEAN'MESSAGE(MSGADR, MSGLEN);                              <<U.RAO>>27660000
   <<THE MESSAGE IS NOW READY TO GO.>>                         <<U.RAO>>27662000
   <<STEP 3 - SENDING THE MESSAGE.  THERE ARE 3 PROBLEMS HERE.><<U.RAO>>27664000
   <<IF THERE ARE NO JOBS MATCHING THE DESCRIPTION, THE SENDER><<U.RAO>>27666000
   <<MUST BE TOLD;  IF ANY JOB SELECTED IS RUNNING QUIET, THE>><<U.RAO>>27668000
   <<SENDER MUST BE TOLD;  FINALLY, THE MESSAGE MUST BE SENT>> <<U.RAO>>27670000
                                                               <<01652>>27672000
   DO   << SCAN FOR THE FIRST ACCEPTABLE ENTRY. >>             <<01652>>27674000
   BEGIN                                                       <<01652>>27676000
                                                               <<01652>>27678000
      FOUNDENTRY := SCANJMAT( NEXTJMATINDEX, RESULT,           <<01652>>27680000
                              JMATRETURN             );        <<01652>>27682000
                                                               <<01652>>27684000
   << THE SENDER IS NOT A QUALIFED TARGET.  IF THE SENDER >>   <<01652>>27686000
   << IS SELECTED, SKIP OVER IT.                          >>   <<01652>>27688000
      IF RESULT = JITDATA THEN                                 <<01652>>27690000
      BEGIN                                                    <<01652>>27692000
         SENDER'IS'TARGET := TRUE;                             <<01652>>27694000
         FOUNDENTRY := SCANJMAT( NEXTJMATINDEX, RESULT,        <<01652>>27696000
                                 JMATRETURN             );     <<01652>>27698000
      END;                                                     <<01652>>27700000
                                                               <<01652>>27702000
   END                                                         <<01652>>27704000
   UNTIL  NOT FOUNDENTRY                                       <<01652>>27706000
          OR  (JMATRETURN.JMATTYPE = RUNNINGJOB);              <<01652>>27708000
                                                               <<01652>>27710000
   IF NOT FOUNDENTRY THEN   <<NO SUCH JOBS FITTING JOBID FOUND><<U.RAO>>27712000
      IF SENDER'IS'TARGET                                      <<01652>>27714000
         THEN CIERR( -TELLSENDONLYTARGET, PARMSP )             <<01652>>27716000
         ELSE CIERR( -TELLNOSUCHJOBS,     PARMSP )             <<01652>>27718000
   ELSE   <<HAVE AT LEAST ONE WINNER>>                         <<U.RAO>>27720000
      DO   <<LOOP THROUGH JMAT, SENDING MESSAGES>>             <<U.RAO>>27722000
         IF (JMATRETURN.JMATTYPE = RUNNINGJOB)                 <<U.RAO>>27724000
               AND (RESULT<>JITDATA) <<NOT SENDER>> THEN       <<U.RAO>>27726000
         IF LOGICAL(JMATRETURN.QUIETBIT) AND NOT WARNFLG THEN  <<00552>>27728000
               BEGIN   <<TELL SENDER>>                         <<U.RAO>>27730000
               <<FORMAT JOBID OF TARGET>>                      <<U.RAO>>27732000
               RECIPSNUM(2) := " ";                            <<U.RAO>>27734000
               MOVE RECIPSNUM(3) := RECIPSNUM(2),(3);          <<U.RAO>>27736000
               IF RESULT.JOBFIELD = SESSIONTYPE THEN           <<U.RAO>>27738000
                  RECIPSNUM := "S"                             <<U.RAO>>27740000
               ELSE                                            <<U.RAO>>27742000
                  RECIPSNUM := "J";                            <<U.RAO>>27744000
               ASCII(RESULT.(2:14), 10, RECIPSNUM(1));         <<U.RAO>>27746000
               FORMNAME(5,RECIPID,RECIPSNUM,BRESULT(2),BRESULT(10),     27748000
                  DUMMY);                                      <<U.RAO>>27750000
               GENMSG(CIGENERALMSGSET, TELLNOTACCEPT, 0, @RECIPID);     27752000
               END                                             <<U.RAO>>27754000
            ELSE   <<ACCEPTING MESSAGES, SEND MESSAGE>>        <<U.RAO>>27756000
         IF RESULT.JOBFIELD = JOBTYPE THEN << TELL TO JOB>>    <<04208>>27758000
            TELLTOJOB := TRUE                                  <<04208>>27760000
         ELSE                                                  <<04208>>27762000
         IF WARNFLG THEN GENMSG(1,OPWARN,0,@MSGADR,,,,,        <<00552>>27764000
               JMATRETURN(1),,,,JMATRETURN(2)&LSL(12)+2)       <<01317>>27766000
                                                               <<00552>>27768000
         ELSE <<OP.01>>                                        <<00552>>27770000
               GENMSG(CIGENERALMSGSET, TELLFROM, 0, @USERID, @MSGADR,   27772000
                  ,,,JMATRETURN(1),,,,JMATRETURN(2)&LSL(12)+1) <<U.RAO>>27774000
         UNTIL NOT SCANJMAT(NEXTJMATINDEX, RESULT, JMATRETURN);<<U.RAO>>27776000
   <<MESSAGES ALL SENT.  NOW CLEAN UP AND RETURN>>             <<U.RAO>>27778000
    IF TELLTOJOB THEN                                          <<04208>>27780000
       CIERR(-TELLJOBINVALID,PARMSP);                          <<04208>>27782000
   IF MSGMOVED THEN   <<SHIFT RIGHT 1 BYTE>>                   <<U.RAO>>27784000
      BEGIN                                                    <<U.RAO>>27786000
      MOVE MSGADR(MSGLEN) := MSGADR(MSGLEN-1), (-MSGLEN);      <<U.RAO>>27788000
      MSGADR := SAVEDBYTE;                                     <<U.RAO>>27790000
      @MSGADR := @MSGADR+1;                                    <<U.RAO>>27792000
      END;                                                     <<U.RAO>>27794000
   MSGADR(MSGLEN) := %15;  <<RESTORE OVER TRAILING 0>>         <<U.RAO>>27796000
   END;                                                        <<U.RAO>>27798000
END;  <<PROCEDURE CXTELL>>                                     <<U.RAO>>27800000
PROCEDURE CXHELP EXECUTORHEAD;                                 <<01.EB>>27802000
   OPTION UNCALLABLE;                                          <<01.EB>>27804000
BEGIN                                                          <<01.EB>>27806000
                                                               <<01.EB>>27808000
EQUATE                                                         <<01.EB>>27810000
   BREAKHIT  = 41,                                             <<01.EB>>27812000
   FATALERR  = 50,                                             <<01.EB>>27814000
   HELPSPACE         = 3650,  << HELPROC NEEDS AS OF FIX. >>   <<01895>>27816000
   CATERR            = 51,                                     <<06.EB>>27818000
   USERLABELERR      = 54;                                     <<06.EB>>27820000
                                                               <<01.EB>>27822000
BYTE ARRAY BUFF(0:13);                                         <<01.EB>>27824000
INTEGER                                                        <<01895>>27826000
   OLD'RELZ,   << Z BEFORE ZSIZE CALL. >>                      <<01895>>27828000
   HELPCATFN;                                                  <<01895>>27830000
                                                               <<01.EB>>27832000
PROCEDURE HELPROC(CATFN,LISTFN,COMIMAGE,COMBASE,ERRNO,         <<01.EB>>27834000
      INTACTIVE);                                              <<01.EB>>27836000
   VALUE CATFN,LISTFN,INTACTIVE;                               <<01.EB>>27838000
   INTEGER CATFN,LISTFN,ERRNO;                                 <<01.EB>>27840000
   BYTE ARRAY COMIMAGE,COMBASE;                                <<01.EB>>27842000
   LOGICAL INTACTIVE;                                          <<01.EB>>27844000
   OPTION EXTERNAL;                                            <<01.EB>>27846000
                                                               <<01.EB>>27848000
<< NEED TO MAKE SURE THAT THERE IS ENOUGH STACK SPACE >>       <<01895>>27850000
<< FOR PROGRAMMATIC CALLS TO HELP.                    >>       <<01895>>27852000
                                                               <<01895>>27854000
PUSH(Z);                                                       <<01895>>27856000
OLD'RELZ := TOS;                                               <<01895>>27858000
                                                               <<01895>>27860000
TOS := 0;  << GET SPACE FOR ZSIZE RETURN VALUE. >>             <<01895>>27862000
PUSH(S);                                                       <<01895>>27864000
TOS := TOS + HELPSPACE;                                        <<01895>>27866000
ZSIZE(*);                                                      <<01895>>27868000
IF <> THEN                                                     <<01895>>27870000
   BEGIN                                                       <<01895>>27872000
   ZSIZE(OLD'RELZ);                                            <<01895>>27874000
   CIERR( ERRNUM := NOSTACKSPACE );                            <<01895>>27876000
   RETURN;                                                     <<01895>>27878000
   END;                                                        <<01895>>27880000
                                                               <<01895>>27882000
MOVE BUFF := "CICAT.PUB.SYS ";                                 <<14.EB>>27884000
HELPCATFN := FOPEN(BUFF,1,%300);                               <<14.EB>>27886000
IF <> THEN                                                     <<14.EB>>27888000
BEGIN                                                          <<14.EB>>27890000
   FERROR'(HELPCATFN,PARMNUM);                                 <<14.EB>>27892000
   CIERR( ERRNUM := OPENCATFAIL );                             <<01895>>27894000
   ZSIZE(OLD'RELZ);  << GET Z BACK DOWN. >>                    <<01895>>27896000
   RETURN;                                                     <<14.EB>>27898000
END;                                                           <<14.EB>>27900000
HELPROC(HELPCATFN,2,PARMSP,BCOMIMAGE,ERRNUM,JOBSESSIONMAIN);   <<14.EB>>27902000
IF ERRNUM >= FATALERR THEN                                     <<06.EB>>27904000
BEGIN                                                          <<01.EB>>27906000
   IF ERRNUM = CATERR OR ERRNUM = USERLABELERR THEN            <<06.EB>>27908000
      FERROR'(HELPCATFN,PARMNUM);                              <<06.EB>>27910000
   CIERR(ERRNUM := ERRNUM +HELPOFFSET);                        <<01.EB>>27912000
END                                                            <<01.EB>>27914000
ELSE                                                           <<01.EB>>27916000
BEGIN                                                          <<01.EB>>27918000
   IF ERRNUM = BREAKHIT THEN GENMSG(CIERRMSGSET,               <<01.EB>>27920000
      HELPTERMINATED);                                         <<01.EB>>27922000
   ERRNUM := 0; << EVERYTHING PEACHY >>                        <<01.EB>>27924000
END;                                                           <<01.EB>>27926000
                                                               <<01.EB>>27928000
FCLOSE(HELPCATFN, 0, 0);                                       <<U.RAO>>27930000
                                                               <<01895>>27932000
ZSIZE(OLD'RELZ);     << RETURN Z TO PREVIOUS VALUE >>          <<01895>>27934000
                                                               <<01895>>27936000
END; << CXHELP >>                                              <<01.EB>>27938000
$CONTROL SEGMENT=CISYSMGR                                      <<U.RAO>>27940000
      PROCEDURE SHOWLOGFILE;                                            27942000
      OPTION PRIVILEGED, UNCALLABLE;                                    27944000
      BEGIN                                                             27946000
      COMMENT                                                           27948000
      ISSUES A MESSAGE SHOWING NAME OF CURRENT LOG FILE AS WELL         27950000
      AS PERCENTAGE OF USE.                                             27952000
      IF NO LOGGING THEN RETURNS APPROPPRIATE MESSAGE.                  27954000
      IF LOGGING RETURNS CCE,OTHERWISE CCL.                             27956000
      ;                                                                 27958000
      ARRAY WBUF (0:14);                                                27960000
      INTEGER T;                                                        27962000
      BYTE ARRAY BUF(*)=WBUF,TEMP(0:4),LOGN(*)=BUF(12),PC(*)=BUF(20),   27964000
      MES1(0:10)=PB:="NO LOGGING";                                      27966000
      BYTE ARRAY MES0(0:28)=PB:="LOG FILE LOG0000 IS   % FULL";         27968000
                                                                        27970000
      INTEGER SUBROUTINE PERCENT(TOTAL,NUMBER);                         27972000
      VALUE TOTAL,NUMBER;                                               27974000
      DOUBLE TOTAL,NUMBER;                                              27976000
      BEGIN<< COMPUTES THE % FOR THE % FULL MESSAGE>>                   27978000
      PERCENT:=INTEGER(FIXR((REAL(NUMBER)/REAL(TOTAL))*REAL(100)));     27980000
      END;  << P E R C E N T  >>                                        27982000
      STATUS.(6:2) := CCE; <<SET NORMAL PRINT OUT STATUS>>              27984000
      IF NOT(ABSOLUTE(LINFO)) THEN                                      27986000
         BEGIN                            <<NO LOGGING>>                27988000
         MOVE BUF(0):=MES1(0),(10);                                     27990000
         PRINT (WBUF, -10, 0);<<PRINT NO LOGGING MSG>>                  27992000
         STATUS.(6:2):=CCL;                                             27994000
         IF ABSOLUTE(FLAGX).(11:2)=0 THEN RETURN ELSE STATUS.(6:2):=CCG;27996000
         END;                                                           27998000
      MOVE BUF(0):=MES0(0),(28);        <<TRANSFER MESSAGE>>            28000000
      T:=ASCII(ABSOLUTE(LOGFILENO),10,TEMP);<<CONVERT LOG# TO ASCII>>   28002000
      MOVE LOGN(3):=TEMP(T-1),(-T);    <<LOG FILE NUMBER>>              28004000
      ASSEMBLE(ZERO);                                                   28006000
      TOS:=ABSOLUTE(LOGFILESIZE);<<GET BLOCK SIZE>>                     28008000
      TOS:=ABSOLUTE(X:=X+1);                                            28010000
      TOS:=ABSOLUTE(X:=X+2);<<GET BLOCK COUNT>>                         28012000
      TOS:=ABSOLUTE(X:=X+1);                                            28014000
      TOS:=PERCENT(*,*);<<CHANGE TO %>>                                 28016000
      ASSEMBLE(ZERO,XCH);                                               28018000
      T:=ASCII(*,10,TEMP);<<CONVERT % TO ASCII>>                        28020000
      MOVE PC(1):=TEMP(T-1),(-T);                                       28022000
      PRINT (WBUF, -28, 0);<<PRINT LOGGING MESSAGE>>                    28024000
      END;<<SHOWLOGFILE>>                                               28026000
      PROCEDURE CXSHOWLOG EXECUTORHEAD;                                 28028000
      OPTION PRIVILEGED,UNCALLABLE;                                     28030000
      BEGIN                                                             28032000
      COMMENT                                                           28034000
      CXSHOWLOG IS THE EXECUTOR FOR THE SHOWLOG,SWITCHLOG&RESUMELOG     28036000
      COMMANDS                                                          28038000
      COMMAND FORMAT                                                    28040000
      SHOWLOG                                                           28042000
      RESUMELOG                                                         28044000
      SWITCHLOG                                                         28046000
      ;                                                                 28048000
      ENTRY CXRESUMELOG,CXSWITCHLOG;                                    28050000
      LOGICAL DL:=%6400,SWITCHLOG:=0,RESUMELOG:=0;                      28052000
                                                                        28054000
      GO TO PROCESS;                                                    28056000
CXRESUMELOG:<<ENTRY POINT FOR RESUMELOG COMMAND>>                       28058000
      RESUMELOG:=RESUMELOG+1;<<SET FLAG>>                               28060000
      GO TO PROCESS;                                                    28062000
CXSWITCHLOG:<<ENTRY POINT FOR SWITCHLOG COMMAND>>                       28064000
      SWITCHLOG:=SWITCHLOG+1;<<SET FLAG>>                               28066000
PROCESS:                                                                28068000
      MYCOMMAND(PARMSP,DL,0);<<CHECK COMMAND FOR VALIDITY>>             28070000
      IF <> THEN CIERR(-WARNXPARMSIGNORED,PARMSP);             <<U.RAO>>28072000
      IF SWITCHLOG THEN                                                 28074000
         BEGIN<<SWITCHLOG>>                                             28076000
         SHOWLOGFILE;<<PRINT OUT STATISTICS>>                           28078000
         IF=THEN                                                        28080000
            BEGIN<<LOGGING ENABLED CREATE NEW FILE>>                    28082000
            ASSEMBLE(SED 0);                                            28084000
            ABSOLUTE(FLAGX).(14:1):=1;<<SET SWITCH LOG FLAG>>           28086000
            AWAKE(ABSOLUTE(LOGPROCESS),%20,0);<<DO SWITCH>>             28088000
            ASSEMBLE(SED 1);                                            28090000
            END;                                                        28092000
         END                                                            28094000
      ELSE IF RESUMELOG THEN                                            28096000
         BEGIN<<RESUME LOG FILE>>                                       28098000
         IF ABSOLUTE(LINFO) THEN RETURN;<<LOGGING INHIBITED>>           28100000
         TOS:=ABSOLUTE(FLAGX);                                          28102000
         ASSEMBLE(TBC 12);                                              28104000
         IF <> THEN RETURN;<<HARD ERROR>>                               28106000
         ASSEMBLE(TBC 11);                                              28108000
         IF = THEN RETURN;<<WE ARE ON AND WORKING>>                     28110000
         ASSEMBLE(SED 0);                                               28112000
         AWAKE(ABSOLUTE(LOGPROCESS),%20,0);<<RESUME>>                   28114000
         ASSEMBLE(SED 1);                                               28116000
         END                                                            28118000
     ELSE SHOWLOGFILE;<<SHOW LOG FILE>>                                 28120000
     END;<<CXSHOWLOG/CXRESUMELOG/CXSWITCHLOG>>                          28122000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>28124000
      PROCEDURE CXDEBUG EXECUTORHEAD;                                   28126000
      OPTION PRIVILEGED,UNCALLABLE;                                     28128000
      BEGIN                                                             28130000
      COMMENT                                                           28132000
      CXDEBUG IS THE EXECUTOR FOR THE DEBUG COMMAND                     28134000
      COMMAND FORMAT                                                    28136000
      DEBUG                                                             28138000
;                                                              <<U.RAO>>28140000
SCAN PARMSP WHILE %6440;                                       <<U.RAO>>28142000
IF NOCARRY THEN CIERR(-WARNXPARMSIGNORED, PARMSP);             <<U.RAO>>28144000
DEBUG;                                                         <<U.RAO>>28146000
END;   <<CXDEBUG>>                                             <<U.RAO>>28148000
$PAGE "IF, ELSE, ENDIF AND JCW RELATED PROCEDURES"             <<08.RO>>28150000
<< There are really just two issues to be dealt with>>         <<08.RO>>28152000
<< in the IF command jungle of procedures.  The bulk >>        <<08.RO>>28154000
<< of the code is for parsing the JCW expression in   >>       <<08.RO>>28156000
<< the IF command header.  That problem is handled in >>       <<08.RO>>28158000
<< a more or less standard interpreter manner, with   >>       <<08.RO>>28160000
<< recursive descent parsers which return subexpression>>      <<08.RO>>28162000
<< values to the caller.  Eventually CXIF gets a      >>       <<08.RO>>28164000
<< TRUE/FALSE/ERROR return as the value of the        >>       <<08.RO>>28166000
<< expression.  The second issue to be dealt with is  >>       <<08.RO>>28168000
<< the actual functional operation of the commands.   >>       <<08.RO>>28170000
<< There are three global CI variables used for keeping>>      <<08.RO>>28172000
<< track of the current if levels.  IFNESTING is a    >>       <<08.RO>>28174000
<< count of the IF levels.  It is incremented by CXIF >>       <<08.RO>>28176000
<< and decremented by CXENDIF.  IFSKIP is a flag      >>       <<08.RO>>28178000
<< indicating whether we are currently in the false   >>       <<08.RO>>28180000
<< block of an IF expression, in which case the       >>       <<08.RO>>28182000
<< CI commands are ignored.  NOTE that there are some >>       <<08.RO>>28184000
<< problems in this area.  These problems will be     >>       <<08.RO>>28186000
<< described below.  Management of IFSKIP is very     >>       <<08.RO>>28188000
<< tricky, due to handling nesting levels.  See the   >>       <<08.RO>>28190000
<< code for details.  Finally, the global variable    >>       <<08.RO>>28192000
<< ELSESEEN is used for avoiding mishandling          >>       <<08.RO>>28194000
<< redundantly specified ELSE's.                      >>       <<08.RO>>28196000
<< There are two significant, perhaps incompletely    >>       <<08.RO>>28198000
<< resolved problems with the IF construct.  It has   >>       <<08.RO>>28200000
<< been suggested, and I concur, that the IF level on >>       <<08.RO>>28202000
<< exit from a UDC should be the same as the level on >>       <<08.RO>>28204000
<< entry to that same UDC.  A mechanism will have to  >>       <<08.RO>>28206000
<< be invented to solve this problem.  This probably  >>       <<08.RO>>28208000
<< just requires that the current values be saved on  >>       <<08.RO>>28210000
<< entry to a UDC and restored on exit.  The second   >>       <<08.RO>>28212000
<< problem is to make sure that all commands which    >>       <<08.RO>>28214000
<< MUST be recognized, regardless of whether we are   >>       <<08.RO>>28216000
<< flushing or not, are seen by the appropriate       >>       <<08.RO>>28218000
<< executor.  There are currently four such commands, >>       <<08.RO>>28220000
<< IF, ELSE, ENDIF and RFA.  Job terminating commands >>       <<08.RO>>28222000
<< such as BYE, JOB, HELLO etc. are also automatically>>       <<08.RO>>28224000
<< seen by the I/O system.  There is a bit in the     >>       <<08.RO>>28226000
<< access entry in COMSEARCH which controls whether a >>       <<08.RO>>28228000
<< command is recognized while flushing.              >>       <<08.RO>>28230000
<<                                                    >>       <<08.RO>>28232000
$CONTROL SEGMENT=CIMISC                                        <<U.RAO>>28234000
PROCEDURE GETNEXTIFOP(OP, OPARR);                              <<U.RAO>>28236000
BYTE ARRAY OP, OPARR;                                          <<U.RAO>>28238000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>28240000
BEGIN                                                          <<U.RAO>>28242000
BYTE ARRAY LOCOP(0:4);                                         <<U.RAO>>28244000
MOVE OPARR := "     ";                                         <<U.RAO>>28246000
LOCOP(4) := " ";                                               <<U.RAO>>28248000
MOVE LOCOP := OP, (4);                                         <<U.RAO>>28250000
MOVE OPARR := LOCOP WHILE ANS;                                 <<U.RAO>>28252000
END;   <<PROCEDURE GETNEXTIFOP>>                               <<U.RAO>>28254000
PROCEDURE JCWPRIMARY(PARMPTR,JCWVALUE,ERRNUM,ERRADR,PARMNUM);  <<U.RAO>>28256000
BYTE ARRAY PARMPTR;                                            <<U.RAO>>28258000
LOGICAL JCWVALUE;                                              <<U.RAO>>28260000
INTEGER ERRNUM, ERRADR, PARMNUM;                               <<U.RAO>>28262000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>28264000
BEGIN                                                          <<U.RAO>>28266000
<<THIS PROCEDURE DETERMINES IF A GIVEN TOKEN IS A JCW PRIMARY. <<U.RAO>>28268000
<<A JCW PRIMARY IS EITHER A NUMBER (POSSIBLY OCTAL), A JCW     <<U.RAO>>28270000
<<EQUATE (SEE TRANSJCWEQUATE), OR AN EXISTING JCW NAME.        <<U.RAO>>28272000
<<PARMPTR POINTS AT THE FIRST BYTE OF THE TOKEN ON ENTRY.      <<U.RAO>>28274000
<<JCWVALUE WILL BE RETURNED THE VALUE OF THE PRIMARY, IF NO    <<U.RAO>>28276000
<<   ERRORS WERE DETECTED.  IT HAS NO INPUT SIGNIFICANCE.      <<U.RAO>>28278000
<<ERRNUM IS RETURNED AN ERROR CODE (SEE TRANSJCWEQUATE).       <<U.RAO>>28280000
<<   IT IS ASSUMED TO BE 0 ON ENTRY.  THE POSSIBLE ERRORS ARE  <<U.RAO>>28282000
<<   DETAILED BELOW.                                           <<U.RAO>>28284000
<<ERRADR IS RETURNED EITHER THE BYTE ADDRESS AT WHICH AN ERROR <<U.RAO>>28286000
<<   WAS DETECTED OR THE ADDRESS OF THE NEXT NON-BLANK BEYOND  <<U.RAO>>28288000
<<   THE CURRENT PRIMARY.                                      <<U.RAO>>28290000
<<PARMNUM IS THE ORDINAL OF THE CURRENT PARM.  IT IS ASSUMED   <<U.RAO>>28292000
<<   TO BE THE PREVIOUS TOKEN UPON ENTRY AND WILL BE UPDATED.  <<U.RAO>>28294000
<<THE CONDITION CODE IS UNCHANGED.                             <<U.RAO>>28296000
<<THE ALGORITHM IS NOT PARTICULARLY INTERESTING OR TRICKY.     <<U.RAO>>28298000
INTEGER PARMLEN;  <<LENGTH OF THE TOKEN BEING PROCESSED.>>     <<U.RAO>>28300000
INTEGER TRANSERR;  <<RETURNED ERROR CODE FROM TRANSJCWEQUATE.>><<U.RAO>>28302000
INTEGER TRANSERRPTR;  <<RETURNED ERROR/END AROM TRANSJCWEQUATE.<<U.RAO>>28304000
DOUBLE TEMPJCWVALUE := 0D;  <<HOLDS CONVERTED RESULT>>         <<02.RO>>28306000
LOGICAL REALJCWVALUE = TEMPJCWVALUE+1; <<SIGNIFICANT PART>>    <<02.RO>>28308000
EQUATE                                                         <<U.RAO>>28310000
   NOJCWERR       = 0,  <<NO ERRORS ENCOUNTERED.>>             <<U.RAO>>28312000
   NOPRIMARY      = 1,  <<NOTHING FOUND AT ALL.>>              <<U.RAO>>28314000
   NUM2LARGE      = 2,  <<NUM EXCEEDS 65535.>>                 <<U.RAO>>28316000
   INVOCTDGT      = 3,  <<8 OR 9 IN OCTAL NUMBER.>>            <<U.RAO>>28318000
   INVJCWEQNUM    = 2,  <<INVALID NUMBER WITH THIS EQUATE TYPE><<U.RAO>>28320000
   <<5,6,7 USED>>                                              <<U.RAO>>28322000
   JCWNAME2LONG   = 8,  <<NAME > 255 CHARACTERS LONG.>>        <<U.RAO>>28324000
   JCWNAMENOALPHA = 9,  <<NAME DOES NOT START WITH ALPHA.>>    <<U.RAO>>28326000
   NOSUCHJCW      = 10, <<NO SUCH JCW IN JCW TABLE.>>          <<U.RAO>>28328000
   INVJCWTYPE     = 1;  <<TYPE PART OF JCW NOT RECOGNIZED.>>   <<U.RAO>>28330000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>28332000
SCAN PARMPTR WHILE %6440,1;  <<SKIP LEADING BLANKS>>           <<U.RAO>>28334000
@PARMPTR := ERRADR := TOS;                                     <<U.RAO>>28336000
IF CARRY THEN   <<HIT CARRIAGE RETURN, NO PARM SUPPLIED>>      <<U.RAO>>28338000
   ERRNUM := NOPRIMARY                                         <<U.RAO>>28340000
ELSE                                                           <<U.RAO>>28342000
   BEGIN                                                       <<U.RAO>>28344000
   IF (PARMPTR=NUMERIC) OR (PARMPTR="%") THEN                  <<U.RAO>>28346000
      BEGIN   <<GUESS THAT IT IS A NUMBER>>                    <<U.RAO>>28348000
      IF PARMPTR = "%" THEN   <<OCTAL VALUE>>                  <<U.RAO>>28350000
         PARMLEN := 1                                          <<U.RAO>>28352000
      ELSE                                                     <<U.RAO>>28354000
         PARMLEN := 0;                                         <<U.RAO>>28356000
      MOVE PARMPTR(PARMLEN) := PARMPTR(PARMLEN) WHILE N,1;     <<U.RAO>>28358000
      PARMLEN := TOS-@PARMPTR;  <<TOKEN LEN>>                  <<U.RAO>>28360000
      TEMPJCWVALUE := DBINARY(PARMPTR, PARMLEN);               <<02.RO>>28362000
      IF < THEN   <<INVALID NUMBER>>                           <<02.RO>>28364000
         ERRNUM := INVOCTDGT                                   <<02.RO>>28366000
      ELSE IF > OR TEMPJCWVALUE > 65535D THEN                  <<02.RO>>28368000
         ERRNUM := NUM2LARGE                                   <<02.RO>>28370000
      ELSE  <<VALID NUMBER>>                                   <<02.RO>>28372000
         @PARMPTR := @PARMPTR+PARMLEN;  <<GOOD, MOVE PAST TOKEN<<02.RO>>28374000
      JCWVALUE := REALJCWVALUE;   <<RETURN SIGNIFICANT WORD>>  <<02.RO>>28376000
      END                                                      <<U.RAO>>28378000
   ELSE  <<IS ALPHA, 2 POSSIBILITIES>>                         <<U.RAO>>28380000
      BEGIN                                                    <<U.RAO>>28382000
      TRANSJCWEQUATE(PARMPTR, JCWVALUE, TRANSERR, TRANSERRPTR);<<U.RAO>>28384000
      IF (TRANSERR <> INVJCWTYPE)AND(TRANSERR <> NOJCWERR) THEN<<U.RAO>>28386000
         BEGIN  <<BAD JCW EQUATE>>                             <<U.RAO>>28388000
         ERRNUM := INVJCWEQNUM+TRANSERR;                       <<U.RAO>>28390000
         ERRADR := TRANSERRPTR;                                <<U.RAO>>28392000
         END                                                   <<U.RAO>>28394000
      ELSE IF TRANSERR = NOJCWERR THEN   <<IS VALID JCW EQUATE><<U.RAO>>28396000
         @PARMPTR := TRANSERRPTR  <<JUST UPDATE END POINTER>>  <<U.RAO>>28398000
      ELSE  <<WAS NOT A JCW EQUATE EITHER.>>                   <<U.RAO>>28400000
         BEGIN  <<LAST CHANCE IS ANOTHER JCW>>                 <<U.RAO>>28402000
         FINDJCW(PARMPTR, JCWVALUE, TRANSERR);                 <<U.RAO>>28404000
         CASE *TRANSERR OF                                     <<U.RAO>>28406000
            BEGIN                                              <<U.RAO>>28408000
               BEGIN  <<NO ERROR, UPDATE POINTER.>>            <<U.RAO>>28410000
               MOVE PARMPTR := PARMPTR WHILE AN,1;             <<U.RAO>>28412000
               @PARMPTR := TOS;                                <<U.RAO>>28414000
               END;                                            <<U.RAO>>28416000
                                                               <<U.RAO>>28418000
               ERRNUM := JCWNAME2LONG;                         <<U.RAO>>28420000
                                                               <<U.RAO>>28422000
               ERRNUM := JCWNAMENOALPHA;                       <<U.RAO>>28424000
                                                               <<U.RAO>>28426000
               ERRNUM := NOSUCHJCW;                            <<U.RAO>>28428000
            END;                                               <<U.RAO>>28430000
         END;   <<OTHER JCW CASE>>                             <<U.RAO>>28432000
      END;  <<ALPHA CASE>>                                     <<U.RAO>>28434000
   END;  <<PARM EXISTS CASE>>                                  <<U.RAO>>28436000
IF ERRNUM = NOJCWERR THEN                                      <<U.RAO>>28438000
   BEGIN  <<LAST JOB IS TO SKIP BLANKS TO NEXT TOKEN>>         <<U.RAO>>28440000
   SCAN PARMPTR WHILE %6440,1;                                 <<U.RAO>>28442000
   ERRADR := TOS;                                              <<U.RAO>>28444000
   END;                                                        <<U.RAO>>28446000
END;   <<JCWPRIMARY>>                                          <<U.RAO>>28448000
PROCEDURE CPRIMARY(PRIMARY,PRIMARYVALUE,ERRNUM,ENDADR,PARMNUM);<<U.RAO>>28450000
BYTE ARRAY PRIMARY;                                            <<U.RAO>>28452000
LOGICAL PRIMARYVALUE;                                          <<U.RAO>>28454000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>28456000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>28458000
BEGIN                                                          <<U.RAO>>28460000
<<This procedure determines if a particular part of the        <<U.RAO>>28462000
<<conditional expression is a conditional primary.  In BNF terms U.RAO>>28464000
<<it is looking for <cprimary>::=<jcwprimary><relop><jcwprimary>.U.RAO>>28466000
<<PRIMARY is a byte pointer to the suspected conditional primary.U.RAO>>28468000
<<PRIMARYVALUE will be returned the value of the conditional   <<U.RAO>>28470000
<<   primary.                                                  <<U.RAO>>28472000
<<ERRNUM will be the (already sent) CI error number, if any.   <<U.RAO>>28474000
<<ENDADR is the address of the error or of the next token,     <<U.RAO>>28476000
<<   if no errors were encountered.                            <<U.RAO>>28478000
<<PARMNUM is the ordinal of the current parameter.             <<U.RAO>>28480000
<<The condition code is unaffected.                            <<U.RAO>>28482000
EQUATE CR=%15;                                                 <<U.RAO>>28484000
INTEGER TRANSERR:=0; <<INTERNAL ERROR CODE RETURNED BY JCWPRIMA<<U.RAO>>28486000
INTEGER TRANSERRADR;  <<ADDRESS OF END/ERROR FROM JCWPRIMARY>> <<U.RAO>>28488000
INTEGER RELOPLEN;   <<LENGTH OF THE RELATIONAL OPERATOR.>>     <<U.RAO>>28490000
BYTE ARRAY RELOPDICTP(0:1) = PB :=                             <<U.RAO>>28492000
   3,1,"<",                                                    <<U.RAO>>28494000
   3,1,"=",                                                    <<U.RAO>>28496000
   3,1,">",                                                    <<U.RAO>>28498000
   4,2,"<=",                                                   <<U.RAO>>28500000
   4,2,">=",                                                   <<U.RAO>>28502000
   4,2,"<>",                                                   <<U.RAO>>28504000
   0;                                                          <<U.RAO>>28506000
EQUATE RELOPDICTLEN=3+3+3+4+4+4+1;                             <<U.RAO>>28508000
BYTE ARRAY RELOPDICT(0:RELOPDICTLEN-1);                        <<U.RAO>>28510000
INTEGER RELOPINDEX; <<WHICH RELATIONAL OPERATOR WAS FOUND>>    <<U.RAO>>28512000
   << 1 <, 2 =, 3 >, 4 <=, 5 >=, 6 <>  >>                      <<U.RAO>>28514000
LOGICAL PRIMARY2VALUE;<<TEMPORARY FOR SECOND JCW PRIMARY VALUE><<U.RAO>>28516000
<<***  START OF BODY  ***>>                                    <<U.RAO>>28518000
JCWPRIMARY(PRIMARY,PRIMARYVALUE,TRANSERR,TRANSERRADR,PARMNUM); <<U.RAO>>28520000
@PRIMARY := TRANSERRADR;                                       <<U.RAO>>28522000
CASE *TRANSERR OF                                              <<U.RAO>>28524000
   BEGIN                                                       <<U.RAO>>28526000
      IF PRIMARY = CR THEN  <<REST OF RELATIONAL MISSING>>     <<U.RAO>>28528000
         ERRNUM := IFXPCTRELATION;                             <<U.RAO>>28530000
      ERRNUM := IFXPCTRELOP;                                   <<U.RAO>>28532000
      ERRNUM := SETJCWNUM2LARGE;                               <<U.RAO>>28534000
      ERRNUM := SETJCWINVOCTDGT;                               <<U.RAO>>28536000
      ERRNUM := SETJCWOKVAL2BIG;                               <<U.RAO>>28538000
      ERRNUM := SETJCWWARNVAL;                                 <<U.RAO>>28540000
      ERRNUM := SETJCWFATALVAL;                                <<U.RAO>>28542000
      ERRNUM := SETJCWSYSTEMVAL;                               <<U.RAO>>28544000
      ERRNUM := SETJCWNAME2LONG;                               <<U.RAO>>28546000
      ERRNUM := SETJCWNAMENOALP;                               <<U.RAO>>28548000
      ERRNUM := IFNOSUCHJCW;                                   <<U.RAO>>28550000
   END;                                                        <<U.RAO>>28552000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>28554000
   CIERR(ERRNUM, PRIMARY)                                      <<U.RAO>>28556000
ELSE                                                           <<U.RAO>>28558000
   BEGIN  <<HAVE FIRST ELEMENT, GO FOR RELATIONAL OP>>         <<U.RAO>>28560000
   IF "<" <= INTEGER(PRIMARY(1)) <= ">" THEN                   <<U.RAO>>28562000
      RELOPLEN := 2                                            <<U.RAO>>28564000
   ELSE                                                        <<U.RAO>>28566000
      RELOPLEN := 1;                                           <<U.RAO>>28568000
   MOVE RELOPDICT := RELOPDICTP, (RELOPDICTLEN);               <<U.RAO>>28570000
   RELOPINDEX := SEARCH(PRIMARY, RELOPLEN, RELOPDICT);         <<U.RAO>>28572000
   IF (RELOPINDEX=0) OR (PRIMARY(RELOPLEN)<>" ") AND           <<U.RAO>>28574000
         (PRIMARY(RELOPLEN)<>"%") AND                          <<U.RAO>>28576000
         (PRIMARY(RELOPLEN)<>CR) AND                           <<U.RAO>>28578000
         (PRIMARY(RELOPLEN)=SPECIAL) THEN  <<BAD RELOP>>       <<U.RAO>>28580000
      CIERR(ERRNUM := IFXPCTRELOP, PRIMARY)                    <<U.RAO>>28582000
   ELSE                                                        <<U.RAO>>28584000
      BEGIN  <<HAVE FIRST PRIMARY AND RELOP>>                  <<U.RAO>>28586000
      @PRIMARY := @PRIMARY+RELOPLEN;                           <<U.RAO>>28588000
      JCWPRIMARY(PRIMARY, PRIMARY2VALUE, TRANSERR, TRANSERRADR,<<U.RAO>>28590000
         PARMNUM);  <<CHECK SECOND PRIMARY>>                   <<U.RAO>>28592000
      @PRIMARY := TRANSERRADR;                                 <<U.RAO>>28594000
      CASE *TRANSERR OF                                        <<U.RAO>>28596000
         BEGIN                                                 <<U.RAO>>28598000
            BEGIN  <<NO ERROR, DO RETURN STUFF>>               <<U.RAO>>28600000
            ENDADR := @PRIMARY;                                <<U.RAO>>28602000
            CASE *RELOPINDEX-1 OF  <<COMPUTE RETURN VALUE>>    <<U.RAO>>28604000
               BEGIN                                           <<U.RAO>>28606000
               PRIMARYVALUE := PRIMARYVALUE < PRIMARY2VALUE;   <<U.RAO>>28608000
               PRIMARYVALUE := PRIMARYVALUE = PRIMARY2VALUE;   <<U.RAO>>28610000
               PRIMARYVALUE := PRIMARYVALUE > PRIMARY2VALUE;   <<U.RAO>>28612000
               PRIMARYVALUE := PRIMARYVALUE <= PRIMARY2VALUE;  <<U.RAO>>28614000
               PRIMARYVALUE := PRIMARYVALUE >= PRIMARY2VALUE;  <<U.RAO>>28616000
               PRIMARYVALUE := PRIMARYVALUE <> PRIMARY2VALUE;  <<U.RAO>>28618000
               END;                                            <<U.RAO>>28620000
            END;  <<SUCCESS CASE>>                             <<U.RAO>>28622000
            ERRNUM := IFXPCTJCWVAL;                            <<U.RAO>>28624000
            ERRNUM := SETJCWNUM2LARGE;                         <<U.RAO>>28626000
            ERRNUM := SETJCWINVOCTDGT;                         <<U.RAO>>28628000
            ERRNUM := SETJCWOKVAL2BIG;                         <<U.RAO>>28630000
            ERRNUM := SETJCWWARNVAL;                           <<U.RAO>>28632000
            ERRNUM := SETJCWFATALVAL;                          <<U.RAO>>28634000
            ERRNUM := SETJCWSYSTEMVAL;                         <<U.RAO>>28636000
            ERRNUM := SETJCWNAME2LONG;                         <<U.RAO>>28638000
            ERRNUM := SETJCWNAMENOALP;                         <<U.RAO>>28640000
            ERRNUM := IFNOSUCHJCW;                             <<U.RAO>>28642000
         END;                                                  <<U.RAO>>28644000
      IF ERRNUM <> 0 THEN  <<SEND ERROR MESSAGE>>              <<U.RAO>>28646000
         CIERR(ERRNUM, PRIMARY);                               <<U.RAO>>28648000
      END;                                                     <<U.RAO>>28650000
   END;                                                        <<U.RAO>>28652000
END;   <<PROCEDURE CPRIMARY>>                                  <<U.RAO>>28654000
PROCEDURE CFACTOR(FACTOR,FACTORVALUE,ERRNUM,ENDADR,PARMNUM);   <<U.RAO>>28656000
BYTE ARRAY FACTOR;                                             <<U.RAO>>28658000
LOGICAL FACTORVALUE;                                           <<U.RAO>>28660000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>28662000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>28664000
BEGIN                                                          <<U.RAO>>28666000
<<This procedure determines if the tokens following FACTOR >>  <<U.RAO>>28668000
<<constitute a conditional factor in the terms of the      >>  <<U.RAO>>28670000
<<IF command.  In BNF terms it is looking for              >>  <<U.RAO>>28672000
<< <cfactor> ::= (<cexpression>) | <cprimary>              >>  <<U.RAO>>28674000
<<FACTOR is a byte pointer to the suspected factor.        >>  <<U.RAO>>28676000
<<FACTORVALUE will be returned the value of the factor.    >>  <<U.RAO>>28678000
<<ERRNUM, ENDADR, PARMNUM are defined as usual for this set>>  <<U.RAO>>28680000
<<   of procedures.                                        >>  <<U.RAO>>28682000
                                                               <<U.RAO>>28684000
IF FACTOR = "(" THEN                                           <<U.RAO>>28686000
   BEGIN  <<ASSUME EXPRESSION FOLLOWS.>>                       <<U.RAO>>28688000
   SCAN FACTOR(1) WHILE %6440,1;  <<SKIP BLANKS TO FIRST TOKEN><<U.RAO>>28690000
   @FACTOR := TOS;                                             <<U.RAO>>28692000
   CONDEXP(FACTOR, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);      <<U.RAO>>28694000
   IF ERRNUM = 0 THEN   <<NO ERRORS IN EXPRESSION>>            <<U.RAO>>28696000
      BEGIN  <<CHECK END OF EXPRESSION, RETURN>>               <<U.RAO>>28698000
      @FACTOR := ENDADR;                                       <<U.RAO>>28700000
      IF FACTOR <> ")" THEN   <<MISSING TRAILING PAREN>>       <<U.RAO>>28702000
         CIERR(ERRNUM := IFXPCTCLOSPAREN, FACTOR)              <<U.RAO>>28704000
      ELSE  <<EVERYTHING IS FINE.>>                            <<U.RAO>>28706000
         BEGIN  <<CLEANUP, EXIT>>                              <<U.RAO>>28708000
         SCAN FACTOR(1) WHILE %6440,1;                         <<U.RAO>>28710000
         ENDADR := TOS;  <<SKIP TO NEXT TOKEN>>                <<U.RAO>>28712000
         END                                                   <<U.RAO>>28714000
      END                                                      <<U.RAO>>28716000
   END                                                         <<U.RAO>>28718000
ELSE   <<MUST BE CONDITIONAL PRIMARY>>                         <<U.RAO>>28720000
   CPRIMARY(FACTOR, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>28722000
END;   <<CFACTOR>>                                             <<U.RAO>>28724000
PROCEDURE CTERM(TERM, TERMVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>28726000
BYTE ARRAY TERM;                                               <<U.RAO>>28728000
LOGICAL TERMVALUE;                                             <<U.RAO>>28730000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>28732000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>28734000
BEGIN                                                          <<U.RAO>>28736000
<<This procedure checks for a conditional term.  In BNF it is>><<U.RAO>>28738000
<<   looking for                                             >><<U.RAO>>28740000
<<      <cterm> ::= <cterm> { AND <cterm> }                  >><<U.RAO>>28742000
<<                                                           >><<U.RAO>>28744000
<<TERM is a byte pointer to the start of the <term>.         >><<U.RAO>>28746000
<<TERMVALUE will be returned the value of the <term>.        >><<U.RAO>>28748000
<<ERRNUM, ENDADR, PARMNUM are as usual under these procedures>><<U.RAO>>28750000
                                                               <<U.RAO>>28752000
BYTE ARRAY ANDARRAY(0:4);  <<LOCAL FOR "AND" OPERATOR IN PARSE.<<U.RAO>>28754000
LOGICAL FACTORVALUE;   <<TEMPORARY FOR RETURN FROM CFACTOR>>   <<U.RAO>>28756000
CFACTOR(TERM, TERMVALUE, ERRNUM, ENDADR, PARMNUM);             <<U.RAO>>28758000
@TERM := ENDADR;                                               <<U.RAO>>28760000
GETNEXTIFOP(TERM, ANDARRAY);  <<EXTRACT NEXT TOKEN FOR CHECK>> <<U.RAO>>28762000
WHILE (ERRNUM=0) AND (ANDARRAY="AND ") DO                      <<U.RAO>>28764000
   BEGIN  <<LOOP THROUGH "AND <factor>"'s    >>                <<U.RAO>>28766000
   SCAN TERM(3) WHILE %6440,1;  <<SKIP TO START OF FACTOR>>    <<U.RAO>>28768000
   @TERM := TOS;                                               <<U.RAO>>28770000
   CFACTOR(TERM, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);        <<U.RAO>>28772000
   @TERM := ENDADR;                                            <<U.RAO>>28774000
   TERMVALUE := TERMVALUE LAND FACTORVALUE;                    <<U.RAO>>28776000
   GETNEXTIFOP(TERM, ANDARRAY);  <<PREP FOR NEXT LOOP>>        <<U.RAO>>28778000
   END;                                                        <<U.RAO>>28780000
END;  <<PROCEDURE CTERM>>                                      <<U.RAO>>28782000
PROCEDURE CONDEXP(EXP, EXPVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>28784000
BYTE ARRAY EXP;                                                <<U.RAO>>28786000
LOGICAL EXPVALUE;                                              <<U.RAO>>28788000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>28790000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>28792000
BEGIN                                                          <<U.RAO>>28794000
<<This procedure checks for a conditional expression.        >><<U.RAO>>28796000
<<The BNF is   <cexpression> ::= <cterm> { OR <cterm> }      >><<U.RAO>>28798000
<<The parameters are analogous to those under CTERM.         >><<U.RAO>>28800000
                                                               <<U.RAO>>28802000
BYTE ARRAY ORARRAY(0:4);  <<HOLDS "OR" OPERATOR FOR LOOP TEST>><<U.RAO>>28804000
LOGICAL TERMVALUE;   <<TEMP FOR SECOND CALL TO CTERM>>         <<U.RAO>>28806000
                                                               <<U.RAO>>28808000
CTERM(EXP, EXPVALUE, ERRNUM, ENDADR, PARMNUM);                 <<U.RAO>>28810000
@EXP := ENDADR;                                                <<U.RAO>>28812000
GETNEXTIFOP(EXP, ORARRAY);                                     <<U.RAO>>28814000
WHILE (ERRNUM=0) AND (ORARRAY="OR ") DO                        <<U.RAO>>28816000
   BEGIN   <<LOOP THROUGH "OR <term>"'s >>                     <<U.RAO>>28818000
   SCAN EXP(2) WHILE %6440,1;                                  <<U.RAO>>28820000
   @EXP := TOS;                                                <<U.RAO>>28822000
   CTERM(EXP, TERMVALUE, ERRNUM, ENDADR, PARMNUM);             <<U.RAO>>28824000
   @EXP := ENDADR;                                             <<U.RAO>>28826000
   EXPVALUE := EXPVALUE LOR TERMVALUE;                         <<U.RAO>>28828000
   GETNEXTIFOP(EXP, ORARRAY);                                  <<U.RAO>>28830000
   END;                                                        <<U.RAO>>28832000
END;   <<PROCEDURE CONDEXP>>                                   <<U.RAO>>28834000
PROCEDURE CXIF EXECUTORHEAD;                                   <<U.RAO>>28836000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>28838000
BEGIN                                                          <<U.RAO>>28840000
LOGICAL EXPVALUE;  <<RETURNED VALUE OF CONDITIONAL EXPRESSION>><<U.RAO>>28842000
INTEGER EXPEND;   <<HOLDS ADDRESS OF END OF EXPRESSION>>       <<U.RAO>>28844000
BYTE ARRAY THENLOC(0:3);                                       <<U.RAO>>28846000
if ifnesting >= 15 then   <<has or will overflow>>             <<U.RAO>>28848000
   begin                                                       <<U.RAO>>28850000
   ifnesting := ifnesting+1;  <<count it anyhow>>              <<U.RAO>>28852000
   cierr(errnum := ifnestingtoogreat);                         <<U.RAO>>28854000
   end                                                         <<U.RAO>>28856000
else if ifskip then  <<flushing - flush "if", but account>>    <<U.RAO>>28858000
   begin   <<for it since it will have matching endif>>        <<U.RAO>>28860000
   ifnesting := ifnesting+1;                                   <<U.RAO>>28862000
   ifskip := ifskip&lsl(1) lor 1;  <<flag still flushing>>     <<U.RAO>>28864000
   ELSESEEN := ELSESEEN&LSL(1);  <<SET FOR NEW ELSE LEVEL>>    <<07.RO>>28866000
   end                                                         <<U.RAO>>28868000
else  <<no strange problems, just do it>>                      <<U.RAO>>28870000
   begin                                                       <<U.RAO>>28872000
   parmnum := 0;                                               <<U.RAO>>28874000
   SCAN PARMSP WHILE %6440,1;                                  <<U.RAO>>28876000
   @PARMSP := TOS;                                             <<U.RAO>>28878000
   IF CARRY THEN                                               <<U.RAO>>28880000
      BEGIN   <<NO PARAMETERS>>                                <<U.RAO>>28882000
      CIERR(ERRNUM := IFNOPARMS, PARMSP);                      <<U.RAO>>28884000
      RETURN;                                                  <<U.RAO>>28886000
      END;                                                     <<U.RAO>>28888000
   CONDEXP(PARMSP, EXPVALUE, ERRNUM, EXPEND, PARMNUM);         <<U.RAO>>28890000
   @PARMSP := EXPEND;                                          <<U.RAO>>28892000
   IF ERRNUM = 0 THEN   <<HAVE VALID EXPRESSION, WE THINK>>    <<U.RAO>>28894000
      BEGIN                                                    <<U.RAO>>28896000
      PARMNUM := PARMNUM+1;  <<TO TAKE INTO ACCOUNT THE THEN>> <<U.RAO>>28898000
      MOVE PARMSP := PARMSP WHILE AN,1;                        <<U.RAO>>28900000
      IF TOS-@PARMSP <> 4 THEN   <<NEXT TOKEN <> "THEN">>      <<U.RAO>>28902000
         CIERR(ERRNUM := IFNOTHEN, PARMSP)                     <<U.RAO>>28904000
      ELSE                                                     <<U.RAO>>28906000
         BEGIN   <<CHECK FOR ACTUAL THEN>>                     <<U.RAO>>28908000
         MOVE THENLOC := PARMSP WHILE ANS;                     <<U.RAO>>28910000
         IF THENLOC <> "THEN" THEN  <<NEXT TOKEN <> "THEN">>   <<U.RAO>>28912000
            CIERR(ERRNUM := IFNOTHEN, PARMSP)                  <<U.RAO>>28914000
         ELSE   <<HAVE THEN, LOOK FOR EXTRANEOUS GARBAGE>>     <<U.RAO>>28916000
            BEGIN                                              <<U.RAO>>28918000
            SCAN PARMSP(4) WHILE %6440,1;                      <<U.RAO>>28920000
            @PARMSP := TOS;                                    <<U.RAO>>28922000
            IF NOCARRY THEN   <<IS EXTRANEOUS GARBAGE>>        <<U.RAO>>28924000
               CIERR(ERRNUM := IFEXTRANEOUS, PARMSP)           <<U.RAO>>28926000
            ELSE  <<IT ALL LOOKS GOOD FROM HERE>>              <<U.RAO>>28928000
               BEGIN                                           <<U.RAO>>28930000
               PARMNUM := 0;                                   <<U.RAO>>28932000
               ifnesting := ifnesting+1;                       <<U.RAO>>28934000
               elseseen := elseseen&lsl(1);                    <<U.RAO>>28936000
               IF EXPVALUE THEN   <<DO IF BLOCK>>              <<U.RAO>>28938000
                  BEGIN                                        <<00849>>28940000
                  IFSKIP := 0; <<0 => NOT FLUSHING>>           <<00849>>28942000
                  IF UDC4.NESTLEVEL=0 OR UDC3.OPTLIST THEN     <<00849>>28944000
                     GENMSG(CIGENERALMSGSET,CONDITION'TRUE);   <<00849>>28946000
                  END                                          <<00849>>28948000
               ELSE   <<DO ELSE BLOCK, FLUSH IF BLOCK>>        <<U.RAO>>28950000
                  BEGIN                                        <<00849>>28952000
                  IFSKIP := 1; <<1 => FLUSH>>                  <<U.RAO>>28954000
                  IF UDC4.NESTLEVEL=0 OR UDC3.OPTLIST THEN     <<00849>>28956000
                     GENMSG(CIGENERALMSGSET,CONDITION'FALSE);  <<00849>>28958000
                  END;                                         <<00849>>28960000
               END   <<SUCCESS BLOCK>>                         <<U.RAO>>28962000
            END  <<FOUND THEN BLOCK>>                          <<U.RAO>>28964000
         END  <<CHECK FOR ACTUAL THEN BLOCK>>                  <<U.RAO>>28966000
      END  <<HAVE VALID EXPRESSION BLOCK>>                     <<U.RAO>>28968000
   END;   <<PROCEDURE CXIF>>                                   <<U.RAO>>28970000
end;                                                           <<U.RAO>>28972000
PROCEDURE CXELSE EXECUTORHEAD;                                 <<U.RAO>>28974000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>28976000
BEGIN                                                          <<U.RAO>>28978000
PARMNUM := 0;                                                  <<U.RAO>>28980000
SCAN PARMSP WHILE %6440,1;  <<SKIP ANY LEADING BLANKS>>        <<U.RAO>>28982000
@PARMSP := TOS;                                                <<U.RAO>>28984000
IF NOCARRY THEN   <<FOUND SOME EXTRANEOUS PARMS>>              <<U.RAO>>28986000
   CIERR(ERRNUM := -ELSE2MP, PARMSP);                          <<U.RAO>>28988000
IF IFNESTING <= 0 THEN                                         <<U.RAO>>28990000
   CIERR(ERRNUM := ELSEUNPAIRED)                               <<U.RAO>>28992000
else if ifnesting <= 15 then   <<note: >15 if's are ignored.>> <<U.RAO>>28994000
   begin                                                       <<U.RAO>>28996000
   if elseseen then  <<already have else for this level>>      <<U.RAO>>28998000
      cierr(errnum := else2manyelses)                          <<U.RAO>>29000000
   else                                                        <<U.RAO>>29002000
      begin  <<have valid if-else paIR>>                       <<U.RAO>>29004000
      elseseen := elseseen lor 1;  <<=> seen else for this leve<<U.RAO>>29006000
      <<next step is to toggle flush bit.  tricky bit is, if>> <<U.RAO>>29008000
      <<this whole "if" level is being flushed due to a flush ><<U.RAO>>29010000
      <<at a lower level, we don't want to start executing now.<<U.RAO>>29012000
      <<so must check to see if we are being flushed from a>>  <<U.RAO>>29014000
      <<lower level.  this is done by counting the number of>> <<U.RAO>>29016000
      <<flushing levels as recorded by ifskip.>>               <<U.RAO>>29018000
      if ifskip <= 1 then  <<at most 1 level of flushing>>     <<U.RAO>>29020000
         begin   <<toggle bit.  if flushing (1) then want>>    <<U.RAO>>29022000
         <<not flushing (0) or vice versa.>>                   <<U.RAO>>29024000
         <<INDICATE WHETHER SUBSEQUENT COMMANDS WILL BE>>      <<00849>>29026000
         <<IGNORED OR EXECUTED                         >>      <<00849>>29028000
         IF UDC4.NESTLEVEL=0 OR UDC3.OPTLIST THEN              <<00849>>29030000
            GENMSG(CIGENERALMSGSET,(IF IFSKIP=1 THEN           <<00849>>29032000
                   RESUME'EXEC ELSE IGNORE'COMM));             <<00849>>29034000
         tos := ifskip;                                        <<U.RAO>>29036000
         aSsemble(tcbc 15);                                    <<U.RAO>>29038000
         ifskip := tos;                                        <<U.RAO>>29040000
         end;                                                  <<U.RAO>>29042000
      end;                                                     <<U.RAO>>29044000
   END;                                                        <<U.RAO>>29046000
END;   <<PROCEDURE CXELSE>>                                    <<U.RAO>>29048000
PROCEDURE CXENDIF EXECUTORHEAD;                                <<U.RAO>>29050000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>29052000
BEGIN                                                          <<U.RAO>>29054000
PARMNUM := 0;                                                  <<U.RAO>>29056000
SCAN PARMSP WHILE %6440,1;                                     <<U.RAO>>29058000
@PARMSP := TOS;  <<SKIP ANY LEADING BLANKS>>                   <<U.RAO>>29060000
IF NOCARRY THEN  <<EXTRANEOUS DATA FOUND>>                     <<U.RAO>>29062000
   CIERR(ERRNUM := -ENDIF2MP, PARMSP);                         <<U.RAO>>29064000
IF IFNESTING <= 0 THEN                                         <<U.RAO>>29066000
   CIERR(ERRNUM := -ENDIFUNPAIRED)                             <<U.RAO>>29068000
else if ifnesting>15 then  <<handling ignored overflow>>       <<U.RAO>>29070000
   ifnesting := ifnesting-1                                    <<U.RAO>>29072000
ELSE  <<ITS OK, DELETE THIS NESTING LEVEL>>                    <<U.RAO>>29074000
   BEGIN                                                       <<U.RAO>>29076000
   IFNESTING := IFNESTING-1;                                   <<U.RAO>>29078000
   <<IF ENDING AN 'IFSKIP' THEN INFORM USER>>                  <<00849>>29080000
   <<THAT EXECTION OF COMMANDS WILL RESUME >>                  <<00849>>29082000
   IF IFSKIP=1 AND (UDC4.NESTLEVEL=0 OR UDC3.OPTLIST) THEN     <<00849>>29084000
      GENMSG(CIGENERALMSGSET,RESUME'EXEC);                     <<00849>>29086000
   IFSKIP := IFSKIP&LSR(1);                                    <<U.RAO>>29088000
   elseseen := elseseen&lsr(1);                                <<U.RAO>>29090000
   END;                                                        <<U.RAO>>29092000
END;                                                           <<U.RAO>>29094000
PROCEDURE TRANSJCWEQUATE(EQ, JCW, ERRNUM, ERRPTR);             <<U.RAO>>29096000
BYTE ARRAY EQ;                                                 <<U.RAO>>29098000
INTEGER JCW, ERRNUM, ERRPTR;                                   <<U.RAO>>29100000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>29102000
<<THIS PROCEDURE TRANSLATES JCW EQUATES INTO AN INTEGER.       <<U.RAO>>29104000
<<EQ IS A BYTE ARRAY HOLDING THE PUTATIVE JCW EQUATE.          <<U.RAO>>29106000
<<JCW WILL BE RETURNED THE EQUIVALENT INTEGER VALUE OF THE EQUA<<U.RAO>>29108000
<<ERRNUM INDICATES WHAT, IF ANY, ERRORS WERE DETECTED.         <<U.RAO>>29110000
<<   0 => NO ERRORS.                                           <<U.RAO>>29112000
<<   1 => INVALID TYPE PART (I.E., NOT OK, WARN, FATAL, OR SYST<<U.RAO>>29114000
<<   2 => NUMBER PART OF OK > 65535                            <<U.RAO>>29116000
<<   3 => NUMBER PART OF WARN > 49151                          <<U.RAO>>29118000
<<   4 => NUMBER PART OF FATAL > 32767                         <<U.RAO>>29120000
<<   5 => NUMBER PART OF SYSTEM > 16383                        <<U.RAO>>29122000
<<ERRPTR WILL BE RETURNED A BYTE ADDRESS.  IF NO ERROR WAS DETE<<U.RAO>>29124000
<<   IT WILL BE THE ADDRESS OF THE NEXT BYTE BEYOND THE NAME.  <<U.RAO>>29126000
<<   ERROR WAS DETECTED, IT WILL POINT TO THE ITEM PROBABLY AT <<U.RAO>>29128000
BEGIN                                                          <<U.RAO>>29130000
BYTE ARRAY TYPE(0:1) = PB :=                                   <<U.RAO>>29132000
   4,2,"OK",                                                   <<U.RAO>>29134000
   6,4,"WARN",                                                 <<U.RAO>>29136000
   7,5,"FATAL",                                                <<U.RAO>>29138000
   8,6,"SYSTEM",                                               <<U.RAO>>29140000
   0;                                                          <<U.RAO>>29142000
EQUATE TYPEARRAYLEN = 4+6+7+8+1;                               <<U.RAO>>29144000
BYTE ARRAY LOCALTYPE(0:TYPEARRAYLEN-1);  <<HOLDS DB REL ARRAY T<<U.RAO>>29146000
INTEGER TYPELEN;  <<LENGTH OF TYPE PART OF EQUATE FOR SEARCH IN<<U.RAO>>29148000
EQUATE MAXTYPELEN = 6;   <<"SYSTEM">>                          <<U.RAO>>29150000
BYTE ARRAY LOCALEQ(0:MAXTYPELEN-1); <<HOLDS LOCAL COPY OF TYPE <<U.RAO>>29152000
INTEGER EQTYPE;  <<RESULT FROM SEARCH OF TYPE ARRAY>>          <<U.RAO>>29154000
INTEGER NUMLEN;  <<LENGTH OF NUMERIC PART OF EQUATE>>          <<U.RAO>>29156000
DOUBLE DNUMVAL;  <<HOLDS VALUE OF NUMERIC PART OF EQUATE>>     <<U.RAO>>29158000
EQUATE NOERROR = 0,                                            <<U.RAO>>29160000
       INVALIDTYPE = 1,                                        <<U.RAO>>29162000
       INVALIDNUM = 2,                                         <<U.RAO>>29164000
       BADRANGEOK = INVALIDNUM,                                <<U.RAO>>29166000
       BADRANGEWARN = INVALIDNUM+1,                            <<U.RAO>>29168000
       BADRANGEFATAL = INVALIDNUM+2,                           <<U.RAO>>29170000
       BADRANGESYSTEM = INVALIDNUM+3;                          <<U.RAO>>29172000
ERRPTR := @EQ;                                                 <<U.RAO>>29174000
<<FIRST STEP IS TO EXTRACT TYPE FIELD>>                        <<U.RAO>>29176000
MOVE LOCALTYPE := TYPE,(TYPEARRAYLEN);                         <<U.RAO>>29178000
MOVE EQ := EQ WHILE A,1;  <<TO GET TOKEN LENGTH>>              <<U.RAO>>29180000
TYPELEN := TOS-@EQ;                                            <<U.RAO>>29182000
IF TYPELEN > MAXTYPELEN THEN                                   <<U.RAO>>29184000
   ERRNUM := INVALIDTYPE                                       <<U.RAO>>29186000
ELSE                                                           <<U.RAO>>29188000
   BEGIN                                                       <<U.RAO>>29190000
   MOVE LOCALEQ := EQ WHILE AS;  <<GET SHIFTED LOCAL COPY>>    <<U.RAO>>29192000
   EQTYPE := SEARCH(LOCALEQ, TYPELEN, LOCALTYPE) -1;           <<U.RAO>>29194000
   IF < THEN                                                   <<U.RAO>>29196000
      ERRNUM := INVALIDTYPE                                    <<U.RAO>>29198000
   ELSE                                                        <<U.RAO>>29200000
      BEGIN  <<HAVE VALID TYPE, NOW CHECK NUMERIC PART>>       <<U.RAO>>29202000
      ERRPTR := @EQ + TYPELEN;                                 <<U.RAO>>29204000
      MOVE EQ(TYPELEN) := EQ(TYPELEN) WHILE N,1;               <<U.RAO>>29206000
      NUMLEN := TOS-@EQ(TYPELEN);                              <<U.RAO>>29208000
      DNUMVAL := DBINARY(EQ(TYPELEN), NUMLEN);                 <<U.RAO>>29210000
      IF <> OR (DNUMVAL>%177777D) THEN                         <<U.RAO>>29212000
         ERRNUM := INVALIDNUM+EQTYPE                           <<U.RAO>>29214000
      ELSE                                                     <<U.RAO>>29216000
         BEGIN  <<DO RANGE CHECKS>>                            <<U.RAO>>29218000
         <<WHOLE TRICK HERE IS, MUST FIT IN 16 BITS.>>         <<U.RAO>>29220000
         <<CALCULATE RESULT VALUE, CHECK < %177777D >>         <<U.RAO>>29222000
         TOS := 0;                                             <<U.RAO>>29224000
         TOS := EQTYPE&CSR(2);  <<SET UP TYPE INDUCED MASK>>   <<U.RAO>>29226000
         TOS := TOS+DNUMVAL;  <<MASK + NUMERIC PART>>          <<U.RAO>>29228000
         IF DS1 > %177777D THEN                                <<U.RAO>>29230000
            ERRNUM := INVALIDNUM+EQTYPE                        <<U.RAO>>29232000
         ELSE  <<EVERYTHING FINE, RETURN VALUES>>              <<U.RAO>>29234000
            BEGIN                                              <<U.RAO>>29236000
            ERRNUM := NOERROR;                                 <<U.RAO>>29238000
            ERRPTR := @EQ+TYPELEN+NUMLEN;                      <<U.RAO>>29240000
            JCW := TOS;  <<RESULT VALUE WAS ON TOS, REMEMBER>> <<U.RAO>>29242000
            END;                                               <<U.RAO>>29244000
         END;                                                  <<U.RAO>>29246000
      END;                                                     <<U.RAO>>29248000
   END;                                                        <<U.RAO>>29250000
END;   <<TRANSJCWEQUATE>>                                      <<U.RAO>>29252000
PROCEDURE CXSETJCW EXECUTORHEAD;                               <<U.RAO>>29254000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>29256000
<<THE SYNTAX OF THE SETJCW COMMAND IS                          <<U.RAO>>29258000
<<                                                  {<number>} <<U.RAO>>29260000
<<   SETJCW  <jcwname><non-alphanumeric except cr,%>{<equate>} <<U.RAO>>29262000
<<                                                  {<existing <<U.RAO>>29264000
<<                                                             <<U.RAO>>29266000
BEGIN                                                          <<U.RAO>>29268000
BYTE POINTER PARMPTR;  <<LOCAL POINTER INTO PARAMETER STRING>> <<U.RAO>>29270000
EQUATE CR=%15;  <<CARRIAGE RETURN>>                            <<U.RAO>>29272000
INTEGER NAMELEN;  <<HOLDS JCW NAME LENGTH>>                    <<U.RAO>>29274000
                                                               <<04646>>29276000
LOGICAL INTERACTIVE;  << TRUE IF IN A SESSION. >>              <<01893>>29278000
INTEGER TRANSERR:=0;<<ERROR RETURNS FROM EXTERNAL PROCEDURES>> <<U.RAO>>29280000
INTEGER TRANSERRPTR:=0; <<ERROR ADDRESS FROM TRANSJCWEQUATE>>  <<U.RAO>>29282000
EQUATE NOJCWERR = 0,                                           <<U.RAO>>29284000
       INVJCWTYPE = 1;                                         <<U.RAO>>29286000
EQUATE INVJCWEQNUM = SETJCWOKVAL2BIG-2;                        <<U.RAO>>29288000
                                                               <<04646>>29290000
DOUBLE DOUBLE'NEWVALUE:=0D;         << LOGICAL ARITHEMETIC >>  <<04646>>29292000
LOGICAL NEWVALUE=DOUBLE'NEWVALUE+1; << SIGNIFICANT PART    >>  <<04646>>29294000
DOUBLE TEMPJCWVALUE;                << LOGICAL ARITHMETIC  >>  <<04646>>29296000
LOGICAL REALJCWVALUE=TEMPJCWVALUE+1;<< SIGNIFICANT PART    >>  <<04646>>29298000
LOGICAL ADD;                        << OPERATION TYPE      >>  <<04646>>29300000
DOUBLE SECOND'VALUE:=0D;            << LOGICAL ARITHMETIC  >>  <<04646>>29302000
LOGICAL SECOND=SECOND'VALUE+1;      << SIGNIFICANT PART    >>  <<04646>>29304000
EQUATE PLUS="+";                                               <<04646>>29306000
EQUATE MINUS="-";                                              <<04646>>29308000
                                                               <<04646>>29310000
<<BASIC SCHEME: 1) FIND NAME, 2) FIND DELIMITER, 3) GET VALUE>><<U.RAO>>29312000
ERRNUM := 0;                                                   <<U.RAO>>29314000
PARMNUM := 1;                                                  <<U.RAO>>29316000
WHILE PARMSP=" " DO @PARMSP := @PARMSP+1;                      <<U.RAO>>29318000
MOVE PARMSP := PARMSP WHILE ANS,1; <<RESULT IS ADDR OF DELIM>> <<U.RAO>>29320000
@PARMPTR := TOS;                                               <<U.RAO>>29322000
IF (@PARMPTR = @PARMSP) AND PARMPTR <> "@" THEN                <<04.RO>>29324000
   CIERR(ERRNUM := SETJCWNONAME, PARMSP)                       <<U.RAO>>29326000
ELSE                                                           <<U.RAO>>29328000
   BEGIN  <<NAME IS NON-NULL.  GET VALUE>>                     <<U.RAO>>29330000
   NAMELEN := @PARMPTR - @PARMSP;                              <<U.RAO>>29332000
   IF NAMELEN = 0 THEN   <<WAS "@", SKIP OVER>>                <<04.RO>>29334000
      @PARMPTR := @PARMPTR+1;                                  <<04.RO>>29336000
   WHILE (PARMPTR = SPECIAL) AND (PARMPTR <> CR) AND           <<04646>>29338000
        (PARMPTR<>"%") AND (PARMPTR<>MINUS) DO                 <<04646>>29340000
      @PARMPTR := @PARMPTR+1;                                  <<U.RAO>>29342000
   IF PARMPTR = MINUS THEN                                     <<04646>>29344000
      ERRNUM := SETJCWNUM2LARGE                                <<04646>>29346000
   ELSE                                                        <<04646>>29348000
   BEGIN                                                       <<04646>>29350000
   JCWPRIMARY(PARMPTR, NEWVALUE, TRANSERR, TRANSERRPTR,        <<U.RAO>>29352000
      PARMNUM);                                                <<U.RAO>>29354000
   @PARMPTR := TRANSERRPTR;                                    <<U.RAO>>29356000
   CASE *TRANSERR OF                                           <<U.RAO>>29358000
      BEGIN                                                    <<U.RAO>>29360000
      IF (PARMPTR<>CR) AND                                     <<04646>>29362000
         (PARMPTR<>PLUS) AND (PARMPTR<>MINUS) THEN             <<04646>>29364000
            ERRNUM := SETJCW2MP;                               <<04646>>29366000
         ERRNUM := SETJCWNOVALUE;                              <<U.RAO>>29368000
         ERRNUM := SETJCWNUM2LARGE;                            <<U.RAO>>29370000
         ERRNUM := SETJCWINVOCTDGT;                            <<U.RAO>>29372000
         ERRNUM := SETJCWOKVAL2BIG;                            <<U.RAO>>29374000
         ERRNUM := SETJCWWARNVAL;                              <<U.RAO>>29376000
         ERRNUM := SETJCWFATALVAL;                             <<U.RAO>>29378000
         ERRNUM := SETJCWSYSTEMVAL;                            <<U.RAO>>29380000
         ERRNUM := SETJCWNAME2LONG;                            <<U.RAO>>29382000
         ERRNUM := SETJCWNAMENOALP;                            <<U.RAO>>29384000
         ERRNUM := SETJCWNOSUCHJCW;                            <<U.RAO>>29386000
      END;                                                     <<U.RAO>>29388000
   END;                                                        <<04646>>29390000
   IF ERRNUM <> 0 THEN                                         <<U.RAO>>29392000
      CIERR(ERRNUM, PARMPTR)                                   <<U.RAO>>29394000
   ELSE   <<HAVE VALID JCW VALUE IN "NEWVALUE".  EXECUTE!>>    <<U.RAO>>29396000
      BEGIN                                                    <<U.RAO>>29398000
                                                               <<04646>>29400000
<<  NOW CHECK IF ANY ARITHMETIC OPERATIONS NEED TO BE >>       <<04646>>29402000
<<  PERFORMED ON THE PARAMETERS.                      >>       <<04646>>29404000
                                                               <<04646>>29406000
      IF (PARMPTR=PLUS) OR (PARMPTR=MINUS) THEN                <<04646>>29408000
       BEGIN                                                   <<04646>>29410000
                                                               <<04646>>29412000
<<  DETERMINE OPERATION TYPE                          >>       <<04646>>29414000
                                                               <<04646>>29416000
         IF (PARMPTR=PLUS) THEN                                <<04646>>29418000
            ADD:=TRUE                                          <<04646>>29420000
         ELSE ADD:=FALSE;                                      <<04646>>29422000
         @PARMPTR:=@PARMPTR+1;                                 <<04646>>29424000
                                                               <<04646>>29426000
<<  GET A VALUE FOR THE SECOND JCW VALUE              >>       <<04646>>29428000
                                                               <<04646>>29430000
         JCWPRIMARY(PARMPTR,SECOND,TRANSERR,TRANSERRPTR,       <<04646>>29432000
            PARMNUM);                                          <<04646>>29434000
         @PARMPTR:=TRANSERRPTR;                                <<04646>>29436000
         CASE *TRANSERR OF                                     <<04646>>29438000
            BEGIN                                              <<04646>>29440000
               IF (PARMPTR<>CR) THEN                           <<04646>>29442000
                  ERRNUM := SETJCW2MP;                         <<04646>>29444000
               ERRNUM := SETJCWNOVALUE;                        <<04646>>29446000
               ERRNUM := SETJCWNUM2LARGE;                      <<04646>>29448000
               ERRNUM := SETJCWINVOCTDGT;                      <<04646>>29450000
               ERRNUM := SETJCWOKVAL2BIG;                      <<04646>>29452000
               ERRNUM := SETJCWWARNVAL;                        <<04646>>29454000
               ERRNUM := SETJCWFATALVAL;                       <<04646>>29456000
               ERRNUM := SETJCWSYSTEMVAL;                      <<04646>>29458000
               ERRNUM := SETJCWNAME2LONG;                      <<04646>>29460000
               ERRNUM := SETJCWNAMENOALP;                      <<04646>>29462000
               ERRNUM := SETJCWNOSUCHJCW;                      <<04646>>29464000
            END;                                               <<04646>>29466000
         IF ERRNUM <> 0 THEN                                   <<04646>>29468000
            BEGIN                                              <<04646>>29470000
              CIERR(ERRNUM,PARMPTR);                           <<04646>>29472000
              RETURN;                                          <<04646>>29474000
            END;                                               <<04646>>29476000
                                                               <<04646>>29478000
<<  NO ERRORS YET--NOW PERFORM THE ARITHMETIC         >>       <<04646>>29480000
                                                               <<04646>>29482000
         IF NOT ADD THEN                                       <<04646>>29484000
            SECOND'VALUE := -SECOND'VALUE;                     <<04646>>29486000
         TEMPJCWVALUE := DOUBLE'NEWVALUE + SECOND'VALUE;       <<04646>>29488000
                                                               <<04646>>29490000
<<  NOW CHECK IF THE RESULT IS TOO LARGE              >>       <<04646>>29492000
                                                               <<04646>>29494000
         IF (TEMPJCWVALUE > 65535D) OR (TEMPJCWVALUE < 0D) THEN<<04646>>29496000
            BEGIN                                              <<04646>>29498000
              ERRNUM := SETJCWNUM2LARGE;                       <<04646>>29500000
              @PARMPTR := @PARMPTR-2;                          <<04646>>29502000
              CIERR(ERRNUM, PARMPTR);                          <<04646>>29504000
              RETURN;                                          <<04646>>29506000
            END                                                <<04646>>29508000
         ELSE                                                  <<04646>>29510000
            NEWVALUE := REALJCWVALUE;                          <<04646>>29512000
       END;                                                    <<04646>>29514000
      PUTJCW(PARMSP, NEWVALUE, TRANSERR);  <<SEND NEW VALUE>>  <<U.RAO>>29516000
      CASE *TRANSERR OF                                        <<U.RAO>>29518000
         BEGIN                                                 <<U.RAO>>29520000
            <<NO ERRORS, SEE IF IT WAS "JCW">>                 <<U.RAO>>29522000
            IF NEWVALUE.(0:1) <<BIT 0 SET>> THEN               <<04.RO>>29524000
               IF (NAMELEN=3) AND PARMSP="JCW"                 <<04.RO>>29526000
                  OR PARMSP="@" THEN                           <<04.RO>>29528000
               BEGIN                                           <<01893>>29530000
               << IF :SETJCW IS EXECUTED PROGRAMMATICALLY, >>  <<01893>>29532000
               << DON'T BOTHER WITH ANY ERROR MESSAGES.    >>  <<01893>>29534000
                  IF JOBSESSIONMAIN THEN                       <<01893>>29536000
                  BEGIN                                        <<01893>>29538000
                  << WARNING ABOUT POSSIBLE FLUSHING OF UDC. >><<01893>>29540000
                     IF UDC4.NESTLEVEL <> 0 THEN               <<01893>>29542000
                        CIERR( -SETJCWFATINUDC );              <<01893>>29544000
                                                               <<01893>>29546000
                  << WARNING ABOUT POSSIBLE JOB FLUSHING. >>   <<01893>>29548000
                     INTERACTIVETEST;                          <<01893>>29550000
                     INTERACTIVE := TOS;                       <<01893>>29552000
                     IF NOT INTERACTIVE THEN                   <<01893>>29554000
                        CIERR( -SETJCWFATINJOB );              <<01893>>29556000
                                                               <<01893>>29558000
                  END;                                         <<01893>>29560000
                                                               <<01893>>29562000
               << KILL JOB IF APPROPRIATE.           >>        <<01893>>29564000
                                                               <<01893>>29566000
                   CIERR;                                      <<01893>>29568000
                END;                                           <<01893>>29570000
            CIERR(ERRNUM := SETJCWNAME2LONG, PARMSP);          <<01893>>29572000
            CIERR(ERRNUM := SETJCWNAMENOALP, PARMSP);          <<U.RAO>>29574000
            CIERR(ERRNUM := JCWTABOVERFLOW, PARMSP);           <<U.RAO>>29576000
         END;                                                  <<U.RAO>>29578000
      END;                                                     <<U.RAO>>29580000
   END;                                                        <<U.RAO>>29582000
END;   <<PROCEDURE CXSETJCW>>                                  <<U.RAO>>29584000
PROCEDURE CXSHOWJCW EXECUTORHEAD;                              <<U.RAO>>29586000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>29588000
<<SYNTAX     SHOWJCW [<jcwname>]    >>                         <<U.RAO>>29590000
BEGIN                                                          <<U.RAO>>29592000
INTEGER NAMELEN;   <<LENGTH OF JCW NAME>>                      <<U.RAO>>29594000
INTEGER JDTDST;   <<HOLDS DST NUMBER OF JDT>>                  <<U.RAO>>29596000
EQUATE JJCWADR = 5;                                            <<U.RAO>>29598000
DOUBLE JCWTABLIMITS;                                           <<U.RAO>>29600000
INTEGER NEXTJCWADR = JCWTABLIMITS;  <<LOWER BOUND OF JCW TABLE><<U.RAO>>29602000
INTEGER JCWTABEND = JCWTABLIMITS+1; <<UPPER BOUND OF JCW TABLE><<U.RAO>>29604000
INTEGER ARRAY CANDIDATEW(0:128);                               <<U.RAO>>29606000
BYTE ARRAY CANDIDATE(*) = CANDIDATEW;                          <<U.RAO>>29608000
INTEGER ERROR;  <<FOR CALL TO FINDJCW>>                        <<U.RAO>>29610000
INTEGER JCWGROUP;  <<NEED TO ACCOUNT FOR OK, WARN, ETC.>>      <<U.RAO>>29612000
INTEGER JCWVALUE;                 <<ACTUAL JCWVALUE PART>>     <<U.RAO>>29614000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>29616000
                                                               <<U.RAO>>29618000
<<FIRST CHECK FOR PARM>>                                       <<U.RAO>>29620000
SCAN PARMSP WHILE %6440,1;  <<SKIP ANY LEADING BLANKS>>        <<U.RAO>>29622000
@PARMSP := TOS;                                                <<U.RAO>>29624000
IF NOCARRY THEN   <<SOMETHING ELSE BEFORE CR>>                 <<U.RAO>>29626000
   BEGIN                                                       <<U.RAO>>29628000
   PARMNUM := 1;                                               <<U.RAO>>29630000
   MOVE PARMSP := PARMSP WHILE AN,1;  <<TO GET NAME LENGTH>>   <<U.RAO>>29632000
   NAMELEN := TOS-@PARMSP;                                     <<U.RAO>>29634000
   IF NAMELEN > 255 THEN                                       <<U.RAO>>29636000
      CIERR(ERRNUM := SETJCWNAME2LONG, PARMSP)                 <<U.RAO>>29638000
   ELSE  <<NAME IS LEGAL LENGTH>>                              <<U.RAO>>29640000
      BEGIN   <<TRY TO GET IT>>                                <<U.RAO>>29642000
      MOVE CANDIDATE := PARMSP WHILE ANS,0;                    <<U.RAO>>29644000
      SCAN * WHILE %6440,1;  <<LOOK FOR EXTRANEOUS DATA>>      <<U.RAO>>29646000
      IF NOCARRY THEN   <<IS SOME EXTRANEOUS PARM, WARN>>      <<U.RAO>>29648000
         BEGIN                                                 <<U.RAO>>29650000
         TOS := ERRNUM := -SHOWJCW2MP;                         <<U.RAO>>29652000
         ASSEMBLE(XCH);                                        <<U.RAO>>29654000
         CIERR(*,*);                                           <<U.RAO>>29656000
         END;                                                  <<U.RAO>>29658000
      CANDIDATE(NAMELEN) := 0;  <<END OF NAME STOPPER>>        <<U.RAO>>29660000
      FINDJCW(CANDIDATE, JCWVALUE, ERROR);                     <<U.RAO>>29662000
      JCWGROUP := JCWVALUE.(0:2);  <<EXTRACT TYPE FIELD>>      <<U.RAO>>29664000
      JCWVALUE := JCWVALUE.(2:14);  <<MODIFIER FIELD>>         <<U.RAO>>29666000
      CASE *ERROR OF                                           <<U.RAO>>29668000
         BEGIN                                                 <<U.RAO>>29670000
            GENMSG(CIGENERALMSGSET, SHOWJCWMSG+JCWGROUP,       <<U.RAO>>29672000
                     %01000, @CANDIDATE, JCWVALUE);            <<U.RAO>>29674000
            ;  <<NAME > 255 CHAR CAN'T HAPPEN>>                <<U.RAO>>29676000
            CIERR(ERRNUM := SETJCWNAMENOALP, PARMSP);          <<U.RAO>>29678000
            CIERR(ERRNUM := SHOWJCWNOSCHJCW, PARMSP);          <<U.RAO>>29680000
         END;                                                  <<U.RAO>>29682000
      END;                                                     <<U.RAO>>29684000
   END                                                         <<U.RAO>>29686000
ELSE   <<NO PARAMETERS, LIST ALL JCWS>>                        <<U.RAO>>29688000
   BEGIN                                                       <<U.RAO>>29690000
   <<FIRST GET BOUNDS ON TABLE>>                               <<U.RAO>>29692000
   SETXPXGLOB+PXGWJDT;                                         <<U.RAO>>29694000
   JDTDST := ARRDB0(XREG).(6:10);                              <<KS.01>>29696000
   MOVEFROMDSEG(@JCWTABLIMITS, JDTDST, JJCWADR, 2);            <<U.RAO>>29698000
   <<NOW LOOP THROUGH JCW TABLE, PRINTING ENTRIES>>            <<U.RAO>>29700000
   WHILE NEXTJCWADR < JCWTABEND DO                             <<U.RAO>>29702000
      BEGIN                                                    <<U.RAO>>29704000
      <<FIRST GET NEXT ENTRY IN FROM TABLE.>>                  <<U.RAO>>29706000
      TOS := @CANDIDATEW;                                      <<U.RAO>>29708000
      TOS := JDTDST;                                           <<U.RAO>>29710000
      TOS := NEXTJCWADR;                                       <<U.RAO>>29712000
      <<LENGTH TO READ IS MIN OF 129 OR THE SPACE LEFT IN TABLE<<U.RAO>>29714000
      IF JCWTABEND-NEXTJCWADR > 129 THEN                       <<U.RAO>>29716000
         TOS := 129                                            <<U.RAO>>29718000
      ELSE  <<TABLE HAS LESS THAN 129 WORDS LEFT IN IT>>       <<U.RAO>>29720000
         TOS := JCWTABEND-NEXTJCWADR;                          <<U.RAO>>29722000
      ASSEMBLE(MFDS);  <<GET ITEM IN>>                         <<U.RAO>>29724000
      <<NOW HAVE NEXT CANDIDATE IN LOCAL ARRAY, PREP FOR MESSAG<<U.RAO>>29726000
      JCWVALUE := CANDIDATEW(CANDIDATE&LSR(1)+1);              <<U.RAO>>29728000
      JCWGROUP := JCWVALUE.(0:2);  <<GET TYPE FIELD>>          <<U.RAO>>29730000
      JCWVALUE := JCWVALUE.(2:14);  <<ISOLATE MODIFIER PART>>           29732000
      CANDIDATE(CANDIDATE+1) := 0;  <<STOPPER FOR GENMSG>>     <<U.RAO>>29734000
      <<FINALLY PRINT MESSAGE>>                                <<U.RAO>>29736000
      GENMSG(CIGENERALMSGSET, SHOWJCWMSG+JCWGROUP,             <<U.RAO>>29738000
             %01000, @CANDIDATE(1), JCWVALUE);                 <<U.RAO>>29740000
      NEXTJCWADR := NEXTJCWADR+INTEGER(CANDIDATE)&LSR(1)+2;    <<U.RAO>>29742000
      IF REQUESTSERVICE THEN NEXTJCWADR := JCWTABEND;          <<U.RAO>>29744000
      END;                                                     <<U.RAO>>29746000
   END;                                                        <<U.RAO>>29748000
END;   <<PROCEDURE SHOWJCW>>                                   <<U.RAO>>29750000
$PAGE "MISCELLANEOUS COMMANDS, THIRD BLOCK"                    <<08.RO>>29752000
PROCEDURE CXCOMMENT EXECUTORHEAD;                              <<U.RAO>>29754000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>29756000
      BEGIN                                                             29758000
      <<NOP PROCEDURE...COMMENT ALREADY LISTED BY GETIMAGE>>            29760000
      END;                                                              29762000
$CONTROL SEGMENT=CIPREPRUN                                     <<U.RAO>>29764000
      PROCEDURE CXSETMSG EXECUTORHEAD;                                  29766000
      OPTION PRIVILEGED,UNCALLABLE;                                     29768000
      BEGIN                                                             29770000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>29772000
BYTE POINTER BPARM = PARMS;  <<POINTER TO ARGUMENT>>           <<U.RAO>>29774000
BYTE BPARMLEN = PARMS+1;     <<ARGUMENT LENGTH>>               <<U.RAO>>29776000
BYTE POINTER EXTRAPARM = PARMS+2;                              <<U.RAO>>29778000
DOUBLE DDL := [8/",",8/";",16/%6400]D;                         <<U.RAO>>29780000
BYTE ARRAY DL(*)=DDL;                                          <<U.RAO>>29782000
INTEGER NUMPARMS;                                              <<U.RAO>>29784000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>29786000
IF NUMPARMS = 0 THEN   <<NOT ENOUGH PARMS>>                    <<U.RAO>>29788000
   BEGIN                                                       <<U.RAO>>29790000
   CIERR(ERRNUM := SETMSGPARMPROB, PARMSP(1));                 <<U.RAO>>29792000
   PARMNUM := 1;                                               <<U.RAO>>29794000
   END                                                         <<U.RAO>>29796000
ELSE IF NUMPARMS > 1 THEN  <<TOO MANY PARMS>>                  <<U.RAO>>29798000
   BEGIN                                                       <<U.RAO>>29800000
   CIERR(ERRNUM := SETMSGEXTRAPARM, EXTRAPARM);                <<U.RAO>>29802000
   PARMNUM := 2;                                               <<U.RAO>>29804000
   END                                                         <<U.RAO>>29806000
ELSE IF (BPARMLEN=2) AND (BPARM="ON")                          <<U.RAO>>29808000
     OR (BPARMLEN=3) AND (BPARM="OFF") THEN                    <<U.RAO>>29810000
   BEGIN  <<HAVE LEGAL ARGUMENT>>                              <<U.RAO>>29812000
   SETXPXGLOB;                                                 <<U.RAO>>29814000
   TOS := ARRDB3(X).(0:8);  <<GET JMAT INDEX>>                 <<U.RAO>>29816000
   EXCHANGEDB(JMATDST);                                        <<U.RAO>>29818000
   ARRDB0(TOS*JMATLEN).(8:1) := BPARMLEN;  <<TRICKY, THIS>>    <<U.RAO>>29820000
   EXCHANGEDB(0);                                              <<U.RAO>>29822000
   END                                                         <<U.RAO>>29824000
ELSE  <<UNKNOWN ARGUMENT>>                                     <<U.RAO>>29826000
   BEGIN                                                       <<U.RAO>>29828000
   PARMNUM := 1;                                               <<U.RAO>>29830000
   CIERR(ERRNUM := SETMSGPARMPROB, BPARM);                     <<U.RAO>>29832000
   END;                                                        <<U.RAO>>29834000
END;  <<CXSETMSG>>                                             <<U.RAO>>29836000
      PROCEDURE SETDUMP(FLAGS);                                         29838000
      VALUE FLAGS;                                                      29840000
      LOGICAL FLAGS;                                                    29842000
      BEGIN                                                             29844000
      ERRORON;                                                          29846000
      SETXPXGLOB;                                                       29848000
      FLAGS.(10:1):=1;<<ARM>>                                           29850000
      TOS:=IF ARRDB5(X).(0:6)<>0 THEN 0 ELSE 2;                         29852000
      ARRDB5(X).(0:6):=FLAGS;                                           29854000
      STATUS.(6:2):=TOS;<<SET CONDITION CODE>>                          29856000
      ERROREXIT(1,0,0);                                                 29858000
      END;<<SET DUMP>>                                                  29860000
      PROCEDURE RESETDUMP;                                              29862000
      OPTION PRIVILEGED;                                                29864000
      BEGIN                                                             29866000
      ERRORON;                                                          29868000
      SETXPXGLOB;                                                       29870000
      TOS := IF ARRDB5(X).(0:6) = 0 THEN 0 ELSE 2;             <<04177>>29872000
      ARRDB5(X).(0:6):=0;                                               29874000
      STATUS.(6:2):=TOS;                                                29876000
      ERROREXIT(0,0,0);                                                 29878000
      END;<<RESET DUMP>>                                                29880000
PROCEDURE CXSETDUMP EXECUTORHEAD;                              <<U.RAO>>29882000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>29884000
BEGIN                                                          <<U.RAO>>29886000
INTEGER PCNT:=0,  <<PARM COUNT>>                               <<U.RAO>>29888000
        NUMPARMS,                                              <<U.RAO>>29890000
        NEXTDELIM,  <<DELIMITER FOUND AFTER CURRENT TOKEN>>    <<U.RAO>>29892000
        PLEN;   <<LENGTH OF CURRENT PARM>>                     <<U.RAO>>29894000
LOGICAL FLAGS := %20;  <<TEMPLATE FOR DUMP FLAGS>>             <<U.RAO>>29896000
DOUBLE ARRAY PARMS(0:4) = Q;                                   <<U.RAO>>29898000
BYTE POINTER BADPARM = PARMS+8;                                <<U.RAO>>29900000
BYTE POINTER PPNTR;  <<POINTER TO PRESENT TOKEN>>              <<U.RAO>>29902000
DOUBLE DDL := [8/",",8/";",16/%6400]D;                         <<U.RAO>>29904000
BYTE ARRAY DL(*)=DDL;                                          <<U.RAO>>29906000
EQUATE DLEN = 20;  <<LENGTH OF DUMPTYPE ARRAY>>                <<U.RAO>>29908000
BYTE ARRAY DUMPTYPESL(0:DLEN-1) = PB :=                        <<U.RAO>>29910000
   4,2,"ST",                                                   <<U.RAO>>29912000
   4,2,"DB",                                                   <<U.RAO>>29914000
   4,2,"QS",                                                   <<U.RAO>>29916000
   7,5,"ASCII",                                                <<U.RAO>>29918000
   0;                                                          <<U.RAO>>29920000
BYTE ARRAY DUMPTYPES(0:DLEN-1);                                <<U.RAO>>29922000
                                                               <<U.RAO>>29924000
SUBROUTINE GETNEXTPARM;                                        <<U.RAO>>29926000
BEGIN                                                          <<U.RAO>>29928000
TOS := PARMS(PCNT);                                            <<U.RAO>>29930000
NEXTDELIM := S0.(14:2);                                        <<U.RAO>>29932000
PLEN := TOS&LSR(8);                                            <<U.RAO>>29934000
@PPNTR := TOS;                                                 <<U.RAO>>29936000
END;                                                           <<U.RAO>>29938000
                                                               <<U.RAO>>29940000
SUBROUTINE SYNERR;  <<SYNTAX ERROR>>                           <<U.RAO>>29942000
BEGIN                                                          <<U.RAO>>29944000
PARMNUM := PCNT+1;                                             <<U.RAO>>29946000
PPNTR(PLEN) := 0;                                              <<U.RAO>>29948000
CIERR(ERRNUM := SETDUMPUNKNOWN,PPNTR,0,@PPNTR);                <<U.RAO>>29950000
ASSEMBLE(EXIT 3);  <<RETURN>>                                  <<U.RAO>>29952000
END;                                                           <<U.RAO>>29954000
                                                               <<U.RAO>>29956000
MYCOMMAND(PARMSP,DL,5,NUMPARMS,PARMS);                         <<U.RAO>>29958000
PARMNUM := 5;  <<MAX NUMBER OF PARMS>>                         <<U.RAO>>29960000
IF NUMPARMS > 4 THEN                                           <<U.RAO>>29962000
   CIERR(ERRNUM := SETDUMP2MP,BADPARM)                         <<U.RAO>>29964000
ELSE  <<LEGAL NUMBER OF PARMS>>                                <<U.RAO>>29966000
   BEGIN                                                       <<U.RAO>>29968000
   IF NUMPARMS > 0 THEN                                        <<U.RAO>>29970000
      BEGIN  <<PARSE PARMS>>                                   <<U.RAO>>29972000
      MOVE DUMPTYPES := DUMPTYPESL, (DLEN);  <<INIT SEARCH ARRA<<U.RAO>>29974000
      DO   <<LOOP THROUGH PARMS, IDENTIFYING DUMP TYPES>>      <<U.RAO>>29976000
         BEGIN                                                 <<U.RAO>>29978000
         GETNEXTPARM;                                          <<U.RAO>>29980000
         IF PLEN <> 0 THEN  <<PARM IS PRESENT>>                <<U.RAO>>29982000
            CASE SEARCH(PPNTR, PLEN, DUMPTYPES) OF             <<U.RAO>>29984000
               BEGIN                                           <<U.RAO>>29986000
               SYNERR;  <<NON-EXISTANT TYPE>>                  <<U.RAO>>29988000
               FLAGS.(14:1) := 1;  <<ST>>                      <<U.RAO>>29990000
               FLAGS.(15:1) := 1;  <<DB>>                      <<U.RAO>>29992000
               FLAGS.(13:1) := 1;  <<QS>>                      <<U.RAO>>29994000
               FLAGS.(11:1) := 0;  <<ASCII>>                   <<U.RAO>>29996000
               END;                                            <<U.RAO>>29998000
         PCNT := PCNT+1;                                       <<U.RAO>>30000000
         END                                                   <<U.RAO>>30002000
      UNTIL NEXTDELIM=2;  <<UNTIL FIND CR DELIMITER>>          <<U.RAO>>30004000
      END;                                                     <<U.RAO>>30006000
   SETDUMP(FLAGS);                                             <<U.RAO>>30008000
   END;                                                        <<U.RAO>>30010000
END;  <<CXSETDUMP>>                                            <<U.RAO>>30012000
PROCEDURE CXRESETDUMP EXECUTORHEAD;                            <<U.RAO>>30014000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>30016000
BEGIN                                                          <<U.RAO>>30018000
MYCOMMAND(PARMSP,,0);                                          <<U.RAO>>30020000
IF <> THEN CIERR(-WARNXPARMSIGNORED,PARMSP);                   <<U.RAO>>30022000
RESETDUMP;                                                     <<U.RAO>>30024000
END;                                                           <<U.RAO>>30026000
$CONTROL SEGMENT=CISYSMGR                                      <<U.RAO>>30028000
PROCEDURE CXJOBPRI EXECUTORHEAD;                               <<U.RAO>>30030000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>30032000
BEGIN                                                          <<U.RAO>>30034000
                                                               <<U.RAO>>30036000
LOGICAL DL := %26015; <<COMMA, CR>>                            <<U.RAO>>30038000
INTEGER NUMPARMS,                                              <<U.RAO>>30040000
        NEWMAXQ,  <<LOCAL TEMP FOR MAX JOB QUEUE>>             <<U.RAO>>30042000
        NEWDEFQ;  <<LOCAL TEMP FOR DEFAULT JOB QUEUE>>         <<U.RAO>>30044000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>30046000
BYTE POINTER BMAXQ = PARMS;                                    <<U.RAO>>30048000
BYTE LENMAXQPARM = PARMS+1;                                    <<U.RAO>>30050000
BYTE POINTER BDEFQ = PARMS+2;                                  <<U.RAO>>30052000
BYTE LENDEFQPARM = PARMS+3;                                    <<U.RAO>>30054000
BYTE POINTER BADPARM = PARMS+4;                                <<U.RAO>>30056000
EQUATE CS=150,                                                 <<08.EB>>30058000
       DS=200,                                                 <<08.EB>>30060000
       ES=250;                                                 <<U.RAO>>30062000
EQUATE QNAMELEN=20;                                            <<U.RAO>>30064000
BYTE ARRAY QNAMEP(0:QNAMELEN-1)=PB :=                          <<U.RAO>>30066000
   5,2,"CS",CS,                                                <<U.RAO>>30068000
   5,2,"DS",DS,                                                <<U.RAO>>30070000
   5,2,"ES",ES,                                                <<U.RAO>>30072000
   4,1,"0",0,                                                  <<U.RAO>>30074000
   0;                                                          <<U.RAO>>30076000
BYTE ARRAY QNAME(0:QNAMELEN-1);                                <<U.RAO>>30078000
                                                               <<U.RAO>>30080000
                                                               <<U.RAO>>30082000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>30084000
IF NUMPARMS > 2 THEN                                           <<U.RAO>>30086000
   BEGIN                                                       <<U.RAO>>30088000
   PARMNUM := 3;                                               <<U.RAO>>30090000
   CIERR(ERRNUM := JOBPRI2MP,BADPARM);                         <<U.RAO>>30092000
   END                                                         <<U.RAO>>30094000
ELSE                                                           <<U.RAO>>30096000
   BEGIN                                                       <<U.RAO>>30098000
   <<0, 1, OR 2 PARAMETERS.  IF PARAMETERS ARE PASSED, VALIDATE<<U.RAO>>30100000
   <<IF INVALID, PRINT MESSAGE AND RETURN.  OTHERWISE, IF PARAM<<U.RAO>>30102000
   <<PASSED, SET THE NEW VALUES.  IN ANY CASE, PRINT THE NEW VA<<U.RAO>>30104000
   NEWMAXQ := ABSOLUTE(MAXQUEUE);                              <<U.RAO>>30106000
   NEWDEFQ := ABSOLUTE(DEFAULTQUEUE);                          <<U.RAO>>30108000
   MOVE QNAME := QNAMEP, (QNAMELEN);  <<INIT NAME ARRAY>>      <<U.RAO>>30110000
   IF NUMPARMS >= 1 THEN                                       <<U.RAO>>30112000
      BEGIN  <<SOME PARMS EXIST>>                              <<U.RAO>>30114000
      IF LENMAXQPARM > 0 THEN                                 <<U.RAO>> 30116000
         BEGIN  <<MAX QUEUE PARM PRESENT>>                     <<U.RAO>>30118000
         TOS := 0;                                             <<U.RAO>>30120000
         IF SEARCH(BMAXQ,LENMAXQPARM,QNAME,BPS0) = 0 THEN      <<U.RAO>>30122000
            BEGIN <<UNKNOWN QUEUE NAME>>                       <<U.RAO>>30124000
            PARMNUM := 1;                                      <<U.RAO>>30126000
            CIERR(ERRNUM := JOBPRIUNKNOWNQ, BMAXQ);            <<U.RAO>>30128000
            RETURN                                             <<U.RAO>>30130000
            END;                                               <<U.RAO>>30132000
         NEWMAXQ := INTEGER(BPS0);                             <<U.RAO>>30134000
         DEL;                                                  <<U.RAO>>30136000
         END;                                                  <<U.RAO>>30138000
      IF (NUMPARMS=2) AND (LENDEFQPARM>0) THEN                 <<U.RAO>>30140000
         BEGIN <<DEFAULT QUEUE PARM APPARENTLY PRESENT>>       <<U.RAO>>30142000
         TOS := 0;                                             <<U.RAO>>30144000
         IF SEARCH(BDEFQ,LENDEFQPARM,QNAME,BPS0) = 0 THEN      <<U.RAO>>30146000
            BEGIN  <<UNKNOWN QUEUE NAME>>                      <<U.RAO>>30148000
            PARMNUM := 2;                                      <<U.RAO>>30150000
            CIERR(ERRNUM := JOBPRIUNKNOWNQ, BDEFQ);            <<U.RAO>>30152000
            RETURN                                             <<U.RAO>>30154000
            END;                                               <<U.RAO>>30156000
         IF BPS0 = 0 THEN                                      <<U.RAO>>30158000
            BEGIN <<0 ILLEGAL FOR DEFAULT QUEUE>>              <<U.RAO>>30160000
            CIERR(-JOBPRIWARNNOT0, BDEFQ);                     <<U.RAO>>30162000
            NEWDEFQ := CS;                                     <<U.RAO>>30164000
            END                                                <<U.RAO>>30166000
         ELSE                                                  <<U.RAO>>30168000
            NEWDEFQ := INTEGER(BPS0);                          <<U.RAO>>30170000
         DEL;                                                  <<U.RAO>>30172000
         END;                                                  <<U.RAO>>30174000
      IF NEWDEFQ < NEWMAXQ THEN                                <<U.RAO>>30176000
         BEGIN                                                 <<U.RAO>>30178000
         <<DEFAULT PRIORITY HAS LOWER VALUE AND THUS EXCEEDS TH<<U.RAO>>30180000
         <<IMPOSED BY THE MAXQ PRIORITY.  PRINT ERROR MSG, RETU<<U.RAO>>30182000
         IF NEWDEFQ + NEWMAXQ < CS+ES THEN                     <<U.RAO>>30184000
            CIERR(JOBPRIDEFCSMAXDS)                            <<U.RAO>>30186000
         ELSE IF = THEN                                        <<U.RAO>>30188000
            CIERR(JOBPRIDEFCSMAXES)                            <<U.RAO>>30190000
         ELSE                                                  <<U.RAO>>30192000
            CIERR(JOBPRIDEFDSMAXES);                           <<U.RAO>>30194000
         RETURN                                                <<U.RAO>>30196000
         END;                                                  <<U.RAO>>30198000
      END;                                                     <<U.RAO>>30200000
   <<AT THIS POINT WE HAVE GOOD VALUES.  IT REMAINS TO SET THE <<U.RAO>>30202000
   <<GLOBALS, PRINT THE CURRENT (NEW) VALUES, THEN RETURN>>    <<U.RAO>>30204000
   ABSOLUTE(MAXQUEUE) := NEWMAXQ;                              <<U.RAO>>30206000
   ABSOLUTE(DEFAULTQUEUE) := NEWDEFQ;                          <<U.RAO>>30208000
   QNAME(4) := QNAME(9) := QNAME(14) := 0;  <<FOR GENMSG>>     <<U.RAO>>30210000
   @BMAXQ := (IF NEWMAXQ > DS THEN @QNAME(12)                  <<U.RAO>>30212000
         ELSE IF = THEN @QNAME(7)                              <<U.RAO>>30214000
         ELSE IF NEWMAXQ > 0 THEN @QNAME(2)                    <<U.RAO>>30216000
         ELSE @QNAME(17));                                     <<U.RAO>>30218000
   @BDEFQ := (IF NEWDEFQ > DS THEN @QNAME(12)                  <<U.RAO>>30220000
         ELSE IF = THEN @QNAME(7)                              <<U.RAO>>30222000
         ELSE @QNAME(2));                                      <<U.RAO>>30224000
   GENMSG( CIGENERALMSGSET, JOBPRIVAL, 0, @BMAXQ, @BDEFQ );    <<01525>>30226000
   END;                                                        <<U.RAO>>30228000
END;  <<CXJOBPRI>>                                             <<U.RAO>>30230000
$PAGE   "ORGANIZATIONAL MANAGEMENT COMMANDS"                            30232000
$CONTROL SEGMENT= CIORGMAN                                              30234000
INTEGER PROCEDURE CHECK'N'MOVENAME (SOURCE,SLNGTH,             <<RV.PV>>30236000
                             TARGET,TARGETINCRDECR,MAXPARTS);  <<RV.PV>>30238000
    VALUE   SLNGTH,TARGETINCRDECR,MAXPARTS;                    <<RV.PV>>30240000
    INTEGER SLNGTH,TARGETINCRDECR,MAXPARTS;                    <<RV.PV>>30242000
    BYTE ARRAY SOURCE;                                         <<RV.PV>>30244000
    ARRAY TARGET;                                              <<RV.PV>>30246000
    OPTION PRIVILEGED, UNCALLABLE;                             <<04.RO>>30248000
    BEGIN                                                      <<RV.PV>>30250000
        BYTE ARRAY                                             <<RV.PV>>30252000
            STRING (0:SLNGTH);                                 <<RV.PV>>30254000
        DOUBLE ARRAY                                           <<RV.PV>>30256000
            PARMS (0:MAXPARTS);                                <<RV.PV>>30258000
        DOUBLE                                                 <<RV.PV>>30260000
            PARM;                                              <<RV.PV>>30262000
        INTEGER                                                <<RV.PV>>30264000
            RESULT = CHECK'N'MOVENAME,                         <<RV.PV>>30266000
            NUMPARMS,                                          <<RV.PV>>30268000
            PARM0 = PARM,                                      <<RV.PV>>30270000
            DL := [8/".", 8/%15],                              <<RV.PV>>30272000
            PNUM := 0;                                         <<RV.PV>>30274000
        LOGICAL                                                <<RV.PV>>30276000
            PARM1 = PARM0+1;                                   <<RV.PV>>30278000
        BYTE POINTER                                           <<RV.PV>>30280000
            HERE = PARM0;                                      <<RV.PV>>30282000
        DEFINE                                                 <<RV.PV>>30284000
            BADEXIT = BEGIN                                    <<RV.PV>>30286000
                          CC := CCL;                           <<RV.PV>>30288000
                          RETURN;                              <<RV.PV>>30290000
                      END #,                                   <<RV.PV>>30292000
            LNGTH = PARM1.(0:8) #,                             <<RV.PV>>30294000
            SPEC = PARM1.(10:1) #;                             <<RV.PV>>30296000
        EQUATE                                                 <<RV.PV>>30298000
            EXPECTALPHA = 0, <<START OF NAME MUST BE ALPHA>>   <<RV.PV>>30300000
            SPECHAR     = 1, <<CONTAINS SPEC CHAR(S)>>         <<RV.PV>>30302000
            NAMETOOLONG = 2; <<EXCEEDS 8 BYTES>>               <<RV.PV>>30304000
<<>>                                                           <<RV.PV>>30306000
        CC := CCE; <<OK UNTIL FAILURE>>                        <<RV.PV>>30308000
        MOVE STRING := SOURCE, (SLNGTH);                       <<RV.PV>>30310000
        STRING (SLNGTH) := %15;                                <<RV.PV>>30312000
        MYCOMMAND (STRING,DL,MAXPARTS,NUMPARMS,PARMS);         <<RV.PV>>30314000
        IF > THEN                                              <<RV.PV>>30316000
        BEGIN                                                  <<RV.PV>>30318000
            RESULT := NAMETOOLONG;                             <<RV.PV>>30320000
            BADEXIT;                                           <<RV.PV>>30322000
        END;                                                   <<RV.PV>>30324000
        IF NUMPARMS = 0 THEN RETURN;                           <<RV.PV>>30326000
        DO BEGIN                                               <<RV.PV>>30328000
               PARM := PARMS (PNUM);                           <<RV.PV>>30330000
               IF HERE <> ALPHA THEN                           <<RV.PV>>30332000
                IF LNGTH = 1 AND PNUM=0 AND HERE = "@" THEN    <<RV.PV>>30334000
                ELSE                                           <<RV.PV>>30336000
                BEGIN                                          <<RV.PV>>30338000
                    RESULT := EXPECTALPHA;                     <<RV.PV>>30340000
                    BADEXIT;                                   <<RV.PV>>30342000
                END                                            <<RV.PV>>30344000
               ELSE                                            <<RV.PV>>30346000
                IF SPEC THEN                                   <<RV.PV>>30348000
                BEGIN                                          <<RV.PV>>30350000
                    RESULT := SPECHAR;                         <<RV.PV>>30352000
                    BADEXIT;                                   <<RV.PV>>30354000
                END                                            <<RV.PV>>30356000
                ELSE                                           <<RV.PV>>30358000
                 IF LNGTH > 8 THEN                             <<RV.PV>>30360000
                  BEGIN                                        <<RV.PV>>30362000
                     RESULT := NAMETOOLONG;                    <<RV.PV>>30364000
                     BADEXIT;                                  <<RV.PV>>30366000
                 END;                                          <<RV.PV>>30368000
               TOS := @TARGET & LSL (1);                       <<RV.PV>>30370000
               MOVE * := HERE, (LNGTH);                        <<RV.PV>>30372000
               @TARGET := @TARGET + TARGETINCRDECR;            <<RV.PV>>30374000
           END UNTIL (PNUM:=PNUM+1) = NUMPARMS;                <<RV.PV>>30376000
        RESULT := NUMPARMS;                                    <<RV.PV>>30378000
    END;<<OF CHECK'N'MOVENAME>>                                <<RV.PV>>30380000
LOGICAL PROCEDURE CYORGCOMS'(ERRNUM,PARMNUM,IMAGE,LEVEL,NEWENTRY,       30382000
                             VSCOMM,SPECMASK);                 <<RV.PV>>30384000
<<THIS PROCEDURE PARSES THE PARAMETER LIST SUPPLIED WITH :NEWXXXX>>     30386000
<<AND :ALTXXX COMMANDS FOR ACCOUNTS, GROUPS AND USERS.  ALL DETECTED>>  30388000
<<ERRORS ARE REPORTED IN THIS PROCEDURE.  A RETURN VALUE OF TRUE>>      30390000
<<INDICATES THAT NO ERRORS WERE DETECTED.>>                    <<U.RAO>>30392000
VALUE LEVEL;                                                   <<U.RAO>>30394000
INTEGER ERRNUM;  <<THE USUAL ERRNUM>>                          <<U.RAO>>30396000
INTEGER PARMNUM; <<THE USUAL PARMNUM>>                         <<U.RAO>>30398000
BYTE ARRAY IMAGE;  <<THE PARAMETER IMAGE TO BE PARSED>>        <<U.RAO>>30400000
INTEGER LEVEL;  <<THE LEVEL OF OPERATION - 1=G,2=A,3=U>>       <<U.RAO>>30402000
INTEGER ARRAY NEWENTRY;  <<WHERE THE PARSED INFO IS TO GO>>    <<U.RAO>>30404000
ARRAY VSCOMM;  <<SUPPLIED BY :XXXACCT & :XXXGROUP COMMANDS>>   <<RV.PV>>30406000
ARRAY SPECMASK;   <<THIS IS SUPPLIED BY :ALTXXX COMMANDS.  >>  <<RV.PV>>30408000
  <<IT INDICATES EVERY WORD OF NEWENTRY WHICH WAS SUPPLIED BY THE USER>>30410000
   <<THIS IS SO THAT ONLY CHANGED ITEMS ARE ENTERED IN THE DIRECTORY>>  30412000
OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                         <<U.RAO>>30414000
                                                               <<U.RAO>>30416000
BEGIN                                                          <<U.RAO>>30418000
<<MYCOMMAND VARIABLES>>                                        <<U.RAO>>30420000
INTEGER NUMPARMS;  <<ACTUAL NUMBER OF PARMS DETECTED>>         <<U.RAO>>30422000
DOUBLE ARRAY PARMS(0:70);  <<APPROXIMATE MAXIMUM ON POSSIBLE PARMS>>    30424000
DOUBLE DL := [8/";",8/"=",8/",",8/":"]D;                       <<U.RAO>>30426000
LOGICAL DLEXTENSION := %6400;  <<CARRIAGE RETURN>>             <<U.RAO>>30428000
EQUATE SEMICOLON=0,   <<INDEXES IN THE DL ARRAY>>              <<U.RAO>>30430000
       EQUALS   =1,                                            <<U.RAO>>30432000
       COMMA    =2,                                            <<U.RAO>>30434000
       COLON    =3,                                            <<U.RAO>>30436000
       CR       =4;                                            <<U.RAO>>30438000
<<VARIABLES FOR GLOBAL PARSE>>                                 <<U.RAO>>30440000
DEFINE GROUP = LEVEL=GROUPLEVEL#,                              <<U.RAO>>30442000
       ACCOUNT = LEVEL=ACCOUNTLEVEL#,                          <<U.RAO>>30444000
       USER = LEVEL=USERLEVEL#;                                <<U.RAO>>30446000
INTEGER NEXTDELIM;  <<HOLDS DL INDEX OF NEXT DELIMITER>>       <<U.RAO>>30448000
BYTE POINTER PARMPTR;  <<POINTS TO START OF CURRENT PARAMETER>>         30450000
INTEGER PARMLEN;    <<LENGTH OF CURRENT PARAMETER>>            <<U.RAO>>30452000
LOGICAL EMBEDDEDSPECIAL;  <<FOR CHECKING NAMES FOR SPECIALS>>  <<U.RAO>>30454000
DEFINE RESULTADR= INTEGER(DEFN(LEVEL))#;  <<OFFSET IN NEWENTRY><<U.RAO>>30456000
BYTE POINTER DEFN;  <<POINTS INTO KEYDICT DEFN ARRAY>>         <<U.RAO>>30458000
ARRAY TEMPSPECMASK (0:SPECMASKLN-1);                           <<RV.PV>>30460000
<<MISC VARIABLES>>                                             <<U.RAO>>30462000
BYTE POINTER BNEWENTRY := @NEWENTRY;                           <<U.RAO>>30464000
DOUBLE POINTER GSECURITY := @NEWENTRY(GSEC);                   <<U.RAO>>30466000
INTEGER ACCTSECDEF := [2/1,2/1,2/1,2/1,2/1,2/1];               <<01.RO>>30468000
DOUBLE GROUPSECDEF := [5/2,5/2,5/2,5/2,5/2,5/2]D;              <<01.RO>>30470000
BYTE ARRAY                                                     <<RV.PV>>30472000
    BVSHANAME (*) = VSCOMM (VSHANAME),                         <<RV.PV>>30474000
    BVSHGNAME (*) = VSCOMM (VSHGNAME);                         <<RV.PV>>30476000
EQUATE UNOTDBL = 0,  <<USER NOT ALLOWED DOUBLE INTEGER>>       <<U.RAO>>30478000
       DBLINVALID = 1,  <<PROBLEM WITH STRING>>                <<U.RAO>>30480000
       DBLNEG  = 2,  <<DOUBLE INTEGER IS NEGATIVE>>            <<U.RAO>>30482000
       REDUNDANT = 3,<<REDUNDANTLY DEFINED KEYWORD>>           <<U.RAO>>30484000
       EXPECTALPHA = 1, <<START OF NAME MUST BE ALPHA>>        <<U.RAO>>30486000
       NAMEMISSING = 2, <<EXPECTED NAME>>                      <<U.RAO>>30488000
       NAMETOOLONG = 3,  <<EXCEEDS 8 BYTES>>                   <<U.RAO>>30490000
       EMBEDSPEC = 5;  <<EMBEDDED SPECIAL IN NAME>>            <<U.RAO>>30492000
BYTE POINTER CAPDEFN;  <<POINTER TO DEFINITION WORD OF CAPDICT><<U.RAO>>30494000
LOGICAL PMASK = Q-4;  <<OPTION VARIABLE WORD>>                 <<U.RAO>>30496000
DOUBLE SEC;  <<THE SECURITY WORD DUMMY>>                       <<U.RAO>>30498000
INTEGER SEC1 = SEC;  <<USED FOR GROUP SECURITY>>               <<U.RAO>>30500000
LOGICAL VSPARMACCT; << TRUE IF VS= PARM ON XXXACCT COMMAND >>  <<01460>>30502000
INTEGER ADJUST;<<USED FOR CAPABILITY LIST PARSE>>              <<U.RAO>>30504000
EQUATE CAPDICTLEN = 91;                                        <<00506>>30506000
BYTE ARRAY CAPDICTX(0:CAPDICTLEN-1) = PB :=                    <<U.RAO>>30508000
   <<DEFINITION PART IS BIT POSITION IN CAP MATRIX>>           <<U.RAO>>30510000
   5,2,"SF",15,                                                <<U.RAO>>30512000
   5,2,"ND",14,                                                <<U.RAO>>30514000
   5,2,"CS",13,                                                <<U.RAO>>30516000
   5,2,"BA",23,                                                <<U.RAO>>30518000
   5,2,"IA",24,                                                <<U.RAO>>30520000
   5,2,"PM",25,                                                <<U.RAO>>30522000
   5,2,"MR",28,                                                <<U.RAO>>30524000
   5,2,"DS",30,                                                <<U.RAO>>30526000
   5,2,"PH",31,                                                <<U.RAO>>30528000
   5,2,"UV",7,                                                 <<RH.PV>>30530000
   5,2,"CV",6,                                                 <<RH.PV>>30532000
   5,2,"OP",5,                                                 <<U.RAO>>30534000
   5,2,"DI",4,                                                 <<U.RAO>>30536000
   5,2,"GL",3,                                                 <<U.RAO>>30538000
   5,2,"AL",2,                                                 <<U.RAO>>30540000
   5,2,"AM",1,                                                 <<U.RAO>>30542000
   5,2,"SM",0,                                                 <<U.RAO>>30544000
   5,2,"LG",8,                                                 <<00506>>30546000
   0;                                                          <<U.RAO>>30548000
BYTE ARRAY CAPDICT(0:CAPDICTLEN-1);                            <<U.RAO>>30550000
EQUATE SUBQLEN = 21;                                           <<U.RAO>>30552000
BYTE ARRAY SUBQX(0:SUBQLEN-1) = PB :=                          <<U.RAO>>30554000
   4,2,"ES",                                                   <<U.RAO>>30556000
   4,2,"DS",                                                   <<U.RAO>>30558000
   4,2,"CS",                                                   <<U.RAO>>30560000
   4,2,"BS",                                                   <<U.RAO>>30562000
   4,2,"AS",                                                   <<U.RAO>>30564000
   0;                                                          <<U.RAO>>30566000
BYTE ARRAY SUBQA(0:SUBQLEN-1);                                 <<U.RAO>>30568000
   EQUATE            KEYDICTL          = 117;                  <<RV.PV>>30570000
   BYTE ARRAY        KEYDICTX (0:KEYDICTL-1) = PB :=           <<01.PV>>30572000
         10, 4, "PASS", 4, GPASS,APASS,UPASS,                  <<01.PV>>30574000
         11, 5, "FILES", 2, GDFSLIMIT,ADFSLIMIT,"X",           <<01.PV>>30576000
         9, 3, "CPU", 2, GCPULIMIT,ACPULIMIT,"X",              <<01.PV>>30578000
         13, 7, "CONNECT", 2, GCONTIMELIMIT,ACONTIMELIMIT,"X", <<01.PV>>30580000
         <<LEN=2 FOR A & U>>                                   <<01.PV>>30582000
         9,3,"CAP",1,GCAP,ACAP,UCAP,                           <<01.PV>>30584000
         <<LEN=2 FOR G>>                                       <<01.PV>>30586000
         12,6,"ACCESS",1,GSEC,ASECW,"X",                       <<01.PV>>30588000
         12, 6, "MAXPRI", 1, "X", AMAXJOBW,UMAXJOB,            <<01.PV>>30590000
         13, 7, "LOCATTR", 2, "X",ALATTR,ULATTR,               <<01.PV>>30592000
         8, 2, "VS",12,GHVSNAME,"X","X",                       <<01460>>30594000
         10, 4, "HOME", 4, "X","X",UHGROUP,                    <<01.PV>>30596000
              0,0,0;                                           <<P.RAO>>30598000
   BYTE ARRAY        KEYDICT (0:KEYDICTL-1);                   <<01.PV>>30600000
   EQUATE            SUBKEYDICTL          = 14;                <<00086>>30602000
   BYTE ARRAY        SUBKEYDICTX (0:SUBKEYDICTL-1) = PB :=     <<RV.PV>>30604000
         6, 4, "SPAN",                                         <<00086>>30606000
         5, 3, "ALT",                                          <<00086>>30608000
              0,0,0;                                           <<RV.PV>>30610000
   BYTE ARRAY        SUBKEYDICT (0:SUBKEYDICTL-1);             <<RV.PV>>30612000
DEFINE MAX = 32767,-1#;                                        <<U.RAO>>30614000
   INTEGER ARRAY     INITIALGROUP (0:GSIZE-1) = PB :=          <<01.PV>>30616000
                                       "        ",             <<U.RAO>>30618000
                                       0,                      <<U.RAO>>30620000
                                       "        ",             <<U.RAO>>30622000
                                       0, 0,                   <<U.RAO>>30624000
                                       MAX,                    <<U.RAO>>30626000
                                       0, 0,                   <<U.RAO>>30628000
                                       MAX,                    <<U.RAO>>30630000
                                       0, 0,                   <<U.RAO>>30632000
                                       MAX,                    <<U.RAO>>30634000
                                       [5/2,5/2,4/1],          <<U.RAO>>30636000
                                       [1/0,5/2,5/2,5/2],      <<U.RAO>>30638000
                                       [6/0, 10/%(2)0110000000],        30640000
                                       0, 0,                   <<01.PV>>30642000
                                       "        ",             <<01.PV>>30644000
                                       "        ",             <<01.PV>>30646000
                                       "        ",             <<01.PV>>30648000
                                       0, 0, 0;                <<16.PV>>30650000
   INTEGER ARRAY     INITIALACCT (0:ASIZE-1) = PB :=           <<01460>>30652000
                                       "        ",             <<U.RAO>>30654000
                                       0,                      <<U.RAO>>30656000
                                       0,                      <<U.RAO>>30658000
                                       [7/%(2)0111000,7/0,2/%(2)11],    30660000
                                       [6/0, 10/%(2)0110000000],        30662000
                                       0, 0,                   <<U.RAO>>30664000
                                       "        ",             <<U.RAO>>30666000
                                       0, 0,                   <<U.RAO>>30668000
                                       MAX,                    <<U.RAO>>30670000
                                       0, 0,                   <<U.RAO>>30672000
                                       MAX,                    <<U.RAO>>30674000
                                       0, 0,                   <<U.RAO>>30676000
                                       MAX,                    <<U.RAO>>30678000
                                       [2/1,2/1,2/1,2/1,2/1,   <<U.RAO>>30680000
                                        2/1],                  <<U.RAO>>30682000
                                       150,    <<"CS">>        <<U.RAO>>30684000
                                       0,                      <<U.RAO>>30686000
                                       0;                      <<01460>>30688000
   INTEGER ARRAY     INITIALUSER (0:USIZE-1) = PB :=           <<01.PV>>30690000
                                       "        ",             <<U.RAO>>30692000
                                       [7/0,7/0,2/%(2)11],     <<U.RAO>>30694000
                                       [6/0, 10/%(2)0110000000],        30696000
                                       0, 0,                   <<U.RAO>>30698000
                                       "        ",             <<U.RAO>>30700000
                                       "        ",             <<U.RAO>>30702000
                                       0,                      <<U.RAO>>30704000
                                       150,    <<"CS">>        <<U.RAO>>30706000
                                       0;                      <<U.RAO>>30708000
                                                               <<U.RAO>>30710000
<<                 *********************                   >>  <<U.RAO>>30712000
<<                 *    SETSPECMASK    *                   >>  <<U.RAO>>30714000
<<                 *********************                   >>  <<U.RAO>>30716000
                                                               <<U.RAO>>30718000
LOGICAL SUBROUTINE SETSPECMASK(COUNT);                         <<U.RAO>>30720000
VALUE COUNT;                                                   <<U.RAO>>30722000
INTEGER COUNT;  <<NUMBER OF WORDS IN ITEM>>                    <<U.RAO>>30724000
<<THIS SUBROUTINE SETS THE BITS IN SPECMASK CORRESPONDING>>    <<U.RAO>>30726000
<<TO THE NEW ITEMS IN NEWENTRY.  IT RETURNS FALSE IF THOSE>>   <<U.RAO>>30728000
<<BITS WERE ALREADY SET, INDICATING REDUNDANTLY DEFINED KEYWORD<<U.RAO>>30730000
BEGIN                                                          <<U.RAO>>30732000
SETSPECMASK := TRUE;  <<NOT REDUNDANTLY DEFINED ITEM>>         <<U.RAO>>30734000
TOS := DEFN (LEVEL);  <<DISPLACEMENT WITHIN ENTRY>>            <<RV.PV>>30736000
DO BEGIN  <<UNTIL COUNT IS 0>>                                 <<RV.PV>>30738000
       TOS := S0 & LSR (4); <<DISPL DIV 16>>                   <<RV.PV>>30740000
       TOS := TEMPSPECMASK (S0); <<APPROPRIATE MASK WORD>>     <<RV.PV>>30742000
       X := LS2 LAND %17; <<DISPL MOD 16>>                     <<RV.PV>>30744000
       ASSEMBLE (TSBC 0,X); <<SET APPROPRIATE BIT>>            <<RV.PV>>30746000
       IF <> THEN S5 := 0; <<SETSPECMASK := 0>>                <<RV.PV>>30748000
       ASSEMBLE (XCH, STAX);                                   <<RV.PV>>30750000
       TEMPSPECMASK (X) := TOS; <<UPDATE MASK WORD>>           <<RV.PV>>30752000
       TOS := TOS+1;  <<INCREM DISPL>>                         <<RV.PV>>30754000
   END UNTIL (S2 := S2-1) = 0;                                 <<RV.PV>>30756000
DEL; <<DISPL>>                                                 <<RV.PV>>30758000
END;  <<SUBROUTINE SETSPECMASK>>                               <<U.RAO>>30760000
                                                               <<U.RAO>>30762000
<<                 *********************                   >>  <<U.RAO>>30764000
<<                 *       NEXT        *                   >>  <<U.RAO>>30766000
<<                 *********************                   >>  <<U.RAO>>30768000
                                                               <<U.RAO>>30770000
SUBROUTINE NEXT;                                               <<U.RAO>>30772000
<<THIS SUBROUTINE SIMPLY DECOMPOSES THE DATA RETURNED BY>>     <<U.RAO>>30774000
<<MYCOMMAND INTO INDIVIDUAL ITEMS FOR THE NEXT PARAMETER>>     <<U.RAO>>30776000
BEGIN                                                          <<U.RAO>>30778000
TOS := PARMS(PARMNUM);                                         <<U.RAO>>30780000
EMBEDDEDSPECIAL := S0.(10:1);                                  <<U.RAO>>30782000
NEXTDELIM := S0.(11:5);                                        <<U.RAO>>30784000
PARMLEN := TOS&LSR(8);                                         <<U.RAO>>30786000
@PARMPTR := TOS;                                               <<U.RAO>>30788000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>30790000
END;  <<SUBROUTINE NEXT>>                                      <<U.RAO>>30792000
                                                               <<U.RAO>>30794000
<<                 *********************                   >>  <<U.RAO>>30796000
<<                 *     CHECKNAME     *                   >>  <<U.RAO>>30798000
<<                 *********************                   >>  <<U.RAO>>30800000
                                                               <<U.RAO>>30802000
LOGICAL SUBROUTINE CHECKNAME(DELTA,TARGET,MISSINGOK);          <<U.RAO>>30804000
VALUE MISSINGOK,DELTA;                                         <<U.RAO>>30806000
INTEGER DELTA; <<ERROR DELTA CONVERTS COMMON ERRORS INTO DETAILED>>     30808000
LOGICAL ARRAY TARGET;  <<WHERE THE RESULTING STRING GOES. 4 WORDS>>     30810000
LOGICAL MISSINGOK;  <<TRUE => NULL STRING OK, SUCH AS HOME=;>> <<U.RAO>>30812000
<<THIS SUBROUTINE PARSES UP TO 8 CHARACTERS AS A NAME OF SOME>><<U.RAO>>30814000
<<SORT.  IF VALID, THE NAME IS MOVED INTO TARGET.  IF ERROR,>> <<U.RAO>>30816000
<<CALL CIERR, RETURN FALSE>>                                   <<U.RAO>>30818000
BEGIN                                                          <<U.RAO>>30820000
CHECKNAME := FALSE;                                            <<U.RAO>>30822000
IF PARMLEN=0 THEN                                              <<U.RAO>>30824000
   IF NOT MISSINGOK THEN                                       <<U.RAO>>30826000
      CIERR(ERRNUM:=NAMEMISSING+DELTA,PARMPTR)                 <<U.RAO>>30828000
   ELSE  <<OK FOR IT TO BE MISSING>>                           <<U.RAO>>30830000
      BEGIN  <<RETURN BLANKS, RETURN TRUE>>                    <<U.RAO>>30832000
      CHECKNAME := TRUE;                                       <<U.RAO>>30834000
      MOVE TARGET := "        ";                               <<U.RAO>>30836000
      END                                                      <<U.RAO>>30838000
ELSE IF PARMPTR <> ALPHA THEN                                  <<U.RAO>>30840000
   CIERR(ERRNUM := EXPECTALPHA+DELTA,PARMPTR)                  <<U.RAO>>30842000
ELSE IF PARMLEN > 8 THEN                                       <<U.RAO>>30844000
   CIERR(ERRNUM := NAMETOOLONG+DELTA,PARMPTR)                  <<U.RAO>>30846000
ELSE IF EMBEDDEDSPECIAL THEN                                   <<U.RAO>>30848000
   CIERR(ERRNUM := EMBEDSPEC+DELTA, PARMPTR)                   <<U.RAO>>30850000
ELSE                                                           <<U.RAO>>30852000
   BEGIN  <<LOOKS LIKE LEGAL NAME>>                            <<U.RAO>>30854000
   MOVE TARGET := "        ";                                  <<U.RAO>>30856000
   TOS := @TARGET&LSL(1);  <<MAKE BYTE ADDRESS>>               <<U.RAO>>30858000
   MOVE * := PARMPTR,(PARMLEN);                                <<U.RAO>>30860000
   CHECKNAME := TRUE;                                          <<U.RAO>>30862000
   END;                                                        <<U.RAO>>30864000
END;  <<SUBROUTINE CHECKNAME>>                                 <<U.RAO>>30866000
                                                               <<U.RAO>>30868000
<<                 *********************                   >>  <<U.RAO>>30870000
<<                 *   DOACCESSLIST    *                   >>  <<U.RAO>>30872000
<<                 *********************                   >>  <<U.RAO>>30874000
                                                               <<U.RAO>>30876000
SUBROUTINE DOACCESSLIST;                                       <<U.RAO>>30878000
BEGIN                                                          <<U.RAO>>30880000
IF USER THEN                                                   <<U.RAO>>30882000
   BEGIN  <<NOT VALID OPTION FOR USER - WARN AND IGNORE>>      <<U.RAO>>30884000
   CIERR(-ORGCOMUNOTACCESS,PARMPTR);                           <<U.RAO>>30886000
   NEXT;  <<SKIP TO START OF ACCESS LIST>>                     <<U.RAO>>30888000
   IF PARMLEN <> 0 THEN  <<NON-NULL ACCESS LIST, ATTEMPT RECOVERY>>     30890000
      BEGIN                                                    <<U.RAO>>30892000
      FORMACCESS'(LEVEL,PARMPTR,SEC,ADJUST,ERRNUM);  <<TO SKIP LIST>>   30894000
      PARMNUM := PARMNUM+ADJUST-2;                             <<U.RAO>>30896000
      END                                                      <<U.RAO>>30898000
   ELSE PARMNUM := PARMNUM-1;                                  <<U.RAO>>30900000
   END                                                         <<U.RAO>>30902000
ELSE                                                           <<U.RAO>>30904000
   BEGIN                                                       <<U.RAO>>30906000
   NEXT;  <<SKIP TO START OF ACCESS LIST>>                     <<U.RAO>>30908000
   IF PARMLEN <> 0 THEN  <<ACCESS LIST PRESENT EVIDENTLY>>     <<U.RAO>>30910000
      BEGIN                                                    <<U.RAO>>30912000
      TOS := @NEWENTRY(RESULTADR);  <<TO GET DEFAULT FROM NEWENTRY>>    30914000
      SEC := DPS0;                                             <<U.RAO>>30916000
      FORMACCESS'(LEVEL,PARMPTR,SEC,ADJUST,ERRNUM);            <<U.RAO>>30918000
      PARMNUM := ADJUST+PARMNUM-2;                             <<U.RAO>>30920000
      IF ERRNUM > 0 THEN   <<BAIL OUT>>                        <<U.RAO>>30922000
         BEGIN                                                 <<U.RAO>>30924000
         DEL;  <<POP STACKED POINTER>>                         <<U.RAO>>30926000
         RETURN                                                <<U.RAO>>30928000
         END;                                                  <<U.RAO>>30930000
      IF ACCOUNT THEN  <<ONLY 1 WORD MASK>>                    <<U.RAO>>30932000
         BEGIN                                                 <<U.RAO>>30934000
         PS0 := SEC1;                                          <<U.RAO>>30936000
         DEL;                                                  <<U.RAO>>30938000
         END                                                   <<U.RAO>>30940000
      ELSE                                                     <<U.RAO>>30942000
         BEGIN                                                 <<U.RAO>>30944000
         DPS0 := SEC;                                          <<U.RAO>>30946000
         DEL;                                                  <<U.RAO>>30948000
         END;                                                  <<U.RAO>>30950000
      END                                                      <<U.RAO>>30952000
   ELSE  <<NO ACCESS LIST PRESENT, USE DEFAULT>>               <<01.RO>>30954000
      BEGIN                                                    <<01.RO>>30956000
      IF ACCOUNT THEN                                          <<01.RO>>30958000
         NEWENTRY(ASECW) := ACCTSECDEF                         <<01.RO>>30960000
      ELSE                                                     <<01.RO>>30962000
         GSECURITY := GROUPSECDEF;                             <<01.RO>>30964000
      PARMNUM := PARMNUM-1;  <<BACK UP>>                       <<01.RO>>30966000
      END;                                                     <<01.RO>>30968000
   TOS := 0;  <<RETURN SPACE FOR SETSPECMASK>>                 <<U.RAO>>30970000
   IF ACCOUNT THEN TOS := 1 ELSE TOS := 2;  <<# WORDS IN LIST>><<U.RAO>>30972000
   IF NOT SETSPECMASK(*) THEN CIERR(-ORGCOMACCESSRDND,PARMPTR);<<U.RAO>>30974000
   END;                                                        <<U.RAO>>30976000
NEXT;  <<MOVE POINTERS TO SEMICOLON>>                          <<U.RAO>>30978000
END;  <<DOACCESSLIST>>                                         <<U.RAO>>30980000
                                                               <<U.RAO>>30982000
SUBROUTINE DOMAXPRI;                                           <<U.RAO>>30984000
<<                 *********************                   >>  <<U.RAO>>30986000
<<                 *     DOMAXPRI      *                   >>  <<U.RAO>>30988000
<<                 *********************                   >>  <<U.RAO>>30990000
                                                               <<U.RAO>>30992000
BEGIN                                                          <<U.RAO>>30994000
IF GROUP THEN  <<NOT APPROPRIATE FOR GROUP>>                   <<U.RAO>>30996000
   BEGIN                                                       <<U.RAO>>30998000
   CIERR(-ORGCOMGNOTMAXPRI,PARMPTR);                           <<U.RAO>>31000000
   NEXT                                                        <<U.RAO>>31002000
   END                                                         <<U.RAO>>31004000
ELSE                                                           <<U.RAO>>31006000
   BEGIN                                                       <<U.RAO>>31008000
   NEXT;                                                       <<U.RAO>>31010000
   IF PARMLEN > 0 THEN                                         <<U.RAO>>31012000
      BEGIN                                                    <<U.RAO>>31014000
      MOVE SUBQA := SUBQX,(SUBQLEN);                           <<U.RAO>>31016000
      IF SEARCH(PARMPTR,PARMLEN,SUBQA)=0 THEN                  <<U.RAO>>31018000
         CIERR(ERRNUM := ORGCOMUNKSUBQ,PARMPTR)                <<U.RAO>>31020000
      ELSE                                                     <<U.RAO>>31022000
         BEGIN                                                 <<U.RAO>>31024000
         TOS := SUBQUEUE(4,PARMPTR);  <<GET PRIORITY NUMBER>>  <<U.RAO>>31026000
         TOS := TOS LAND %377;                                 <<U.RAO>>31028000
         NEWENTRY(RESULTADR) := TOS;                           <<U.RAO>>31030000
         DEL;                                                  <<U.RAO>>31032000
         END;                                                  <<U.RAO>>31034000
      END                                                      <<01.RO>>31036000
   ELSE                                                        <<01.RO>>31038000
      NEWENTRY(RESULTADR) := 150;  <<CS>>                      <<01.RO>>31040000
   IF (ERRNUM = 0) AND NOT SETSPECMASK(DEFN) THEN              <<U.RAO>>31042000
      CIERR(-ORGCOMRDNDMAXPRI);                                <<U.RAO>>31044000
   END;                                                        <<U.RAO>>31046000
END;                                                           <<U.RAO>>31048000
                                                               <<U.RAO>>31050000
<<                 *********************                   >>  <<U.RAO>>31052000
<<                 *     DOCAPLIST     *                   >>  <<U.RAO>>31054000
<<                 *********************                   >>  <<U.RAO>>31056000
                                                               <<U.RAO>>31058000
SUBROUTINE DOCAPLIST;  <<CAPABILITY LIST PARSER>>              <<U.RAO>>31060000
BEGIN                                                          <<U.RAO>>31062000
TOS := PARMS(PARMNUM);                                                  31064000
DELB;  <<POOP POINTER WORD>>                                            31066000
IF (S0.(0:8)=0) AND ((S0.(11:5)=CR) OR (S0.(11:5)=SEMICOLON)) THEN      31068000
   BEGIN  <<USE DEFAULT CAPLIST>>                              <<U.RAO>>31070000
   IF GROUP THEN TOS := 1 ELSE TOS := 2;                       <<U.RAO>>31072000
   IF NOT SETSPECMASK(*) THEN CIERR(-ORGCOMRDNDCAPKY);         <<U.RAO>>31074000
   NEXT;  <<MOVE TO NEXT KEY ENTRY DELIMITER>>                 <<U.RAO>>31076000
   RETURN                                                      <<U.RAO>>31078000
   END;                                                        <<U.RAO>>31080000
DEL;    <<POP DATA WORD>>                                      <<U.RAO>>31082000
TOS := 0D;  <<TEMP SPACE FOR CAPABILITY MATRIX>>               <<U.RAO>>31084000
MOVE CAPDICT := CAPDICTX,(CAPDICTLEN);                         <<U.RAO>>31086000
DO BEGIN  <<UNTIL NEXTDELIM <> COMMA>>                         <<U.RAO>>31088000
   NEXT; <<GET NEXT CAPABILITY TYPE>>                                   31090000
   IF PARMLEN = 0 THEN   <<EVIDENTLY MISSING>>                 <<U.RAO>>31092000
      CIERR(-ORGCOMISSINGCAP,PARMPTR)                          <<U.RAO>>31094000
   ELSE  <<SOMETHING THERE>>                                   <<U.RAO>>31096000
      BEGIN                                                    <<U.RAO>>31098000
      IF SEARCH(PARMPTR,PARMLEN,CAPDICT,CAPDEFN)=0 THEN        <<U.RAO>>31100000
         BEGIN  <<UNKNOWN PARAMETER>>                          <<U.RAO>>31102000
         DDEL;  <<POP TEMP MATRIX>>                            <<U.RAO>>31104000
         IF GROUP THEN                                         <<07.RO>>31106000
            CIERR(ERRNUM := ORGCOMUNKGCAP,PARMPTR)             <<07.RO>>31108000
         ELSE  <<USER OR ACCOUNT>>                             <<07.RO>>31110000
            CIERR(ERRNUM := ORGCOMUNKCAP, PARMPTR);            <<07.RO>>31112000
         RETURN                                                <<U.RAO>>31114000
         END;                                                  <<U.RAO>>31116000
      X := CAPDEFN;  <<BIT POSITION IN MATRIX>>                <<U.RAO>>31118000
      IF X < 16 THEN  <<IN ATTRIBUTES WORD>>                   <<U.RAO>>31120000
         BEGIN                                                 <<U.RAO>>31122000
         IF GROUP THEN CIERR(-ORGCOMCAPCONTXT,PARMPTR);        <<U.RAO>>31124000
         ASSEMBLE(XCH);  <<PUT ATTRIBUTES WORD ON TOS>>        <<U.RAO>>31126000
         END;                                                  <<U.RAO>>31128000
      ASSEMBLE(TSBC 0,X);                                      <<U.RAO>>31130000
      IF <> THEN CIERR(-ORGCOMREDUNDCAP,PARMPTR);  <<REDUNDANT><<U.RAO>>31132000
      IF X < 16 THEN                                           <<00263>>31134000
      BEGIN                                                    <<00263>>31136000
          ASSEMBLE (XCH); <<PUT ATTRIBUTES WORD BACK>>         <<00263>>31140000
      END;                                                     <<00263>>31142000
      END;                                                     <<U.RAO>>31144000
   END UNTIL NEXTDELIM <> COMMA;                               <<U.RAO>>31146000
ASSEMBLE(XCH);                                                 <<02373>>31148000
IF LS0.(6:1) THEN << IF CV >>                                  <<02373>>31150000
   LS0.(7:1) := TRUE; << GIVE UV ALSO >>                       <<02373>>31152000
ASSEMBLE(XCH);                                                 <<02373>>31154000
IF DS1 = 0D THEN   <<NO CAPS SPECIFIED, TAKE DEFAULT>>         <<U.RAO>>31156000
   BEGIN                                                       <<U.RAO>>31158000
   IF GROUP THEN TOS := TOS+1 ELSE TOS := TOS+2;  <<TRICK>>    <<U.RAO>>31160000
   IF NOT SETSPECMASK(*) THEN CIERR(-ORGCOMRDNDCAPKY);         <<U.RAO>>31162000
   RETURN                                                      <<U.RAO>>31164000
   END;                                                        <<U.RAO>>31166000
IF NOT (GROUP) AND (S0.(7:2)=FALSE) THEN                       <<U.RAO>>31168000
   BEGIN  <<NEITHER IA NOR BA SPECIFIED>>                      <<U.RAO>>31170000
   IF ACCOUNT THEN CIERR(-ORGCOMFORCAIABA)                     <<U.RAO>>31172000
   ELSE CIERR(-ORGCOMFORCUIABA);                               <<U.RAO>>31174000
   TOS.(7:2) := TRUE;                                          <<U.RAO>>31176000
   END;                                                        <<U.RAO>>31178000
IF GROUP THEN  <<ONLY 1 WORD>>                                 <<U.RAO>>31180000
   BEGIN                                                       <<U.RAO>>31182000
   NEWENTRY(RESULTADR) := TOS;                                 <<U.RAO>>31184000
   DEL;                                                        <<U.RAO>>31186000
   IF NOT SETSPECMASK(1) THEN CIERR(-ORGCOMRDNDCAPKY); <<REDUNDANT>>    31188000
   END                                                         <<U.RAO>>31190000
ELSE                                                           <<U.RAO>>31192000
   BEGIN  <<2 WORDS>>                                          <<U.RAO>>31194000
   IF ACCOUNT THEN                                             <<U.RAO>>31196000
      BEGIN  <<FORCE AM CAPABILITY>>                           <<U.RAO>>31198000
      ASSEMBLE(XCH);                                           <<U.RAO>>31200000
      TOS.(1:1) := TRUE;                                       <<U.RAO>>31202000
      ASSEMBLE(XCH);                                           <<U.RAO>>31204000
      END;                                                     <<U.RAO>>31206000
   NEWENTRY(RESULTADR+1) := TOS;                               <<U.RAO>>31208000
   NEWENTRY(X:=X-1) := TOS;                                    <<U.RAO>>31210000
   IF NOT SETSPECMASK(2) THEN CIERR(-ORGCOMRDNDCAPKY);         <<U.RAO>>31212000
   END;                                                        <<U.RAO>>31214000
END;  <<SUBROUTINE DOCAPLIST>>                                 <<U.RAO>>31216000
                                                               <<U.RAO>>31218000
<<                 *********************                   >>  <<U.RAO>>31220000
<<                 *     DODOUBLE      *                   >>  <<U.RAO>>31222000
<<                 *********************                   >>  <<U.RAO>>31224000
                                                               <<U.RAO>>31226000
SUBROUTINE DODOUBLE(ERRDELTA);                                 <<U.RAO>>31228000
VALUE ERRDELTA;                                                <<U.RAO>>31230000
INTEGER ERRDELTA;  <<OFFSET FOR TAILORING ERROR MESSAGES>>     <<U.RAO>>31232000
<<THIS SUBROUTINE PROCESSES DOUBLE INTEGERS FOR CPU, CONNECT,>><<U.RAO>>31234000
<<FILES OPTIONS.  IT DOES NOT HANDLE LOCAL ATTRIBUTE OPTION>>  <<U.RAO>>31236000
BEGIN                                                          <<U.RAO>>31238000
IF USER THEN  <<HAS NO MEANING FOR USER DEFINITION>>           <<U.RAO>>31240000
   BEGIN                                                       <<U.RAO>>31242000
   CIERR(-(UNOTDBL+ERRDELTA), PARMPTR);                      <<U.RAO>>  31244000
   NEXT;  <<ATTEMPT RECOVERY>>                                 <<U.RAO>>31246000
   END                                                         <<U.RAO>>31248000
ELSE                                                           <<U.RAO>>31250000
   BEGIN                                                       <<U.RAO>>31252000
   NEXT;                                                       <<U.RAO>>31254000
   IF PARMLEN <> 0 THEN <<I.E., PARM PRESENT THUS NO DEFAULT>> <<U.RAO>>31256000
      BEGIN                                                    <<U.RAO>>31258000
      TOS := DBINARY(PARMPTR, PARMLEN);                        <<U.RAO>>31260000
      IF <> THEN   <<DBINARY FAILED>>                          <<U.RAO>>31262000
         BEGIN                                                 <<U.RAO>>31264000
         DDEL;  <<POP RESULT;                                  <<U.RAO>>31266000
         CIERR(ERRNUM := DBLINVALID+ERRDELTA, PARMPTR);        <<U.RAO>>31268000
         END                                                   <<U.RAO>>31270000
      ELSE                                                     <<U.RAO>>31272000
         BEGIN                                                 <<U.RAO>>31274000
         ASSEMBLE(DDUP);                                       <<U.RAO>>31276000
         NEWENTRY(RESULTADR+1) := TOS;                         <<U.RAO>>31278000
         NEWENTRY(X := X-1) := TOS;                            <<U.RAO>>31280000
         IF TOS < 0D THEN    <<NEGATIVE NUMBER NOT ALLOWED>>   <<U.RAO>>31282000
            CIERR(ERRNUM := DBLNEG+ERRDELTA, PARMPTR);         <<U.RAO>>31284000
         END;                                                  <<U.RAO>>31286000
      END;                                                     <<U.RAO>>31288000
   IF (ERRNUM=0) AND NOT SETSPECMASK(DEFN) THEN                <<U.RAO>>31290000
      CIERR(-(REDUNDANT+ERRDELTA));  <<REDUNDANTLY DEFINED KEYWORD>>    31292000
   END;                                                        <<U.RAO>>31294000
END;                                                           <<U.RAO>>31296000
                                                               <<U.RAO>>31298000
<<                 *********************                   >>  <<U.RAO>>31300000
<<                 *     DOLOCATTR     *                   >>  <<U.RAO>>31302000
<<                 *********************                   >>  <<U.RAO>>31304000
                                                               <<U.RAO>>31306000
SUBROUTINE DOLOCATTR;  <<LOCAL ATTRIBUTES - A DOUBLE INTEGER>> <<U.RAO>>31308000
BEGIN                                                          <<U.RAO>>31310000
IF GROUP THEN                                                  <<U.RAO>>31312000
   BEGIN  <<NOT APPROPRIATE FOR GROUP>>                        <<U.RAO>>31314000
   CIERR(-ORGCOMGLOCATTR,PARMPTR);                             <<U.RAO>>31316000
   NEXT;  <<ATTEMPT RECOVERY>>                                 <<U.RAO>>31318000
   END                                                         <<U.RAO>>31320000
ELSE                                                           <<U.RAO>>31322000
   BEGIN                                                       <<U.RAO>>31324000
   NEWENTRY(RESULTADR) := 0;                                   <<01.RO>>31326000
   NEWENTRY(RESULTADR+1) := 0;  <<ZERO ENTRY>>                 <<01.RO>>31328000
   NEXT;                                                       <<U.RAO>>31330000
   IF PARMLEN <> 0 THEN  <<EXISTS, DON'T USE DEFAULT>>         <<U.RAO>>31332000
      BEGIN                                                    <<U.RAO>>31334000
      TOS := DBINARY(PARMPTR,PARMLEN);                         <<U.RAO>>31336000
      IF <> THEN                                               <<U.RAO>>31338000
         BEGIN                                                 <<U.RAO>>31340000
         DDEL;                                                 <<U.RAO>>31342000
         CIERR(ERRNUM := ORGCOMINVLDLATR,PARMPTR)              <<U.RAO>>31344000
         END                                                   <<U.RAO>>31346000
      ELSE                                                     <<U.RAO>>31348000
         BEGIN                                                 <<U.RAO>>31350000
         NEWENTRY(RESULTADR+1) := TOS;                         <<U.RAO>>31352000
         NEWENTRY(X := X-1) := TOS;                            <<U.RAO>>31354000
         END;                                                  <<U.RAO>>31356000
      END;                                                     <<U.RAO>>31358000
   IF (ERRNUM=0) AND NOT SETSPECMASK(DEFN) THEN  <<REDUNDANT>> <<U.RAO>>31360000
      CIERR(-ORGCOMRDNDLATTR);                                 <<U.RAO>>31362000
   END;                                                        <<U.RAO>>31364000
END;  <<SUBROUTINE DOLOCATTR>>                                 <<U.RAO>>31366000
                                                               <<U.RAO>>31368000
<<                 *********************                   >>  <<U.RAO>>31370000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>31372000
<<                 *********************                   >>  <<U.RAO>>31374000
                                                               <<U.RAO>>31376000
<<MAIN BODY OF PROCEDURE                                     >><<U.RAO>>31378000
<<THERE ARE THREE MAIN TASKS:                                >><<U.RAO>>31380000
<<  1)  INITIALIZE NEWENTRY TO DEFAULTS                      >><<U.RAO>>31382000
<<  2)  FIND AND VALIDATE REQUIRED PARAMETERS                >><<U.RAO>>31384000
<<        (THAT IS, ITEM NAME AND, IF NEWACCT, MANAGER'S NAME>><<U.RAO>>31386000
<<  3)  PARSE OPTIONAL PARMS. THIS IS MOSTLY DONE BY         >><<U.RAO>>31388000
<<        SUBROUTINES.                                       >><<U.RAO>>31390000
PARMNUM := 0;                                                  <<U.RAO>>31392000
CYORGCOMS' := FALSE;                                           <<U.RAO>>31394000
CASE LEVEL-1 OF                                                <<U.RAO>>31396000
   BEGIN  <<INITIALIZE NEWENTRY WITH DEFAULTS IN PB>>          <<U.RAO>>31398000
   MOVE NEWENTRY := INITIALGROUP,(GSIZE);                      <<U.RAO>>31400000
   MOVE NEWENTRY := INITIALACCT,(ASIZE);                       <<U.RAO>>31402000
   MOVE NEWENTRY := INITIALUSER,(USIZE);                       <<U.RAO>>31404000
   END;                                                        <<U.RAO>>31406000
IF PMASK.(14:1) THEN                                           <<RV.PV>>31408000
BEGIN                                                          <<RV.PV>>31410000
    VSCOMM (VSMASK) := 0;                                      <<RV.PV>>31412000
    VSCOMM (VSHANAME) := "  ";                                 <<RV.PV>>31414000
    MOVE VSCOMM (VSHANAME+1) :=                                <<RV.PV>>31416000
         VSCOMM (VSHANAME), ((NAMESIZE*3)-1);                  <<RV.PV>>31418000
END;                                                           <<RV.PV>>31420000
MOVE TEMPSPECMASK := SPECMASKLN (0); <<INITIALIZE>>            <<RV.PV>>31422000
IF PMASK THEN MOVE SPECMASK := TEMPSPECMASK, (SPECMASKLN);     <<RV.PV>>31424000
VSPARMACCT := FALSE; << NO VS= YET >>                          <<01460>>31426000
                                                               <<U.RAO>>31428000
<<NOW CRUNCH PARAMETER IMAGE>>                                 <<U.RAO>>31430000
TOS := @IMAGE;  <<SET UP PARMS IN CASE ALL MISSING>>           <<U.RAO>>31432000
TOS := CR;                                                     <<U.RAO>>31434000
PARMS := TOS;                                                  <<U.RAO>>31436000
MYCOMMAND(IMAGE,DL,70,NUMPARMS,PARMS);                         <<U.RAO>>31438000
IF <> THEN  <<TOO MANY PARAMETERS>>                            <<U.RAO>>31440000
   BEGIN                                                       <<U.RAO>>31442000
   PARMNUM := 72;                                              <<U.RAO>>31444000
   IF PMASK THEN     <<:ALTXXX COMMAND>>                       <<U.RAO>>31446000
      IF ACCOUNT THEN TOS := ALTACCT2MP                        <<U.RAO>>31448000
      ELSE IF < THEN TOS := ALTGROUP2MP                        <<U.RAO>>31450000
      ELSE TOS := ALTUSER2MP                                   <<U.RAO>>31452000
   ELSE  <<:NEWXXX COMMAND>>                                   <<U.RAO>>31454000
      IF ACCOUNT THEN TOS := NEWACCT2MP                        <<U.RAO>>31456000
      ELSE IF < THEN TOS := NEWGROUP2MP                        <<U.RAO>>31458000
      ELSE TOS := NEWUSER2MP;                                  <<U.RAO>>31460000
   ERRNUM := S0;                                               <<U.RAO>>31462000
   CIERR(*);                                                   <<U.RAO>>31464000
   RETURN                                                      <<U.RAO>>31466000
   END;                                                        <<U.RAO>>31468000
                                                               <<U.RAO>>31470000
<<NOW WE LOOK FOR REQUIRED ITEMS, FIRST THE ITEM NAME>>        <<U.RAO>>31472000
NEXT;  <<SET UP FIRST PARM>>                                   <<U.RAO>>31474000
TOS := 0;  <<RETURN SPACE FOR CHECKNAME>>                      <<U.RAO>>31476000
IF ACCOUNT THEN TOS := FANAMEBASE                              <<U.RAO>>31478000
ELSE IF GROUP THEN TOS := FGNAMEBASE                           <<U.RAO>>31480000
ELSE TOS := USERNAMEBASE;                                      <<U.RAO>>31482000
IF NOT CHECKNAME(*,NEWENTRY,FALSE) THEN RETURN;  <<ERROR DETECTED>>     31484000
                                                               <<U.RAO>>31486000
<<IF NEWACCT THEN LOOK FOR MANAGER'S NAME>>                    <<U.RAO>>31488000
IF (ACCOUNT) AND NOT PMASK THEN  <<:NEWACCT COMMAND>>          <<U.RAO>>31490000
   BEGIN                                                       <<U.RAO>>31492000
   IF NEXTDELIM <> COMMA THEN  <<SYNTAX ERROR, AT LEAST>>      <<U.RAO>>31494000
      BEGIN                                                    <<U.RAO>>31496000
      CIERR(ERRNUM := NEWACCTXPCTCMA,PARMPTR(PARMLEN));        <<U.RAO>>31498000
      RETURN                                                   <<U.RAO>>31500000
      END;                                                     <<U.RAO>>31502000
   NEXT;  <<ACTUALLY GET NAME>>                                <<U.RAO>>31504000
   IF NOT CHECKNAME(MGRNAMEBASE,NEWENTRY(ASIZE),FALSE) THEN RETURN;     31506000
   END;                                                        <<U.RAO>>31508000
                                                               <<U.RAO>>31510000
<<NOW FINISH UP INITIALIZATION STAGE>>                         <<U.RAO>>31512000
<<PROBLEM IS TO SET SPECIAL SECURITY MASK FOR SYS ACCOUNT AND>><<U.RAO>>31514000
<<PUB GROUP>>                                                  <<U.RAO>>31516000
IF (ACCOUNT) AND (BNEWENTRY = "SYS ") THEN                     <<U.RAO>>31518000
   BEGIN  <<SET UP SPECIAL SECURITY>>                          <<01.RO>>31520000
   ACCTSECDEF := [2/2,2/1,2/1,2/1,2/2,2/1];                    <<01.RO>>31522000
   NEWENTRY(ASECW) := ACCTSECDEF;                              <<01.RO>>31524000
   END                                                         <<01.RO>>31526000
ELSE IF (GROUP) AND (BNEWENTRY = "PUB ") THEN                  <<U.RAO>>31528000
   BEGIN                                                       <<01.RO>>31530000
   GROUPSECDEF := [5/16,5/6,5/6,5/6,5/16,5/6]D;                <<01.RO>>31532000
   GSECURITY := GROUPSECDEF;                                   <<01.RO>>31534000
   END;                                                        <<01.RO>>31536000
                                                               <<U.RAO>>31538000
<<NOW WE FINALLY GET AROUND TO PARSING THE OPTIONAL PARMS>>    <<U.RAO>>31540000
MOVE KEYDICT := KEYDICTX,(KEYDICTL);                           <<U.RAO>>31542000
MOVE SUBKEYDICT := SUBKEYDICTX, (SUBKEYDICTL);                 <<RV.PV>>31544000
WHILE NEXTDELIM = SEMICOLON DO                                 <<U.RAO>>31546000
   BEGIN                                                       <<U.RAO>>31548000
   NEXT;  <<GET KEYWORD>>                                      <<U.RAO>>31550000
   IF PARMLEN = 0 THEN                                         <<U.RAO>>31552000
      BEGIN                                                    <<U.RAO>>31554000
      CIERR(ERRNUM := ORGCOMNOKEY,PARMPTR);                    <<U.RAO>>31556000
      RETURN                                                   <<U.RAO>>31558000
      END;                                                     <<U.RAO>>31560000
   IF NEXTDELIM <> EQUALS THEN  <<MISSING EQUAL SIGN AFTER KEY><<U.RAO>>31562000
      BEGIN                                                    <<U.RAO>>31564000
      CIERR(ERRNUM := ORGCOMXPCTEQUALS, PARMPTR(PARMLEN));     <<U.RAO>>31566000
      RETURN                                                   <<U.RAO>>31568000
      END;                                                     <<U.RAO>>31570000
   CASE SEARCH(PARMPTR,PARMLEN,KEYDICT,DEFN) OF                <<U.RAO>>31572000
      BEGIN                                                    <<U.RAO>>31574000
                                                               <<U.RAO>>31576000
      <<CASE 0 --- UNKNOWN KEYWORD>>                           <<U.RAO>>31578000
      CIERR(ERRNUM := ORGCOMUNKNONKEY,PARMPTR);                <<U.RAO>>31580000
                                                               <<U.RAO>>31582000
      BEGIN  <<PASSWORD, A STRING>>                            <<U.RAO>>31584000
      NEXT;   <<POINT TO PASSWORD VALUE>>                      <<U.RAO>>31586000
      IF CHECKNAME(PASSWORDBASE,NEWENTRY(RESULTADR),TRUE) THEN <<U.RAO>>31588000
         IF NOT SETSPECMASK(DEFN) THEN                         <<U.RAO>>31590000
            CIERR(-(ORGCOMRDNDPASS));                          <<U.RAO>>31592000
      END;                                                     <<U.RAO>>31594000
                                                               <<U.RAO>>31596000
      <<FILES - FILE LIMITS IN SECTORS, A DOUBLE INTEGER>>     <<U.RAO>>31598000
      DODOUBLE(ORGCOMFILESBASE);                               <<U.RAO>>31600000
                                                               <<U.RAO>>31602000
      <<CPU - CPU USAGE LIMIT IN SECONDS, A DOUBLE INTEGER>>   <<U.RAO>>31604000
      DODOUBLE(ORGCOMCPUBASE);                                 <<U.RAO>>31606000
                                                               <<U.RAO>>31608000
      <<CONNECT - CONNECT TIME USAGE, A DOUBLE INTEGER>>       <<U.RAO>>31610000
      DODOUBLE(ORGCOMCONNECTBS);                               <<U.RAO>>31612000
                                                               <<U.RAO>>31614000
      <<CAPABILITY LIST>>                                      <<U.RAO>>31616000
      DOCAPLIST;                                               <<U.RAO>>31618000
                                                               <<U.RAO>>31620000
      <<ACCESS LIST>>                                          <<U.RAO>>31622000
      DOACCESSLIST;                                            <<U.RAO>>31624000
                                                               <<U.RAO>>31626000
      <<MAXPRI>>                                               <<U.RAO>>31628000
      DOMAXPRI;                                                <<U.RAO>>31630000
                                                               <<U.RAO>>31632000
      <<LOCAL ATTRIBUTES>>                                     <<U.RAO>>31634000
      DOLOCATTR;                                               <<U.RAO>>31636000
                                                               <<U.RAO>>31638000
      <<VS - HOME VOLUME SET>>                                 <<U.RAO>>31640000
      BEGIN <<VS>>                                             <<RV.PV>>31642000
      IF USER THEN                                             <<00580>>31644000
      BEGIN  <<NOT VALID OPTION FOR USER - WARN AND IGNORE>>   <<00580>>31646000
          CIERR (-ORGCOMUNOTVS,PARMPTR);                       <<00580>>31648000
          << TRY TO RECOVER >>                                 <<00580>>31650000
          NEXT; << SKIP VSNAME >>                              <<00580>>31652000
          << SKIP 'SPAN' IF PRESENT >>                         <<00580>>31654000
          IF NEXTDELIM = COLON THEN NEXT;                      <<00580>>31656000
      END                                                      <<00580>>31658000
      ELSE                                                     <<00580>>31660000
      BEGIN                                                    <<00580>>31662000
          NEXT;                                                <<RV.PV>>31664000
          TOS := CHECK'N'MOVENAME (PARMPTR,PARMLEN,            <<RV.PV>>31666000
                                   VSCOMM (VSHVNAME),-4,3);    <<RV.PV>>31668000
          IF <> THEN                                           <<RV.PV>>31670000
           CIERR (ERRNUM := TOS+VCSREFBASE,PARMPTR)            <<RV.PV>>31672000
          ELSE                                                 <<RV.PV>>31674000
          BEGIN  << NO ERROR IN VOLSET >>                      <<01460>>31676000
                                                               <<01460>>31678000
               << CHECK FOR REDUNDANTLY SPECIFIED VS= >>       <<01460>>31680000
               IF (GROUP) THEN                                 <<01460>>31682000
               BEGIN                                           <<01460>>31684000
                   IF NOT SETSPECMASK(DEFN) THEN               <<01460>>31686000
                      CIERR(-ORGCOMRDNDVS);                    <<01460>>31688000
               END      << OF GROUP REDUNDANT CHECK >>         <<01460>>31690000
               ELSE                                            <<01460>>31692000
               BEGIN    << ACCOUNT CHECK >>                    <<01460>>31694000
                   VSPARMACCT.(15:1) := 1; << GOT VS= PARM >>  <<01460>>31696000
                   IF <> THEN CIERR(-ORGCOMRDNDVS);            <<01460>>31698000
               END;                                            <<01460>>31700000
                                                               <<01460>>31702000
               <<# OF NAMES GOES TO VSMASK.(14:2)>>            <<RV.PV>>31704000
               VSCOMM (VSMASK) := VSSPECIFIED LOR LS0;         <<RV.PV>>31706000
               CASE TOS OF                                     <<RV.PV>>31708000
               BEGIN                                           <<RV.PV>>31710000
                   ; <<NO NAME SUPPLIED. ATTEMPT TO RESET HVS>><<RV.PV>>31712000
                   WHO (,,,,BVSHGNAME,BVSHANAME);              <<RV.PV>>31714000
                   WHO (,,,,,BVSHANAME);                       <<RV.PV>>31716000
                   ; <<ALL NAMES SUPPLIED>>                    <<RV.PV>>31718000
               END;                                            <<RV.PV>>31720000
               IF NEXTDELIM = COLON THEN                       <<RV.PV>>31722000
               BEGIN                                           <<RV.PV>>31724000
                   NEXT;                                       <<RV.PV>>31726000
                   IF (TOS := SEARCH (PARMPTR,PARMLEN,         <<00086>>31728000
                              SUBKEYDICT)) <> 0 THEN           <<00086>>31730000
                    IF (VSCOMM (VSMASK) LAND 3) <> 0 THEN      <<RV.PV>>31732000
                    BEGIN                                      <<00086>>31734000
                        CASE (S0-1) OF                         <<00086>>31736000
                        BEGIN                                  <<00086>>31738000
                            TOS := SPANSPECIFIED; <<1>>        <<00086>>31740000
                            TOS := ALTSPECIFIED;  <<2>>        <<00086>>31742000
                        END;                                   <<00086>>31744000
                        VSCOMM (VSMASK) := VSCOMM (VSMASK) LOR LS0;     31746000
                        DEL; <<VALUE FROM CASE STMT>>          <<00086>>31748000
                    END                                        <<00086>>31750000
                    ELSE                                       <<RV.PV>>31752000
                     CIERR (ERRNUM:=ORGCOMSPANCNTXT)           <<RV.PV>>31754000
                   ELSE                                        <<RV.PV>>31756000
                    CIERR (ERRNUM:=ORGCOMUNKNONKEY,PARMPTR);   <<RV.PV>>31758000
                   DEL; <<RETURN FROM SEARCH>>                 <<00086>>31760000
               END;                                            <<RV.PV>>31762000
          END;  << OF NO ERROR IN VOLSET >>                    <<01460>>31764000
      END;                                                     <<00580>>31766000
      END;<<OF VS>>                                            <<RV.PV>>31768000
                                                               <<RV.PV>>31770000
      <<HOME GROUP SPECIFICATION>>                             <<U.RAO>>31772000
      IF NOT(USER) THEN                                        <<U.RAO>>31774000
         BEGIN  <<INAPPROPRIATE KEYWORD>>                      <<U.RAO>>31776000
         CIERR(-ORGCOMUHOMEGRP,PARMPTR);                       <<U.RAO>>31778000
         NEXT;                                                 <<U.RAO>>31780000
         END                                                   <<U.RAO>>31782000
      ELSE                                                     <<U.RAO>>31784000
         BEGIN                                                 <<U.RAO>>31786000
         NEXT;                                                 <<U.RAO>>31788000
         IF CHECKNAME(FGNAMEBASE,NEWENTRY(RESULTADR),TRUE) THEN<<U.RAO>>31790000
            IF NOT SETSPECMASK(DEFN) THEN  <<REDUNDANT>>       <<U.RAO>>31792000
               CIERR(-ORGCOMRDNDGROUP);                        <<U.RAO>>31794000
         END;                                                  <<U.RAO>>31796000
                                                               <<U.RAO>>31798000
      END;  <<OF CASE STATEMENT ON KEYWORDS>>                  <<U.RAO>>31800000
   IF ERRNUM > 0 THEN RETURN;  <<SOME FATAL ERROR ALONG THE WAY<<U.RAO>>31802000
   END;  <<OF WHILE LOOP ON SEMICOLON>>                        <<U.RAO>>31804000
                                                               <<U.RAO>>31806000
<<NOW FINAL CLEANUP BEFORE EXIT>>                              <<U.RAO>>31808000
IF NEXTDELIM <> CR THEN   <<GARBAGE IN STRING>>                <<U.RAO>>31810000
   BEGIN                                                       <<U.RAO>>31812000
   NEXT;                                                       <<U.RAO>>31814000
   CIERR(ERRNUM := ORGCOMXPCTKEYWD,PARMPTR)                    <<U.RAO>>31816000
   END                                                         <<U.RAO>>31818000
ELSE                                                           <<U.RAO>>31820000
   BEGIN                                                       <<U.RAO>>31822000
   PARMNUM := 0;                                               <<U.RAO>>31824000
   CYORGCOMS' := TRUE;                                         <<U.RAO>>31826000
   IF PMASK THEN                                               <<RV.PV>>31828000
   BEGIN <<ONLY THE ONES NEEDED>>                              <<RV.PV>>31830000
       X := SPECMASKLN-1;                                      <<RV.PV>>31832000
       DO                                                      <<RV.PV>>31834000
        SPECMASK (X) := SPECMASK (X) XOR TEMPSPECMASK (X)      <<RV.PV>>31836000
       UNTIL (X:=X-1) < 0;                                     <<RV.PV>>31838000
   END;                                                        <<RV.PV>>31840000
   END;                                                        <<U.RAO>>31842000
END;  <<CYORGCOMS'>>                                           <<U.RAO>>31844000
PROCEDURE CAP'ERR(ERRNUM,CAP'DENIED);                          <<00879>>31846000
VALUE ERRNUM;                                                  <<00879>>31848000
INTEGER ERRNUM;           <<ERRNUM FOR CIERR>>                 <<00879>>31850000
INTEGER ARRAY CAP'DENIED; <<2 WORD ARRAY OF DENIED CAP>>       <<00879>>31852000
OPTION UNCALLABLE,PRIVILEGED;                                  <<00879>>31854000
BEGIN                                                          <<00879>>31856000
   COMMENT:                                                    <<00879>>31858000
      THIS PROCEDURE HANDLES CAPABILITY ERRORS FOR THE         <<00879>>31860000
      ORGANIZATION MANAGEMENT COMMANDS.;                       <<00879>>31862000
   EQUATE                                                      <<00879>>31864000
      CAPLEN     = 3,                                          <<00879>>31866000
      CAPDICTLEN = CAPLEN*32;                                  <<00879>>31868000
   BYTE ARRAY CAPDICT(0:CAPDICTLEN-1) = PB :=                  <<00879>>31870000
      <<0>> "SM,",                                             <<00879>>31872000
      <<1>> "AM,",                                             <<00879>>31874000
      <<2>> "AL,",                                             <<00879>>31876000
      <<3>> "GL,",                                             <<00879>>31878000
      <<4>> "DI,",                                             <<00879>>31880000
      <<5>> "OP,",                                             <<00879>>31882000
      <<6>> "CV,",                                             <<00879>>31884000
      <<7>> "UV,",                                             <<00879>>31886000
      <<8>> "LG,",                                             <<01724>>31888000
      <<9>> "   ",                                             <<00879>>31890000
      <<10>>"   ",                                             <<00879>>31892000
      <<11>>"   ",                                             <<00879>>31894000
      <<12>>"   ",                                             <<00879>>31896000
      <<13>>"CS,",                                             <<00879>>31898000
      <<14>>"ND,",                                             <<00879>>31900000
      <<15>>"SF,",                                             <<00879>>31902000
      <<16>>"   ",                                             <<00879>>31904000
      <<17>>"   ",                                             <<00879>>31906000
      <<18>>"   ",                                             <<00879>>31908000
      <<19>>"   ",                                             <<00879>>31910000
      <<20>>"   ",                                             <<00879>>31912000
      <<21>>"   ",                                             <<00879>>31914000
      <<22>>"   ",                                             <<00879>>31916000
      <<23>>"BA,",                                             <<00879>>31918000
      <<24>>"IA,",                                             <<00879>>31920000
      <<25>>"PM,",                                             <<00879>>31922000
      <<26>>"   ",                                             <<00879>>31924000
      <<27>>"   ",                                             <<00879>>31926000
      <<28>>"MR,",                                             <<00879>>31928000
      <<29>>"   ",                                             <<00879>>31930000
      <<30>>"DS,",                                             <<00879>>31932000
      <<31>>"PH,";                                             <<00879>>31934000
   BYTE ARRAY STRING(0:CAPDICTLEN-1);                          <<00879>>31936000
   INTEGER                                                     <<00879>>31938000
      INX,                                                     <<00879>>31940000
      CAP'NUM,                                                 <<00879>>31942000
      I;                                                       <<00879>>31944000
                                                               <<00879>>31946000
   << >>                                                       <<00879>>31948000
   INX := -3;                                                  <<00879>>31950000
   STRING := " ";                                              <<00879>>31952000
   MOVE STRING(1) := STRING(0),(CAPDICTLEN-1);                 <<00879>>31954000
   FOR I := 0 UNTIL 1 DO                                       <<00879>>31956000
      BEGIN                                                    <<00879>>31958000
      CAP'NUM := I*16-1; << INIT TO LEFT MOST BIT POSITION >>  <<00879>>31960000
      TOS := CAP'DENIED(I);                                    <<00879>>31962000
      WHILE S0 <> 0 DO                                         <<00879>>31964000
         BEGIN                                                 <<00879>>31966000
         X := CAP'NUM;                                         <<00879>>31968000
         ASSEMBLE (SCAN ,X);                                   <<00879>>31970000
         CAP'NUM := X;<<CAP'NUM GETS BIT POSITION OF NEXT CAP>><<00879>>31972000
         MOVE STRING(INX:=INX+CAPLEN):=CAPDICT(CAP'NUM*CAPLEN) <<00879>>31974000
                                         ,(CAPLEN);            <<00879>>31976000
         END;                                                  <<00879>>31978000
      DEL;  << REMOVE CAP'DENIED(I) >>                         <<00879>>31980000
      END;                                                     <<00879>>31982000
   STRING(INX+2) := 0;                                         <<00879>>31984000
   CIERR(ERRNUM,,0,@STRING);                                   <<00879>>31986000
                                                               <<00879>>31988000
END; << CAP'ERROR >>                                           <<00879>>31990000
$CONTROL SEGMENT=CIALTORG                                               31992000
INTEGER PROCEDURE GET'PUT'NAME (HEREINFO, THERE,               <<RV.PV>>31994000
                                WHICHKIND, WHERE);             <<RV.PV>>31996000
    VALUE   HEREINFO, WHICHKIND, WHERE;                        <<RV.PV>>31998000
    DOUBLE  HEREINFO;                                          <<RV.PV>>32000000
    ARRAY   THERE;                                             <<RV.PV>>32002000
    INTEGER WHICHKIND, WHERE;                                  <<RV.PV>>32004000
    OPTION PRIVILEGED, INTERNAL;                               <<RV.PV>>32006000
    BEGIN                                                      <<RV.PV>>32008000
        BYTE POINTER                                           <<RV.PV>>32010000
            WHEREADR = WHERE,                                  <<RV.PV>>32012000
            HERE = HEREINFO;                                   <<RV.PV>>32014000
        LOGICAL                                                <<RV.PV>>32016000
            ERRNO,                                             <<RV.PV>>32018000
            PARM1 = HERE+1;                                    <<RV.PV>>32020000
        DEFINE                                                 <<RV.PV>>32022000
            LNGTH = PARM1.(0:8) #,                             <<RV.PV>>32024000
            SPEC  = PARM1.(10:1) #,                            <<RV.PV>>32026000
            DELNO = PARM1.(11:5) #;                            <<RV.PV>>32028000
                                                               <<RV.PV>>32030000
        CC := CCE;                                             <<RV.PV>>32032000
        THERE := "  ";                                         <<RV.PV>>32034000
        MOVE THERE (1) := THERE, (NAMESIZE-1);                 <<RV.PV>>32036000
        GET'PUT'NAME := DELNO;                                 <<RV.PV>>32038000
        IF LNGTH = 0 THEN                                      <<RV.PV>>32040000
        BEGIN <<OMMITTED>>                                     <<RV.PV>>32042000
            CIERR (VSDEFMISSNAME, HERE, 0, @WHICHKIND);        <<RV.PV>>32044000
            CC := CCG;                                         <<RV.PV>>32046000
        END                                                    <<RV.PV>>32048000
        ELSE                                                   <<RV.PV>>32050000
        BEGIN                                                  <<RV.PV>>32052000
            IF SPEC OR HERE <> ALPHA OR LNGTH > 8 THEN         <<RV.PV>>32054000
            BEGIN  <<ILLEGAL NAME>>                            <<RV.PV>>32056000
                ERRNO := IF SPEC THEN VSDEFSPECHAR ELSE        <<RV.PV>>32058000
                          IF HERE <> ALPHA THEN VSDEFNOTALPHA  <<RV.PV>>32060000
                                           ELSE VSDEFTOOLONG;  <<RV.PV>>32062000
                CIERR (ERRNO, WHEREADR, 0, WHICHKIND);         <<RV.PV>>32064000
                CC := CCL;                                     <<RV.PV>>32066000
            END                                                <<RV.PV>>32068000
            ELSE                                               <<RV.PV>>32070000
            BEGIN                                              <<RV.PV>>32072000
                TOS := @THERE & LSL (1); <<BYTE POINTER>>      <<RV.PV>>32074000
                MOVE * := HERE, (LNGTH);                       <<RV.PV>>32076000
            END;                                               <<RV.PV>>32078000
        END;                                                   <<RV.PV>>32080000
    END;<<OF GET'PUT'NAME>>                                    <<RV.PV>>32082000
LOGICAL PROCEDURE CYCLASS (HEREINFO, VSDEF, VCDEF, PARMSP);    <<RV.PV>>32084000
    VALUE   HEREINFO;                                          <<RV.PV>>32086000
    DOUBLE  HEREINFO;                                          <<RV.PV>>32088000
    ARRAY   VSDEF, VCDEF;                                      <<RV.PV>>32090000
    BYTE ARRAY PARMSP;                                         <<RV.PV>>32092000
    OPTION PRIVILEGED, INTERNAL;                               <<RV.PV>>32094000
    BEGIN                                                      <<RV.PV>>32096000
        ENTRY CYCLASS';                                        <<RV.PV>>32098000
        BYTE POINTER                                           <<RV.PV>>32100000
            WHERE',                                            <<RV.PV>>32102000
            HERE = HEREINFO,                                   <<RV.PV>>32104000
            STRING;                                            <<RV.PV>>32106000
        DOUBLE                                                 <<RV.PV>>32108000
                  <<  =      :      ,      CR >>               <<RV.PV>>32110000
            X1 := [8/%75, 8/%72, 8/%54, 8/%15] D;              <<RV.PV>>32112000
        LOGICAL                                                <<RV.PV>>32114000
            FOUND,                                             <<RV.PV>>32116000
            MV := FALSE,                                       <<RV.PV>>32118000
            STOP = CYCLASS,                                    <<RV.PV>>32120000
            PARM1 = HERE+1;                                    <<RV.PV>>32122000
        EQUATE                                                 <<RV.PV>>32124000
            CR = %15,                                          <<RV.PV>>32126000
            GVSMEMBSZ = GVSINFO-GVSNAME+1;                     <<RV.PV>>32128000
        DEFINE                                                 <<RV.PV>>32130000
            BAD'RETURN = BEGIN STOP := TRUE; RETURN; END #,    <<RV.PV>>32132000
            WHERE = @PARMSP+(@HERE-@STRING) #,                 <<RV.PV>>32134000
            LNGTH = PARM1.(0:8) #,                             <<RV.PV>>32136000
            SPEC  = PARM1.(10:1) #,                            <<RV.PV>>32138000
            DELNO = PARM1.(11:5) #;                            <<RV.PV>>32140000
        BYTE ARRAY                                             <<RV.PV>>32142000
            CLASS' (0:5),                                      <<RV.PV>>32144000
            BVSDEF (*) = VSDEF,                                <<RV.PV>>32146000
            BVCDEF (*) = VCDEF,                                <<RV.PV>>32148000
            DELIMS (*) = X1;                                   <<RV.PV>>32150000
        INTEGER                                                <<RV.PV>>32152000
            CLASS = CLASS',                                    <<RV.PV>>32154000
            NUM'MEMBERS,                                       <<RV.PV>>32156000
            GVCINFO' := 0,                                     <<RV.PV>>32158000
            VOLCNT := 0,                                       <<RV.PV>>32160000
            NUMPARMS,                                          <<RV.PV>>32162000
            PNUM := 0;                                         <<RV.PV>>32164000
        DOUBLE ARRAY                                           <<RV.PV>>32166000
            PARMS (0:VMAX+1); <<INCLUDES KEYWORD PARAMETER>>   <<RV.PV>>32168000
                                                               <<RV.PV>>32170000
                                                               <<RV.PV>>32172000
        IF FALSE THEN                                          <<RV.PV>>32174000
    CYCLASS':                                                  <<RV.PV>>32176000
         MV := TRUE;                                           <<RV.PV>>32178000
        MOVE CLASS' := ("CLASS",0);                            <<RV.PV>>32180000
        TOS := (LNGTH+2) & LSR (1);                            <<RV.PV>>32182000
        PUSH (S);                                              <<RV.PV>>32184000
        @STRING := TOS & LSL (1);                              <<RV.PV>>32186000
        ASSEMBLE (ADDS 0);                                     <<RV.PV>>32188000
        MOVE STRING := HERE, (LNGTH);                          <<RV.PV>>32190000
        @PARMSP := @HERE;                                      <<RV.PV>>32192000
        STRING (LNGTH) := CR;                                  <<RV.PV>>32194000
        MYCOMMAND (STRING, DELIMS, VMAX+2, NUMPARMS, PARMS);   <<RV.PV>>32196000
        IF > THEN                                              <<RV.PV>>32198000
        BEGIN <<TOO MANY PARAMETERS>>                          <<RV.PV>>32200000
            CIERR (VSDEFTOOMANY, HERE, 0, CLASS);              <<RV.PV>>32202000
            BAD'RETURN;                                        <<RV.PV>>32204000
        END;                                                   <<RV.PV>>32206000
        IF NUMPARMS < 3 THEN                                   <<RV.PV>>32208000
        BEGIN <<NOT ENOUGH PARAMETERS>>                        <<RV.PV>>32210000
            CIERR (VSDEFTOOFEW, HERE, 0, CLASS);               <<RV.PV>>32212000
            BAD'RETURN;                                        <<RV.PV>>32214000
        END;                                                   <<RV.PV>>32216000
        PNUM := PNUM + 1; <<GET PAST KEYWORD>>                 <<RV.PV>>32218000
        HEREINFO := PARMS (PNUM);  <<GET VOLUME CLASS NAME>>   <<RV.PV>>32220000
        TOS := GET'PUT'NAME (HEREINFO, VCDEF (GVCNAME),        <<RV.PV>>32222000
                             CLASS, WHERE);                    <<RV.PV>>32224000
        IF <> THEN                                             <<RV.PV>>32226000
        BEGIN <<ILLEGAL NAME>>                                 <<RV.PV>>32228000
            DEL;                                               <<RV.PV>>32230000
            BAD'RETURN;                                        <<RV.PV>>32232000
        END;                                                   <<RV.PV>>32234000
        IF TOS <> 1 THEN                                       <<RV.PV>>32236000
        BEGIN <<MISSING :>>                                    <<RV.PV>>32238000
            @WHERE' := WHERE;                                  <<RV.PV>>32240000
            CIERR (VSDEFMISSCOLON, WHERE', 0, CLASS);          <<RV.PV>>32242000
            BAD'RETURN;                                        <<RV.PV>>32244000
        END;                                                   <<RV.PV>>32246000
        NUM'MEMBERS := VSDEF (GVSINFO).(0:4);                  <<RV.PV>>32248000
        PNUM := PNUM + 1; <<GET PAST VOL CLASS NAME>>          <<RV.PV>>32250000
        <<START OF LOOP TO GET AND ANALYZE MEMBERS>>           <<RV.PV>>32252000
        DO BEGIN                                               <<RV.PV>>32254000
               VOLCNT := VOLCNT+1;                             <<RV.PV>>32256000
               HEREINFO := PARMS (PNUM);                       <<RV.PV>>32258000
               GET'PUT'NAME (HEREINFO, VCDEF (GVCPNAME),       <<RV.PV>>32260000
                                    CLASS, WHERE);             <<RV.PV>>32262000
               IF <> THEN <<ILLEGAL NAME>> BAD'RETURN;         <<RV.PV>>32264000
               TOS := 1; <<START SCAN AT 1ST MEMBER ENTRY>>    <<RV.PV>>32266000
               DO BEGIN                                        <<RV.PV>>32268000
                      FOUND := BVSDEF (S0*(GVSMEMBSZ*2)) =     <<RV.PV>>32270000
                             BVCDEF (GVCPNAME*2), (NAMESIZE*2);<<RV.PV>>32272000
                      TOS := TOS+1;                            <<RV.PV>>32274000
                  END UNTIL FOUND OR S0 > NUM'MEMBERS;         <<RV.PV>>32276000
               IF NOT FOUND THEN                               <<RV.PV>>32278000
               BEGIN <<VNAME SPECIFICATION UNIDENTIFIED>>      <<RV.PV>>32280000
                   DEL;                                        <<RV.PV>>32282000
                   @WHERE' := WHERE;                           <<RV.PV>>32284000
                   CIERR (VSDEFUNDFN, WHERE');                 <<RV.PV>>32286000
                   BAD'RETURN;                                 <<RV.PV>>32288000
               END;                                            <<RV.PV>>32290000
               X := TOS-1; <<POSITION OF MEMBER DEFINITION>>   <<RV.PV>>32292000
               MV := MV LOR (LOGICAL (X) = 1);                 <<RV.PV>>32294000
               X := 16-X;  <<FOR SETTING VCLASS MASK>>         <<RV.PV>>32296000
               TOS := GVCINFO';                                <<RV.PV>>32298000
               ASSEMBLE (TSBC 0, X);                           <<RV.PV>>32300000
               IF <> THEN                                      <<RV.PV>>32302000
               BEGIN <<DUPLICATE MEMBER SPECIFICATION>>        <<RV.PV>>32304000
                   DEL;                                        <<RV.PV>>32306000
                   @WHERE' := WHERE;                           <<RV.PV>>32308000
                   CIERR (VSDEFDUPMEMB, WHERE');               <<RV.PV>>32310000
                   BAD'RETURN;                                 <<RV.PV>>32312000
               END;                                            <<RV.PV>>32314000
               GVCINFO' := TOS;                                <<RV.PV>>32316000
           END UNTIL STOP OR (PNUM:=PNUM+1) >= NUMPARMS;       <<RV.PV>>32318000
        IF NOT STOP THEN                                       <<RV.PV>>32320000
        BEGIN                                                  <<RV.PV>>32322000
            IF NOT MV THEN                                     <<RV.PV>>32324000
            BEGIN <<MASTER VOLUME UNDEFINED>>                  <<RV.PV>>32326000
                CIERR (VSDEFUNDFNMASTR);                       <<RV.PV>>32328000
                BAD'RETURN;                                    <<RV.PV>>32330000
            END;                                               <<RV.PV>>32332000
            GVCINFO'.(0:4) := VOLCNT;                          <<RV.PV>>32334000
            VCDEF (GVCINFO) := GVCINFO';                       <<RV.PV>>32336000
        END;                                                   <<RV.PV>>32338000
    END;<<OF CYCLASS>>                                         <<RV.PV>>32340000
LOGICAL PROCEDURE CYMEMBERS (HEREINFO, VSDEF,                  <<RV.PV>>32342000
                             DISKTYPES, PARMSP);               <<RV.PV>>32344000
    VALUE   HEREINFO;                                          <<RV.PV>>32346000
    DOUBLE  HEREINFO;                                          <<RV.PV>>32348000
    ARRAY   VSDEF;                                             <<RV.PV>>32350000
    BYTE ARRAY DISKTYPES, PARMSP;                              <<RV.PV>>32352000
    OPTION PRIVILEGED, INTERNAL;                               <<RV.PV>>32354000
    BEGIN                                                      <<RV.PV>>32356000
        ENTRY CYMEMBERS';                                      <<RV.PV>>32358000
        BYTE POINTER                                           <<RV.PV>>32360000
            WHERE',                                            <<RV.PV>>32362000
            HERE = HEREINFO,                                   <<RV.PV>>32364000
            STRING,                                            <<RV.PV>>32366000
            DEFN;                                              <<RV.PV>>32368000
        POINTER                                                <<RV.PV>>32370000
            MV := 0;  <<MASTER VOL MEMBER TEMP POSITION>>      <<RV.PV>>32372000
        DOUBLE                                                 <<RV.PV>>32374000
                  <<  =      :      ,      CR >>               <<RV.PV>>32376000
            X1 := [8/%75, 8/%72, 8/%54, 8/%15] D;              <<RV.PV>>32378000
        LOGICAL                                                <<RV.PV>>32380000
            SKIPMV := FALSE,                                   <<RV.PV>>32382000
            STOP = CYMEMBERS,                                  <<RV.PV>>32384000
            PARM1 = HERE+1;                                    <<RV.PV>>32386000
        EQUATE                                                 <<RV.PV>>32388000
            CR = %15,                                          <<RV.PV>>32390000
            GVSMEMBSZ = GVSINFO-GVSNAME+1;                     <<RV.PV>>32392000
        DEFINE                                                 <<RV.PV>>32394000
            BAD'RETURN = BEGIN STOP := TRUE; RETURN; END #,    <<RV.PV>>32396000
            WHERE = @PARMSP+(@HERE-@STRING) #,                 <<RV.PV>>32398000
            LNGTH = PARM1.(0:8) #,                             <<RV.PV>>32400000
            SPEC  = PARM1.(10:1) #,                            <<RV.PV>>32402000
            DELNO = PARM1.(11:5) #;                            <<RV.PV>>32404000
        BYTE ARRAY                                             <<RV.PV>>32406000
            MEMBERS' (0:7),                                    <<RV.PV>>32408000
            BVSDEF (*) = VSDEF,                                <<RV.PV>>32410000
            DELIMS (*) = X1;                                   <<RV.PV>>32412000
        INTEGER                                                <<RV.PV>>32414000
            MEMBERS = MEMBERS',                                <<RV.PV>>32416000
            VOLCNT := 0,                                       <<RV.PV>>32418000
            NUMPARMS,                                          <<RV.PV>>32420000
            PNUM := 0;                                         <<RV.PV>>32422000
        DOUBLE ARRAY                                           <<RV.PV>>32424000
            PARMS (0:VMAX*2); <<INCLUDES KEYWORD PARAMETER>>   <<RV.PV>>32426000
                                                               <<RV.PV>>32428000
                                                               <<RV.PV>>32430000
        IF FALSE THEN                                          <<RV.PV>>32432000
    CYMEMBERS':                                                <<RV.PV>>32434000
         SKIPMV := TRUE;                                       <<RV.PV>>32436000
        MOVE MEMBERS' := ("MEMBERS",0);                        <<RV.PV>>32438000
        TOS := (LNGTH+2) & LSR (1);                            <<RV.PV>>32440000
        PUSH (S);                                              <<RV.PV>>32442000
        @STRING := TOS & LSL (1);                              <<RV.PV>>32444000
        ASSEMBLE (ADDS 0);                                     <<RV.PV>>32446000
        MOVE STRING := HERE, (LNGTH);                          <<RV.PV>>32448000
        @PARMSP := @HERE;                                      <<RV.PV>>32450000
        STRING (LNGTH) := CR;                                  <<RV.PV>>32452000
        MYCOMMAND (STRING, DELIMS, (VMAX*2)+1,                 <<RV.PV>>32454000
                   NUMPARMS,PARMS);                            <<RV.PV>>32456000
        IF > THEN                                              <<RV.PV>>32458000
        BEGIN <<TOO MANY PARAMETERS>>                          <<RV.PV>>32460000
            CIERR (VSDEFTOOMANY, HERE, 0, MEMBERS);            <<RV.PV>>32462000
            BAD'RETURN;                                        <<RV.PV>>32464000
        END;                                                   <<RV.PV>>32466000
        IF NUMPARMS < 3 THEN                                   <<RV.PV>>32468000
        BEGIN <<NOT ENOUGH PARAMETERS>>                        <<RV.PV>>32470000
            CIERR (VSDEFTOOFEW, HERE, 0, MEMBERS);             <<RV.PV>>32472000
            BAD'RETURN;                                        <<RV.PV>>32474000
        END;                                                   <<RV.PV>>32476000
        PNUM := PNUM + 1; <<GET PAST KEYWORD>>                 <<RV.PV>>32478000
        <<START OF LOOP TO GET AND ANALYZE MEMBERS>>           <<RV.PV>>32480000
        DO BEGIN                                               <<RV.PV>>32482000
               VOLCNT := VOLCNT+1;                             <<RV.PV>>32484000
               HEREINFO := PARMS (PNUM);                       <<RV.PV>>32486000
               TOS := GET'PUT'NAME (HEREINFO,                  <<RV.PV>>32488000
                    VSDEF (VOLCNT*GVSMEMBSZ), MEMBERS, WHERE); <<RV.PV>>32490000
               IF <> THEN                                      <<RV.PV>>32492000
               BEGIN <<ILLEGAL NAME>>                          <<RV.PV>>32494000
                   DEL;                                        <<RV.PV>>32496000
                   BAD'RETURN;                                 <<RV.PV>>32498000
               END;                                            <<RV.PV>>32500000
               IF TOS <> 1 THEN                                <<RV.PV>>32502000
               BEGIN <<MISSING :>>                             <<RV.PV>>32504000
                   @WHERE' := WHERE;                           <<RV.PV>>32506000
                   CIERR (VSDEFMISSCOLON, WHERE', 0, MEMBERS); <<RV.PV>>32508000
                   BAD'RETURN;                                 <<RV.PV>>32510000
               END;                                            <<RV.PV>>32512000
               TOS := 1; <<START SCAN AT 1ST MEMBER ENTRY>>    <<RV.PV>>32514000
               WHILE S0 < VOLCNT DO                            <<RV.PV>>32516000
               BEGIN                                           <<RV.PV>>32518000
                   IF BVSDEF (S0*(GVSMEMBSZ*2)) =              <<RV.PV>>32520000
                    BVSDEF (VOLCNT*(GVSMEMBSZ*2)), (NAMESIZE*2)<<RV.PV>>32522000
                   THEN                                        <<RV.PV>>32524000
                   BEGIN <<DUPLICATE MEMBER DEFINITION>>       <<RV.PV>>32526000
                       DEL;                                    <<RV.PV>>32528000
                       @WHERE' := WHERE;                       <<RV.PV>>32530000
                       CIERR (VSDEFDUPMEMBDEF, WHERE', 0, MEMBERS);     32532000
                       BAD'RETURN;                             <<RV.PV>>32534000
                   END;                                        <<RV.PV>>32536000
                   TOS := TOS+1;                               <<RV.PV>>32538000
               END;                                            <<RV.PV>>32540000
               DEL;                                            <<RV.PV>>32542000
               IF BVSDEF (VOLCNT*(GVSMEMBSZ*2)) =              <<RV.PV>>32544000
                  BVSDEF (GVSNAME), (NAMESIZE*2) THEN          <<RV.PV>>32546000
                @MV := @VSDEF (VOLCNT*GVSMEMBSZ);              <<RV.PV>>32548000
               HEREINFO := PARMS (PNUM+1);                     <<RV.PV>>32550000
               TOS := 0; <<RETURN FOR SEARCH>>                 <<RV.PV>>32552000
               TOS := HEREINFO;                                <<RV.PV>>32554000
               TOS := TOS & LSR (8); <<LENGTH OF PARAMETER>>   <<RV.PV>>32556000
               IF SEARCH (*, *, DISKTYPES, DEFN) = 0 THEN      <<RV.PV>>32558000
               BEGIN <<ILLEGAL DISK TYPE DESIGNATOR>>          <<RV.PV>>32560000
                   @WHERE' := WHERE;                           <<RV.PV>>32562000
                   CIERR (VSDEFUNDFNTYPE, WHERE', 0, MEMBERS); <<RV.PV>>32564000
                   BAD'RETURN;                                 <<RV.PV>>32566000
               END;                                            <<RV.PV>>32568000
               VSDEF ((VOLCNT*GVSMEMBSZ)+GVSINFO).(0:8):= DEFN;<<RV.PV>>32570000
           END UNTIL STOP OR (PNUM:=PNUM+2) >= NUMPARMS;       <<RV.PV>>32572000
        IF NOT STOP THEN                                       <<RV.PV>>32574000
        BEGIN                                                  <<RV.PV>>32576000
            IF NOT SKIPMV THEN                                 <<RV.PV>>32578000
            BEGIN                                              <<RV.PV>>32580000
                IF @MV = 0 THEN                                <<RV.PV>>32582000
                BEGIN <<MASTER VOLUME UNDEFINED>>              <<RV.PV>>32584000
                    CIERR (VSDEFUNDFNMASTR);                   <<RV.PV>>32586000
                    BAD'RETURN;                                <<RV.PV>>32588000
                END;                                           <<RV.PV>>32590000
                IF @MV <> @VSDEF (GVSVOLNAME) THEN             <<RV.PV>>32592000
                BEGIN <<MV ENTRY NEEDS TO GO TO 1ST SLOT>>     <<RV.PV>>32594000
                    TOS := MV (GVSINFO); <<SAVE INFO WORD>>    <<RV.PV>>32596000
                    MOVE MV := VSDEF (GVSVOLNAME), (GVSMEMBSZ);<<RV.PV>>32598000
                    MOVE VSDEF (GVSVOLNAME) :=                 <<RV.PV>>32600000
                         VSDEF (GVSNAME), (NAMESIZE);          <<RV.PV>>32602000
                    VSDEF (GVSVOLINFO) := TOS;                 <<RV.PV>>32604000
                END;                                           <<RV.PV>>32606000
            END;                                               <<RV.PV>>32608000
            TOS := %177777D;                                   <<RV.PV>>32610000
            DS1 := DS1 & DLSL (VOLCNT);                        <<RV.PV>>32612000
            DEL;                                               <<RV.PV>>32614000
            VSDEF (GVSINFO).(0:4) := VOLCNT;                   <<RV.PV>>32616000
            VSDEF (X).(8:8) := TOS; <<SET MASK>>               <<RV.PV>>32618000
        END;                                                   <<RV.PV>>32620000
    END;<<OF CYMEMBERS>>                                       <<RV.PV>>32622000
PROCEDURE CXNEWVSET EXECUTORHEAD;                              <<RV.PV>>32624000
    OPTION PRIVILEGED, UNCALLABLE;                             <<RV.PV>>32626000
    BEGIN                                                      <<RV.PV>>32628000
        DOUBLE                                                 <<RV.PV>>32630000
            PARM;                                              <<RV.PV>>32632000
        BYTE POINTER                                           <<RV.PV>>32634000
            JUNKBP,                                            <<RV.PV>>32636000
            STRING = PARM;                                     <<RV.PV>>32638000
        DOUBLE POINTER                                         <<RV.PV>>32640000
            JUNKDP;                                            <<RV.PV>>32642000
        INTEGER                                                <<RV.PV>>32644000
            JUNK,                                              <<RV.PV>>32646000
            PNUM,                                              <<RV.PV>>32648000
            PARM1 = STRING+1,                                  <<RV.PV>>32650000
            X1 := [8/%73, 8/%15], <<; CR>>                     <<RV.PV>>32652000
            NUMPARMS;                                          <<RV.PV>>32654000
        LOGICAL                                                <<RV.PV>>32656000
            CLASS := FALSE,                                    <<RV.PV>>32658000
            STOP := FALSE;                                     <<RV.PV>>32660000
        INTEGER ARRAY                                          <<RV.PV>>32662000
            ACCOUNT (0:NAMESIZE-1),                            <<RV.PV>>32664000
            GROUP (0:NAMESIZE-1),                              <<RV.PV>>32666000
            VSDEF (0:GVSDSIZE-1),                              <<RV.PV>>32668000
            VCDEF (0:GVCDSIZE-1);                              <<RV.PV>>32670000
        DOUBLE ARRAY                                           <<RV.PV>>32672000
            PARMS (0:2);                                       <<RV.PV>>32674000
        EQUATE                                                 <<RV.PV>>32676000
            CR = %15,                                          <<RV.PV>>32678000
            KEYDICTL = 17,                                     <<RV.PV>>32680000
        DISKTYPESL = 64;                                       <<03513>>32682000
        DEFINE                                                 <<RV.PV>>32684000
            LNGTH = PARM1.(0:8) #,                             <<RV.PV>>32686000
            SPEC  = PARM1.(10:1) #,                            <<RV.PV>>32688000
            DELNO = PARM1.(11:5) #;                            <<RV.PV>>32690000
        BYTE ARRAY                                             <<RV.PV>>32692000
            VSET' (0:4),                                       <<RV.PV>>32694000
            BACCOUNT (*) = ACCOUNT,                            <<RV.PV>>32696000
            BGROUP (*) = GROUP,                                <<RV.PV>>32698000
            KEYDICT (0:KEYDICTL-1),                            <<RV.PV>>32700000
            DISKTYPES (0:DISKTYPESL-1),                        <<RV.PV>>32702000
            DELIMS (*) = X1;                                   <<RV.PV>>32704000
        INTEGER                                                <<RV.PV>>32706000
            VSET = VSET';                                      <<RV.PV>>32708000
        INTEGER ARRAY                                          <<RV.PV>>32710000
            INITVSDEF (0:GVSINFO) = PB :=                      <<RV.PV>>32712000
                "        ",                                    <<RV.PV>>32714000
                0,0;                                           <<RV.PV>>32716000
        INTEGER ARRAY                                          <<RV.PV>>32718000
            INITVCDEF (0:GVCUNUSED-1) = PB :=                  <<RV.PV>>32720000
                "        ",                                    <<RV.PV>>32722000
                %100000,0,                                     <<RV.PV>>32724000
                "        ", "        ", "        ";            <<RV.PV>>32726000
        BYTE ARRAY                                             <<RV.PV>>32728000
            KEYDICTX (0:KEYDICTL-1) = PB :=                    <<RV.PV>>32730000
                9,7,"MEMBERS",                                 <<RV.PV>>32732000
                7,5,"CLASS",                                   <<RV.PV>>32734000
                0;                                             <<RV.PV>>32736000
        BYTE ARRAY                                             <<RV.PV>>32738000
    COMMENT                                                    <<00263>>32740000
                                                               <<00263>>32742000
    PSEUDO SUBTYPES FOR THE DIFFERENT DISCS DEFINED            <<00263>>32744000
    BELOW WHERE DEVLOPED AS FOLLOWS:                           <<00263>>32746000
                                                               <<00263>>32748000
    [PSEUDO SUBTYPE] = ([ACTUAL TYPE] * 16) + [ACTUAL SUBTYPE] <<00263>>32750000
                                                               <<00263>>32752000
    ;                                                          <<00263>>32754000
                                                               <<00263>>32756000
            DISKTYPESX (0:DISKTYPESL-1) = PB :=                <<RV.PV>>32758000
                9,6,"HP7905",4,                                <<RV.PV>>32760000
                9,6,"HP7920",8,                                <<RV.PV>>32762000
                9,6,"HP7925",9,                                <<03.KM>>32764000
                9,6,"HP7906",10,                               <<00263>>32766000
                9,6,"HP7902",32,                               <<00263>>32768000
                9,6,"HP9895",32,                               <<01850>>32770000
            9,6,"HP7933",56,                                            32772000
                0;                                             <<RV.PV>>32774000
                                                               <<RV.PV>>32776000
                                                               <<RV.PV>>32778000
        MOVE VSET' := ("VSET",0);                              <<RV.PV>>32780000
        VSDEF := 0;                                            <<RV.PV>>32782000
        MOVE VSDEF (1) := VSDEF, (GVSDSIZE-1);                 <<RV.PV>>32784000
        TOS := VMAX;                                           <<RV.PV>>32786000
        DO BEGIN                                               <<RV.PV>>32788000
               MOVE VSDEF (S0*(GVSINFO+1)) :=                  <<RV.PV>>32790000
                    INITVSDEF, (GVSINFO+1);                    <<RV.PV>>32792000
               TOS := TOS-1;                                   <<RV.PV>>32794000
           END UNTIL <;                                        <<RV.PV>>32796000
        DEL;                                                   <<RV.PV>>32798000
        VCDEF := 0;                                            <<RV.PV>>32800000
        MOVE VCDEF (1) := VCDEF, (GVCDSIZE-1);                 <<RV.PV>>32802000
        MOVE VCDEF := INITVCDEF, (GVCUNUSED);                  <<RV.PV>>32804000
        MYCOMMAND (PARMSP, DELIMS, 3<<MAXPARMS>>,              <<RV.PV>>32806000
                             NUMPARMS, PARMS);                 <<RV.PV>>32808000
        IF > THEN                                              <<RV.PV>>32810000
        BEGIN <<TOO MANY PARAMETERS>>                          <<RV.PV>>32812000
            CIERR (VSDEFTOOMANY, PARMSP, 0, VSET);             <<RV.PV>>32814000
            RETURN;                                            <<RV.PV>>32816000
        END;                                                   <<RV.PV>>32818000
        IF NUMPARMS < 2 THEN                                   <<RV.PV>>32820000
        BEGIN <<NOT ENOUGH PARAMETERS>>                        <<RV.PV>>32822000
            CIERR (VSDEFTOOFEW, PARMSP, 0, VSET);              <<RV.PV>>32824000
            RETURN;                                            <<RV.PV>>32826000
        END;                                                   <<RV.PV>>32828000
        TOS := GET'PUT'NAME (PARMS, VSDEF (GVSNAME),           <<RV.PV>>32830000
                             VSET, STRING);                    <<RV.PV>>32832000
        IF <> THEN                                             <<RV.PV>>32834000
        BEGIN <<ILLEGAL OR OMMITTED NAME>>                     <<RV.PV>>32836000
            DEL;                                               <<RV.PV>>32838000
            RETURN;                                            <<RV.PV>>32840000
        END;                                                   <<RV.PV>>32842000
        PNUM := 1;  <<START AFTER VS DEFINITION NAME>>         <<RV.PV>>32844000
        MOVE KEYDICT := KEYDICTX, (KEYDICTL);                  <<RV.PV>>32846000
        MOVE DISKTYPES := DISKTYPESX, (DISKTYPESL);            <<RV.PV>>32848000
    << THE FOLLOWING SECTION OF CODE PARSES THE PARMS >>       <<03513>>32850000
    << FOR "MEMBERS" AND "CLASS" PARMS.               >>       <<03513>>32852000
        DO BEGIN                                               <<RV.PV>>32854000
               PARM := PARMS (PNUM); <<CURRENT PARAMETER>>     <<RV.PV>>32856000
               TOS := (LNGTH+2) & LSR (1);                     <<RV.PV>>32858000
               PUSH (S);                                       <<RV.PV>>32860000
               @JUNKBP := TOS & LSL (1);                       <<RV.PV>>32862000
               ASSEMBLE (ADDS 0); <<ROOM FOR TEMP PARSE>>      <<RV.PV>>32864000
               X1 := %036415; << = CR >>                       <<RV.PV>>32866000
               MOVE JUNKBP := STRING, (LNGTH);                 <<RV.PV>>32868000
               JUNKBP (LNGTH) := CR;                           <<RV.PV>>32870000
               TOS := 4;                                       <<RV.PV>>32872000
               PUSH (S);                                       <<RV.PV>>32874000
               @JUNKDP := TOS;                                 <<RV.PV>>32876000
               ASSEMBLE (ADDS 0);                              <<RV.PV>>32878000
               MYCOMMAND (JUNKBP, DELIMS, 2<<MAXPARMS>>,       <<RV.PV>>32880000
                          JUNK, JUNKDP);                       <<RV.PV>>32882000
               IF > THEN                                       <<RV.PV>>32884000
               BEGIN <<TOO MANY PARAMETERS>>                   <<RV.PV>>32886000
                   CIERR (VSDEFTOOMANY, STRING, 0, VSET);      <<RV.PV>>32888000
                   RETURN;                                     <<RV.PV>>32890000
               END;                                            <<RV.PV>>32892000
               IF JUNK < 2 THEN                                <<RV.PV>>32894000
               BEGIN <<NOT ENOUGH PARAMETERS>>                 <<RV.PV>>32896000
                   CIERR (VSDEFTOOFEW, STRING, 0, VSET);       <<RV.PV>>32898000
                   RETURN;                                     <<RV.PV>>32900000
               END;                                            <<RV.PV>>32902000
               TOS := JUNKDP;                                  <<RV.PV>>32904000
               DEL;                                            <<RV.PV>>32906000
               @JUNKBP := TOS;                                 <<RV.PV>>32908000
               TOS := 0;  <<FOR RETURN FROM SEARCH>>           <<RV.PV>>32910000
               TOS := JUNKDP; <<1ST PAIR OF PARM WORDS>>       <<RV.PV>>32912000
               TOS := TOS & LSR (8); <<LENGTH OF PARAMETER>>   <<RV.PV>>32914000
               TOS := SEARCH (*, *, KEYDICT);                  <<RV.PV>>32916000
               IF S0 = 0 THEN                                  <<RV.PV>>32918000
               BEGIN <<ILLEGAL KEYWORD>>                       <<RV.PV>>32920000
                   DEL;                                        <<RV.PV>>32922000
                   CIERR (VSDEFILLEGALKEY, STRING);            <<RV.PV>>32924000
                   RETURN;                                     <<RV.PV>>32926000
               END;                                            <<RV.PV>>32928000
               TOS := JUNKDP;                                  <<RV.PV>>32930000
               DELB;                                           <<RV.PV>>32932000
               IF TOS.(11:5) <> 0 THEN                         <<RV.PV>>32934000
               BEGIN <<KEYWORD NOT FOLLOWED BY AN = >>         <<RV.PV>>32936000
                   CIERR (VSDEFMISSEQUAL, STRING);             <<RV.PV>>32938000
                   RETURN;                                     <<RV.PV>>32940000
               END;                                            <<RV.PV>>32942000
               X := TOS;                                       <<RV.PV>>32944000
               TOS := ((LNGTH+2) & LSR (1)) + 4;               <<RV.PV>>32946000
               ASSEMBLE (SUBS 0); <<CUT BACK STACK STORAGE>>   <<RV.PV>>32948000
               CASE X OF                                       <<RV.PV>>32950000
               BEGIN                                           <<RV.PV>>32952000
                   ;  <<TAKEN CARE OF ABOVE>>                  <<RV.PV>>32954000
                   BEGIN <<MEMBERS>>                           <<RV.PV>>32956000
                       STOP := CYMEMBERS (PARM, VSDEF,         <<RV.PV>>32958000
                                          DISKTYPES, PARMSP);  <<RV.PV>>32960000
                   END;                                        <<RV.PV>>32962000
                   BEGIN <<CLASS>>                             <<RV.PV>>32964000
                       STOP := CYCLASS (PARM, VSDEF,           <<RV.PV>>32966000
                                        VCDEF, PARMSP);        <<RV.PV>>32968000
                       CLASS := TRUE;                          <<RV.PV>>32970000
                   END;                                        <<RV.PV>>32972000
               END;<<OF CASE ON KEYWORD>>                      <<RV.PV>>32974000
           END UNTIL STOP OR (PNUM:=PNUM+1) >= NUMPARMS;       <<RV.PV>>32976000
        IF NOT STOP THEN                                       <<RV.PV>>32978000
        BEGIN                                                  <<RV.PV>>32980000
            WHO (, , , ,BGROUP, BACCOUNT);                     <<RV.PV>>32982000
            TOS := 0;  TOS.(ENDLEVELF) := VSDEFLEVEL;          <<RV.PV>>32984000
            TOS := DIRECINSERT (S0, 0D, ACCOUNT, GROUP, VSDEF, <<38.PV>>32986000
                                VSDEF (GVSLINKAGEW));          <<RV.PV>>32988000
            IF <> THEN                                         <<RV.PV>>32990000
            BEGIN                                              <<RV.PV>>32992000
                IF S0 = 2 THEN SUDDENDEATH (505);              <<RV.PV>>32994000
                CYDIRERR' (*, %147000, ERRNUM);                <<RV.PV>>32996000
            END ELSE DDEL;                                     <<RV.PV>>32998000
            IF CLASS THEN                                      <<RV.PV>>33000000
            BEGIN                                              <<RV.PV>>33002000
                MOVE VCDEF (GVCPANAME) := ACCOUNT, (NAMESIZE); <<RV.PV>>33004000
                MOVE VCDEF (GVCPGNAME) := GROUP, (NAMESIZE);   <<RV.PV>>33006000
                MOVE VCDEF (GVCPVSNAME) :=                     <<RV.PV>>33008000
                     VSDEF (GVSNAME), (NAMESIZE);              <<RV.PV>>33010000
                TOS := DIRECINSERT (S0, 0D, ACCOUNT, GROUP,    <<38.PV>>33012000
                             VCDEF, VCDEF (GVCLINKAGEW));      <<RV.PV>>33014000
                IF <> THEN                                     <<RV.PV>>33016000
                BEGIN                                          <<RV.PV>>33018000
                    TOS := DIRECPURGE (S2, 0D, ACCOUNT,        <<38.PV>>33020000
                                       GROUP, VSDEF);          <<RV.PV>>33022000
                    IF <> THEN SUDDENDEATH (502);              <<RV.PV>>33024000
                    DDEL;                                      <<RV.PV>>33026000
                    IF S0 = 2 THEN SUDDENDEATH (503);          <<RV.PV>>33028000
                    CYDIRERR' (*, %147000, ERRNUM);            <<RV.PV>>33030000
                    DEL;                                       <<RV.PV>>33032000
                END ELSE ASSEMBLE (DDEL, DEL)                  <<RV.PV>>33034000
            END ELSE DEL;                                      <<RV.PV>>33036000
        END;                                                   <<RV.PV>>33038000
    END;<<OF CXNEWVSET>>                                       <<RV.PV>>33040000
INTEGER PROCEDURE CYALTVS (ELEMENT,LEVEL,PARMS,SIRS);          <<RV.PV>>33042000
    VALUE   LEVEL,PARMS,SIRS;                                  <<RV.PV>>33044000
    INTEGER ARRAY   ELEMENT;                                   <<RV.PV>>33046000
    INTEGER LEVEL,PARMS;                                       <<RV.PV>>33048000
    DOUBLE  SIRS;                                              <<RV.PV>>33050000
    OPTION PRIVILEGED, UNCALLABLE;                             <<04.RO>>33052000
    BEGIN                                                      <<RV.PV>>33054000
        LOGICAL                                                <<RV.PV>>33056000
            DADIRTY = DB+145;                                  <<38.PV>>33058000
        INTEGER                                                <<RV.PV>>33060000
            VSVOLCNT,                                          <<RV.PV>>33062000
            ALTVOLCNT,                                         <<RV.PV>>33064000
            VOLCNT,                                            <<RV.PV>>33066000
            JUNK := 1; <<REL DISP OF 1ST NEW MEMBER>>          <<RV.PV>>33068000
        INTEGER ARRAY                                          <<RV.PV>>33070000
            VSDEF (*);                                         <<RV.PV>>33072000
        BYTE ARRAY                                             <<RV.PV>>33074000
            BVSDEF (*) = VSDEF;                                <<RV.PV>>33076000
        DEFINE                                                 <<RV.PV>>33078000
            RESULT = ARRQ0 (PARMS-1) #;                        <<RV.PV>>33080000
        EQUATE                                                 <<RV.PV>>33082000
            GVSMEMBSZ = GVSINFO-GVSNAME+1,                     <<RV.PV>>33084000
            DIRDST = 20;                                       <<RV.PV>>33086000
                                                               <<RV.PV>>33088000
        CYALTVS := 5; <<SIR NOT RELEASED, STOP SCAN>>          <<RV.PV>>33090000
        PARMS := PARMS - DELTAQ;                               <<RV.PV>>33092000
        IF LEVEL <> VSDEFLEVEL THEN RETURN;                    <<RV.PV>>33094000
        IF ELEMENT (GVCLINKAGEW) >= 0 THEN                     <<RV.PV>>33096000
        BEGIN <<SET DEFINITION>>                               <<RV.PV>>33098000
            VSVOLCNT := ELEMENT (GVCINFO).(0:4);               <<RV.PV>>33100000
            ALTVOLCNT := ARRQ0 (X+PARMS).(0:4);                <<RV.PV>>33102000
            IF (VOLCNT := VSVOLCNT + ALTVOLCNT) > VMAX THEN    <<RV.PV>>33104000
            BEGIN                                              <<RV.PV>>33106000
                DDEL;                                          <<RV.PV>>33108000
                RESULT := ALTVSDVMAX;                          <<RV.PV>>33110000
                RETURN;                                        <<RV.PV>>33112000
            END;                                               <<RV.PV>>33114000
            EXCHANGEDB (0);                                    <<RV.PV>>33116000
            TOS := GVSDSIZE;                                   <<RV.PV>>33118000
            @VSDEF := @S0;                                     <<RV.PV>>33120000
            @BVSDEF := @VSDEF & LSL (1);                       <<RV.PV>>33122000
            ASSEMBLE (ADDS 0);                                 <<RV.PV>>33124000
            TOS := @VSDEF;     <<D>>                           <<RV.PV>>33126000
            TOS := DIRDST;     <<C>>                           <<RV.PV>>33128000
            TOS := @ELEMENT;   <<B>>                           <<RV.PV>>33130000
            TOS := GVSDSIZE;   <<A>>                           <<RV.PV>>33132000
            ASSEMBLE (MFDS); <<MOVE TO LOCAL STORE>>           <<RV.PV>>33134000
            DO BEGIN <<CHECK AND UPDATE SET DEFINITION ENTRY>> <<RV.PV>>33136000
                   VSVOLCNT := VSVOLCNT+1;                     <<RV.PV>>33138000
                   MOVE VSDEF (VSVOLCNT*GVSMEMBSZ) :=          <<RV.PV>>33140000
                        ARRQ0 (PARMS+(JUNK*GVSMEMBSZ)),        <<RV.PV>>33142000
                        (GVSMEMBSZ);                           <<RV.PV>>33144000
                   TOS := 1; <<START SCAN AT 1ST MEMBER ENTRY>><<RV.PV>>33146000
                   WHILE S0 < VSVOLCNT DO                      <<RV.PV>>33148000
                   BEGIN                                       <<RV.PV>>33150000
                       IF BVSDEF ((S0*GVSMEMBSZ)*2) =          <<RV.PV>>33152000
                          BVSDEF ((VSVOLCNT*GVSMEMBSZ)*2),     <<RV.PV>>33154000
                          (NAMESIZE*2) THEN                    <<RV.PV>>33156000
                       BEGIN <<DUPLICATE MEMBER DEFINITION>>   <<RV.PV>>33158000
                           DEL; <<SCAN CONTROL COUNTER>>       <<RV.PV>>33160000
                           RESULT := ALTVSDDUPMEMB;            <<RV.PV>>33162000
                           EXCHANGEDB (DIRDST);                <<RV.PV>>33164000
                           RETURN;                             <<RV.PV>>33166000
                       END;                                    <<RV.PV>>33168000
                       TOS := TOS+1; <<CHECK NEXT ONE>>        <<RV.PV>>33170000
                   END;                                        <<RV.PV>>33172000
                   DEL; <<SCAN CONTROL COUNTER>>               <<RV.PV>>33174000
                   JUNK := JUNK+1; <<NEXT NEW MEMBER>>         <<RV.PV>>33176000
               END UNTIL VSVOLCNT >= VOLCNT;                   <<RV.PV>>33178000
            TOS := VSDEF (GVSINFO).(8:8); <<OLD MASK>>         <<RV.PV>>33180000
            TOS := %100000;                                    <<RV.PV>>33182000
            S0 := S0 & ASR (ALTVOLCNT); <<MASK EXPANSION>>     <<RV.PV>>33184000
            DS1 := DS1 & DLSL (ALTVOLCNT); <<EXPAND MASK>>     <<RV.PV>>33186000
            DEL; <<MASK EXPANSION>>                            <<RV.PV>>33188000
            S0.(0:4) := VOLCNT; <<COMPLETE GVSINFO>>           <<RV.PV>>33190000
            VSDEF (GVSINFO) := TOS;                            <<RV.PV>>33192000
            TOS := DIRDST;    <<D>>                            <<RV.PV>>33194000
            TOS := @ELEMENT;  <<C>>                            <<RV.PV>>33196000
            TOS := @VSDEF;    <<B>>                            <<RV.PV>>33198000
            TOS := GVSDSIZE;  <<A>>                            <<RV.PV>>33200000
            ASSEMBLE (MTDS); <<UPDATE DDS>>                    <<RV.PV>>33202000
            EXCHANGEDB (DIRDST);                               <<RV.PV>>33204000
            DADIRTY := TRUE;                                   <<RV.PV>>33206000
        END ELSE RESULT := ALTVSDNOTAVSD;                      <<RV.PV>>33208000
    END;<<OF CYALTVS>>                                         <<RV.PV>>33210000
INTEGER PROCEDURE CYALTVC (ELEMENT,LEVEL,PARMS,SIRS);          <<RV.PV>>33212000
    VALUE   LEVEL,PARMS,SIRS;                                  <<RV.PV>>33214000
    INTEGER ARRAY   ELEMENT;                                   <<RV.PV>>33216000
    INTEGER LEVEL,PARMS;                                       <<RV.PV>>33218000
    DOUBLE  SIRS;                                              <<RV.PV>>33220000
    OPTION PRIVILEGED, UNCALLABLE;                             <<04.RO>>33222000
    BEGIN                                                      <<RV.PV>>33224000
        LOGICAL                                                <<RV.PV>>33226000
            DADIRTY = DB+145;                                  <<38.PV>>33228000
        INTEGER                                                <<RV.PV>>33230000
            VOLCNT;                                            <<RV.PV>>33232000
        DEFINE                                                 <<RV.PV>>33234000
            RESULT = ARRQ0 (PARMS-1) #;                        <<RV.PV>>33236000
                                                               <<RV.PV>>33238000
        CYALTVC := 5; <<SIR NOT RELEASED, STOP SCAN>>          <<RV.PV>>33240000
        PARMS := PARMS - DELTAQ;                               <<RV.PV>>33242000
        IF LEVEL <> VSDEFLEVEL THEN RETURN;                    <<RV.PV>>33244000
        IF ELEMENT (GVCLINKAGEW) < 0 THEN                      <<RV.PV>>33246000
        BEGIN <<CLASS DEFINITION>>                             <<RV.PV>>33248000
            TOS := ELEMENT (GVCINFO);                          <<RV.PV>>33250000
            TOS := ARRQ0 (X+PARMS);                            <<RV.PV>>33252000
            VOLCNT := S0.(0:4) + S1.(0:4);                     <<RV.PV>>33254000
            IF (LS0.(8:8) LAND LS1.(8:8)) <> 0 THEN            <<RV.PV>>33256000
            BEGIN                                              <<RV.PV>>33258000
                DDEL;                                          <<RV.PV>>33260000
                RESULT := ALTVCSDUPMEMB;                       <<RV.PV>>33262000
                RETURN;                                        <<RV.PV>>33264000
            END;                                               <<RV.PV>>33266000
            S0 := LS0.(8:8) LOR LS1.(8:8);                     <<RV.PV>>33268000
            S0.(0:4) := VOLCNT;                                <<RV.PV>>33270000
            ELEMENT (GVCINFO) := TOS;                          <<RV.PV>>33272000
            DEL;                                               <<RV.PV>>33274000
            DADIRTY := TRUE;                                   <<RV.PV>>33276000
        END ELSE RESULT := ALTVCSNOTAVCD;                      <<RV.PV>>33278000
    END;<<OF CYALTVC>>                                         <<RV.PV>>33280000
PROCEDURE CXALTVSET EXECUTORHEAD;                              <<RV.PV>>33282000
    OPTION PRIVILEGED, UNCALLABLE;                             <<RV.PV>>33284000
    BEGIN                                                      <<RV.PV>>33286000
        LOGICAL ARRAY                                          <<RV.PV>>33288000
            COMMARY (0:1+(GVSDSIZE-1)) = Q,                    <<RV.PV>>33290000
            RESULT (*) = COMMARY,                              <<RV.PV>>33292000
            DSPARMS (*) = RESULT (1),                          <<RV.PV>>33294000
            VCDEF (*) = DSPARMS,                               <<RV.PV>>33296000
            VSDEF' (*) = VCDEF,                                <<RV.PV>>33298000
            TARGET (*) = VCDEF,                                <<RV.PV>>33300000
            VSDEF (0:GVSDSIZE-1),                              <<RV.PV>>33302000
            ACCOUNT (0:NAMESIZE-1),                            <<RV.PV>>33304000
            GROUP (0:NAMESIZE-1),                              <<RV.PV>>33306000
            VSNAME (0:NAMESIZE-1);                             <<RV.PV>>33308000
        DOUBLE                                                 <<RV.PV>>33310000
            PARM;                                              <<RV.PV>>33312000
        BYTE POINTER                                           <<RV.PV>>33314000
            JUNKBP,                                            <<RV.PV>>33316000
            STRING = PARM;                                     <<RV.PV>>33318000
        DOUBLE POINTER                                         <<RV.PV>>33320000
            JUNKDP;                                            <<RV.PV>>33322000
        INTEGER                                                <<RV.PV>>33324000
            JUNK,                                              <<RV.PV>>33326000
            PNUM := 0,                                         <<RV.PV>>33328000
            PARM1 = STRING+1,                                  <<RV.PV>>33330000
            X1 := [8/";", 8/%15], <<; CR>>                     <<RV.PV>>33332000
            NUMPARMS;                                          <<RV.PV>>33334000
        LOGICAL                                                <<RV.PV>>33336000
            CLASS := FALSE,                                    <<RV.PV>>33338000
            STOP := FALSE;                                     <<RV.PV>>33340000
        DOUBLE ARRAY                                           <<RV.PV>>33342000
            PARMS (0:3);                                       <<RV.PV>>33344000
        EQUATE                                                 <<RV.PV>>33346000
            GVSMEMBSZ = GVSINFO-GVSNAME+1,                     <<RV.PV>>33348000
            CR = %15,                                          <<RV.PV>>33350000
            KEYDICTL = 35,                                     <<RV.PV>>33352000
        DISKTYPESL = 64;                                       <<03513>>33354000
        DEFINE                                                 <<RV.PV>>33356000
            LNGTH = PARM1.(0:8) #,                             <<RV.PV>>33358000
            SPEC  = PARM1.(10:1) #,                            <<RV.PV>>33360000
            DELNO = PARM1.(11:5) #;                            <<RV.PV>>33362000
        BYTE ARRAY                                             <<RV.PV>>33364000
            ALTVSET' (0:7),                                    <<RV.PV>>33366000
            BACCOUNT (*) = ACCOUNT,                            <<RV.PV>>33368000
            BGROUP (*) = GROUP,                                <<RV.PV>>33370000
            KEYDICT (0:KEYDICTL-1),                            <<RV.PV>>33372000
            DISKTYPES (0:DISKTYPESL-1),                        <<RV.PV>>33374000
            DELIMS (*) = X1;                                   <<RV.PV>>33376000
        INTEGER                                                <<RV.PV>>33378000
            ALTVSET = ALTVSET';                                <<RV.PV>>33380000
        INTEGER ARRAY                                          <<RV.PV>>33382000
            INITVSDEF (0:GVSINFO) = PB :=                      <<RV.PV>>33384000
                "        ",                                    <<RV.PV>>33386000
                0,0;                                           <<RV.PV>>33388000
        INTEGER ARRAY                                          <<RV.PV>>33390000
            INITVCDEF (0:GVCUNUSED-1) = PB :=                  <<RV.PV>>33392000
                "        ",                                    <<RV.PV>>33394000
                %100000,0,                                     <<RV.PV>>33396000
                "        ", "        ", "        ";            <<RV.PV>>33398000
        BYTE ARRAY                                             <<RV.PV>>33400000
            KEYDICTX (0:KEYDICTL-1) = PB :=                    <<RV.PV>>33402000
                13,11,"EXPANDCLASS",                           <<RV.PV>>33404000
                10,8,"ADDCLASS",                               <<RV.PV>>33406000
                11,9,"EXPANDSET",                              <<RV.PV>>33408000
                0;                                             <<RV.PV>>33410000
    COMMENT                                                    <<00263>>33412000
                                                               <<00263>>33414000
    PSEUDO SUBTYPES FOR THE DIFFERENT DISCS DEFINED            <<00263>>33416000
    BELOW WHERE DEVLOPED AS FOLLOWS:                           <<00263>>33418000
                                                               <<00263>>33420000
    [PSEUDO SUBTYPE] = ([ACTUAL TYPE] * 16) + [ACTUAL SUBTYPE] <<00263>>33422000
                                                               <<00263>>33424000
    ;                                                          <<00263>>33426000
                                                               <<00263>>33428000
        BYTE ARRAY                                             <<RV.PV>>33430000
            DISKTYPESX (0:DISKTYPESL-1) = PB :=                <<RV.PV>>33432000
                9,6,"HP7905",4,                                <<RV.PV>>33434000
                9,6,"HP7920",8,                                <<RV.PV>>33436000
                9,6,"HP7925",9,                                <<03.KM>>33438000
                9,6,"HP7906",10,                               <<00263>>33440000
                9,6,"HP7902",32,                               <<00263>>33442000
            9,6,"HP9895",32,                                   <<03513>>33444000
            9,6,"HP7933",56,                                            33446000
                0;                                             <<RV.PV>>33448000
                                                               <<RV.PV>>33450000
                                                               <<RV.PV>>33452000
        MOVE ALTVSET' := ("ALTVSET",0);                        <<RV.PV>>33454000
        MYCOMMAND (PARMSP, DELIMS, 4<<MAXPARMS>>,              <<RV.PV>>33456000
                             NUMPARMS, PARMS);                 <<RV.PV>>33458000
        IF > THEN                                              <<RV.PV>>33460000
        BEGIN <<TOO MANY PARAMETERS>>                          <<RV.PV>>33462000
            CIERR (VSDEFTOOMANY, PARMSP, 0, ALTVSET);          <<RV.PV>>33464000
            RETURN;                                            <<RV.PV>>33466000
        END;                                                   <<RV.PV>>33468000
        IF NUMPARMS < 2 THEN                                   <<RV.PV>>33470000
        BEGIN <<NOT ENOUGH PARAMETERS>>                        <<RV.PV>>33472000
            CIERR (VSDEFTOOFEW, PARMSP, 0, ALTVSET);           <<RV.PV>>33474000
            RETURN;                                            <<RV.PV>>33476000
        END;                                                   <<RV.PV>>33478000
        PARM := PARMS (PNUM);                                  <<RV.PV>>33480000
    << MOVE STRING TO VSNAME IS WHAT'S DONE HERE >>            <<03513>>33482000
        TOS := GET'PUT'NAME (PARMS, VSNAME,                    <<RV.PV>>33484000
                             ALTVSET, STRING);                 <<RV.PV>>33486000
        IF <> THEN                                             <<RV.PV>>33488000
        BEGIN <<ILLEGAL OR OMMITTED NAME>>                     <<RV.PV>>33490000
            DEL;                                               <<RV.PV>>33492000
            RETURN;                                            <<RV.PV>>33494000
        END;                                                   <<RV.PV>>33496000
        WHO (, , , , GROUP,ACCOUNT);                           <<RV.PV>>33498000
        PNUM := PNUM + 1;  <<START AFTER VS DEFINITION NAME>>  <<RV.PV>>33500000
    << INITIALIZE KEYDICTX AND DISKTYPESX FROM PB  >>          <<03513>>33502000
    << RELATIVE ARRAY TO DB RELATIVE ARRAY.        >>          <<03513>>33504000
        MOVE KEYDICT := KEYDICTX, (KEYDICTL);                  <<RV.PV>>33506000
        MOVE DISKTYPES := DISKTYPESX, (DISKTYPESL);            <<RV.PV>>33508000
    << THE FOLLOWING SECTION OF CODE PARSES THE PARMS >>       <<03513>>33510000
    << FOR "ADDCLASS", "EXPANDCLASS", AND "EXPANDSET".>>       <<03513>>33512000
        DO BEGIN                                               <<RV.PV>>33514000
               PARM := PARMS (PNUM); <<CURRENT PARAMETER>>     <<RV.PV>>33516000
            << CHANGE TO A WORD LENGTH  >>                     <<03513>>33518000
               TOS := (LNGTH+2) & LSR (1);                     <<RV.PV>>33520000
               PUSH (S);                                       <<RV.PV>>33522000
               @JUNKBP := TOS & LSL (1);                       <<RV.PV>>33524000
               ASSEMBLE (ADDS 0); <<ROOM FOR TEMP PARSE>>      <<RV.PV>>33526000
               X1 := [8/"=", 8/CR];                            <<RV.PV>>33528000
               MOVE JUNKBP := STRING, (LNGTH);                 <<RV.PV>>33530000
               JUNKBP (LNGTH) := CR;                           <<RV.PV>>33532000
               TOS := 4;                                       <<RV.PV>>33534000
               PUSH (S);                                       <<RV.PV>>33536000
               @JUNKDP := TOS;                                 <<RV.PV>>33538000
               ASSEMBLE (ADDS 0);                              <<RV.PV>>33540000
               MYCOMMAND (JUNKBP, DELIMS, 2<<MAXPARMS>>,       <<RV.PV>>33542000
                          JUNK, JUNKDP);                       <<RV.PV>>33544000
               IF > THEN                                       <<RV.PV>>33546000
               BEGIN <<TOO MANY PARAMETERS>>                   <<RV.PV>>33548000
                   CIERR (VSDEFTOOMANY, STRING, 0, ALTVSET);   <<RV.PV>>33550000
                   RETURN;                                     <<RV.PV>>33552000
               END;                                            <<RV.PV>>33554000
               IF JUNK < 2 THEN                                <<RV.PV>>33556000
               BEGIN <<NOT ENOUGH PARAMETERS>>                 <<RV.PV>>33558000
                   CIERR (VSDEFTOOFEW, STRING, 0, ALTVSET);    <<RV.PV>>33560000
                   RETURN;                                     <<RV.PV>>33562000
               END;                                            <<RV.PV>>33564000
               TOS := JUNKDP;                                  <<RV.PV>>33566000
               DEL;                                            <<RV.PV>>33568000
               @JUNKBP := TOS;                                 <<RV.PV>>33570000
               TOS := 0;  <<FOR RETURN FROM SEARCH>>           <<RV.PV>>33572000
               TOS := JUNKDP; <<1ST PAIR OF PARM WORDS>>       <<RV.PV>>33574000
               TOS := TOS & LSR (8); <<LENGTH OF PARAMETER>>   <<RV.PV>>33576000
               TOS := SEARCH (*, *, KEYDICT);                  <<RV.PV>>33578000
            << ENTRY NUMBER IS RETURNED TO TOS  >>             <<03513>>33580000
               IF S0 = 0 THEN                                  <<RV.PV>>33582000
               BEGIN <<ILLEGAL KEYWORD>>                       <<RV.PV>>33584000
                   DEL;                                        <<RV.PV>>33586000
                   CIERR (VSDEFILLEGALKEY, STRING);            <<RV.PV>>33588000
                   RETURN;                                     <<RV.PV>>33590000
               END;                                            <<RV.PV>>33592000
               TOS := JUNKDP;                                  <<RV.PV>>33594000
               DELB;                                           <<RV.PV>>33596000
               IF TOS.(11:5) <> 0 THEN                         <<RV.PV>>33598000
               BEGIN <<KEYWORD NOT FOLLOWED BY AN = >>         <<RV.PV>>33600000
                   CIERR (VSDEFMISSEQUAL, STRING);             <<RV.PV>>33602000
                   RETURN;                                     <<RV.PV>>33604000
               END;                                            <<RV.PV>>33606000
               X := TOS;                                       <<RV.PV>>33608000
            << X IS ENTRY VALUE FROM KEYDICT    >>             <<03513>>33610000
               TOS := ((LNGTH+2) & LSR (1)) + 4;               <<RV.PV>>33612000
               ASSEMBLE (SUBS 0); <<CUT BACK STACK STORAGE>>   <<RV.PV>>33614000
               CASE X OF  <<"KEYWORD">>                        <<RV.PV>>33616000
               BEGIN                                           <<RV.PV>>33618000
                   ;  <<TAKEN CARE OF ABOVE>>                  <<RV.PV>>33620000
                   BEGIN <<EXPANDCLASS>>                       <<RV.PV>>33622000
                       TOS := 0;  TOS.(ENDLEVELF) := VSDEFLEVEL;        33624000
                       IF (TOS := DIRECFIND (S0,0D,ACCOUNT,GROUP,       33626000
                                           VSNAME,VSDEF)) <> 0D THEN    33628000
                       BEGIN                                   <<RV.PV>>33630000
                           IF S0=2 AND GROUPLEVEL<=S1<=ACCOUNTLEVEL     33632000
                            THEN SUDDENDEATH (504);            <<RV.PV>>33634000
                           CYDIRERR' (*,%120000,ERRNUM);       <<RV.PV>>33636000
                           DEL; <<TYPE>>                       <<RV.PV>>33638000
                           STOP := TRUE;                       <<RV.PV>>33640000
                       END ELSE                                <<RV.PV>>33642000
                       IF INTEGER(VSDEF(GVSLINKAGEW)) >= 0 THEN<<01.RO>>33644000
                        BEGIN <<ITS A VOLUME SET DEF ENTRY>>   <<RV.PV>>33646000
                            VCDEF := 0;                        <<RV.PV>>33648000
                            MOVE VCDEF (1) := VCDEF, (GVCDSIZE-1);      33650000
                            MOVE VCDEF := INITVCDEF, (GVCUNUSED);       33652000
                            IF NOT STOP := CYCLASS' (PARM,VSDEF,VCDEF,  33654000
                                                     PARMSP) THEN       33656000
                            BEGIN                                       33658000
                                ASSEMBLE (CAB); <<STILL SET UP>>        33660000
                                TOS.(TOLEVELF) := VSDEFLEVEL;           33662000
                                RESULT := 0;                            33664000
                                TOS := DIRECSCAN (*,0D,ACCOUNT,GROUP,   33666000
                                           VCDEF,CYALTVC,DSPARMS);      33668000
                                IF <> THEN                              33670000
                                BEGIN                                   33672000
                                    IF S0=2 AND                         33674000
                                       GROUPLEVEL<=S1<=ACCOUNTLEVEL     33676000
                                     THEN SUDDENDEATH (505);            33678000
                                    CYDIRERR' (*,%120000,ERRNUM);       33680000
                                    DEL; <<TYPE>>                       33682000
                                    STOP := TRUE;                       33684000
                                END ELSE                                33686000
                                BEGIN                                   33688000
                                    DDEL; DEL;                          33690000
                                    IF STOP := (RESULT <> 0) THEN       33692000
                                     CIERR (RESULT,STRING);             33694000
                                END;                                    33696000
                            END; <<NOT STOP>>                           33698000
                        END ELSE                                        33700000
                        BEGIN <<NOT A SET DEFINITION>>                  33702000
                            STOP := FALSE;                              33704000
                            CIERR (ALTVSDNOTAVSD,PARMSP);               33706000
                        END;                                            33708000
                   END; <<EXPANDCLASS>>                                 33710000
                   BEGIN <<ADDCLASS>>                                   33712000
                       TOS := 0;  TOS.(ENDLEVELF) := VSDEFLEVEL;        33714000
                       IF (TOS := DIRECFIND (S0,0D,ACCOUNT,GROUP,       33716000
                                           VSNAME,VSDEF)) <> 0D THEN    33718000
                       BEGIN                                   <<RV.PV>>33720000
                           IF S0=2 AND GROUPLEVEL<=S1<=ACCOUNTLEVEL     33722000
                            THEN SUDDENDEATH (504);            <<RV.PV>>33724000
                           CYDIRERR' (*,%120000,ERRNUM);       <<RV.PV>>33726000
                           DEL; <<TYPE>>                       <<RV.PV>>33728000
                           STOP := TRUE;                       <<RV.PV>>33730000
                       END ELSE                                <<RV.PV>>33732000
                       IF INTEGER(VSDEF(GVSLINKAGEW)) >= 0 THEN<<01.RO>>33734000
                        BEGIN <<ITS A VOLUME SET DEFINITION>>           33736000
                            VCDEF := 0;                                 33738000
                            MOVE VCDEF (1) := VCDEF, (GVCDSIZE-1);      33740000
                            MOVE VCDEF := INITVCDEF, (GVCUNUSED);       33742000
                            IF NOT STOP := CYCLASS (PARM, VSDEF,        33744000
                                                    VCDEF, PARMSP) THEN 33746000
                            BEGIN                                       33748000
                                MOVE VCDEF (GVCPANAME) :=               33750000
                                     ACCOUNT , (NAMESIZE);              33752000
                                MOVE VCDEF (GVCPGNAME) :=               33754000
                                     GROUP, (NAMESIZE);                 33756000
                                MOVE VCDEF (GVCPVSNAME) :=              33758000
                                     VSDEF (GVSNAME), (NAMESIZE);       33760000
                                ASSEMBLE (CAB); <<STILL SET UP>>        33762000
                                TOS.(TOLEVELF) := VSDEFLEVEL;           33764000
                                TOS:=DIRECINSERT (*, 0D, ACCOUNT, GROUP,33766000
                                          VCDEF, VCDEF (GVCLINKAGEW));  33768000
                                IF <> THEN                              33770000
                                BEGIN                                   33772000
                                    IF S0 = 2 THEN SUDDENDEATH (505);   33774000
                                    CYDIRERR' (*, %147000, ERRNUM);     33776000
                                    DEL;                                33778000
                                END ELSE ASSEMBLE (DDEL, DEL);          33780000
                            END;  <<NOT STOP>>                          33782000
                        END ELSE                                        33784000
                        BEGIN <<NOT SET DEFINITION ENTRY>>              33786000
                            STOP := TRUE;                               33788000
                            CIERR (ALTVSDNOTAVSD,PARMSP);               33790000
                        END;                                            33792000
                   END; <<ADDCLASS>>                                    33794000
                   BEGIN <<EXPANDSET>>                                  33796000
                       TOS := VMAX;                                     33798000
                       DO BEGIN                                         33800000
                              MOVE VSDEF' (S0*(GVSMEMBSZ)) :=           33802000
                                   INITVSDEF, (GVSMEMBSZ);              33804000
                              TOS := TOS-1;                             33806000
                          END UNTIL <;                                  33808000
                       DEL; <<LOOP CONTROL>>                            33810000
                       IF NOT STOP := CYMEMBERS' (PARM,VSDEF',          33812000
                                       DISKTYPES,PARMSP) THEN           33814000
                       BEGIN                                            33816000
                           RESULT := 0;                                 33818000
                           TOS := 0;  TOS.(TOLEVELF) := VSDEFLEVEL;     33820000
                           TOS.(ENDLEVELF) := VSDEFLEVEL;               33822000
                           TOS := DIRECSCAN (S0,0D,ACCOUNT,GROUP,       33824000
                                             VSNAME,CYALTVS,DSPARMS);   33826000
                           IF <> THEN                                   33828000
                           BEGIN                               <<RV.PV>>33830000
                               IF S0 = 2 AND                   <<RV.PV>>33832000
                                  GROUPLEVEL<=S1<=ACCOUNTLEVEL <<RV.PV>>33834000
                                THEN SUDDENDEATH (505);        <<RV.PV>>33836000
                               CYDIRERR' (*,%120000,ERRNUM);   <<RV.PV>>33838000
                               DEL; <<TYPE>>                   <<RV.PV>>33840000
                               STOP := TRUE;                   <<RV.PV>>33842000
                           END ELSE                            <<RV.PV>>33844000
                           BEGIN                               <<RV.PV>>33846000
                               DDEL; DEL;                      <<RV.PV>>33848000
                               IF STOP := (RESULT <> 0) THEN   <<RV.PV>>33850000
                                CIERR (RESULT,STRING);         <<RV.PV>>33852000
                           END;                                <<RV.PV>>33854000
                       END; <<NOT STOP>>                       <<RV.PV>>33856000
                   END;  <<EXPANDSET>>                         <<RV.PV>>33858000
               END;<<OF CASE ON KEYWORD>>                      <<RV.PV>>33860000
           END UNTIL STOP OR (PNUM:=PNUM+1) >= NUMPARMS;       <<RV.PV>>33862000
    END;<<OF CXALTVSET>>                                       <<RV.PV>>33864000
                                                               <<RV.PV>>33866000
$CONTROL SEGMENT=CIORGMAN                                      <<U.RAO>>33868000
PROCEDURE CXNEWACCT EXECUTORHEAD;                                       33870000
   OPTION PRIVILEGED,UNCALLABLE;                                        33872000
BEGIN                                                                   33874000
   INTEGER           SAVESIR;                                           33876000
   EQUATE            DIRSIR            = 8;                             33878000
   LOGICAL ARRAY     VSCOMM (0:VSCOMMSZ-1);                    <<RV.PV>>33880000
   INTEGER ARRAY     GROUP (0:GSIZE-1),                        <<01.PV>>33882000
                     ACCOUNT (0:ASIZE-1),                      <<01.PV>>33884000
                     USER (0:USIZE-1); <<MUST FOLLOW ACCT>>    <<01.PV>>33886000
   DOUBLE ARRAY      DUSER (*)         = USER;                          33888000
   DOUBLE ARRAY      DGROUP1 (*)       = GROUP (1);                     33890000
   DOUBLE            INITIALGSEC       := [5/16,5/6,5/6,5/6,5/16,5/6]D; 33892000
   BYTE ARRAY        BHVSANAME (*)     = VSCOMM (VSHANAME),    <<RV.PV>>33894000
                     BHVSGNAME (*)     = VSCOMM (VSHGNAME),    <<RV.PV>>33896000
                     BHVSVNAME (*)     = VSCOMM (VSHVNAME);    <<RV.PV>>33898000
   EQUATE                                                      <<RV.PV>>33900000
       CONDMOUNT = 3,                                          <<RV.PV>>33902000
       CONDDISMOUNT = 3;                                       <<RV.PV>>33904000
   LOGICAL                                                     <<RV.PV>>33906000
       MOUNTED := FALSE,                                       <<00263>>33908000
       PVINFO,                                                 <<RV.PV>>33910000
       REQTYPE := CONDMOUNT;                                   <<RV.PV>>33912000
   DEFINE                                                      <<RV.PV>>33914000
       CLASSFLG = PVINFO.(0:1) #,                              <<RV.PV>>33916000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>33918000
       VMASK  = PVINFO.(8:8) #,                                <<RV.PV>>33920000
       VSSPECIFIED   = VSCOMM (VSMASK).(0:1) #,                <<RV.PV>>33922000
       SPANSPECIFIED = VSCOMM (VSMASK).(1:1) #,                <<RV.PV>>33924000
       NUMNAMES      = VSCOMM (VSMASK).(14:2) #;               <<RV.PV>>33926000
   SUBROUTINE RELRESOURCES;                                    <<RV.PV>>33928000
       BEGIN                                                   <<RV.PV>>33930000
           IF NOT MOUNTED THEN RETURN;                         <<00263>>33932000
           REQTYPE := CONDDISMOUNT;                            <<RV.PV>>33934000
           DISMOUNT (BHVSVNAME, BHVSGNAME, BHVSANAME, REQTYPE);<<RV.PV>>33936000
           IF <> THEN                                          <<RV.PV>>33938000
           BEGIN                                               <<RV.PV>>33940000
               <<REQTYPE CONTAINS ERROR CODE. MAP TO CIERR>>   <<RV.PV>>33942000
               CIERR (ERRNUM);                                 <<RV.PV>>33944000
           END;                                                <<RV.PV>>33946000
       END;<<OF RELRESOURCES>>                                 <<RV.PV>>33948000
                                                                        33950000
<< >>                                                                   33952000
IF CYORGCOMS' (ERRNUM,PARMNUM,PARMSP,ACCOUNTLEVEL,             <<RV.PV>>33954000
               ACCOUNT,VSCOMM) THEN                            <<RV.PV>>33956000
   BEGIN  <<PARM LIST PARSED OK>>                              <<U.RAO>>33958000
   SAVESIR := GETSIR (DIRSIR);                                          33960000
   TOS := 0; TOS.(ENDLEVELF) := ACCOUNTLEVEL;                  <<01.PV>>33962000
   TOS := DIRECINSERT (S0, 0D, ACCOUNT, ARRDB0, ARRDB0,        <<38.PV>>33964000
                       ACCOUNT (AGIPNTR));                     <<01.PV>>33966000
   IF <> THEN << ACCOUNT INSERT FAILED >>                      <<01096>>33968000
         BEGIN                                                 <<01096>>33970000
            RELSIR(DIRSIR,SAVESIR);                            <<01187>>33972000
            GO TO DOERR;                                       <<01096>>33974000
         END;                                                  <<01096>>33976000
   DDEL; DEL;                                                  <<01.PV>>33978000
   MOVE GROUP := "PUB ";                                                33980000
   GROUP (2) := "  ";                                                   33982000
   MOVE GROUP (3) := GROUP (2), (6);                                    33984000
   MOVE GROUP (GDFSCOUNT) := ACCOUNT (ADFSCOUNT), (12);        <<01.PV>>33986000
   DGROUP1 (GSEC/2) := INITIALGSEC;                            <<01.PV>>33988000
   GROUP (GCAP) := ACCOUNT (ACAP+1);                           <<01.PV>>33990000
   GROUP (GLINKAGE) := 0;                                      <<01.PV>>33992000
   GROUP (GHVSNAME) := "  ";                                   <<RV.PV>>33994000
   MOVE GROUP (GHVSNAME+1):=GROUP (GHVSNAME),((NAMESIZE*3)-1); <<RV.PV>>33996000
   GROUP (GSPARE) := GROUP (GMOUNTREFCNTR) :=                  <<RV.PV>>33998000
                     GROUP (GSAVEFIPNTR) := 0;                 <<RV.PV>>34000000
   TOS := 0; TOS.(ENDLEVELF) := GROUPLEVEL;                    <<01.PV>>34002000
   TOS := DIRECINSERT (S0, 0D, ACCOUNT, GROUP, ARRDB0,         <<38.PV>>34004000
                       GROUP (GFIPNTR));                       <<01.PV>>34006000
   IF <> THEN GOTO PURGEA;                                              34008000
   DDEL; DEL;                                                  <<01.PV>>34010000
   MOVE USER (UCAP) := ACCOUNT (ACAP),(4);                     <<01.PV>>34012000
   USER (UPASS) := "  ";                                       <<01.PV>>34014000
   MOVE USER(9) := USER(8), (7);                                        34016000
   DUSER (UHGROUP/2) := "PUB ";                                <<01.PV>>34018000
   USER (ULOGCOUNT) := 0;                                      <<01.PV>>34020000
   USER (UMAXJOB) := ACCOUNT (AMAXJOBW);                       <<01.PV>>34022000
   USER (USPARE) := 0;                                         <<01.PV>>34024000
   IF VSSPECIFIED THEN                                         <<RV.PV>>34026000
   BEGIN <<VS SPECIFIED>>                                      <<RV.PV>>34028000
       IF SPANSPECIFIED THEN                                   <<RV.PV>>34030000
       BEGIN <<SPAN SPECIFIED>>                                <<RV.PV>>34032000
           MOUNT (BHVSVNAME, BHVSGNAME, BHVSANAME,             <<RV.PV>>34034000
                  REQTYPE, 0<<GEN>>, PVINFO);                  <<RV.PV>>34036000
           IF < THEN                                           <<RV.PV>>34038000
           BEGIN                                               <<RV.PV>>34040000
               <<TRANSLATE ERROR IN REQTYPE TO CIERR>>         <<RV.PV>>34042000
               << Cierr cannot be called at this point   >>    <<01315>>34044000
               << because in batch we abort. We have to  >>    <<01315>>34046000
               << release the DIRSIR and purge the acct. >>    <<01315>>34048000
               ERRNUM := ALTGRPVSNOTMNTD;                      <<01315>>34050000
               GO TO PURGEA;                                   <<00263>>34052000
           END;                                                <<RV.PV>>34054000
           MOUNTED := TRUE;                                    <<00263>>34056000
       END <<WILL NEED TO DISMOUNT LATER>>                     <<RV.PV>>34058000
       ELSE                                                    <<RV.PV>>34060000
       BEGIN <<SPAN NOT OPTIONAL>>                             <<RV.PV>>34062000
           CIERR (-XXXACCTPRMNOTOPT);                          <<RV.PV>>34064000
       END;                                                    <<RV.PV>>34066000
   END;<<OF VSSPECIFIED>>                                      <<RV.PV>>34068000
   TOS := 0; TOS.(ENDLEVELF) := USERLEVEL;                     <<01.PV>>34070000
   TOS := DIRECINSERT (S0, 0D, ACCOUNT, USER, ARRDB0,          <<38.PV>>34072000
                       USER (UCAP));                           <<01.PV>>34074000
   IF <> THEN                                                           34076000
                                                                        34078000
PURGEA:                                                                 34080000
      BEGIN                                                             34082000
      << We have the DIRSIR and we are just about  >>          <<01187>>34084000
      << to call DIRECPURGE which aquires the FISIR>>          <<01187>>34086000
      << This would result in a lockout,since FISIR>>          <<01187>>34088000
      << has a lower logical rank than the DIRSIR. >>          <<01187>>34090000
      << In order to avoid this release the DIRSIR.>>          <<01187>>34092000
      RELSIR(DIRSIR,SAVESIR);                                  <<01187>>34094000
      TOS := 0; TOS.(ENDLEVELF) := ACCOUNTLEVEL;               <<01.PV>>34096000
      TOS := DIRECPURGE (S0, 0D, ACCOUNT, ARRDB0, ARRDB0);     <<38.PV>>34098000
      << If purge does not suceed, there are two   >>          <<01187>>34100000
      << reasons: (1)another process purged it from>>          <<01187>>34102000
      << under us, or (2) because entry is in use. >>          <<01187>>34104000
      << If (2) then bad news, time to die.        >>          <<01187>>34106000
      IF <> AND S0 <> 2 THEN SUDDENDEATH(502);                 <<01187>>34108000
      DDEL;  DEL;                                              <<01.PV>>34110000
      RELRESOURCES;                                            <<RV.PV>>34112000
DOERR:                                                                  34114000
      IF ERRNUM <> 0 THEN                                      <<01315>>34116000
         BEGIN                                                 <<01315>>34118000
            CIERR(ERRNUM);                                     <<01315>>34120000
            RETURN;                                            <<01315>>34122000
         END;                                                  <<01315>>34124000
      << DIRECTORY PROBLEM DEFINED BY S-2, S-1, S-0 >>                  34126000
      IF (S0 = 1) AND (S2 <> %20) THEN SUDDENDEATH(503);                34128000
      CYDIRERR'(*,%147000,ERRNUM);                             <<U.RAO>>34130000
      END                                                      <<U.RAO>>34132000
   ELSE                                                        <<U.RAO>>34134000
      BEGIN                                                    <<RV.PV>>34136000
          DDEL;                                                <<RV.PV>>34138000
          RELSIR (DIRSIR,SAVESIR);                             <<RV.PV>>34140000
          IF SPANSPECIFIED THEN                                <<RV.PV>>34142000
          BEGIN                                                <<RV.PV>>34144000
              TOS.(ENDLEVELF) := ACCOUNTLEVEL;                 <<RV.PV>>34146000
              TOS := DIRECINSERT (S0,0D,ACCOUNT,ARRDB0,ARRDB0, <<RV.PV>>34148000
                                  ACCOUNT (AGIPNTR),MVTABX);   <<RV.PV>>34150000
              IF <> THEN                                       <<RV.PV>>34152000
              BEGIN <<INSERT ERROR ON NON-SYSVS DIRECTORY>>    <<RV.PV>>34154000
                  CYDIRERR' (*,%167000,ERRNUM);                <<RV.PV>>34156000
                  DEL;                                         <<RV.PV>>34158000
                  CIERR (-XXXACCTSPANFAILD);                   <<RV.PV>>34160000
              END ELSE ASSEMBLE (DDEL,DEL);                    <<RV.PV>>34162000
              RELRESOURCES;                                    <<RV.PV>>34164000
          END <<OF SPANSPECIFIED>> ELSE DEL;                   <<RV.PV>>34166000
      END;                                                     <<RV.PV>>34168000
   END;                                                        <<RV.PV>>34170000
END;   <<CXNEWACCT>>                                           <<U.RAO>>34172000
PROCEDURE CXNEWGROUP EXECUTORHEAD;                                      34174000
   OPTION PRIVILEGED,UNCALLABLE;                                        34176000
BEGIN                                                                   34178000
   LOGICAL ARRAY     VSCOMM (0:VSCOMMSZ-1);                    <<RV.PV>>34180000
   INTEGER ARRAY     GROUP (0:GSIZE-1);                        <<01.PV>>34182000
   INTEGER ARRAY     ACCOUNT (0:ASIZE-1);                      <<01.PV>>34184000
   LOGICAL ARRAY     LGROUP (*)        = GROUP;                         34186000
   LOGICAL ARRAY     LACCOUNT (*)      = ACCOUNT;                       34188000
   BYTE ARRAY        BACCOUNT (*)      = ACCOUNT,              <<RV.PV>>34190000
                     BHVSANAME (*)     = VSCOMM (VSHANAME),    <<RV.PV>>34192000
                     BHVSGNAME (*)     = VSCOMM (VSHGNAME),    <<RV.PV>>34194000
                     BHVSVNAME (*)     = VSCOMM (VSHVNAME);    <<RV.PV>>34196000
   DOUBLE ARRAY      DGROUPX (*)       = GROUP (GDFSLIMIT),    <<01.PV>>34198000
                     DACCOUNTX (*)     = ACCOUNT (ADFSLIMIT);  <<01.PV>>34200000
   INTEGER ARRAY     CAP'DENIED(0:1);                          <<00879>>34202000
   EQUATE                                                      <<RV.PV>>34204000
       CONDMOUNT = 3,                                          <<RV.PV>>34206000
       CONDDISMOUNT = 3;                                       <<RV.PV>>34208000
   LOGICAL                                                     <<RV.PV>>34210000
       PVINFO,                                                 <<RV.PV>>34212000
       REQTYPE := CONDMOUNT;                                   <<RV.PV>>34214000
   DEFINE                                                      <<RV.PV>>34216000
       CLASSFLG = PVINFO.(0:1) #,                              <<RV.PV>>34218000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>34220000
       VMASK  = PVINFO.(8:8) #,                                <<RV.PV>>34222000
       VSSPECIFIED   = VSCOMM (VSMASK).(0:1) #,                <<RV.PV>>34224000
       SPANSPECIFIED = VSCOMM (VSMASK).(1:1) #,                <<RV.PV>>34226000
       NUMNAMES      = VSCOMM (VSMASK).(14:2) #;               <<RV.PV>>34228000
   SUBROUTINE RELRESOURCES;                                    <<RV.PV>>34230000
       BEGIN                                                   <<RV.PV>>34232000
           IF NOT SPANSPECIFIED THEN RETURN;                   <<RV.PV>>34234000
           REQTYPE := CONDDISMOUNT;                            <<RV.PV>>34236000
           DISMOUNT (BHVSVNAME, BHVSGNAME, BHVSANAME, REQTYPE);<<RV.PV>>34238000
           IF <> THEN                                          <<RV.PV>>34240000
           BEGIN                                               <<RV.PV>>34242000
               <<REQTYPE CONTAINS ERROR CODE. MAP TO CIERR>>   <<RV.PV>>34244000
               CIERR (ERRNUM);                                 <<RV.PV>>34246000
           END;                                                <<RV.PV>>34248000
       END;<<OF RELRESOURCES>>                                 <<RV.PV>>34250000
                                                                        34252000
<< >>                                                                   34254000
IF CYORGCOMS' (ERRNUM,PARMNUM,PARMSP,GROUPLEVEL,               <<RV.PV>>34256000
               GROUP,VSCOMM) THEN                              <<RV.PV>>34258000
   BEGIN                                                       <<U.RAO>>34260000
   <<THE FIRST MAJOR TASK IS TO VALIDATE ANY NEW FILE, CPU  >> <<U.RAO>>34262000
   <<OR CONNECT LIMITS TO VERIFY THAT THEY DO NOT EXCEED    >> <<U.RAO>>34264000
   <<THE ACCOUNT LIMITS.  TO DO THIS WE USE DIRECFIND TO GET>> <<U.RAO>>34266000
   <<THE CURRENT ACCOUNT VALUES.                            >> <<U.RAO>>34268000
   <<FIRST STEP IS TO SET UP FOR DIRECFIND OF ACCOUNT>>        <<U.RAO>>34270000
   << DO VOLUME THING >>                                                34272000
   WHO (, , , , , BACCOUNT);                                            34274000
   TOS := 0; TOS.(ENDLEVELF) := ACCOUNTLEVEL;                  <<01.PV>>34276000
   IF (DIRECFIND (S0, 0D, ACCOUNT, ARRDB0, ARRDB0,             <<38.PV>>34278000
                  ACCOUNT)) <> 0D THEN                         <<01.PV>>34280000
   SUDDENDEATH(504);                                                    34282000
   DEL;                                                        <<01.PV>>34284000
   <<NOW CHECK LIMITS>>                                        <<U.RAO>>34286000
   IF DACCOUNTX(4) < DGROUPX(4) THEN                          <<U.RAO>> 34288000
      BEGIN                                                    <<U.RAO>>34290000
      IF DGROUPX(4) <> %17777777777D THEN  <<WARN>>            <<U.RAO>>34292000
         CIERR(-ALTGRPCPULIMITS);                              <<U.RAO>>34294000
      DGROUPX(4) := DACCOUNTX(4);                              <<U.RAO>>34296000
      END;                                                     <<U.RAO>>34298000
   IF DACCOUNTX(2) < DGROUPX(2) THEN                          <<U.RAO>> 34300000
      BEGIN                                                    <<U.RAO>>34302000
      IF DGROUPX(2) <> %17777777777D THEN  <<WARN>>            <<U.RAO>>34304000
         CIERR(-ALTGRPCONNECTLM);                              <<U.RAO>>34306000
      DGROUPX(2) := DACCOUNTX(2);                              <<U.RAO>>34308000
      END;                                                     <<U.RAO>>34310000
   IF DACCOUNTX < DGROUPX THEN                                <<U.RAO>> 34312000
      BEGIN                                                    <<U.RAO>>34314000
      IF DGROUPX <> %17777777777D THEN <<WARN>>                <<U.RAO>>34316000
         CIERR(-ALTGRPFILELIMIT);                             <<U.RAO>> 34318000
      DGROUPX := DACCOUNTX;                                    <<U.RAO>>34320000
      END;                                                     <<U.RAO>>34322000
   IF (LGROUP(GCAP) LOR LACCOUNT(ACAP+1)) <> LACCOUNT(ACAP+1) THEN      34324000
      BEGIN  <<CAPABILITIES EXCEED ACCOUNTS>>                  <<U.RAO>>34326000
      CAP'DENIED := 0; << 1ST WORD OF CAPABILITIES >>          <<00879>>34328000
      CAP'DENIED(1) := LGROUP(GCAP) XOR                        <<00879>>34330000
                       (LGROUP(GCAP) LAND LACCOUNT(ACAP+1));   <<00879>>34332000
      CAP'ERR(-ALTGRPEXCAP,CAP'DENIED);                        <<00879>>34334000
      LGROUP(GCAP) := LGROUP(GCAP) LAND LACCOUNT(ACAP+1);      <<00879>>34336000
      END;                                                     <<U.RAO>>34338000
   IF VSSPECIFIED THEN                                         <<RV.PV>>34340000
   BEGIN <<VS SPECIFIED>>                                      <<RV.PV>>34342000
       MOVE GROUP (GHVSANAME):=VSCOMM (VSHANAME), (NAMESIZE*3);<<RV.PV>>34344000
       IF SPANSPECIFIED THEN                                   <<RV.PV>>34346000
       BEGIN <<SPAN SPECIFIED>>                                <<RV.PV>>34348000
           MOUNT (BHVSVNAME, BHVSGNAME, BHVSANAME,             <<RV.PV>>34350000
                  REQTYPE, 0<<GEN>>, PVINFO);                  <<RV.PV>>34352000
           IF < THEN                                           <<RV.PV>>34354000
           BEGIN                                               <<RV.PV>>34356000
               <<TRANSLATE ERROR IN REQTYPE TO CIERR>>         <<RV.PV>>34358000
               CIERR (ALTGRPVSNOTMNTD);                        <<RV.PV>>34360000
               RETURN;                                         <<RV.PV>>34362000
           END;                                                <<RV.PV>>34364000
       END;<<WILL NEED TO DISMOUNT LATER>>                     <<RV.PV>>34366000
       GROUP (GLINKAGE) := %100000;                            <<RV.PV>>34368000
   END;<<OF VSSPECIFIED>>                                      <<RV.PV>>34370000
   TOS := 0; TOS.(ENDLEVELF) := GROUPLEVEL;                    <<01.PV>>34372000
   TOS := DIRECINSERT (S0, 0D, ACCOUNT, GROUP, ARRDB0,         <<38.PV>>34374000
                       GROUP (GFIPNTR));                       <<01.PV>>34376000
   IF <> THEN                                                           34378000
      BEGIN                                                             34380000
      IF S0 = 2 THEN SUDDENDEATH(505);                                  34382000
      CYDIRERR'(*,%147000,ERRNUM);                             <<U.RAO>>34384000
      DEL;                                                     <<RV.PV>>34386000
      RELRESOURCES;                                            <<RV.PV>>34388000
      END ELSE                                                 <<RV.PV>>34390000
      BEGIN                                                    <<RV.PV>>34392000
          DDEL;                                                <<RV.PV>>34394000
          IF SPANSPECIFIED THEN                                <<RV.PV>>34396000
          BEGIN                                                <<RV.PV>>34398000
              GROUP (GLINKAGE) := 0;                           <<RV.PV>>34400000
              TOS := DIRECINSERT (S0,0D,ACCOUNT,GROUP,ARRDB0,  <<RV.PV>>34402000
                                  GROUP (GFIPNTR),MVTABX);     <<RV.PV>>34404000
              IF <> THEN                                       <<RV.PV>>34406000
              BEGIN <<INSERT ERROR ON NON-SYSVS DIRECTORY>>    <<RV.PV>>34408000
                  CYDIRERR' (*,%167000,ERRNUM);                <<RV.PV>>34410000
                  DEL;                                         <<RV.PV>>34412000
                  CIERR (-XXXGRPSPANFAILD)                     <<RV.PV>>34414000
              END ELSE ASSEMBLE (DDEL,DEL);                    <<RV.PV>>34416000
              RELRESOURCES;                                    <<RV.PV>>34418000
          END <<OF SPANSPECIFIED>> ELSE DEL;                   <<RV.PV>>34420000
      END;                                                     <<RV.PV>>34422000
   END;                                                        <<U.RAO>>34424000
END;   <<CXNEWGROUP>>                                          <<U.RAO>>34426000
PROCEDURE  CXNEWUSER EXECUTORHEAD;                                      34428000
   OPTION PRIVILEGED,UNCALLABLE;                                        34430000
BEGIN                                                                   34432000
   INTEGER ARRAY     ACCOUNT (0:ASIZE-1),                      <<01.PV>>34434000
                     USER (0:USIZE-1);                         <<01.PV>>34436000
   LOGICAL ARRAY     LUSERX (*)        = USER (UCAP),          <<01.PV>>34438000
                     LACCOUNTX (*)     = ACCOUNT (ACAP);       <<01.PV>>34440000
   BYTE ARRAY        BACCOUNT (*)      = ACCOUNT;                       34442000
   INTEGER ARRAY     CAP'DENIED(0:1);                          <<00879>>34444000
                                                                        34446000
<< >>                                                                   34448000
IF CYORGCOMS'(ERRNUM,PARMNUM,PARMSP,USERLEVEL,USER) THEN       <<U.RAO>>34450000
   BEGIN  <<PARAMETER LIST PARSED OK>>                         <<U.RAO>>34452000
   <<BEFORE INSERTION OF A NEW USER, CHECK THE REQUESTED>>     <<U.RAO>>34454000
   <<USER BOUNDS AGAINST THE ACCOUNT BOUNDS>>                  <<U.RAO>>34456000
   WHO (, , , , , BACCOUNT);                                            34458000
   TOS := 0; TOS.(ENDLEVELF) := ACCOUNTLEVEL;                  <<01.PV>>34460000
   IF DIRECFIND (S0, 0D, ACCOUNT, ARRDB0, ARRDB0, ACCOUNT)     <<38.PV>>34462000
                 <> 0D THEN                                    <<01.PV>>34464000
    SUDDENDEATH(504);                                                   34466000
   DEL;                                                        <<01.PV>>34468000
   <<CHECK USER CAPABILITIES AGAINST ACCOUNT CAPABILITIES>>    <<U.RAO>>34470000
   IF ((LUSERX LOR LACCOUNTX) <> LACCOUNTX) OR                 <<U.RAO>>34472000
      ((LUSERX(1) LOR LACCOUNTX(1)) <> LACCOUNTX(1)) THEN      <<U.RAO>>34474000
         BEGIN  <<FORCE TO ACCOUNT CAPS>>                      <<U.RAO>>34476000
         CAP'DENIED := LUSERX XOR (LUSERX LAND LACCOUNTX);     <<00879>>34478000
         CAP'DENIED(1) := LUSERX(1) XOR                        <<00879>>34480000
                          (LUSERX(1) LAND LACCOUNTX(1));       <<00879>>34482000
         CAP'ERR(-ALTUSERCAPS,CAP'DENIED);                     <<00879>>34484000
         LUSERX := LUSERX LAND LACCOUNTX; << INTERSECTION >>   <<00879>>34486000
         LUSERX(1) := LUSERX(1) LAND LACCOUNTX(1);             <<00879>>34488000
         END;                                                  <<U.RAO>>34490000
   <<CHECK LOCAL ATTRIBUTES>>                                  <<U.RAO>>34492000
   IF ((LUSERX(2) LOR LACCOUNTX(2)) <> LACCOUNTX(2)) OR        <<U.RAO>>34494000
      ((LUSERX(3) LOR LACCOUNTX(3)) <> LACCOUNTX(3)) THEN      <<U.RAO>>34496000
         BEGIN   <<LOCAL ATTRIBUTES DON'T MATCH>>              <<U.RAO>>34498000
         CIERR(-ALTUSERLATTR);                                 <<U.RAO>>34500000
         LUSERX(2) := LACCOUNTX(2) LAND LUSERX(2);             <<01316>>34502000
         LUSERX(3) := LACCOUNTX(3) LAND LUSERX(3);             <<01316>>34504000
         END;                                                  <<U.RAO>>34506000
   IF USER (UMAXJOB).(8:8) < ACCOUNT (AMAXJOBW).(8:8) THEN     <<01.PV>>34508000
      BEGIN                                                    <<U.RAO>>34510000
      CIERR(-ALTUMAXPRI);                                      <<U.RAO>>34512000
      USER(UMAXJOB).(8:8) := ACCOUNT(AMAXJOBW).(8:8);          <<U.RAO>>34514000
      END;                                                     <<U.RAO>>34516000
   TOS := 0; TOS.(ENDLEVELF) := USERLEVEL;                     <<01.PV>>34518000
   TOS := DIRECINSERT (S0, 0D, ACCOUNT, USER,                  <<38.PV>>34520000
                       ARRDB0, USER (UCAP));                   <<01.PV>>34522000
   IF <> THEN                                                           34524000
      CYDIRERR' (*, %147000, ERRNUM)                           <<U.RAO>>34526000
   ELSE DDEL;                                                  <<01.PV>>34528000
   DEL;                                                        <<01.PV>>34530000
   END;                                                        <<U.RAO>>34532000
END;   <<CXNEWUSER>>                                           <<U.RAO>>34534000
$CONTROL SEGMENT=CIALTORG                                      <<U.RAO>>34536000
   INTEGER PROCEDURE SYSLIST (ELEMENT, LEVEL, PARMS, SIRS);             34538000
      VALUE LEVEL, PARMS, SIRS;                                         34540000
      ARRAY ELEMENT;                                                    34542000
      INTEGER LEVEL, PARMS;                                             34544000
      DOUBLE SIRS;                                                      34546000
   OPTION PRIVILEGED,UNCALLABLE;                                        34548000
BEGIN                                                                   34550000
   INTEGER ARRAY     PBUF (0:35)       = Q,                             34552000
                     TBUF (*)          = PBUF(28);                      34554000
   EQUATE FINFOSIZE=128;                                     <<01.02>>  34556000
   DEFINE P'GANAME=     ARRQ0(PARMS+4) #,                      <<03.KM>>34558000
          P'GNAME=      ARRQ0(PARMS+4) #,                      <<03.KM>>34560000
          P'ANAME=      ARRQ0(PARMS+8) #,                      <<03.KM>>34562000
          P'FILENUM=    ARRQ0(PARMS+18) #,                     <<04.KM>>34564000
          P'GLINKAGEW=  ARRQ0(PARMS+23) #,                     <<03.KM>>34566000
          P'GOTENTRY=   ARRQ0(PARMS+24) #,                     <<03.KM>>34568000
          P'IMPMNTDST=  ARRQ0(PARMS+25) #,                     <<03.KM>>34570000
          P'IMPMNTERR=  ARRQ0(PARMS+26) #,                     <<03.KM>>34572000
          P'IMPMNTNAME= ARRQ0(PARMS+27) #,                     <<03.KM>>34574000
          P'IMPMNTGRP=  ARRQ0(PARMS+27) #,                     <<03.KM>>34576000
          P'IMPNTACCT= ARRQ0(PARMS+31) #,                      <<04178>>34578000
          P'ACC'SAVE'COUNT = ARRQ0(PARMS+SAVEBUFFINDEX) #,     <<04178>>34580000
          P'ACC'SAVE = ARRQ0(PARMS+SAVEBUFFINDEX+1) #,         <<04178>>34582000
          P'GRP'SAVE'COUNT=ARRQ0(PARMS+SAVEBUFFINDEX+ASIZE+1)#,<<04178>>34584000
          P'GRP'SAVE = ARRQ0(PARMS+SAVEBUFFINDEX+ASIZE+2) #;   <<04178>>34586000
   DEFINE PVGROUP=    LOGICAL(P'GLINKAGEW.(PVF)) #,            <<03.KM>>34588000
          RELEASESIR=                                          <<03.KM>>34590000
            BEGIN                                              <<03.KM>>34592000
            TOS:=SIRS;                                         <<03.KM>>34594000
            IF <> THEN RELSIR(*,*) ELSE DDEL;                  <<03.KM>>34596000
            END #,                                             <<04178>>34598000
          EXIT'IF'BREAK =                                      <<04178>>34600000
             IF REQUESTSERVICE THEN                            <<04178>>34602000
                BEGIN                                          <<04178>>34604000
                   RTN := 4;                                   <<04178>>34606000
                   GO TO EXIT1;                                <<04178>>34608000
                END #;                                         <<04178>>34610000
   INTEGER PVINFO'ERROR;                                       <<10.KM>>34612000
  INTEGER RTN; <<RETURN VALUE>>                                <<03.MM>>34614000
   EQUATE NOMOUNT= 0;                                          <<03.KM>>34616000
   INTEGER POINTER PPRESULT;                                  <<00.GEN>>34618000
   INTEGER ARRAY DDS(*);                                     <<01.02>>  34620000
   INTEGER ARRAY ELEMENT'BUFF(*);                            <<01.02>>  34622000
   INTEGER DAXSIZE';                                         <<01.02>>  34624000
   INTEGER           REM,                                               34626000
                     CNT,                                               34628000
                     DAXSIZE           = DB+146;               <<38.PV>>34630000
   BYTE ARRAY        BPBUF (*)         = PBUF,                          34632000
                     BTBUF (*)         = TBUF;                          34634000
                                                                        34636000
                                                                        34638000
SUBROUTINE DEF'MOVEFROMDSEG;                                  <<00.GEN>>34640000
                                                              <<00.GEN>>34642000
                                                              <<00.GEN>>34644000
SUBROUTINE PRINTLINE (ELEM, LEN);                                       34646000
   VALUE LEN;                                                           34648000
   INTEGER ARRAY ELEM;                                                  34650000
   INTEGER LEN;                                                         34652000
BEGIN                                                                   34654000
   MOVE TBUF:=ELEM,(LEN);                                    <<01.02>>  34656000
   PBUF := "  ";                                                        34658000
   MOVE PBUF (1) := PBUF, (27);                                         34660000
   MOVE TBUF(LEN) := PBUF, (8-LEN);                                     34662000
   CNT := 0;                                                            34664000
   DO BEGIN                                                             34666000
      TOS := 0;                                                         34668000
      TOS := BTBUF (CNT & LSL(1));                                      34670000
      IF < THEN BTBUF(X) := ".";                                        34672000
      TOS := TOS & LSL(8);                                              34674000
      TOS := BTBUF (X +1);                                              34676000
      IF < THEN BTBUF (X) := ".";                                       34678000
      TOS := TOS LOR TOS;                                               34680000
      ASCII (*, 8, BPBUF (CNT *7));                                     34682000
      CNT := CNT +1;                                                    34684000
      END                                                               34686000
   UNTIL CNT = LEN;                                                     34688000
   FWRITE(P'FILENUM,PBUF,36,0);                                <<04.KM>>34690000
   IF <> THEN GO TO STOPEXIT;                                <<01.02>>  34692000
   END    <<PRINTLINE>>;                                                34694000
                                                                        34696000
                                                                        34698000
SUBROUTINE PRINTENTRY (ELEM, LEN);                                      34700000
   VALUE LEN;                                                           34702000
   INTEGER ARRAY ELEM;                                                  34704000
   INTEGER LEN;                                                         34706000
BEGIN                                                                   34708000
   REM := LEN;                                                          34710000
   WHILE REM > 8 DO                                                     34712000
      BEGIN                                                             34714000
      PRINTLINE (ELEM (LEN -REM), 8);                                   34716000
      REM := REM -8;                                                    34718000
      END;                                                              34720000
   IF REM > 0 THEN PRINTLINE (ELEM (LEN-REM), REM);                     34722000
   END    <<PRINTENTRY>>;                                               34724000
LOGICAL SUBROUTINE AT'NAME(LEVEL);                             <<03.MM>>34726000
  VALUE LEVEL;                                                 <<03.MM>>34728000
  INTEGER LEVEL;                                               <<03.MM>>34730000
BEGIN                                                          <<03.MM>>34732000
  COMMENT:                                                     <<03.MM>>34734000
    THIS SUBROUTINE RETURNS TRUE IF THE NAME AT LEVEL          <<03.MM>>34736000
    'LEVEL' USED FOR THE DIRECTORY SEARCH IS A '@',            <<03.MM>>34738000
    OTHERWISE IT RETURNS FALSE.                                <<03.MM>>34740000
    ;                                                          <<03.MM>>34742000
  AT'NAME:=FALSE;  <<IN CASE OF ERROR IN CALL>>                <<03.MM>>34744000
  CASE LEVEL OF                                                <<03.MM>>34746000
    BEGIN                                                      <<03.MM>>34748000
    <<0>> AT'NAME:=IF D'FNAME.(0:8) = "@" THEN TRUE ELSE FALSE;<<03.MM>>34750000
    <<1>> AT'NAME:=IF D'GNAME.(0:8) = "@" THEN TRUE ELSE FALSE;<<03.MM>>34752000
    <<2>> AT'NAME:=IF D'ANAME.(0:8) = "@" THEN TRUE ELSE FALSE;<<03.MM>>34754000
    <<3>> AT'NAME:=IF D'UNAME.(0:8) = "@" THEN TRUE ELSE FALSE;<<03.MM>>34756000
    <<4>> AT'NAME:=IF D'VNAME.(0:8) = "@" THEN TRUE ELSE FALSE;<<03.MM>>34758000
    END;                                                       <<03.MM>>34760000
END <<SUBROUTINE AT'NAME>>;                                    <<03.MM>>34762000
                                                               <<03.MM>>34764000
                                                               <<03.MM>>34766000
                                                                        34768000
   IF REQUESTSERVICE THEN                                               34770000
      BEGIN                                                             34772000
      RTN:=5;                                                  <<03.MM>>34774000
      GO TO EXIT;                                                       34776000
      END;                                                              34778000
   PARMS := PARMS -INTEGER(DELTAQ);                                     34780000
   DAXSIZE':=DAXSIZE;                                         <<00.GEN>>34782000
   EXCHANGEDB(0);       <<DB TO STACK>>                       <<00.GEN>>34784000
   TOS:=DAXSIZE';                                             <<00.GEN>>34786000
   @ELEMENT'BUFF:=@S0;                                        <<00.GEN>>34788000
   ASSEMBLE(ADDS 0);                                          <<00.GEN>>34790000
   MOVEFROMDSEG(@ELEMENT'BUFF,DDSDST,@ELEMENT,DAXSIZE');      <<00.GEN>>34792000
                                                              <<00.GEN>>34794000
   @PPRESULT:=@ARRQ0(PARMS+SYSL'PPRINX);                      <<00.GEN>>34796000
   IF LOGICAL(D'TYPE.(ALLFLAG)) THEN                          <<00.GEN>>34798000
   BEGIN                                                      <<00.GEN>>34800000
     CASE *LEVEL OF BEGIN                                     <<00.GEN>>34802000
       TOS:=DIRMATCH(G'FNAME,ELEMENT'BUFF);                   <<00.GEN>>34804000
       TOS:=DIRMATCH(G'GNAME,ELEMENT'BUFF);                   <<00.GEN>>34806000
       TOS:=DIRMATCH(G'ANAME,ELEMENT'BUFF);                   <<00.GEN>>34808000
       TOS:=DIRMATCH(G'UNAME,ELEMENT'BUFF);                   <<00.GEN>>34810000
       TOS:=DIRMATCH(G'VNAME,ELEMENT'BUFF);                   <<00.GEN>>34812000
     END;                                                     <<00.GEN>>34814000
     IF TOS<>0 THEN                                           <<00.GEN>>34816000
     BEGIN                                                    <<00.GEN>>34818000
       RTN:=IF < THEN NEXTUNCLE'SIR ELSE NEXTBROTHER'SIR;      <<03.MM>>34820000
       GO EXIT1;                                              <<00.GEN>>34822000
     END;                                                     <<00.GEN>>34824000
   END;                                                       <<00.GEN>>34826000
                                                              <<00.GEN>>34828000
   IF LEVEL = ARRQ0(PARMS+22).(TOLEVELF) THEN                  <<03.MM>>34830000
      BEGIN                                                    <<03.MM>>34832000
      P'GOTENTRY:=TRUE;                                        <<03.MM>>34834000
      RELEASESIR;                                              <<03.MM>>34836000
      RTN:=0;                                                  <<03.MM>>34838000
      TOS := FINFOSIZE;                                        <<04178>>34840000
      @DDS := @S0;                                             <<04178>>34842000
      ASSEMBLE(ADDS 0);                                        <<04178>>34844000
      IF P'ACC'SAVE'COUNT <> 0 THEN << dump account entry >>   <<04178>>34846000
         BEGIN                                                 <<04178>>34848000
            DDS := "A ";                                       <<04178>>34850000
            MOVE DDS(1) := " =  ";                             <<04178>>34852000
            MOVE DDS(3) := P'ANAME,(4);                        <<04178>>34854000
            EXIT'IF'BREAK;                                     <<04178>>34856000
            FWRITE(P'FILENUM,DDS,-14,0);                       <<04178>>34858000
            IF <> THEN GO TO STOPEXIT;                         <<04178>>34860000
            PRINTENTRY(P'ACC'SAVE,P'ACC'SAVE'COUNT);           <<04178>>34862000
            P'ACC'SAVE'COUNT := 0;                             <<04178>>34864000
         END;                                                  <<04178>>34866000
      IF P'GRP'SAVE'COUNT <> 0 THEN  << dump group entry >>    <<04178>>34868000
         BEGIN                                                 <<04178>>34870000
            DDS := "G ";                                       <<04178>>34872000
            MOVE DDS(1) := " =  ";                             <<04178>>34874000
            MOVE DDS(3) := P'GNAME,(4);                        <<04178>>34876000
            EXIT'IF'BREAK;                                     <<04178>>34878000
            FWRITE(P'FILENUM,DDS,-14,0);                       <<04178>>34880000
            IF <> THEN GO TO STOPEXIT;                         <<04178>>34882000
            PRINTENTRY(P'GRP'SAVE,P'GRP'SAVE'COUNT);           <<04178>>34884000
            P'GRP'SAVE'COUNT := 0;                             <<04178>>34886000
         END;                                                  <<04178>>34888000
      CASE LEVEL OF                                            <<04178>>34890000
         BEGIN                                                 <<04178>>34892000
            TOS := "F ";                                       <<04178>>34894000
            TOS := "G ";                                       <<04178>>34896000
            TOS := "A ";                                       <<04178>>34898000
            TOS := "U ";                                       <<04178>>34900000
            TOS := "VS";                                       <<04178>>34902000
         END;                                                  <<04178>>34904000
      DDS := TOS;                                              <<04178>>34906000
      MOVE DDS(1) := " =  ";                                   <<04178>>34908000
      MOVE DDS(3) := ELEMENT'BUFF,(4);                         <<04178>>34910000
      EXIT'IF'BREAK;                                           <<04178>>34912000
      FWRITE(P'FILENUM,DDS,-14,0);                             <<04178>>34914000
      IF <> THEN                                               <<04178>>34916000
STOPEXIT:                                                      <<04178>>34918000
         BEGIN                                                 <<04178>>34920000
            ARRQ0(PARMS + 1) := -1;                            <<04178>>34922000
            RTN := 4;                                          <<04178>>34924000
            GO TO EXIT1;                                       <<04178>>34926000
         END;                                                  <<04178>>34928000
      PRINTENTRY(ELEMENT'BUFF,DAXSIZE');                       <<04178>>34930000
      IF LEVEL = 0 THEN                                        <<04178>>34932000
         BEGIN                                                 <<04178>>34934000
            TOS := 0D;  << RETURUN FOR ATTACHIO >>             <<04178>>34936000
            TOS := LUN(ELEMENT'BUFF(4).(0:8),                  <<04178>>34938000
                       P'GLINKAGEW.(MVTABXF));                 <<04178>>34940000
            TOS := ATTACHIO(*,0,0,@DDS,0,FINFOSIZE,            <<04178>>34942000
                            ELEMENT'BUFF(4).(8:8),             <<04178>>34944000
                            ELEMENT'BUFF(5),1);                <<04178>>34946000
            ASSEMBLE(DEL);                                     <<04178>>34948000
            IF TOS.(13:3) <> 1 THEN                            <<04178>>34950000
               BEGIN                                           <<04178>>34952000
                  CIERR(-LISTFFLABIOERR);                      <<04178>>34954000
                  RTN := 0;                                    <<04178>>34956000
                  GO TO OKEXIT;                                <<04178>>34958000
               END;                                            <<04178>>34960000
            PRINTENTRY(DDS,FINFOSIZE);                         <<04178>>34962000
         END;                                                  <<04178>>34964000
      END                                                      <<03.MM>>34966000
   ELSE                                                        <<03.MM>>34968000
      BEGIN                                                    <<03.MM>>34970000
      IF LEVEL=ACCOUNTLEVEL THEN                               <<03.MM>>34972000
        BEGIN                                                  <<03.MM>>34974000
        MOVE P'ANAME:=ELEMENT'BUFF,(4);                        <<03.MM>>34976000
        IF AT'NAME(LEVEL) THEN                                 <<03.MM>>34978000
          BEGIN                                                <<03.MM>>34980000
          P'ACC'SAVE'COUNT := DAXSIZE';                        <<04178>>34982000
          MOVE P'ACC'SAVE := ELEMENT'BUFF,(DAXSIZE');          <<04178>>34984000
          RELEASESIR;                                          <<03.MM>>34986000
          RTN:=NEXTSON;                                        <<03.MM>>34988000
          END                                                  <<03.MM>>34990000
        ELSE RTN:=NEXTSON'SIR;                                 <<03.MM>>34992000
        END                                                    <<03.MM>>34994000
      ELSE IF ARRQ0(X).(TOLEVELF)<>FILELEVEL THEN              <<03.MM>>34996000
        BEGIN <<GROUP LEVEL>>                                  <<03.MM>>34998000
        MOVE P'GNAME:=ELEMENT'BUFF,(4);                        <<03.MM>>35000000
        IF AT'NAME(LEVEL) THEN                                 <<03.MM>>35002000
          BEGIN                                                <<03.MM>>35004000
          P'GRP'SAVE'COUNT := DAXSIZE';                        <<04178>>35006000
          MOVE P'GRP'SAVE := ELEMENT'BUFF,(DAXSIZE');          <<04178>>35008000
          RELEASESIR;                                          <<03.MM>>35010000
          RTN:=NEXTSON;                                        <<03.MM>>35012000
          END                                                  <<03.MM>>35014000
        ELSE RTN:=NEXTSON'SIR;                                 <<03.MM>>35016000
        END                                                    <<03.MM>>35018000
      ELSE                                                     <<04.KM>>35020000
        BEGIN <<GROUP LEVEL>>                                  <<04.KM>>35022000
        IF AT'NAME(LEVEL) THEN                                 <<04178>>35024000
           BEGIN                                               <<04178>>35026000
              P'GRP'SAVE'COUNT := DAXSIZE';                    <<04178>>35028000
              MOVE P'GRP'SAVE := ELEMENT'BUFF,(DAXSIZE');      <<04178>>35030000
           END;                                                <<04178>>35032000
        P'GLINKAGEW:=ELEMENT'BUFF(GLINKAGE);                   <<04.KM>>35034000
        MOVE P'GNAME:=ELEMENT'BUFF,(4);                        <<04.KM>>35036000
        RELEASESIR;                                            <<04.KM>>35038000
        IF NOT PVGROUP THEN RTN:=NEXTSON                       <<03.MM>>35040000
        ELSE IF IMPLICITMNT(P'GNAME,P'ANAME,P'IMPMNTDST,       <<04.KM>>35042000
                            PVINFO'ERROR) THEN                 <<10.KM>>35044000
          BEGIN                                                <<04.KM>>35046000
          P'GLINKAGEW.(MVTABXF):=PVINFO'ERROR.(PVMVTABXF);     <<10.KM>>35048000
          RTN:=REVISIT;                                        <<03.MM>>35050000
          END                                                  <<04.KM>>35052000
        ELSE IF PVINFO'ERROR=NOMOUNT THEN                      <<10.KM>>35054000
          BEGIN                                                <<04.KM>>35056000
          P'IMPMNTERR:=PVINFO'ERROR;                           <<10.KM>>35058000
          RTN:=REVISIT;                <<DDS USED BY "MOUNT">> <<03.MM>>35060000
          END                                                  <<04.KM>>35062000
        ELSE                                                   <<04.KM>>35064000
          BEGIN                                                <<04.KM>>35066000
          P'IMPMNTERR:=PVINFO'ERROR;                           <<10.KM>>35068000
          MOVE P'IMPMNTNAME:=P'GANAME,(8);                     <<04.KM>>35070000
          RTN:=ABORTSCAN;                                      <<03.MM>>35072000
          END;                                                 <<04.KM>>35074000
        END <<GROUP LEVEL>>;                                   <<04.KM>>35076000
      END;                                                     <<04.KM>>35080000
OKEXIT:                                                                 35084000
EXIT1:                                                       <<01.02>>  35086000
   EXCHANGEDB(DDSDST);                                       <<01.02>>  35088000
EXIT:                                                                   35090000
   SYSLIST:=RTN;                                               <<03.MM>>35092000
   END    <<SYSLIST>>;                                                  35094000
INTEGER PROCEDURE CYALTORG (ELEMENT, LEVEL, PARMS, SIRS);               35096000
   VALUE LEVEL, PARMS, SIRS;                                            35098000
   ARRAY ELEMENT;                                                       35100000
   INTEGER LEVEL, PARMS;                                                35102000
   DOUBLE SIRS;                                                         35104000
   OPTION PRIVILEGED,UNCALLABLE;                                        35106000
BEGIN                                                                   35108000
   LOGICAL           DADIRTY           = DB+145;               <<38.PV>>35110000
   INTEGER                                                     <<RV.PV>>35112000
       ALTNTRYX,                                               <<RV.PV>>35114000
       XX;                                                     <<RV.PV>>35116000
   EQUATE                                                      <<RV.PV>>35118000
       SPECMASKLN' = SPECMASKLN-1;                             <<RV.PV>>35120000
                                                                        35122000
                                                                        35124000
   PARMS := PARMS - DELTAQ;                                    <<RV.PV>>35126000
   ALTNTRYX := PARMS + SPECMASKLN;                             <<RV.PV>>35128000
   IF LEVEL < ACCOUNTLEVEL THEN                                <<RV.PV>>35130000
      IF ARRQ0 (PARMS).(11:2) = 3 THEN                         <<RV.PV>>35132000
         BEGIN    <<LIMIT SPECIFIED>>                                   35134000
         XX := 9;                                              <<RV.PV>>35136000
         GOTO CHECKC;                                                   35138000
         END;                                                           35140000
   IF = THEN                                                            35142000
      IF ARRQ0 (PARMS+1).(0:2) = 3 THEN                        <<RV.PV>>35144000
         BEGIN    <<NEW ACCT LIM SPECIFIED>>                            35146000
         XX := 14;                                             <<RV.PV>>35148000
CHECKC:  TOS := ELEMENT(XX);  TOS := ELEMENT(X:=X+1);          <<RV.PV>>35150000
         TOS := ARRQ0 (XX+2+ALTNTRYX);  TOS := ARRQ0 (X:=X+1); <<RV.PV>>35152000
         ASSEMBLE (DCMP);                                               35154000
         IF > THEN                                                      35156000
            BEGIN                                                       35158000
            ARRQ0 (PARMS-1) := 1;  <<SIGNAL LIM ERROR>>                 35160000
            CYALTORG := 5;                                              35162000
            RETURN;                                                     35164000
            END;                                                        35166000
         END;                                                           35168000
  <<MAX JOB PRI IS JUST A BYTE.  THE OTHER BYTE IN THE>>       <<02331>>35170000
  <<WORD IS USED FOR FLAGS.  TO AVOID DESTROYING THOSE>>       <<02331>>35172000
  <<FLAGS, WE OVERLAY LEFT BYTE OF THE NEW WORD WITH THE>>     <<02331>>35174000
  <<LEFT BYTE OF THE EXISTING WORD. NOTE THAT THIS ONLY >>     <<02331>>35176000
  <<WORKS WHILE THE DIRECTORY IS LOCKED.                >>     <<02331>>35178000
    IF LEVEL = ACCOUNTLEVEL OR LEVEL=USERLEVEL THEN            <<02331>>35180000
       CASE LEVEL OF                                           <<02331>>35182000
          BEGIN                                                <<02331>>35184000
          ; <<FILELEVEL = 0 >>                                 <<02331>>35186000
          ; <<GROUPLEVEL = 1 >>                                <<02331>>35188000
          ARRQ0(ALTNTRYX+AMAXJOBW) :=                          <<02331>>35190000
              LOGICAL(ARRQ0(ALTNTRYX+AMAXJOBW)).(8:8) LOR      <<02331>>35192000
              (ELEMENT(AMAXJOBW) LAND %177400);                <<02331>>35194000
          ARRQ0(ALTNTRYX+UMAXJOB) :=                           <<02331>>35196000
              LOGICAL(ARRQ0(ALTNTRYX+UMAXJOB)).(8:8) LOR       <<02331>>35198000
              (ELEMENT(UMAXJOB) LAND %177400);                 <<02331>>35200000
          ; <<VSDEFLEVEL = 4 >>                                <<02331>>35202000
          END;                                                 <<02331>>35204000
   TOS := SPECMASKLN';   <<SET UP LOOP LIMIT>>                 <<RV.PV>>35206000
   DO BEGIN <<ALL MASK WORDS>>                                 <<RV.PV>>35208000
          TOS := ARRQ0 (PARMS+(SPECMASKLN'-S0)); <<MASK WORD>> <<RV.PV>>35210000
          XX := (SPECMASKLN'-S1) & LSL (4); <<WORD OFFSET>>    <<RV.PV>>35212000
          ASSEMBLE (TEST);                                     <<RV.PV>>35214000
          DO BEGIN <<EACH MASK WORD>>                          <<RV.PV>>35216000
                 IF < THEN ELEMENT (XX) := ARRQ0 (XX+ALTNTRYX);<<RV.PV>>35218000
                 XX:=XX+1;  <<NEXT WORD>>                      <<RV.PV>>35220000
                 TOS := TOS & LSL (1);                         <<RV.PV>>35222000
             END UNTIL =;                                      <<RV.PV>>35224000
          DEL;  <<MASK WORD>>                                  <<RV.PV>>35226000
       END UNTIL (TOS:=TOS-1) < 0;                             <<RV.PV>>35228000
   DEL;  <<LOOP LIMIT>>                                        <<RV.PV>>35230000
   <<RETURN UPDATED ENTRY>>                                    <<RV.PV>>35232000
   CASE LEVEL OF                                               <<RV.PV>>35234000
   BEGIN                                                       <<RV.PV>>35236000
       ;                                                       <<RV.PV>>35238000
       XX := GSIZE-1;                                          <<RV.PV>>35240000
       XX := ASIZE-1;                                          <<RV.PV>>35242000
       XX := USIZE-1;                                          <<RV.PV>>35244000
   END;                                                        <<RV.PV>>35246000
   DO                                                          <<RV.PV>>35248000
    ARRQ0 (XX+ALTNTRYX) := ELEMENT (XX)                        <<RV.PV>>35250000
   UNTIL (XX:=XX-1) < 0;                                       <<RV.PV>>35252000
   DADIRTY.(15:1) := TRUE;                                     <<RV.PV>>35254000
   CYALTORG := 1;                                                       35256000
   END    <<CYALTORG>>;                                                 35258000
INTEGER PROCEDURE CYLOWERALT( ELEMENT, LEVEL, PARMS, SIRS );   <<01320>>35260000
   VALUE LEVEL, PARMS, SIRS;                                   <<01320>>35262000
   LOGICAL ARRAY ELEMENT;                                      <<01320>>35264000
   INTEGER LEVEL, PARMS;                                       <<01320>>35266000
   DOUBLE SIRS;                                                <<01320>>35268000
   OPTION PRIVILEGED, UNCALLABLE;                              <<01320>>35270000
BEGIN                                                          <<01320>>35272000
                                                               <<01320>>35274000
   << CHANGES HAVE BEEN MADE TO AN ACCOUNT'S CAPABILITIES  >>  <<01320>>35276000
   << AND/OR LOCAL ATTRIBUTES.  FOR THOSE CAPS/ATTRS THAT  >>  <<01320>>35278000
   << HAVE BEEN DELETED FROM ACCOUNT, REMOVE THEM FROM THE >>  <<01320>>35280000
   << GROUPS/USERS IN THAT ACCOUNT.                        >>  <<01320>>35282000
                                                               <<01320>>35284000
   LOGICAL                                                     <<01320>>35286000
      DOUSER,            << VISITING USER OR GROUP?        >>  <<01320>>35288000
      EXTRACAPS,         << TEMP STORAGE.                  >>  <<01450>>35290000
      DADIRTY = DB+145;  << FOR MARKING CHANGES TO ENTRY.  >>  <<01320>>35292000
                                                               <<01320>>35294000
   DEFINE                                                      <<01320>>35296000
      AM'SWITCHED'IA'BA  =  ARRQ0(PARMS+5) #,                  <<01450>>35298000
                                                               <<01320>>35300000
                                                               <<01320>>35302000
      GOT'IA'OR'BA  =  ARRQ0(PARMS+4) #;                       <<01450>>35304000
                                                               <<01450>>35306000
                                                               <<01450>>35308000
   PARMS := PARMS - DELTAQ;  << ARRANGE POINTERS TO PARMS  >>  <<01320>>35310000
   DOUSER := IF LEVEL = USERLEVEL THEN TRUE ELSE FALSE;        <<01320>>35312000
                                                               <<01320>>35314000
   IF DOUSER THEN                                              <<01320>>35316000
   BEGIN            << CHANGE ALL CAPS/ATTRS OF USER.      >>  <<01320>>35318000
      ELEMENT( UCAP ) := ELEMENT( UCAP )                       <<01320>>35320000
                         LAND LOGICAL( ARRQ0( PARMS ) );       <<01320>>35322000
      ELEMENT(UCAP+1) := ELEMENT(UCAP+1)                       <<01320>>35324000
                         LAND LOGICAL( ARRQ0(PARMS+1) );       <<01320>>35326000
      ELEMENT( ULATTR ) := ELEMENT( ULATTR )                   <<01320>>35328000
                           LAND LOGICAL( ARRQ0(PARMS+2) );     <<01320>>35330000
      ELEMENT(ULATTR+1) := ELEMENT(ULATTR+1)                   <<01320>>35332000
                           LAND LOGICAL( ARRQ0(PARMS+3) );     <<01320>>35334000
      IF ELEMENT(UCAP+1).(7:2) = 0 THEN  << NO IA OR BA.  >>   <<01450>>35336000
      BEGIN                                                    <<01450>>35338000
                                                               <<01450>>35340000
                                                               <<01450>>35342000
         IF ELEMENT(UCAP).(1:1) = 1 THEN << USER WAS AM.  >>   <<01450>>35344000
         BEGIN                                                 <<01450>>35346000
                                                               <<01450>>35348000
            EXTRACAPS := 0;                                    <<01450>>35350000
            EXTRACAPS.(7:2) := LOGICAL(ARRQ0(PARMS+1)).(7:2);  <<01450>>35352000
            ELEMENT(UCAP+1)                                    <<01450>>35354000
               := ELEMENT(UCAP+1) LOR EXTRACAPS;               <<01450>>35356000
                                                               <<01450>>35358000
            AM'SWITCHED'IA'BA := INTEGER( TRUE );              <<01450>>35360000
                                                               <<01450>>35362000
         END                                                   <<01450>>35364000
         ELSE   GOT'IA'OR'BA := INTEGER( FALSE );              <<01450>>35366000
                                                               <<01450>>35368000
                                                               <<01450>>35370000
      END;                                                     <<01450>>35372000
                                                               <<01450>>35374000
                                                               <<01450>>35376000
                                                               <<01320>>35378000
   END                                                         <<01450>>35380000
   ELSE   << CHANGE GROUP'S CAPABILITIES. >>                   <<01450>>35382000
   BEGIN                                                       <<01450>>35384000
      ELEMENT( GCAP ) := ELEMENT( GCAP )                       <<01450>>35386000
                         LAND LOGICAL( ARRQ0(PARMS+1) );       <<01450>>35388000
      IF ELEMENT( GCAP ).(7:2) = 0   << CHECK FOR USELESS >>   <<01450>>35390000
         THEN GOT'IA'OR'BA := INTEGER( FALSE ); << GROUPS >>   <<01450>>35392000
   END;                                                        <<01450>>35394000
                                                               <<01450>>35396000
   DADIRTY := TRUE;                                            <<01450>>35398000
   CYLOWERALT := 1;    << NO SIRS RELEASED, CONTINUE      >>   <<01450>>35400000
                                                               <<01450>>35402000
END;  << CYLOWERALT >>                                         <<01450>>35404000
                                                               <<01450>>35406000
                                                               <<01450>>35408000
PROCEDURE CXALTACCT EXECUTORHEAD;                                       35410000
   OPTION PRIVILEGED,UNCALLABLE;                                        35412000
BEGIN                                                                   35414000
                                                               <<01450>>35416000
   LOGICAL ARRAY     COMMARY (0:VSCOMMSZ+1+SPECMASKLN+(ASIZE-1)) = Q,   35418000
                     VSCOMM (*)        = COMMARY,              <<RV.PV>>35420000
                     RESULT (*)        = COMMARY (VSCOMMSZ'),  <<RV.PV>>35422000
                     DSPARMS (*)       = RESULT (1),           <<RV.PV>>35424000
                     ACCOUNT (*)       = DSPARMS (SPECMASKLN), <<RV.PV>>35426000
                     NTRY (0:GSIZE-1);                         <<RV.PV>>35428000
   BYTE ARRAY        BACCT (*)         = ACCOUNT,              <<RV.PV>>35430000
                     BHVSANAME (*)     = VSCOMM (VSHANAME),    <<RV.PV>>35432000
                     BHVSGNAME (*)     = VSCOMM (VSHGNAME),    <<RV.PV>>35434000
                     BHVSVNAME (*)     = VSCOMM (VSHVNAME);    <<RV.PV>>35436000
   EQUATE                                                      <<RV.PV>>35438000
       CONDMOUNT = 3,                                          <<RV.PV>>35440000
       CONDDISMOUNT = 3;                                       <<RV.PV>>35442000
   LOGICAL                                                     <<RV.PV>>35444000
       ALLL,                                                   <<01320>>35446000
       PVINFO,                                                 <<RV.PV>>35448000
       REQTYPE := CONDMOUNT;                                   <<RV.PV>>35450000
   DEFINE                                                      <<RV.PV>>35452000
       GOT'IA'OR'BA = CAPLAPARMS(4)  #,                        <<01320>>35454000
       AM'SWITCHED'IA'BA = CAPLAPARMS(5)  #,                   <<01450>>35456000
       CLASSFLG = PVINFO.(0:1) #,                              <<RV.PV>>35458000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>35460000
       VMASK  = PVINFO.(8:8) #,                                <<RV.PV>>35462000
       VSSPECIFIED   = VSCOMM (VSMASK).(0:1) #,                <<RV.PV>>35464000
       SPANSPECIFIED = VSCOMM (VSMASK).(1:1) #,                <<RV.PV>>35466000
       ALTSPECIFIED  = VSCOMM (VSMASK).(2:1) #,                <<00086>>35468000
       NUMNAMES      = VSCOMM (VSMASK).(14:2) #;               <<RV.PV>>35470000
                                                               <<01320>>35472000
   LOGICAL ARRAY                                               <<01320>>35474000
       CAPLAPARMS(0:4),                                        <<01320>>35476000
       ALL(*)   =   ALLL;                                      <<01320>>35478000
                                                               <<01320>>35480000
   SUBROUTINE RELRESOURCES;                                    <<RV.PV>>35482000
       BEGIN                                                   <<RV.PV>>35484000
           IF NOT (SPANSPECIFIED LOR ALTSPECIFIED) THEN RETURN;<<00086>>35486000
           REQTYPE := CONDDISMOUNT;                            <<RV.PV>>35488000
           DISMOUNT (BHVSVNAME, BHVSGNAME, BHVSANAME, REQTYPE);<<RV.PV>>35490000
           IF <> THEN                                          <<RV.PV>>35492000
           BEGIN                                               <<RV.PV>>35494000
               <<REQTYPE CONTAINS ERROR CODE. MAP TO CIERR>>   <<RV.PV>>35496000
               CIERR (ERRNUM);                                 <<RV.PV>>35498000
           END;                                                <<RV.PV>>35500000
       END;<<OF RELRESOURCES>>                                 <<RV.PV>>35502000
<< >>                                                                   35504000
RESULT := 0;                                                   <<RV.PV>>35506000
IF CYORGCOMS' (ERRNUM,PARMNUM,PARMSP,ACCOUNTLEVEL,ACCOUNT,     <<RV.PV>>35508000
               VSCOMM,DSPARMS) THEN                            <<RV.PV>>35510000
   BEGIN                                                       <<U.RAO>>35512000
   IF BACCT="SYS " AND DSPARMS.(ACAP:2)=3 AND                  <<U.RAO>>35514000
         NOT ACCOUNT(ACAP).(0:1) THEN                          <<07.RO>>35516000
      BEGIN <<ATTEMPT TO REMOVE SM CAP FROM SYS ACCOUNT>>      <<U.RAO>>35518000
      CIERR(-ALTACCTSMCAP);                                    <<U.RAO>>35520000
      ACCOUNT(ACAP).(0:1) := 1;  <<SM CAP>>                    <<U.RAO>>35522000
      END;                                                     <<U.RAO>>35524000
   IF VSSPECIFIED THEN                                         <<RV.PV>>35526000
       BEGIN                                                   <<00086>>35528000
       IF SPANSPECIFIED OR ALTSPECIFIED THEN                   <<00086>>35530000
       BEGIN <<SPAN SPECIFIED>>                                <<RV.PV>>35532000
           MOUNT (BHVSVNAME, BHVSGNAME, BHVSANAME,             <<RV.PV>>35534000
                  REQTYPE, 0<<GEN>>, PVINFO);                  <<RV.PV>>35536000
           IF < THEN                                           <<RV.PV>>35538000
           BEGIN                                               <<RV.PV>>35540000
               <<TRANSLATE ERROR IN REQTYPE TO CIERR>>         <<RV.PV>>35542000
               CIERR (ALTGRPVSNOTMNTD);                        <<RV.PV>>35544000
               RETURN;                                         <<RV.PV>>35546000
           END;                                                <<RV.PV>>35548000
       END <<WILL NEED TO DISMOUNT LATER>>                     <<RV.PV>>35550000
       ELSE                                                    <<RV.PV>>35552000
       BEGIN <<SPAN NOT OPTIONAL>>                             <<RV.PV>>35554000
           CIERR (-XXXACCTPRMNOTOPT);                          <<RV.PV>>35556000
       END;                                                    <<RV.PV>>35558000
   END;<<OF VSSPECIFIED>>                                      <<RV.PV>>35560000
   TOS := 0;                                                   <<U.RAO>>35562000
   TOS.(TOLEVELF) := ACCOUNTLEVEL;                             <<U.RAO>>35564000
   TOS.(ENDLEVELF) := ACCOUNTLEVEL;                            <<U.RAO>>35566000
   TOS := DIRECSCAN (S0,0D,ACCOUNT,ARRDB0,ARRDB0,CYALTORG,     <<00086>>35568000
             DSPARMS,IF ALTSPECIFIED THEN MVTABX ELSE 0);      <<00086>>35570000
   IF <> THEN                                                  <<RV.PV>>35572000
   BEGIN <<DIRECSCAN FAILED>>                                  <<RV.PV>>35574000
       CYDIRERR' (*,%120000,ERRNUM);                           <<RV.PV>>35576000
       DEL;                                                    <<RV.PV>>35578000
   END                                                         <<RV.PV>>35580000
   ELSE                                                        <<RV.PV>>35582000
   BEGIN                                                       <<RV.PV>>35584000
       DDEL;                                                   <<RV.PV>>35586000
       IF RESULT <> 0 THEN                                     <<RV.PV>>35588000
       BEGIN                                                   <<RV.PV>>35590000
           DEL;                                                <<RV.PV>>35592000
           CIERR (ERRNUM := FLIMIT'LT'USED);                   <<RV.PV>>35594000
       END                                                     <<RV.PV>>35596000
       ELSE                                                    <<RV.PV>>35598000
       BEGIN                                                   <<01320>>35600000
                                                               <<01320>>35602000
                                                               <<01320>>35604000
       IF DSPARMS.(6:4) <> 0   THEN                            <<01320>>35606000
       BEGIN   << CAPS OR LOCAL ATTRIBUTES HAVE CHANGED.  >>   <<01320>>35608000
               << "BUBBLE" CHANGES DOWN TO USER/GROUPS.   >>   <<01320>>35610000
          CAPLAPARMS      := ACCOUNT( ACAP );                  <<01320>>35612000
          CAPLAPARMS(1)   := ACCOUNT(ACAP+1);                  <<01320>>35614000
          CAPLAPARMS(2)   := ACCOUNT( ALATTR );                <<01320>>35616000
          CAPLAPARMS(3)   := ACCOUNT(ALATTR+1);                <<01320>>35618000
          GOT'IA'OR'BA    := TRUE;                             <<01320>>35620000
          AM'SWITCHED'IA'BA := FALSE;                          <<01450>>35622000
          ALL := "@ ";                                         <<01320>>35624000
          TOS := 0;                                            <<01320>>35626000
          TOS.(TOLEVELF  ) := USERLEVEL;                       <<01320>>35628000
          TOS.(ENDLEVELFX) := ALLUSERS;                        <<01320>>35630000
          TOS := DIRECSCAN( S0, 0D, ACCOUNT, ALL, ARRDB0,      <<01320>>35632000
                            CYLOWERALT, CAPLAPARMS,            <<01320>>35634000
                       IF ALTSPECIFIED THEN MVTABX ELSE 0 );   <<01320>>35636000
          IF <> THEN                                           <<01320>>35638000
          BEGIN                                                <<01320>>35640000
             CYDIRERR'( *, %120000, ERRNUM );                  <<01320>>35642000
             DEL;                                              <<01320>>35644000
             RELRESOURCES;                                     <<01320>>35646000
             RETURN;                                           <<01320>>35648000
          END;                                                 <<01320>>35650000
          IF AM'SWITCHED'IA'BA                                 <<01450>>35652000
            THEN CIERR( ERRNUM := -AM'SWITCHEDCAPS );          <<01450>>35654000
          IF NOT GOT'IA'OR'BA                                  <<01450>>35656000
             THEN CIERR( ERRNUM := -DIRUGOTNOIABA );           <<01320>>35658000
          DDEL;                                                <<01320>>35660000
          TOS.(TOLEVELF  ) := GROUPLEVEL;                      <<01320>>35662000
          TOS.(ENDLEVELFX) := ALLGROUPS;                       <<01320>>35664000
          GOT'IA'OR'BA := TRUE;                                <<01320>>35666000
          TOS := DIRECSCAN( S0, 0D, ACCOUNT, ALL, ARRDB0,      <<01320>>35668000
                            CYLOWERALT, CAPLAPARMS,            <<01320>>35670000
                       IF ALTSPECIFIED THEN MVTABX ELSE 0 );   <<01320>>35672000
          IF <> THEN                                           <<01320>>35674000
          BEGIN                                                <<01320>>35676000
             CYDIRERR'( *, %120000, ERRNUM );                  <<01320>>35678000
             DEL;                                              <<01320>>35680000
             RELRESOURCES;                                     <<01320>>35682000
             RETURN;                                           <<01320>>35684000
          END;                                                 <<01320>>35686000
          IF NOT GOT'IA'OR'BA                                  <<01320>>35688000
             THEN CIERR( ERRNUM := -DIRGGOTNOIABA );           <<01320>>35690000
          DDEL;   DEL;                                         <<01320>>35692000
                                                               <<01320>>35694000
       END;  << "BUBBLING" CHANGES DOWN.  >>                   <<01320>>35696000
                                                               <<01320>>35698000
        IF SPANSPECIFIED THEN                                  <<RV.PV>>35700000
        BEGIN                                                  <<RV.PV>>35702000
            ACCOUNT (ADFSCOUNT) := 0;  ACCOUNT (X:=X+1) := 0;  <<RV.PV>>35704000
            ACCOUNT (ACPUCOUNT) := 0;  ACCOUNT (X:=X+1) := 0;  <<RV.PV>>35706000
            ACCOUNT (ACONTIMECOUNT):=0; ACCOUNT (X:=X+1):=0;   <<RV.PV>>35708000
            TOS.(TOLEVELF) := 0;                               <<RV.PV>>35710000
            TOS := DIRECINSERT (S0,0D,ACCOUNT,ARRDB0,ARRDB0,   <<38.PV>>35712000
                                ACCOUNT (AGIPNTR),MVTABX);     <<RV.PV>>35714000
            IF <> THEN                                         <<RV.PV>>35716000
            BEGIN <<INSERT ERROR ON NON-SYSVS DIRECTORY>>      <<RV.PV>>35718000
                CYDIRERR' (*,%167000,ERRNUM);                  <<RV.PV>>35720000
                DEL;                                           <<RV.PV>>35722000
                CIERR (-XXXACCTSPANFAILD);                     <<RV.PV>>35724000
            END ELSE ASSEMBLE (DDEL,DEL);                      <<RV.PV>>35726000
        END <<OF SPANSPECIFIED>> ELSE DEL;                     <<RV.PV>>35728000
                                                               <<01320>>35730000
       END;   << RESULT = 0 CASE.  >>                          <<01320>>35732000
                                                               <<01320>>35734000
   END;                                                        <<RV.PV>>35736000
   RELRESOURCES;                                               <<00086>>35738000
   END;                                                        <<RV.PV>>35740000
END;   <<CXALTACCT>>                                           <<U.RAO>>35742000
PROCEDURE CXALTGROUP EXECUTORHEAD;                                      35744000
   OPTION PRIVILEGED,UNCALLABLE;                                        35746000
BEGIN                                                                   35748000
   LOGICAL ARRAY     COMMARY (0:VSCOMMSZ+1+SPECMASKLN+(GSIZE-1)) = Q,   35750000
                     VSCOMM (*)        = COMMARY,              <<RV.PV>>35752000
                     RESULT (*)        = COMMARY (VSCOMMSZ'),  <<RV.PV>>35754000
                     DSPARMS (*)       = RESULT (1),           <<RV.PV>>35756000
                     NTRY (0:GSIZE-1);                         <<RV.PV>>35758000
   INTEGER ARRAY     GROUP (*)         = DSPARMS (SPECMASKLN), <<RV.PV>>35760000
                     ACCOUNT (0:ASIZE-1);                      <<01.PV>>35762000
   BYTE ARRAY        BACCOUNT (*)      = ACCOUNT,              <<RV.PV>>35764000
                     BHVSANAME (*)     = VSCOMM (VSHANAME),    <<RV.PV>>35766000
                     BHVSGNAME (*)     = VSCOMM (VSHGNAME),    <<RV.PV>>35768000
                     BHVSVNAME (*)     = VSCOMM (VSHVNAME);    <<RV.PV>>35770000
   LOGICAL ARRAY     LGROUP (*)        = GROUP,                         35772000
                     LACCOUNT (*)      = ACCOUNT;                       35774000
   DOUBLE ARRAY      DACCOUNTX (*)     = ACCOUNT (ADFSLIMIT),  <<01.PV>>35776000
                     DGROUPX (*)       = GROUP (GDFSLIMIT),    <<RV.PV>>35778000
                     DGDFSCOUNT (*)    = NTRY (GDFSCOUNT);     <<RV.PV>>35780000
   LOGICAL           DSPARMS1          = DSPARMS +1;                    35782000
                                                               <<00879>>35784000
   INTEGER ARRAY     CAP'DENIED(0:1);                          <<00879>>35786000
   EQUATE                                                      <<RV.PV>>35788000
       CONDMOUNT = 3,                                          <<RV.PV>>35790000
       CONDDISMOUNT = 3;                                       <<RV.PV>>35792000
   LOGICAL                                                     <<RV.PV>>35794000
       GLINKAGE',                                              <<RV.PV>>35796000
       PVINFO,                                                 <<RV.PV>>35798000
       REQTYPE := CONDMOUNT;                                   <<RV.PV>>35800000
   DEFINE                                                      <<RV.PV>>35802000
       CLASSFLG = PVINFO.(0:1) #,                              <<RV.PV>>35804000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>35806000
       VMASK  = PVINFO.(8:8) #,                                <<RV.PV>>35808000
       VSSPECIFIED   = VSCOMM (VSMASK).(0:1) #,                <<RV.PV>>35810000
       SPANSPECIFIED = VSCOMM (VSMASK).(1:1) #,                <<RV.PV>>35812000
       ALTSPECIFIED  = VSCOMM (VSMASK).(2:1) #,                <<00086>>35814000
       NUMNAMES      = VSCOMM (VSMASK).(14:2) #;               <<RV.PV>>35816000
   SUBROUTINE RELRESOURCES;                                    <<RV.PV>>35818000
       BEGIN                                                   <<RV.PV>>35820000
           IF NOT (SPANSPECIFIED LOR ALTSPECIFIED) THEN RETURN;<<00086>>35822000
           REQTYPE := CONDDISMOUNT;                            <<RV.PV>>35824000
           DISMOUNT (BHVSVNAME, BHVSGNAME, BHVSANAME, REQTYPE);<<RV.PV>>35826000
           IF <> THEN                                          <<RV.PV>>35828000
           BEGIN                                               <<RV.PV>>35830000
               <<REQTYPE CONTAINS ERROR CODE. MAP TO CIERR>>   <<RV.PV>>35832000
               CIERR (ERRNUM);                                 <<RV.PV>>35834000
           END;                                                <<RV.PV>>35836000
       END;<<OF RELRESOURCES>>                                 <<RV.PV>>35838000
RESULT := 0;                                                   <<RV.PV>>35840000
IF CYORGCOMS'(ERRNUM,PARMNUM,PARMSP,GROUPLEVEL,GROUP,          <<U.RAO>>35842000
              VSCOMM,DSPARMS) THEN  <<LIST PARSED OK>>         <<RV.PV>>35844000
   BEGIN                                                       <<U.RAO>>35846000
   <<THE FIRST MAJOR TASK IS TO VALIDATE ANY NEW FILE, CPU  >> <<U.RAO>>35848000
   <<OR CONNECT LIMITS TO VERIFY THAT THEY DO NOT EXCEED    >> <<U.RAO>>35850000
   <<THE ACCOUNT LIMITS.  TO DO THIS WE USE DIRECFIND TO GET>> <<U.RAO>>35852000
   <<THE CURRENT ACCOUNT VALUES.  INCIDENTALLY, THE CURRENT >> <<U.RAO>>35854000
   <<ACTUAL FILE LIMITS ARE CHECKED IN CYALTORG, NOT HERE.  >> <<U.RAO>>35856000
   <<FIRST STEP IS TO SET UP FOR DIRECFIND OF ACCOUNT>>        <<U.RAO>>35858000
   WHO(,,,,,BACCOUNT);  <<LOGON ACCOUNT>>                      <<U.RAO>>35860000
   TOS := 0; TOS.(ENDLEVELF) := ACCOUNTLEVEL;                  <<U.RAO>>35862000
   IF DIRECFIND(S0,0D,ACCOUNT,ARRDB0,ARRDB0,ACCOUNT) <> 0D THEN<<38.PV>>35864000
      SUDDENDEATH(504);  <<DISCREPANCY BETWEEN WHO & DIRECFIND><<U.RAO>>35866000
   DEL;  <<POP LEVEL WORD>>                                    <<U.RAO>>35868000
   <<NOW CHECK LIMITS>>                                        <<U.RAO>>35870000
   IF DSPARMS1.(3:1) AND (DACCOUNTX(4)<DGROUPX(4)) THEN        <<U.RAO>>35872000
      BEGIN                                                    <<U.RAO>>35874000
      CIERR(-ALTGRPCPULIMITS);                                 <<U.RAO>>35876000
      DGROUPX(4) := DACCOUNTX(4);                              <<U.RAO>>35878000
      END;                                                     <<U.RAO>>35880000
   IF DSPARMS AND (DACCOUNTX(2)<DGROUPX(2)) THEN               <<U.RAO>>35882000
      BEGIN                                                    <<U.RAO>>35884000
      CIERR(-ALTGRPCONNECTLM);                                 <<U.RAO>>35886000
      DGROUPX(2) := DACCOUNTX(2);                              <<U.RAO>>35888000
      END;                                                     <<U.RAO>>35890000
   IF DSPARMS.(11:1) AND (DACCOUNTX<DGROUPX) THEN              <<U.RAO>>35892000
      BEGIN                                                    <<U.RAO>>35894000
      CIERR(-ALTGRPFILELIMIT);                                 <<U.RAO>>35896000
      DGROUPX := DACCOUNTX;                                    <<U.RAO>>35898000
      END;                                                     <<U.RAO>>35900000
   IF DSPARMS1.(7:1) AND                                       <<U.RAO>>35902000
         ((LGROUP(GCAP) LOR LACCOUNT(ACAP+1)) <> LACCOUNT(ACAP+1)) THEN 35904000
      BEGIN  <<CAPABILITIES EXCEED ACCOUNTS>>                  <<U.RAO>>35906000
      CAP'DENIED := 0; << 1ST WORD OF CAPABILITIES >>          <<00879>>35908000
      CAP'DENIED(1) := LGROUP(GCAP) XOR                        <<00879>>35910000
                       (LGROUP(GCAP) LAND LACCOUNT(ACAP+1));   <<00879>>35912000
      CAP'ERR(-ALTGRPEXCAP,CAP'DENIED);                        <<00879>>35914000
      LGROUP(GCAP) := LGROUP(GCAP) LAND LACCOUNT(ACAP+1);      <<U.RAO>>35916000
      END;                                                     <<U.RAO>>35918000
   IF VSSPECIFIED THEN                                         <<RV.PV>>35920000
   BEGIN <<VS SPECIFIED>>                                      <<RV.PV>>35922000
       IF SPANSPECIFIED OR ALTSPECIFIED THEN                   <<00086>>35924000
       BEGIN                                                   <<00086>>35926000
           MOUNT (BHVSVNAME, BHVSGNAME, BHVSANAME,             <<RV.PV>>35928000
                  REQTYPE, 0<<GEN>>, PVINFO);                  <<RV.PV>>35930000
           IF < THEN                                           <<RV.PV>>35932000
           BEGIN                                               <<RV.PV>>35934000
               <<TRANSLATE ERROR IN REQTYPE TO CIERR>>         <<RV.PV>>35936000
               CIERR(ERRNUM:=ALTGRPVSNOTMNTD);                 <<04533>>35938000
               RETURN;                                         <<RV.PV>>35940000
           END;                                                <<RV.PV>>35942000
       END;<<WILL NEED TO DISMOUNT LATER>>                     <<RV.PV>>35944000
       TOS := 0;  TOS.(ENDLEVELF) := GROUPLEVEL;               <<RV.PV>>35946000
       IF (TOS := DIRECFIND (S0,0D,ACCOUNT,GROUP,              <<38.PV>>35948000
                             ARRDB0,NTRY)) <> 0D THEN          <<RV.PV>>35950000
       BEGIN <<OBJECT GROUP NOT FOUND>>                        <<RV.PV>>35952000
           CYDIRERR' (*,%120000,ERRNUM);                       <<RV.PV>>35954000
           DEL;                                                <<RV.PV>>35956000
           RELRESOURCES;                                       <<RV.PV>>35958000
           RETURN;                                             <<RV.PV>>35960000
       END;                                                    <<RV.PV>>35962000
       GLINKAGE' := NUMNAMES <> 0  <<SETS OR RESETS PVF>>      <<00086>>35964000
                    LAND NOT ALTSPECIFIED;                     <<00086>>35966000
       IF NTRY (GLINKAGE).(PVF) = PV THEN                      <<RV.PV>>35968000
        IF NTRY (GMOUNTREFCNTR) > 0 THEN                       <<RV.PV>>35970000
        BEGIN <<CURRENTLY BOUND TO HVS>>                       <<RV.PV>>35972000
            <<CANNOT BE DONE WHILE BOUND TO HVS>>              <<RV.PV>>35974000
            CIERR(ERRNUM:=ALTGRPBOUND);                        <<04533>>35976000
            RELRESOURCES;                                      <<RV.PV>>35978000
            RETURN;                                            <<RV.PV>>35980000
        END                                                    <<RV.PV>>35982000
        ELSE                                                   <<RV.PV>>35984000
       ELSE                                                    <<RV.PV>>35986000
        IF GLINKAGE' THEN <<ASSINGING TO A NON-SYSVS>>         <<RV.PV>>35988000
         IF DGDFSCOUNT > 0D THEN                               <<RV.PV>>35990000
         BEGIN <<CANNOT ASSIGN WHILE FILE TREE NOT NULL>>      <<RV.PV>>35992000
             CIERR(ERRNUM:=ALTGRPFDOMAIN);                     <<04533>>35994000
             RELRESOURCES;                                     <<RV.PV>>35996000
             RETURN;                                           <<RV.PV>>35998000
         END;                                                  <<RV.PV>>36000000
       GROUP (GLINKAGE) := GLINKAGE' LAND %100000;             <<RV.PV>>36002000
       MOVE GROUP (GHVSANAME):=VSCOMM (VSHANAME), (NAMESIZE*3);<<RV.PV>>36004000
       TOS := GLINKAGE & LSR (4);                              <<RV.PV>>36006000
       TOS := DSPARMS (S0);                                    <<RV.PV>>36008000
       X := GLINKAGE LAND %17;                                 <<RV.PV>>36010000
       ASSEMBLE (TSBC 0,X); <<SET SPECMASK FOR GLINKAGE>>      <<RV.PV>>36012000
       ASSEMBLE (XCH,STAX);                                    <<RV.PV>>36014000
       DSPARMS (X) := TOS;                                     <<RV.PV>>36016000
   END;<<OF VSSPECIFIED>>                                      <<RV.PV>>36018000
   <<NOW ACTUALLY ATTEMPT MODIFICATION>>                       <<RV.PV>>36020000
   TOS := 0;                                                   <<U.RAO>>36022000
   TOS.(TOLEVELF) := GROUPLEVEL;                               <<U.RAO>>36024000
   TOS.(ENDLEVELF) := GROUPLEVEL;                              <<U.RAO>>36026000
   TOS := DIRECSCAN (S0,0D,ACCOUNT,GROUP,ARRDB0,CYALTORG,      <<00086>>36028000
             DSPARMS,IF ALTSPECIFIED THEN MVTABX ELSE 0);      <<00086>>36030000
   IF <> THEN                                                  <<U.RAO>>36032000
      BEGIN  <<DIRECTORY PROBLEM>>                             <<U.RAO>>36034000
      IF (DS1 = [16/2,16/2]D) AND (NOT ALTSPECIFIED) THEN      <<00855>>36036000
         SUDDENDEATH(505);  << NON-EXISTENT ACCOUNT >>         <<00855>>36038000
      CYDIRERR'(*,%120000,ERRNUM);                             <<U.RAO>>36040000
      DEL;                                                     <<RV.PV>>36042000
      END                                                      <<U.RAO>>36044000
   ELSE                                                        <<RV.PV>>36046000
   BEGIN                                                       <<RV.PV>>36048000
       DDEL; <<RETURN FROM DIRECSCAN>>                         <<RV.PV>>36050000
       IF RESULT <> 0 THEN                                     <<RV.PV>>36052000
       BEGIN                                                   <<RV.PV>>36054000
           DEL;                                                <<RV.PV>>36056000
           CIERR (ERRNUM := ALTGRPFILEACTUL);                  <<RV.PV>>36058000
       END                                                     <<RV.PV>>36060000
       ELSE                                                    <<RV.PV>>36062000
        IF SPANSPECIFIED THEN                                  <<RV.PV>>36064000
        BEGIN                                                  <<RV.PV>>36066000
            GROUP (GDFSCOUNT) := 0;  GROUP (X:=X+1) := 0;      <<RV.PV>>36068000
            GROUP (GCPUCOUNT) := 0;  GROUP (X:=X+1) := 0;      <<00086>>36070000
            GROUP (GCONTIMECOUNT) := 0; GROUP (X:=X+1) := 0;   <<RV.PV>>36072000
            GROUP (GLINKAGE) := 0;                             <<RV.PV>>36074000
            TOS.(TOLEVELF) := 0;                               <<RV.PV>>36076000
            TOS := DIRECINSERT (S0,0D,ACCOUNT,GROUP,ARRDB0,    <<38.PV>>36078000
                                GROUP (GFIPNTR),MVTABX);       <<RV.PV>>36080000
            IF <> THEN                                         <<RV.PV>>36082000
            BEGIN <<INSERT ERROR ON NON-SYSVS DIRECTORY>>      <<RV.PV>>36084000
                CYDIRERR' (*,%167000,ERRNUM);                  <<RV.PV>>36086000
                DEL;                                           <<RV.PV>>36088000
                CIERR (-XXXGRPSPANFAILD)                       <<RV.PV>>36090000
            END ELSE ASSEMBLE (DDEL,DEL);                      <<RV.PV>>36092000
        END <<OF SPANSPECIFIED>> ELSE DEL;                     <<RV.PV>>36094000
   END;                                                        <<RV.PV>>36096000
   RELRESOURCES;                                               <<00086>>36098000
   END;                                                        <<U.RAO>>36100000
END;  <<CXALTGROUP>>                                           <<U.RAO>>36102000
PROCEDURE CXALTUSER EXECUTORHEAD;                                       36104000
   OPTION PRIVILEGED,UNCALLABLE;                                        36106000
BEGIN                                                                   36108000
   LOGICAL ARRAY     DSPARMS (0:(USIZE-1)+SPECMASKLN) = Q;     <<RV.PV>>36110000
   INTEGER ARRAY     USER (*)          = DSPARMS (SPECMASKLN), <<RV.PV>>36112000
                     ACCOUNT (0:ASIZE-1);                      <<01.PV>>36114000
   BYTE ARRAY        BACCOUNT (*)      = ACCOUNT;                       36116000
   BYTE ARRAY        BUSER (*)         = USER,                          36118000
                     BME (0:7);                                         36120000
   DOUBLE            CAP;                                               36122000
   LOGICAL           LCAP              = CAP;                           36124000
   LOGICAL ARRAY     LUSERX (*)        = USER (UCAP),          <<01.PV>>36126000
                     LACCOUNTX (*)     = ACCOUNT (ACAP);       <<01.PV>>36128000
                                                               <<00879>>36130000
   INTEGER ARRAY     CAP'DENIED(0:1);                          <<00879>>36132000
                                                                        36134000
<< >>                                                                   36136000
IF CYORGCOMS' (ERRNUM,PARMNUM,PARMSP,USERLEVEL,USER,,DSPARMS) THEN      36138000
   BEGIN  <<PARAMETER LIST PARSED OK>>                         <<U.RAO>>36140000
   WHO ( , CAP, , BME, , BACCOUNT);                                     36142000
   IF DSPARMS.(4:2) <> 0 THEN                                  <<01319>>36144000
   BEGIN     << CHANGES TO THE USER'S CAPABILITIES.   >>       <<01319>>36146000
                                                               <<01319>>36148000
                                                               <<01319>>36150000
      IF ( BUSER = "MANAGER " LAND BACCOUNT = "SYS " ) AND     <<01319>>36152000
           LUSERX.(0:1) <> 1    THEN                           <<01319>>36154000
      BEGIN  << ATTEMPT TO REMOVE "SM" FROM MANAGER.SYS.   >>  <<01319>>36156000
         CIERR( ERRNUM := ALTUMGRSMCAP );                      <<01319>>36158000
         RETURN;                                               <<01319>>36160000
      END;                                                     <<01319>>36162000
                                                               <<01319>>36164000
      IF BME = BUSER,(8)  AND  LUSERX.(1:1) <> 1  THEN         <<01319>>36166000
      BEGIN  << ATTEMPT TO REMOVE "AM" FROM CALLER.        >>  <<01319>>36168000
         CIERR( ERRNUM := ALTUMGRAMCAP );                      <<01319>>36170000
         RETURN;                                               <<01319>>36172000
      END;                                                     <<01319>>36174000
                                                               <<01319>>36176000
   END;                                                        <<01319>>36178000
                                                               <<01319>>36180000
   TOS := 0; TOS.(ENDLEVELF) := ACCOUNTLEVEL;                  <<01.PV>>36182000
   IF DIRECFIND (S0, 0D, ACCOUNT, ARRDB0, ARRDB0,              <<38.PV>>36184000
                 ACCOUNT) <> 0D THEN                           <<01.PV>>36186000
   SUDDENDEATH(504);                                                    36188000
   DEL;                                                        <<01.PV>>36190000
   IF DSPARMS.(4:1) THEN  <<UCAP CHANGED, CHECK>>              <<U.RAO>>36192000
      BEGIN   <<AGAINST ACCOUNT CAP>>                          <<U.RAO>>36194000
      TOS := LUSERX LOR LACCOUNTX;                             <<U.RAO>>36196000
      TOS := LUSERX(1) LOR LACCOUNTX(1);                       <<U.RAO>>36198000
      TOS := LACCOUNTX;                                        <<U.RAO>>36200000
      TOS := LACCOUNTX(1);                                     <<U.RAO>>36202000
      ASSEMBLE(DCMP);  <<COMPARE 2 CAP MASKS>>                 <<U.RAO>>36204000
      IF <> THEN   <<USER GIVEN TOO HIGH CAP>>                 <<U.RAO>>36206000
         BEGIN  <<FORCE TO ACCOUNT CAPS>>                      <<U.RAO>>36208000
         CAP'DENIED := LUSERX XOR (LUSERX LAND LACCOUNTX);     <<00879>>36210000
         CAP'DENIED(1) := LUSERX(1) XOR                        <<00879>>36212000
                          (LUSERX(1) LAND LACCOUNTX(1));       <<00879>>36214000
         CAP'ERR(-ALTUSERCAPS,CAP'DENIED);                     <<00879>>36216000
         LUSERX := LACCOUNTX LAND LUSERX;  <<INTERSECTION>>    <<U.RAO>>36218000
         LUSERX(1) := LACCOUNTX(1) LAND LUSERX(1);             <<U.RAO>>36220000
         END                                                   <<U.RAO>>36222000
      END;   <<CHECK OF USER CAPABILITIES>>                    <<U.RAO>>36224000
   IF DSPARMS.(6:1) THEN <<USER LOC ATTR CHANGED, CHECK>>      <<U.RAO>>36226000
      BEGIN   <<AGAINST ACCOUNT LOC ATTRIBUTES>>               <<U.RAO>>36228000
      TOS := LUSERX(2) LOR LACCOUNTX(2);                       <<U.RAO>>36230000
      TOS := LUSERX(3) LOR LACCOUNTX(3);                       <<U.RAO>>36232000
      TOS := LACCOUNTX(2);                                     <<U.RAO>>36234000
      TOS := LACCOUNTX(3);                                     <<U.RAO>>36236000
      ASSEMBLE(DCMP);                                          <<U.RAO>>36238000
      IF <> THEN  <<USER LOC ATTR EXCEEDS ACCOUNT>>            <<U.RAO>>36240000
         BEGIN                                                 <<U.RAO>>36242000
         CIERR(-ALTUSERLATTR);                                 <<U.RAO>>36244000
         LUSERX(2) := LACCOUNTX(2) LAND LUSERX(2);             <<U.RAO>>36246000
         LUSERX(3) := LACCOUNTX(3) LAND LUSERX(3);             <<U.RAO>>36248000
         END                                                   <<U.RAO>>36250000
      END;                                                     <<U.RAO>>36252000
   IF DSPARMS(1).(1:1) THEN                                             36254000
      IF USER (UMAXJOB).(8:8) < ACCOUNT (AMAXJOBW).(8:8) THEN  <<01.PV>>36256000
         BEGIN                                                 <<U.RAO>>36258000
         CIERR(-ALTUMAXPRI);                                   <<U.RAO>>36260000
         USER(UMAXJOB).(8:8) := ACCOUNT(AMAXJOBW).(8:8);       <<U.RAO>>36262000
         END;                                                  <<U.RAO>>36264000
   TOS := 0;                                                   <<01.PV>>36266000
   TOS.(TOLEVELF) := USERLEVEL; TOS.(ENDLEVELF) := USERLEVEL;  <<01.PV>>36268000
   TOS := DIRECSCAN (S0, 0D, ACCOUNT, USER, ARRDB0,            <<38.PV>>36270000
                     CYALTORG, DSPARMS);                       <<01.PV>>36272000
   IF <> THEN                                                           36274000
      BEGIN                                                             36276000
      IF DS1 = [16/2, 16/2]D THEN SUDDENDEATH(505);                     36278000
      CYDIRERR'(*,%120000,ERRNUM);                             <<U.RAO>>36280000
      END ELSE DDEL;                                           <<01.PV>>36282000
   DEL;                                                        <<01.PV>>36284000
   END;                                                        <<U.RAO>>36286000
END;   <<CXALTUSER>>                                           <<U.RAO>>36288000
PROCEDURE CXLISTACCT EXECUTORHEAD;                             <<U.RAO>>36290000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>36292000
BEGIN                                                          <<U.RAO>>36294000
ENTRY CXLISTGROUP,                                             <<U.RAO>>36296000
      CXLISTUSER;                                              <<07.KM>>36298000
INTEGER DL := COMMACR;                                         <<U.RAO>>36300000
INTEGER NUMPARMS,                                              <<04.KM>>36302000
        FNUM;                                                  <<04.KM>>36304000
INTEGER TYPE := ACCOUNTLEVEL;                                  <<U.RAO>>36306000
INTEGER ARRAY SLPARMS(0:SYSL'PARMLEN-1);                      <<00.GEN>>36308000
INTEGER ARRAY PPRESULT(*)=SLPARMS(SYSL'PPRINX);               <<00.GEN>>36310000
DOUBLE ARRAY DPPRESULT(*)=PPRESULT;                           <<00.GEN>>36312000
DEFINE P'FILENUM=  SLPARMS(18) #,                              <<04.KM>>36314000
       P'GOTENTRY= SLPARMS(24) #;                              <<03.KM>>36316000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>36318000
BYTE POINTER LEAF = PARMS;                                     <<U.RAO>>36320000
BYTE LEAFNAMELEN = PARMS+1;                                    <<U.RAO>>36322000
INTEGER LEAFDATA = PARMS+1;                                    <<U.RAO>>36324000
BYTE POINTER LISTFILE = PARMS+2;                               <<U.RAO>>36326000
BYTE LISTFILELEN = PARMS+3;                                    <<U.RAO>>36328000
INTEGER LISTFILEDATA = PARMS+3;                                <<U.RAO>>36330000
BYTE POINTER EXTRAPARM = PARMS+4;                              <<U.RAO>>36332000
ARRAY DATEBUF(0:13);  <<FOR TIME STAMP IF REQUIRED>>           <<02.RO>>36334000
INTEGER DEV := 0;  <<DEVICE TYPE IF LISTFILE SPECIFIED>>       <<03.RO>>36336000
BYTE POINTER DELIM;                                           <<00.GEN>>36338000
                                                               <<U.RAO>>36340000
SUBROUTINE LISTFSERR;  <<HANDLES FILE SYSTEM ERRORS>>          <<U.RAO>>36342000
BEGIN                                                          <<U.RAO>>36344000
FERROR'(FNUM,PARMNUM);                                         <<00582>>36346000
CIERR(ERRNUM := LISTFFSERR,,%10000,PARMNUM);                   <<U.RAO>>36348000
FCLOSE(FNUM,0,0);                                              <<00582>>36350000
ASSEMBLE(EXIT 3);  <<BAIL OUT>>                                <<U.RAO>>36352000
END;                                                           <<U.RAO>>36354000
                                                               <<U.RAO>>36356000
   GOTO START;  <<NEWACCT ENTRY>>                              <<U.RAO>>36358000
                                                               <<U.RAO>>36360000
CXLISTGROUP:                                                   <<U.RAO>>36362000
   TYPE := GROUPLEVEL;                                         <<U.RAO>>36364000
   GOTO START;                                                 <<U.RAO>>36366000
                                                               <<U.RAO>>36368000
CXLISTUSER:                                                    <<U.RAO>>36370000
   TYPE := USERLEVEL;                                          <<U.RAO>>36372000
   GOTO START;                                                 <<U.RAO>>36374000
                                                               <<U.RAO>>36376000
CXLISTVSD:                                                     <<U.RAO>>36378000
   TYPE := VSDEFLEVEL;                                         <<U.RAO>>36380000
   GOTO START;                                                 <<U.RAO>>36382000
                                                               <<U.RAO>>36384000
START:                                                         <<U.RAO>>36386000
                                                               <<U.RAO>>36388000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>36390000
PARMNUM := 1;                                                  <<U.RAO>>36392000
IF NOT PRODUCEPARMS(TYPE,PARMSP,PPRESULT,DELIM,ERRNUM)        <<00.GEN>>36394000
   THEN RETURN;                                               <<00.GEN>>36396000
IF NUMPARMS > 0 THEN                                           <<U.RAO>>36398000
   BEGIN  <<CHECK OUT PARMS>>                                  <<U.RAO>>36400000
   IF @DELIM < INTEGER(LEAFNAMELEN)+@LEAF THEN                <<00.GEN>>36402000
      BEGIN  <<EXTRANEOUS STUFF IN LEAF NAME>>                 <<U.RAO>>36404000
      TOS := ERRNUM := LISTACCTEXTRAN;                         <<U.RAO>>36406000
      TOS := @DELIM;                                          <<00.GEN>>36408000
      CIERR(*,*);                                              <<U.RAO>>36410000
      RETURN;                                                  <<U.RAO>>36412000
      END;                                                     <<U.RAO>>36414000
   IF LEAFNAMELEN > 0 THEN  <<SOME NAME SPECIFIED>>            <<U.RAO>>36416000
      BEGIN  <<CHECK FOR SM CAPABILITY>>                       <<U.RAO>>36418000
      SETXPXGLOB;                                              <<U.RAO>>36420000
      IF NOT SMCAP THEN                                        <<U.RAO>>36422000
         IF CHECKHOMEACCT(PPRESULT) >= 3 THEN                  <<U.RAO>>36424000
            BEGIN                                              <<U.RAO>>36426000
            IF = THEN ERRNUM := LISTACCTNOTAT                  <<U.RAO>>36428000
                 ELSE ERRNUM := LISTACCTSMLOGON;               <<U.RAO>>36430000
            CIERR(ERRNUM, LEAF);                               <<U.RAO>>36432000
            RETURN                                             <<U.RAO>>36434000
            END;                                               <<U.RAO>>36436000
      END;                                                     <<U.RAO>>36438000
   IF NUMPARMS > 1 THEN  <<CHECK FOR LIST FILE>>               <<U.RAO>>36440000
      IF LISTFILELEN = 0 THEN                                  <<U.RAO>>36442000
         BEGIN                                                 <<U.RAO>>36444000
         PARMNUM := 2;                                         <<U.RAO>>36446000
         CIERR(ERRNUM := LISTACCTXPCTLST, LISTFILE);           <<U.RAO>>36448000
         RETURN                                                <<U.RAO>>36450000
         END;                                                  <<U.RAO>>36452000
   IF NUMPARMS > 2 THEN                                        <<U.RAO>>36454000
      BEGIN  <<TOO MANY PARAMETERS>>                           <<U.RAO>>36456000
      PARMNUM := 3;                                            <<U.RAO>>36458000
      CIERR(ERRNUM := LISTACCT2MP, EXTRAPARM);                 <<U.RAO>>36460000
      RETURN                                                   <<U.RAO>>36462000
      END;                                                     <<U.RAO>>36464000
   END;  <<PARSE OF PARAMETERS>>                               <<U.RAO>>36466000
IF TYPE = ACCOUNTLEVEL THEN  <<CHECK FOR PROPER DEFAULT>>      <<04.RO>>36468000
   BEGIN                                                       <<04.RO>>36470000
   SETXPXGLOB;                                                 <<04.RO>>36472000
   IF NOT SMCAP THEN  <<REDUCE DEFAULT TO LOGON ACCOUNT>>      <<04.RO>>36474000
      IF D'ANAME = "@ " THEN                                   <<04.RO>>36476000
         BEGIN  <<REPLACE WITH ACCOUNT NAME>>                  <<05.RO>>36478000
         WHO(,,,,,D'ANAME);                                    <<05.RO>>36480000
         WHO(,,,,,G'ANAME);                                    <<05.RO>>36482000
         END;                                                  <<05.RO>>36484000
   END;                                                        <<05.RO>>36486000
<<NOW OPEN LIST FILE>>                                         <<U.RAO>>36488000
IF NUMPARMS = 2 THEN  <<LISTFILE NAME PRESENT>>                <<U.RAO>>36490000
   BEGIN                                                       <<03.RO>>36492000
   FNUM := FOPEN(LISTFILE, %504, %102, 36);                    <<04.KM>>36494000
   IF CARRY THEN LISTFSERR;                                    <<03.RO>>36496000
   FGETINFO(FNUM,,,,,DEV);  <<GET DEVICE TYPE INFO>>           <<04.KM>>36498000
   IF CARRY THEN LISTFSERR;                                    <<03.RO>>36500000
   END                                                         <<03.RO>>36502000
ELSE                                                           <<U.RAO>>36504000
   FNUM := 2;  <<DEFAULT OF $STDLIST (BUT NO OPEN)>>           <<04.KM>>36506000
<<IF NOT INTERACTIVE OR USER SUPPLIED A LIST FILE, >>          <<02.RO>>36508000
<<TIME STAMP THE OUTPUT OF THE PROCEDURE>>                     <<02.RO>>36510000
INTERACTIVETEST;                                               <<02.RO>>36512000
IF NOT TOS  <<NOT INTERACTIVE>> AND NUMPARMS <> 2 OR           <<03.RO>>36514000
   NUMPARMS = 2 AND DEV.(8:8) >= 8 <<NOT DISC>> THEN           <<03.RO>>36516000
   BEGIN                                                       <<02.RO>>36518000
   DATE'LINE(DATEBUF);                                         <<02.RO>>36520000
   FWRITE(FNUM, DATEBUF, -27, %60);                            <<04.KM>>36522000
   END;                                                        <<02.RO>>36524000
                                                               <<02.RO>>36526000
SLPARMS(1) := 0;                                               <<U.RAO>>36528000
SLPARMS (22) := D'TYPE;                                       <<00.GEN>>36530000
SLPARMS (23) := 0;         <<GLINKAGE INITIALIZATION>>         <<RV.PV>>36532000
SLPARMS(SAVEBUFFINDEX) := 0;  << see syslist >>                <<04178>>36534000
SLPARMS(SAVEBUFFINDEX + ASIZE + 1) := 0;                       <<04178>>36536000
P'GOTENTRY:=FALSE;                                             <<03.KM>>36538000
P'FILENUM:=FNUM;                                               <<04.KM>>36540000
TOS := 0D;                                                     <<38.PV>>36542000
TOS := D'TYPE;                                                <<00.GEN>>36544000
TOS := D'INX1.(MVTABXF);               <<LINKAGE>>            <<05.GEN>>36546000
TOS := D'INX2;                         <<INDEXP>>             <<05.GEN>>36548000
TOS := DIRECSCAN (*,*,D'ANAME,D'GNAME,D'FNAME,                <<00.GEN>>36550000
                  SYSLIST,SLPARMS);                           <<00.GEN>>36552000
IF <> THEN                                                     <<U.RAO>>36554000
   BEGIN  <<DIRECTORY PROBLEM>>                                <<U.RAO>>36556000
   IF FNUM<>2 THEN  <<NOT $STDLIST, CLOSE FILE>>               <<04.KM>>36558000
      BEGIN                                                    <<U.RAO>>36560000
      FCLOSE(FNUM, 0, 0);                                      <<04.KM>>36562000
      IF CARRY THEN                                            <<U.RAO>>36564000
         LISTFSERR;                                            <<U.RAO>>36566000
      END;                                                     <<U.RAO>>36568000
   CYDIRERR'(*, %120000, ERRNUM);                              <<U.RAO>>36570000
   END                                                         <<U.RAO>>36572000
ELSE                                                           <<U.RAO>>36574000
   BEGIN  <<WENT FINE, LET'S GET OUT OF HERE>>                 <<U.RAO>>36576000
   IF SLPARMS(1)<0 THEN LISTFSERR;                             <<04.KM>>36578000
   IF NOT LOGICAL(P'GOTENTRY) THEN                             <<03.KM>>36580000
      BEGIN                                                    <<03.KM>>36582000
      CIERR(-NOXXXLISTED-TYPE);                                <<03.KM>>36584000
             <<XPARENT TO PROGRAMMATIC CALL FOR UPWARD COMPAT>><<03.KM>>36586000
      END;                                                     <<03.KM>>36588000
   IF FNUM<>2 THEN   <<NOT $STDLIST, CLOSE LIST FILE>>         <<04.KM>>36590000
      BEGIN                                                    <<U.RAO>>36592000
      FCLOSE(FNUM, 1, 0);                                      <<04.KM>>36594000
      IF CARRY THEN                                            <<U.RAO>>36596000
         LISTFSERR;                                            <<U.RAO>>36598000
      END;                                                     <<U.RAO>>36600000
   END                                                         <<U.RAO>>36602000
END;  <<CXLISTACCT/LISTUSER/LISTGROUP/LISTVSD>>                <<RV.PV>>36604000
$CONTROL SEGMENT=CIORGMAN                                      <<U.RAO>>36606000
                                                               <<00256>>36608000
                                                               <<00256>>36610000
PROCEDURE RELEASECOMRECS(LEVEL,BTARGET);                       <<00256>>36612000
VALUE LEVEL;                                                   <<00256>>36614000
INTEGER LEVEL;                                                 <<00256>>36616000
BYTE ARRAY BTARGET;                                            <<00256>>36618000
OPTION UNCALLABLE;                                             <<00256>>36620000
   BEGIN                                                       <<00256>>36622000
   COMMENT                                                     <<00256>>36624000
      THIS PROCEDURE RETURNS RECORDS IN COMMAND.PUB.SYS        <<00256>>36626000
      TO THE FREE LIST. IF LEVEL = USERLEVEL, THE RECORDS      <<00256>>36628000
      FOR THIS USER WILL BE RELEASED UNLESS HE IS TRYING       <<00256>>36630000
      TO PURGE HIMSELF. IF LEVEL = ACCTLEVEL, ALL ENTRIES      <<00256>>36632000
      FOR THIS ACCOUNT WILL BE RELEASED.                       <<00256>>36634000
      ;                                                        <<00256>>36636000
   EQUATE                                                      <<00256>>36638000
      COMRECSIZE   = 20,                                       <<00256>>36640000
      COMRECSIZEM1 = COMRECSIZE -1,                            <<00256>>36642000
      COMLINK      = 0,                                        <<00256>>36644000
      EOFFOUND     = 5;                                        <<00256>>36646000
   ARRAY REC(0:COMRECSIZEM1);                                  <<00256>>36648000
   BYTE ARRAY                                                  <<00256>>36650000
      BUSER(0:7),                                              <<00256>>36652000
      BACCT(0:7);                                              <<00256>>36654000
   LOGICAL                                                     <<00256>>36656000
      COMFILELOCKED,                                           <<00256>>36658000
      COMFILEOPEN,                                             <<00256>>36660000
      MOREENTRIES;                                             <<00256>>36662000
   INTEGER                                                     <<00256>>36664000
      COMFN,                                                   <<00256>>36666000
      ERRNO,                                                   <<00256>>36668000
      HEADREC := 0,                                            <<00884>>36670000
      ERR;                                                     <<00256>>36672000
                                                               <<00256>>36674000
   SUBROUTINE ERROR(ERRNO);                                    <<00256>>36676000
   VALUE ERRNO; INTEGER ERRNO;                                 <<00256>>36678000
      BEGIN                                                    <<00256>>36680000
      FCHECK(COMFN,ERR);                                       <<00256>>36682000
      GENMSG(FSERRORMSGSET,ERR);                               <<00256>>36684000
      GENMSG(CIERRMSGSET,ERRNO);                               <<00256>>36686000
      END;  << ERROR >>                                        <<00256>>36688000
                                                               <<00256>>36690000
   SUBROUTINE OPENCOMFILE;                                     <<00256>>36692000
      BEGIN                                                    <<00256>>36694000
      MOVE REC := "COMMAND.PUB.SYS ";                          <<00256>>36696000
      COMFN := FOPEN(REC,1,%346);  <<OLD,SHR,LOCK,EXEC>>       <<00256>>36698000
      IF <> THEN                                               <<00256>>36700000
         BEGIN                                                 <<00256>>36702000
         ERROR(COMOPENFAIL);                                   <<00256>>36704000
         GO OUTL;                                              <<00256>>36706000
         END                                                   <<00256>>36708000
      ELSE COMFILEOPEN:=TRUE;                                  <<00256>>36710000
      END;  << OPENCOMFILE >>                                  <<00256>>36712000
                                                               <<00256>>36714000
   SUBROUTINE CLOSECOMFILE;                                    <<00256>>36716000
      BEGIN                                                    <<00256>>36718000
      FCLOSE(COMFN,0,0);                                       <<00256>>36720000
      END;  << CLOSECOMFILE >>                                 <<00256>>36722000
                                                               <<00256>>36724000
   SUBROUTINE LOCKCOMFILE;                                     <<00256>>36726000
      BEGIN                                                    <<00256>>36728000
      FLOCK(COMFN,TRUE);  <<UNCONDITIONAL>>                    <<00256>>36730000
      IF <> THEN                                               <<00256>>36732000
         BEGIN                                                 <<00256>>36734000
         ERROR(COMLOCKFAIL);                                   <<00256>>36736000
         GO OUTL;                                              <<00256>>36738000
         END                                                   <<00256>>36740000
      ELSE COMFILELOCKED := TRUE;                              <<00256>>36742000
      END;  << LOCKCOMFILE >>                                  <<00256>>36744000
                                                               <<00256>>36746000
   SUBROUTINE UNLOCKCOMFILE;                                   <<00256>>36748000
      BEGIN                                                    <<00256>>36750000
      FUNLOCK(COMFN);                                          <<00256>>36752000
      IF <> THEN                                               <<00256>>36754000
         BEGIN                                                 <<00256>>36756000
         ERROR(COMUNLOCKFAIL);                                 <<00256>>36758000
         GO OUT;                                               <<00256>>36760000
         END;                                                  <<00256>>36762000
      END;  << UNLOCKCOMFILE >>                                <<00256>>36764000
                                                               <<00256>>36766000
   SUBROUTINE RELEASERECS;                                     <<00256>>36768000
      BEGIN                                                    <<00256>>36770000
      << THIS SUBROUTINE RETURNS ALL RECORDS HELD BY A USER >> <<00256>>36772000
      << IN COMMAND.PUB.SYS TO THE FREE LIST. >>               <<00256>>36774000
                                                               <<00256>>36776000
      IF COMFN <> 0 THEN                                       <<00256>>36778000
         DO BEGIN                                              <<00256>>36780000
            FREADDIR(COMFN,REC,COMRECSIZE,DOUBLE(HEADREC));    <<00256>>36782000
            IF <> THEN ERROR (COMREADFAIL);                    <<00256>>36784000
            RELCOMREC(COMFN,HEADREC,ERRNO);                    <<00256>>36786000
            COMFILELOCKED := FALSE;  << RELCOMREC UNLOCKS IT >><<00256>>36788000
            IF ERRNO <> 0 THEN ERROR(ERRNO);                   <<00256>>36790000
            HEADREC := REC(COMLINK);                           <<00256>>36792000
            END                                                <<00256>>36794000
         UNTIL HEADREC = 0;                                    <<00256>>36796000
      END;  << RELEASERECS >>                                  <<00256>>36798000
                                                               <<00256>>36800000
   <<  RELEASECOMRECS  MAIN  BODY  >>                          <<00256>>36802000
                                                               <<00256>>36804000
   COMFILEOPEN:=COMFILELOCKED:=FALSE;                          <<00256>>36806000
                                                               <<00256>>36808000
   IF LEVEL = ACCOUNTLEVEL THEN                                <<00256>>36810000
      BEGIN                                                    <<00256>>36812000
      OPENCOMFILE;                                             <<00256>>36814000
      MOREENTRIES := TRUE;                                     <<00256>>36816000
      HEADREC := 0;                                            <<00256>>36818000
      DO BEGIN                                                 <<00256>>36820000
         LOCKCOMFILE;                                          <<00256>>36822000
         HEADREC := HEADREC + 1;  << MOVE RECORD PTR TO NEXT >><<00256>>36824000
         SEARCHCOMFILE(COMFN,,BTARGET,HEADREC,,ERRNO);         <<00884>>36826000
         IF ERRNO = 0 THEN                                     <<00256>>36828000
            RELEASERECS     << RETURN RECORDS TO FREE LIST >>  <<00256>>36830000
         ELSE                                                  <<00256>>36832000
         IF ERRNO = EOFFOUND THEN                              <<00256>>36834000
            MOREENTRIES :=FALSE                                <<00256>>36836000
         ELSE                                                  <<00256>>36838000
            ERROR(ERRNO);                                      <<00256>>36840000
         END                                                   <<00256>>36842000
      UNTIL NOT MOREENTRIES;                                   <<00256>>36844000
      END                                                      <<00256>>36846000
                                                               <<00256>>36848000
   ELSE                                                        <<00256>>36850000
   IF LEVEL = USERLEVEL THEN                                   <<00256>>36852000
      BEGIN                                                    <<00256>>36854000
      WHO(,,,BUSER,,BACCT);                                    <<00256>>36856000
      IF BUSER <> BTARGET,(8) THEN                             <<00256>>36858000
         BEGIN                                                 <<00256>>36860000
         OPENCOMFILE;                                          <<00256>>36862000
         LOCKCOMFILE;                                          <<00256>>36864000
         SEARCHCOMFILE(COMFN,BTARGET,BACCT,HEADREC,,ERRNO);    <<00884>>36866000
         IF ERRNO = 0 THEN                                     <<00256>>36868000
            RELEASERECS                                        <<00256>>36870000
         ELSE                                                  <<00256>>36872000
         IF ERRNO <> EOFFOUND THEN                             <<00256>>36874000
            ERROR(ERRNO);                                      <<00256>>36876000
         END;                                                  <<00256>>36878000
      END;                                                     <<00256>>36880000
                                                               <<00256>>36882000
   OUTL:   <<  EXIT FOR ERRORS  >>                             <<00256>>36884000
   IF COMFILELOCKED THEN UNLOCKCOMFILE;                        <<00256>>36886000
   OUT:    <<  EXIT FOR UNLOCK FAIL >>                         <<00256>>36888000
   IF COMFILEOPEN THEN CLOSECOMFILE;                           <<00256>>36890000
                                                               <<00256>>36892000
   END;  << RELEASECOMRECS >>                                  <<00256>>36894000
                                                               <<00256>>36896000
PROCEDURE CXPURGEACCT EXECUTORHEAD;                            <<00256>>36898000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>36900000
BEGIN                                                          <<U.RAO>>36902000
ENTRY CXPURGEUSER,                                             <<U.RAO>>36904000
      CXPURGEGROUP,                                            <<RV.PV>>36906000
      CXPURGEVSET;                                             <<RV.PV>>36908000
                                                               <<U.RAO>>36910000
<<VARIABLES FOR THE PARSE>>                                    <<U.RAO>>36912000
DOUBLE DL := [8/";", 8/"=", 8/",", 8/%15] D;                   <<RV.PV>>36914000
DOUBLE ARRAY PARMS (0:3) = Q;                                  <<RV.PV>>36916000
BYTE SAVE'BYTE;                                                <<01034>>36918000
BYTE POINTER PARM;   <<POINTS TO START OF CURRENT PARAMETER>>  <<RV.PV>>36920000
INTEGER                                                        <<RV.PV>>36922000
    NEXTDELIM,  <<HOLDS DL INDEX OF NEXT DELIMITER>>           <<RV.PV>>36924000
    PARMLEN,    <<LENGTH OF CURRENT PARAMETER>>                <<RV.PV>>36926000
    PARMPTR = PARM;                                            <<RV.PV>>36928000
BYTE POINTER EXTRAPARM = PARMS+6;                              <<RV.PV>>36930000
INTEGER NUMPARMS;                                              <<U.RAO>>36932000
LOGICAL EMBEDEDSPECIAL;                                        <<U.RAO>>36934000
                                                               <<U.RAO>>36936000
<<VARIABLES FOR THE PURGE>>                                    <<U.RAO>>36938000
INTEGER TYPE := ACCOUNTLEVEL;  <<TYPE OF PURGE>>               <<U.RAO>>36940000
LOGICAL INTERACTIVE;  <<USED FOR VERIFICATION MESSAGE>>        <<U.RAO>>36942000
DOUBLE REPLY;                                                  <<U.RAO>>36944000
BYTE ARRAY BREPLY(*) = REPLY;                                  <<U.RAO>>36946000
INTEGER ARRAY TARGET(0:3);                                     <<U.RAO>>36948000
BYTE ARRAY BTARGET(*)=TARGET;                                  <<U.RAO>>36950000
INTEGER ARRAY ACCOUNT(0:3);                                    <<U.RAO>>36952000
BYTE ARRAY BACCOUNT(*) = ACCOUNT;                              <<U.RAO>>36954000
INTEGER ARRAY GROUP (0:3);                                     <<RV.PV>>36956000
BYTE ARRAY BGROUP (*) = GROUP;                                 <<RV.PV>>36958000
INTEGER ERRORBASE := FANAMEBASE;                               <<U.RAO>>36960000
<<DECLARATIONS FOR VS PROCESSING>>                             <<RV.PV>>36962000
DEFINE PURGESTATUS= S0.(6:2) #;                                <<07.KM>>36964000
INTEGER S0= S-0;                                               <<07.KM>>36966000
EQUATE                <<INDEXES IN THE DL ARRAY>>              <<RV.PV>>36968000
    CONDMOUNT = 3,                                             <<RV.PV>>36970000
    CONDDISMOUNT = 3,                                          <<RV.PV>>36972000
    SEMICOLON = 0,                                             <<RV.PV>>36974000
    EQUALS    = 1,                                             <<RV.PV>>36976000
    COMMA     = 2,                                             <<RV.PV>>36978000
    CR        = 3;                                             <<RV.PV>>36980000
LOGICAL                                                        <<RV.PV>>36982000
    MOUNTED := FALSE,                                          <<RV.PV>>36984000
    REQTYPE := CONDMOUNT,                                      <<RV.PV>>36986000
    PVINFO := 0;                                               <<RV.PV>>36988000
DEFINE                                                         <<RV.PV>>36990000
       CLASSFLG = PVINFO.(0:1) #,                              <<RV.PV>>36992000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>36994000
       VMASK    = PVINFO.(8:8) #;                              <<RV.PV>>36996000
ARRAY                                                          <<RV.PV>>36998000
    VSREFNAME (0:(NAMESIZE*3)-1),                              <<RV.PV>>37000000
    VSVNAME (*) = VSREFNAME,                                   <<RV.PV>>37002000
    VSGNAME (*) = VSVNAME (NAMESIZE),                          <<RV.PV>>37004000
    VSANAME (*) = VSGNAME (NAMESIZE);                          <<RV.PV>>37006000
                                                               <<RV.PV>>37008000
SUBROUTINE NEXT;                                               <<RV.PV>>37010000
    <<THIS SUBROUTINE SIMPLY DECOMPOSES THE DATA RETURNED BY>> <<RV.PV>>37012000
    <<MYCOMMAND INTO INDIVIDUAL ITEMS FOR THE NEXT PARAMETER>> <<RV.PV>>37014000
    BEGIN                                                      <<RV.PV>>37016000
        TOS := PARMS (PARMNUM);                                <<RV.PV>>37018000
EMBEDEDSPECIAL := S0.(10:1);  <<EMBEDDED SPECIAL BIT FROM MYCOM<<U.RAO>>37020000
        NEXTDELIM := S0.(11:5);                                <<RV.PV>>37022000
        PARMLEN := TOS & LSR (8);                              <<RV.PV>>37024000
        PARMPTR := TOS;                                        <<RV.PV>>37026000
        PARMNUM := PARMNUM + 1;                                <<RV.PV>>37028000
    END;  <<SUBROUTINE NEXT>>                                  <<RV.PV>>37030000
                                                               <<U.RAO>>37032000
GOTO START;  <<PURGEACCOUNT STUFF ALREADY INITIALIZED>>        <<U.RAO>>37034000
                                                               <<U.RAO>>37036000
CXPURGEGROUP:                                                  <<U.RAO>>37038000
   TYPE := GROUPLEVEL;                                         <<U.RAO>>37040000
   ERRORBASE := FGNAMEBASE;                                    <<U.RAO>>37042000
   GO TO START;                                                <<U.RAO>>37044000
                                                               <<U.RAO>>37046000
CXPURGEUSER:                                                   <<U.RAO>>37048000
   TYPE := USERLEVEL;                                          <<U.RAO>>37050000
   ERRORBASE := USERNAMEBASE;                                  <<U.RAO>>37052000
   GO TO START;                                                <<RV.PV>>37054000
CXPURGEVSET:                                                   <<RV.PV>>37056000
   TYPE := VSDEFLEVEL;                                         <<RV.PV>>37058000
   ERRORBASE := VSDNAMEBASE;                                   <<RV.PV>>37060000
                                                               <<U.RAO>>37062000
START:                                                         <<U.RAO>>37064000
                                                               <<U.RAO>>37066000
MYCOMMAND (PARMSP,DL,4,NUMPARMS,PARMS);                        <<RV.PV>>37068000
PARMNUM := 0;                                                  <<RV.PV>>37070000
NEXT;                                                          <<RV.PV>>37072000
IF TYPE > USERLEVEL AND NUMPARMS > 1 OR NUMPARMS > 3 THEN      <<RV.PV>>37074000
   BEGIN                                                       <<U.RAO>>37076000
   PARMNUM := 2;                                               <<U.RAO>>37078000
   CIERR(ERRNUM := PURGEGROUP2MP-1+TYPE, EXTRAPARM);           <<U.RAO>>37080000
   END                                                         <<U.RAO>>37082000
ELSE IF NUMPARMS < 1 THEN <<REQUIRES AT LEAST ONE PARM>>       <<RV.PV>>37084000
   CIERR(ERRNUM := ERRORBASE+2, PARMSP(1))                     <<U.RAO>>37086000
ELSE IF INTEGER (PARMLEN) > 8 THEN                             <<RV.PV>>37088000
   CIERR(ERRNUM := ERRORBASE+3, PARM)                          <<RV.PV>>37090000
ELSE IF PARM <> ALPHA THEN  <<NAME STARTS WITH NONALPHA>>      <<RV.PV>>37092000
   CIERR (ERRNUM := ERRORBASE+1, PARM)                         <<RV.PV>>37094000
ELSE IF EMBEDEDSPECIAL THEN                                    <<U.RAO>>37096000
   CIERR(ERRNUM := ERRORBASE+5, PARM)                          <<U.RAO>>37098000
ELSE                                                           <<U.RAO>>37100000
   BEGIN                                                       <<U.RAO>>37102000
   TARGET := "  ";                                             <<U.RAO>>37104000
   MOVE TARGET(1) := TARGET,(3);                               <<U.RAO>>37106000
   ACCOUNT := "  ";                                            <<U.RAO>>37108000
   MOVE ACCOUNT(1) := ACCOUNT,(3);                             <<U.RAO>>37110000
   MOVE BTARGET := PARM, (INTEGER (PARMLEN));                  <<RV.PV>>37112000
   WHO (INTERACTIVE,,,,BGROUP,BACCOUNT);                       <<RV.PV>>37114000
   IF INTERACTIVE THEN                                         <<U.RAO>>37116000
      DO BEGIN  <<VERIFY PURGE>>                               <<U.RAO>>37118000
         REPLY := "NO  ";                                      <<U.RAO>>37120000
            SAVE'BYTE := PARM(INTEGER(PARMLEN));               <<01034>>37122000
         PARM(INTEGER(PARMLEN)) := 0; <<STOPPER FOR GENMSG>>   <<00832>>37124000
         GENMSG(CIGENERALMSGSET,PURGEGROUPQ-1+TYPE,            <<U.RAO>>37126000
            0,PARMPTR,,,,,,,,,%100000);                        <<RV.PV>>37128000
            PARM(INTEGER(PARMLEN)) := SAVE'BYTE;<<PUT IT BACK>><<01034>>37130000
         READ(REPLY,-4);                                       <<U.RAO>>37132000
         IF <> THEN << EOF OR IO ERROR ON $STDIN >>            <<00832>>37134000
            BEGIN   << ABORT PURGE >>                          <<00832>>37136000
            IF < THEN CIERR(ERRSTDINIO);                       <<00832>>37138000
            RETURN;                                            <<00832>>37140000
            END;                                               <<00832>>37142000
         MOVE BREPLY := BREPLY WHILE AS;                       <<U.RAO>>37144000
         IF REPLY = "NO  " THEN RETURN;                        <<U.RAO>>37146000
         IF REPLY <> "YES " THEN CIERR(-INVLDRESP);            <<U.RAO>>37148000
         END UNTIL REPLY = "YES ";                             <<U.RAO>>37150000
                                                               <<U.RAO>>37152000
   IF NUMPARMS > 1 THEN                                        <<RV.PV>>37154000
   BEGIN <<VS PARAMETER SEQUENCE>>                             <<RV.PV>>37156000
       IF NEXTDELIM <> SEMICOLON THEN                          <<RV.PV>>37158000
       BEGIN                                                   <<RV.PV>>37160000
           CIERR (ERRNUM := ORGCOMXPCTKEYWD,PARM (1));         <<RV.PV>>37162000
           RETURN;                                             <<RV.PV>>37164000
       END;                                                    <<RV.PV>>37166000
       NEXT;                                                   <<RV.PV>>37168000
       IF PARM = "VS" AND PARMLEN = 2 THEN ELSE                <<RV.PV>>37170000
       BEGIN                                                   <<RV.PV>>37172000
           CIERR (ERRNUM := ORGCOMXPCTKEYWD,PARM);             <<RV.PV>>37174000
           RETURN;                                             <<RV.PV>>37176000
       END;                                                    <<RV.PV>>37178000
       IF NEXTDELIM <> EQUALS THEN                             <<RV.PV>>37180000
       BEGIN                                                   <<RV.PV>>37182000
           CIERR (ERRNUM := ORGCOMXPCTEQUALS,PARM (1));        <<RV.PV>>37184000
           RETURN;                                             <<RV.PV>>37186000
       END;                                                    <<RV.PV>>37188000
       VSREFNAME := "  ";                                      <<RV.PV>>37190000
       MOVE VSREFNAME (1) := VSREFNAME, ((NAMESIZE*3)-1);      <<RV.PV>>37192000
       MOVE VSVNAME := "@   "; <<SET UP DEFAULT>>              <<RV.PV>>37194000
       NEXT;                                                   <<RV.PV>>37196000
       TOS := CHECK'N'MOVENAME (PARM,PARMLEN,VSREFNAME,4,3);   <<RV.PV>>37198000
       IF <> THEN                                              <<RV.PV>>37200000
       BEGIN                                                   <<RV.PV>>37202000
           CIERR (ERRNUM := TOS+VCSREFBASE,PARM);              <<RV.PV>>37204000
           RETURN;                                             <<RV.PV>>37206000
       END;                                                    <<RV.PV>>37208000
       CASE TOS OF                                             <<RV.PV>>37210000
       BEGIN                                                   <<RV.PV>>37212000
           WHO (,,,,VSGNAME,VSANAME); <<0 NAMES SUPPLIED>>     <<RV.PV>>37214000
           WHO (,,,,VSGNAME,VSANAME); <<1 NAME SUPPLIED>>      <<RV.PV>>37216000
           WHO (,,,,,VSANAME);        <<2 NAMES SUPPLIED>>     <<RV.PV>>37218000
           ;                          <<ALL NAMES SUPPLIED>>   <<RV.PV>>37220000
       END;                                                    <<RV.PV>>37222000
       MOUNT (VSVNAME,VSGNAME,VSANAME,REQTYPE,0<<GEN>>,PVINFO);<<RV.PV>>37224000
       IF < THEN                                               <<RV.PV>>37226000
       BEGIN                                                   <<RV.PV>>37228000
           CIERR (ERRNUM := ALTGRPVSNOTMNTD);                  <<RV.PV>>37230000
           RETURN;                                             <<RV.PV>>37232000
       END;                                                    <<RV.PV>>37234000
       MOUNTED := TRUE;                                        <<RV.PV>>37236000
   END;<<OF VS SEQUENCE>>                                      <<RV.PV>>37238000
   <<NOW DO PURGE>>                                            <<U.RAO>>37240000
   TOS := 0D;   <<RESULT SPACE FOR DIRECPURGE>>                <<U.RAO>>37242000
   TOS := 0;  TOS.(ENDLEVELF) := TYPE;  <<KIND OF PURGE>>      <<U.RAO>>37244000
   TOS := 0D;  <<NULL INDEX>>                                  <<38.PV>>37246000
   IF TYPE = ACCOUNTLEVEL THEN                                 <<U.RAO>>37248000
      BEGIN                                                    <<U.RAO>>37250000
      TOS := @TARGET;                                          <<U.RAO>>37252000
      TOS := 0;  <<GROUP NAME IS NULL>>                        <<U.RAO>>37254000
      TOS := 0;  <<THIRD NAME IS NULL>>                        <<RV.PV>>37256000
      END                                                      <<U.RAO>>37258000
   ELSE                                                        <<U.RAO>>37260000
    IF TYPE = GROUPLEVEL OR TYPE = USERLEVEL THEN              <<RV.PV>>37262000
      BEGIN  <<GET LOGON ACCOUNT TOO>>                         <<U.RAO>>37264000
      TOS := @ACCOUNT;                                         <<U.RAO>>37266000
      TOS := @TARGET; <<GROUP NAME>>                           <<RV.PV>>37268000
      TOS := 0;       <<THIRD NAME IS NULL>>                   <<RV.PV>>37270000
      END                                                      <<RV.PV>>37272000
    ELSE                                                       <<RV.PV>>37274000
    BEGIN <<TYPE IS VSDEFLEVEL OR VSLISTLEVEL>>                <<RV.PV>>37276000
        TOS := @ACCOUNT;                                       <<RV.PV>>37278000
        TOS := @GROUP;                                         <<RV.PV>>37280000
        TOS := @TARGET;                                        <<RV.PV>>37282000
    END;                                                       <<RV.PV>>37284000
   TOS := DIRECPURGE (*,*,*,*,*,MVTABX);                       <<RV.PV>>37286000
                                                               <<07.KM>>37288000
   PUSH(STATUS);                                               <<07.KM>>37290000
                                                               <<00256>>37292000
   IF MOUNTED THEN                                             <<RV.PV>>37294000
   BEGIN                                                       <<RV.PV>>37296000
       REQTYPE := CONDDISMOUNT;                                <<RV.PV>>37298000
       DISMOUNT (VSVNAME,VSGNAME,VSANAME,REQTYPE);             <<RV.PV>>37300000
       IF <> AND PURGESTATUS=CCE THEN                          <<07.KM>>37302000
       BEGIN                                                   <<RV.PV>>37304000
           CIERR (ERRNUM := 0<<DISMOUNT PROBLEM>>);            <<RV.PV>>37306000
           RETURN;                                             <<RV.PV>>37308000
       END;                                                    <<RV.PV>>37310000
   END;<<OF MOUNTED>>                                          <<RV.PV>>37312000
   SET(STATUS);                                                <<07.KM>>37314000
                                                               <<07.KM>>37316000
<< IF PURGE SUCEEDED THEN TAKE OUT COMMAND.PUB.SYS RECORDS >>  <<01096>>37318000
                                                               <<01096>>37320000
IF <> THEN CYDIRERR'(*,%120400,ERRNUM)                         <<01096>>37322000
ELSE                                                           <<01096>>37324000
   RELEASECOMRECS(TYPE,BTARGET);                               <<01096>>37326000
   END;                                                        <<U.RAO>>37328000
END;  <<CXPURGEACCT, CXPURGEGROUP, CXPURGEUSER>>               <<U.RAO>>37330000
$CONTROL SEGMENT=CISYSMGR                                      <<U.RAO>>37332000
INTEGER PROCEDURE RCREPORT (ELEMENT, LEVEL, PARMS, SIRINFO);            37334000
   VALUE LEVEL, PARMS, SIRINFO;                                << ... >>37336000
   ARRAY ELEMENT;                                              << ... >>37338000
   INTEGER LEVEL;                                                       37340000
   INTEGER PARMS;                                                       37342000
   DOUBLE SIRINFO;                                                      37344000
   OPTION PRIVILEGED, UNCALLABLE;                                       37346000
BEGIN                                                                   37348000
   DEFINE P'GOTENTRY= ARRQ0(PARMS+3) #;                        <<04.KM>>37350000
   ARRAY ARRS11(*)= S-11,                                     <<00.GEN>>37352000
         ARRS16(*)= S-16;                                     <<00.GEN>>37354000
   DOUBLE ARRAY      DELEMENT (*)      = ELEMENT;                       37356000
   DEFINE            FILENUM           = ARRQ0 (PARMS) #,               37358000
                     WRITESIZE         = ARRQP1 (PARMS) #,              37360000
                     COMPLCODE         = ARRQP2 (PARMS) #,              37362000
                     BINARYOUTPUT      = WRITESIZE = 17 #;              37364000
   INTEGER POINTER   INFO;                                              37366000
   INTEGER POINTER PPRESULT;                                  <<00.GEN>>37368000
   DOUBLE POINTER    DINFO2;                                            37370000
   INTEGER POINTER   BUF;                                               37372000
   BYTE POINTER      BBUF,                                              37374000
                     BBUF2,                                             37376000
                     TBBUF;                                             37378000
                                                              <<00.GEN>>37380000
                                                              <<00.GEN>>37382000
SUBROUTINE DEF'MOVEFROMDSEG;                                  <<00.GEN>>37384000
                                                              <<00.GEN>>37386000
                                                                        37388000
   IF REQUESTSERVICE THEN                                               37390000
      BEGIN                                                             37392000
      RCREPORT:=5;                                                      37394000
      RETURN;                                                           37396000
      END;                                                              37398000
   PARMS := PARMS -INTEGER(DELTAQ);                                     37400000
   TOS := LEVEL;                                                        37402000
   TOS := DELEMENT;                                                     37404000
   TOS := DELEMENT (1);                                                 37406000
   EXCHANGEDB(0);                                             <<00.GEN>>37408000
   ASSEMBLE(ADDS 12);                                         <<00.GEN>>37410000
   @INFO:=@ARRS16;                                            <<00.GEN>>37412000
   @DINFO2:=@ARRS11;                                          <<00.GEN>>37414000
   MOVEFROMDSEG(@DINFO2,DDSDST,                               <<00.GEN>>37416000
                @ELEMENT+(IF LEVEL=1 THEN 9 ELSE 14),12);     <<00.GEN>>37418000
   TOS := SIRINFO;                                             <<03.KM>>37420000
   IF <> THEN RELSIR (*, *) ELSE DDEL;                         <<03.KM>>37422000
                                                              <<00.GEN>>37424000
   @PPRESULT:=@ARRQ0(PARMS+RCR'PPRINX);                       <<00.GEN>>37426000
   IF LOGICAL(D'TYPE.(ALLFLAG)) THEN                          <<00.GEN>>37428000
   BEGIN                                                      <<00.GEN>>37430000
     CASE *LEVEL OF BEGIN                                     <<00.GEN>>37432000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>37434000
       TOS:=DIRMATCH(G'GNAME,INFO(1));                        <<06.GEN>>37436000
       TOS:=DIRMATCH(G'ANAME,INFO(1));                        <<06.GEN>>37438000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>37440000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>37442000
     END;                                                     <<00.GEN>>37444000
     IF TOS<>0 THEN                                           <<00.GEN>>37446000
     BEGIN                                                    <<00.GEN>>37448000
       RCREPORT:=IF < THEN NEXTUNCLE ELSE NEXTBROTHER;         <<03.KM>>37450000
       EXCHANGEDB(DDSDST);                                    <<00.GEN>>37452000
       RETURN;                                                <<00.GEN>>37454000
     END;                                                     <<00.GEN>>37456000
   END;                                                       <<00.GEN>>37458000
                                                              <<00.GEN>>37460000
   IF BINARYOUTPUT THEN                                                 37462000
      TOS := @INFO                                                      37464000
   ELSE                                                                 37466000
      BEGIN                                                             37468000
      TOS := 44;                                                        37470000
      @TBBUF := (@BBUF2 := (@BBUF := (@BUF := @S0) &LSL(1)) +21) +45;   37472000
      ASSEMBLE (ADDS 0);                                                37474000
      BUF := "  ";                                                      37476000
      MOVE BUF (1) := BUF, (32);                                        37478000
      TOS := @BUF;                                                      37480000
      IF LEVEL = 1 THEN                                                 37482000
         BEGIN                                                          37484000
         BBUF (3) := "/";                                               37486000
         TOS := TOS +2;                                                 37488000
         END;                                                           37490000
      MOVE * := INFO (1), (4);                                          37492000
      X := 5;                                                           37494000
      DO BEGIN                                                          37496000
         TOS := @BBUF2 + (X *9);                                        37498000
         TOS := @TBBUF;                                                 37500000
         TOS := DASCII (DINFO2 (X), 10, BPS0);                          37502000
         IF S0 > 8 THEN                                                 37504000
            BEGIN                                                       37506000
            ASSEMBLE (DDEL);                                            37508000
            TOS := TOS -2;                                              37510000
            MOVE * := "**";                                             37512000
            END                                                         37514000
         ELSE                                                           37516000
            BEGIN                                                       37518000
            S2 := S2 - S0;                                              37520000
            MOVE * := *, (TOS);                                         37522000
            END;                                                        37524000
         X := X -1;                                                     37526000
         END                                                            37528000
      UNTIL <;                                                          37530000
      TOS := @BUF;                                                      37532000
      END;                                                              37534000
   IF LEVEL=GROUPLEVEL THEN P'GOTENTRY:=TRUE;                  <<03.KM>>37536000
   TOS := FILENUM;                                                      37538000
                                                               <<00506>>37540000
   ASSEMBLE (XCH);                                                      37542000
   FWRITE (*, *, WRITESIZE, 0);                                         37544000
   IF <> THEN                                                  <<02365>>37546000
      BEGIN                                                             37548000
      COMPLCODE := 1;                                                   37550000
      RCREPORT := 4;                                                    37552000
      END;                                                              37554000
   EXCHANGEDB (DDSDST);                                                 37556000
   END    <<RCREPORT>>;                                                 37558000
INTEGER PROCEDURE CHECKHOMEACCT(PPRESULT);                     <<U.RAO>>37560000
INTEGER ARRAY PPRESULT;                                        <<U.RAO>>37562000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>37564000
BEGIN                                                          <<U.RAO>>37566000
<<THIS PROCEDURE CHECKS THE PARAMETERS OF PPRESULT TO VERIFY>> <<U.RAO>>37568000
<<THAT THE USER HAS SPECIFIED HIS LOGON ACCOUNT.            >> <<U.RAO>>37570000
<<IT IS USED TO VERIFY THAT AN ACCOUNT MANAGER IS NOT       >> <<U.RAO>>37572000
<<ATTEMPTING TO ACCESS AN ACCOUNT OUTSIDE HIS OWN, A        >> <<U.RAO>>37574000
<<CAPABILITY RESTRICTED TO SYSTEM MANAGERS.                 >> <<U.RAO>>37576000
<<THE PROCEDURE RETURNS:                                    >> <<U.RAO>>37578000
<<     0 => NO ERRORS                                       >> <<U.RAO>>37580000
<<     3 => USER SPECIFIED "@" ACCOUNTS                     >> <<U.RAO>>37582000
<<     4 => USER SPECIFIED NON-LOGON ACCOUNT                >> <<U.RAO>>37584000
                                                               <<U.RAO>>37586000
BYTE ARRAY LOACCT(0:7);                                        <<U.RAO>>37588000
BYTE ARRAY BPPRESULT(*)=PPRESULT;                             <<00.GEN>>37590000
                                                              <<00.GEN>>37592000
                                                              <<00.GEN>>37594000
CHECKHOMEACCT := 0;                                            <<U.RAO>>37596000
IF D'TYPE.(ENDLEVELFX) = ALLACCTS THEN                        <<00.GEN>>37598000
   CHECKHOMEACCT := 3                                          <<U.RAO>>37600000
ELSE IF D'ANAME <> "  " THEN  <<NON-NULL ACCOUNT NAME>>       <<00.GEN>>37602000
   BEGIN                                                       <<U.RAO>>37604000
   WHO(,,,,,LOACCT);                                           <<U.RAO>>37606000
   IF D'BANAME<>LOACCT,(8) THEN CHECKHOMEACCT:=4;             <<00.GEN>>37608000
   END                                                         <<U.RAO>>37610000
END;                                                           <<U.RAO>>37612000
INTEGER PROCEDURE CHECKHOMEGROUP(PPRESULT);                    <<U.RAO>>37614000
INTEGER ARRAY PPRESULT;                                        <<U.RAO>>37616000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>37618000
BEGIN                                                          <<U.RAO>>37620000
<<THIS PROCEDURE CHECKS THE PARAMETERS OF PPRESULT TO >>       <<U.RAO>>37622000
<<VERIFY THAT THE USER HAS SPECIFIED HIS LOGON GROUP  >>       <<U.RAO>>37624000
<<THE PROCEDURE RETURNS:                              >>       <<U.RAO>>37626000
<<         0 => NO ERRORS DETECTED                    >>       <<U.RAO>>37628000
<<         1 => USER SPECIFIED "@" GROUPS             >>       <<U.RAO>>37630000
<<         2 => USER SPECIFIED NON-LOGON GROUP        >>       <<U.RAO>>37632000
<<         3 => USER SPECIFIED "@" ACCOUNTS           >>       <<U.RAO>>37634000
<<         4 => USER SPECIFIED NON-LOGON ACCOUNT      >>       <<U.RAO>>37636000
BYTE ARRAY LOGRP(0:7);                                         <<U.RAO>>37638000
BYTE ARRAY BPPRESULT(*)=PPRESULT;                             <<00.GEN>>37640000
                                                              <<00.GEN>>37642000
                                                              <<00.GEN>>37644000
CHECKHOMEGROUP := 0;                                           <<U.RAO>>37646000
IF D'TYPE.(ENDLEVELFX) = ALLGROUPS THEN                       <<00.GEN>>37648000
   CHECKHOMEGROUP := 1                                         <<U.RAO>>37650000
ELSE IF D'GNAME <> "  " THEN                                  <<00.GEN>>37652000
   BEGIN                                                       <<U.RAO>>37654000
   WHO(,,,,LOGRP);                                             <<U.RAO>>37656000
   IF D'BGNAME<>LOGRP,(8) THEN                                <<00.GEN>>37658000
      CHECKHOMEGROUP := 2                                      <<U.RAO>>37660000
   ELSE                                                        <<U.RAO>>37662000
      CHECKHOMEGROUP := CHECKHOMEACCT(PPRESULT);               <<U.RAO>>37664000
   END                                                         <<U.RAO>>37666000
END;                                                           <<U.RAO>>37668000
PROCEDURE CXREPORT EXECUTORHEAD;                               <<U.RAO>>37670000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>37672000
BEGIN                                                          <<U.RAO>>37674000
BYTE POINTER DELIM;                                           <<00.GEN>>37676000
DOUBLE DL := [8/";", 8/"=", 8/",", 8/%15] D;                   <<00086>>37678000
INTEGER NUMPARMS;  <<RETURNED BY MYCOMMAND>>                   <<U.RAO>>37680000
INTEGER ARRAY RECIPPARMS(0:RCR'PARMLEN-1);                    <<00.GEN>>37682000
INTEGER ARRAY PPRESULT(*)=RECIPPARMS(RCR'PPRINX);             <<00.GEN>>37684000
DEFINE FNUM =      RECIPPARMS #,                              <<00.GEN>>37686000
       WRITESIZE = RECIPPARMS(1) #,                           <<00.GEN>>37688000
       COMPLCODE = RECIPPARMS(2) #,                            <<03.KM>>37690000
       P'GOTENTRY= RECIPPARMS(3) #;                            <<03.KM>>37692000
DOUBLE ARRAY PARMS (0:4) = Q;                                  <<00129>>37694000
BYTE POINTER PARM;   <<POINTS TO START OF CURRENT PARAMETER>>  <<00086>>37696000
DEFINE REPORTSTATUS= S0.(6:2) #;                               <<00086>>37698000
INTEGER S0= S-0;                                               <<00086>>37700000
INTEGER                                                        <<00086>>37702000
    NEXTDELIM,  <<HOLDS DL INDEX OF NEXT DELIMITER>>           <<00086>>37704000
    PARMLEN,    <<LENGTH OF CURRENT PARAMETER>>                <<00086>>37706000
    PARMPTR = PARM;                                            <<00086>>37708000
BYTE POINTER LEAF = PARM;                                      <<00129>>37710000
INTEGER LEAFNAMELEN = PARMLEN;                                 <<00129>>37712000
BYTE POINTER LISTFILE := 0;                                    <<00129>>37714000
INTEGER LISTFILELEN = PARMLEN;                                 <<00129>>37716000
BYTE POINTER EXTRAPARM = PARMS+8;                              <<00129>>37718000
LOGICAL FOPTIONS;                                              <<U.RAO>>37720000
INTEGER CLOSEOPTION := 0;                                     <<01067>> 37722000
EQUATE NEWFILE        = 0,                                     <<01067>>37724000
       TEMP'DOMAIN    = 2,                                     <<01067>>37726000
       CUR'DOMAIN     = 0;                                     <<01067>>37728000
ARRAY DATEBUF(0:13);   <<FOR TIME STAMP, IF REQUIRED>>         <<02.RO>>37730000
INTEGER DEV := 0;  <<DEVICE TYPE OF LISTFILE>>                 <<03.RO>>37732000
<<DECLARATIONS FOR VS PROCESSING>>                             <<00086>>37734000
EQUATE                <<INDEXES IN THE DL ARRAY>>              <<00086>>37736000
    CONDMOUNT = 3,                                             <<00086>>37738000
    CONDDISMOUNT = 3,                                          <<00086>>37740000
    SEMICOLON = 0,                                             <<00086>>37742000
    EQUALS    = 1,                                             <<00086>>37744000
    COMMA     = 2,                                             <<00086>>37746000
    CR        = 3;                                             <<00086>>37748000
LOGICAL                                                        <<00086>>37750000
    MOUNTED := FALSE,                                          <<00086>>37752000
    REQTYPE := CONDMOUNT,                                      <<00086>>37754000
    PVINFO := 0;                                               <<00086>>37756000
DEFINE                                                         <<00086>>37758000
       CLASSFLG = PVINFO.(0:1) #,                              <<00086>>37760000
       MVTABX   = PVINFO.(4:4) #,                              <<00086>>37762000
       VMASK    = PVINFO.(8:8) #;                              <<00086>>37764000
ARRAY                                                          <<00086>>37766000
    VSREFNAME (0:(NAMESIZE*3)-1),                              <<00086>>37768000
    VSVNAME (*) = VSREFNAME,                                   <<00086>>37770000
    VSGNAME (*) = VSVNAME (NAMESIZE),                          <<00086>>37772000
    VSANAME (*) = VSGNAME (NAMESIZE);                          <<00086>>37774000
                                                               <<00086>>37776000
SUBROUTINE NEXT;                                               <<00086>>37778000
    <<THIS SUBROUTINE SIMPLY DECOMPOSES THE DATA RETURNED BY>> <<00086>>37780000
    <<MYCOMMAND INTO INDIVIDUAL ITEMS FOR THE NEXT PARAMETER>> <<00086>>37782000
    BEGIN                                                      <<00086>>37784000
        TOS := PARMS (PARMNUM);                                <<00086>>37786000
        NEXTDELIM := S0.(11:5);                                <<00086>>37788000
        PARMLEN := TOS & LSR (8);                              <<00086>>37790000
        PARMPTR := TOS;                                        <<00086>>37792000
        PARMNUM := PARMNUM + 1;                                <<00086>>37794000
    END;  <<SUBROUTINE NEXT>>                                  <<00086>>37796000
                                                               <<00086>>37798000
                                                               <<U.RAO>>37800000
SUBROUTINE LISTFSERR;                                          <<U.RAO>>37802000
<<MANAGES LIST FILE I/O ERROR>>                                <<U.RAO>>37804000
BEGIN                                                          <<U.RAO>>37806000
FERROR'(FNUM,PARMNUM);                                         <<U.RAO>>37808000
CIERR(ERRNUM := LISTFFSERR,,%10000,PARMNUM);                   <<U.RAO>>37810000
ASSEMBLE(EXIT 3);                                              <<U.RAO>>37812000
END;                                                           <<U.RAO>>37814000
                                                               <<U.RAO>>37816000
MYCOMMAND (PARMSP,DL,4,NUMPARMS,PARMS);                        <<00129>>37818000
PARMNUM := 0;                                                  <<00129>>37820000
NEXT;                                                          <<00129>>37822000
IF NOT PRODUCEPARMS(1,PARMSP,PPRESULT,DELIM,ERRNUM)            <<01.KM>>37824000
   THEN RETURN;                                               <<00.GEN>>37826000
IF NUMPARMS>0 AND @DELIM<@LEAF(LEAFNAMELEN) THEN               <<01.KM>>37828000
   BEGIN                                                       <<01.KM>>37830000
   TOS := ERRNUM := REPORTEXTRANLEAF;                          <<01.KM>>37832000
   TOS := @DELIM;                                              <<01.KM>>37834000
   CIERR(*,*);                                                 <<01.KM>>37836000
   RETURN;                                                     <<01.KM>>37838000
   END;                                                        <<01.KM>>37840000
                                                               <<01.KM>>37842000
IF NUMPARMS=0 OR LEAFNAMELEN=0 THEN                            <<01.KM>>37844000
   BEGIN                                                       <<01.KM>>37846000
   COMMENT:                                                    <<01.KM>>37848000
     NO GROUP DESIGNATOR:  "PRODUCEPARMS" SET DEFAULT TO       <<01.KM>>37850000
     "@.LAN".  THIS IS FINE FOR ACCT MGR.  FOR STANDARD        <<01.KM>>37852000
     USER WE WANT "LGN.LAN".  FOR SM WE WANT "@.@";            <<01.KM>>37854000
                                                               <<01.KM>>37856000
   SETXPXGLOB;                                                 <<01.KM>>37858000
   IF ARRDB2(X).(0:2)<1 THEN            <<STD USER>>           <<01.KM>>37860000
      BEGIN                                                    <<01.KM>>37862000
      GETDIRINFO(0,2,PPRESULT);                                <<01.KM>>37864000
      D'TYPE.(ENDLEVELFX):=GROUPLEVEL;                         <<01.KM>>37866000
      END                                                      <<01.KM>>37868000
   ELSE IF > THEN                       <<SYS MGR>>            <<01.KM>>37870000
      BEGIN                                                    <<01.KM>>37872000
      MOVE D'ANAME:="@       ";                                <<01.KM>>37874000
      MOVE G'ANAME:="@       ";                                <<01.KM>>37876000
      D'TYPE.(ENDLEVELFX):=ALLACCTS;                           <<01.KM>>37878000
      END;                                                     <<01.KM>>37880000
   END                                                         <<01.KM>>37882000
ELSE                                                           <<01.KM>>37884000
   BEGIN                               <<CHECK CAPS>>          <<01.KM>>37886000
   SETXPXGLOB;                                                 <<U.RAO>>37888000
   IF ARRDB2(X).(0:2) < 1 THEN  <<PLAIN USER>>                 <<U.RAO>>37890000
      BEGIN                                                    <<U.RAO>>37892000
      X:=CHECKHOMEGROUP(PPRESULT)-1;                           <<01.KM>>37894000
      IF >= THEN                                               <<U.RAO>>37896000
         BEGIN  <<FOUND ERROR CONDITION>>                      <<U.RAO>>37898000
         CASE X OF                                             <<01.KM>>37900000
            BEGIN                                              <<U.RAO>>37902000
            TOS := REPORTNOTAMAT;                              <<U.RAO>>37904000
            TOS := REPORTNOTAMLOGON;                           <<U.RAO>>37906000
            TOS := REPORTNOTSMAT;                              <<U.RAO>>37908000
            TOS := REPORTNOTSMLOGON;                           <<U.RAO>>37910000
            END;                                               <<U.RAO>>37912000
         ERRNUM := TOS;                                        <<U.RAO>>37914000
         CIERR(ERRNUM, LEAF);                                  <<U.RAO>>37916000
         RETURN                                                <<U.RAO>>37918000
         END;                                                  <<U.RAO>>37920000
      END                                                      <<U.RAO>>37922000
   ELSE IF = AND CHECKHOMEACCT(PPRESULT)>=3 THEN               <<01.KM>>37924000
      BEGIN                            <<WRONG ACCT FOR AM>>   <<01.KM>>37926000
      IF = THEN ERRNUM := REPORTNOTSMAT                        <<U.RAO>>37928000
           ELSE ERRNUM := REPORTNOTSMLOGON;                    <<U.RAO>>37930000
      CIERR(ERRNUM, LEAF);                                     <<U.RAO>>37932000
      RETURN                                                   <<U.RAO>>37934000
      END;                                                     <<U.RAO>>37936000
   END;  <<VALIDATION OF LEAF NAME ACCESS>>                    <<U.RAO>>37938000
IF NUMPARMS > 1 THEN                                           <<00129>>37940000
BEGIN                                                          <<00129>>37942000
    IF NEXTDELIM = COMMA THEN                                  <<00129>>37944000
    BEGIN                                                      <<00129>>37946000
        NEXT;                                                  <<00129>>37948000
        IF LISTFILELEN = 0 THEN                                <<00129>>37950000
        BEGIN  <<MISSING LIST FILE NAME>>                      <<00129>>37952000
            PARMNUM := 2;                                      <<00129>>37954000
            CIERR(ERRNUM := REPORTEXPECTLIST, LISTFILE);       <<00129>>37956000
            RETURN;                                            <<00129>>37958000
        END;                                                   <<00129>>37960000
        @LISTFILE := @PARM;                                    <<00129>>37962000
    END ELSE NUMPARMS := 3; <<FAKE>>                           <<00129>>37964000
    IF NUMPARMS > 2 THEN                                       <<00129>>37966000
    BEGIN <<VS PARAMETER SEQUENCE>>                            <<00129>>37968000
        IF NEXTDELIM <> SEMICOLON THEN                         <<00129>>37970000
        BEGIN                                                  <<00129>>37972000
            CIERR (ERRNUM := ORGCOMXPCTKEYWD,PARM (1));        <<00129>>37974000
            RETURN;                                            <<00129>>37976000
        END;                                                   <<00129>>37978000
        NEXT;                                                  <<00129>>37980000
        IF PARM = "VS" AND PARMLEN = 2 THEN ELSE               <<00129>>37982000
        BEGIN                                                  <<00129>>37984000
            CIERR (ERRNUM := ORGCOMXPCTKEYWD,PARM);            <<00129>>37986000
            RETURN;                                            <<00129>>37988000
        END;                                                   <<00129>>37990000
        IF NEXTDELIM <> EQUALS THEN                            <<00129>>37992000
        BEGIN                                                  <<00129>>37994000
            CIERR (ERRNUM := ORGCOMXPCTEQUALS,PARM (1));       <<00129>>37996000
            RETURN;                                            <<00129>>37998000
        END;                                                   <<00129>>38000000
        VSREFNAME := "  ";                                     <<00129>>38002000
        MOVE VSREFNAME (1) := VSREFNAME, ((NAMESIZE*3)-1);     <<00129>>38004000
        MOVE VSVNAME := "@   "; <<SET UP DEFAULT>>             <<00129>>38006000
        NEXT;                                                  <<00129>>38008000
        TOS := CHECK'N'MOVENAME (PARM,PARMLEN,VSREFNAME,4,3);  <<00129>>38010000
        IF <> THEN                                             <<00129>>38012000
        BEGIN                                                  <<00129>>38014000
            CIERR (ERRNUM := TOS+VCSREFBASE,PARM);             <<00129>>38016000
            RETURN;                                            <<00129>>38018000
        END;                                                   <<00129>>38020000
        CASE TOS OF                                            <<00129>>38022000
        BEGIN                                                  <<00129>>38024000
            WHO (,,,,VSGNAME,VSANAME);<<0 NAMES SUPPLIED>>     <<00129>>38026000
            WHO (,,,,VSGNAME,VSANAME);<<1 NAME SUPPLIED>>      <<00129>>38028000
            WHO (,,,,,VSANAME);       <<2 NAMES SUPPLIED>>     <<00129>>38030000
            ;                         <<ALL NAMES SUPPLIED>    <<00129>>38032000
        END;                                                   <<00129>>38034000
        MOUNT (VSVNAME,VSGNAME,VSANAME,REQTYPE,                <<00129>>38036000
               -1<<GEN>>,PVINFO);                              <<00129>>38038000
        IF < THEN                                              <<00129>>38040000
        BEGIN                                                  <<00129>>38042000
            CIERR (ERRNUM := ALTGRPVSNOTMNTD);                 <<00129>>38044000
            RETURN;                                            <<00129>>38046000
        END;                                                   <<00129>>38048000
        MOUNTED := TRUE;                                       <<00129>>38050000
    END;<<OF VS SEQUENCE>>                                     <<00129>>38052000
    IF NUMPARMS > 4 THEN                                       <<00129>>38054000
    BEGIN  <<TOO MANY PARAMETERS>>                             <<00129>>38056000
        PARMNUM := 5;                                          <<00129>>38058000
        CIERR (ERRNUM := REPORT2MP, EXTRAPARM);                <<00129>>38060000
        RETURN;                                                <<00129>>38062000
    END;                                                       <<00129>>38064000
END;                                                           <<00129>>38066000
                                                               <<01.KM>>38068000
D'TYPE.(HITFLAG):=1;                                           <<01.KM>>38070000
D'TYPE.(STARTLEVELF):=0;                                       <<01.KM>>38072000
                                                               <<U.RAO>>38074000
<<NOW OPEN LIST FILE, GET RELEVANT INFO, PUT OUT HEADER>>      <<U.RAO>>38076000
IF @LISTFILE <> 0 THEN  <<LISTFILE PRESENT>>                   <<00129>>38078000
   BEGIN  <<MUST OPEN A REAL FILE>>                            <<U.RAO>>38080000
   FNUM := FOPEN(LISTFILE,%2504,%101);                         <<01067>>38082000
   IF CARRY THEN LISTFSERR;  <<OPEN FAILED>>                   <<U.RAO>>38084000
   END                                                         <<U.RAO>>38086000
ELSE                                                           <<U.RAO>>38088000
   FNUM := 2;                                                  <<U.RAO>>38090000
FGETINFO(FNUM,,FOPTIONS,,,DEV);                                <<03.RO>>38092000
IF CARRY THEN LISTFSERR;                                       <<U.RAO>>38094000
CLOSEOPTION.(13:3) := IF FOPTIONS.(14:2) = NEWFILE THEN        <<01067>>38096000
                      TEMP'DOMAIN ELSE CUR'DOMAIN;             <<01067>>38098000
IF FOPTIONS.(13:1) THEN  <<ASCII FILE>>                        <<U.RAO>>38100000
   BEGIN                                                       <<U.RAO>>38102000
   <<IF NOT INTERACTIVE OR IF TO LIST FILE THEN TIME STAMP>>   <<02.RO>>38104000
   INTERACTIVETEST;                                            <<02.RO>>38106000
   IF NOT TOS  <<NOT INTERACTIVE>> AND @LISTFILE = 0 OR        <<00129>>38108000
      @LISTFILE <> 0 AND DEV.(8:8) >= 8 <<NOT DISC>> THEN      <<00129>>38110000
      BEGIN                                                    <<02.RO>>38112000
      DATE'LINE(DATEBUF);                                      <<02.RO>>38114000
      FWRITE(FNUM, DATEBUF, -27, %60);                         <<02.RO>>38116000
      END;                                                     <<02.RO>>38118000
   GENMSG(CIGENERALMSGSET,REPORTLINE1,,,,,,,-FNUM);            <<U.RAO>>38120000
   GENMSG(CIGENERALMSGSET,REPORTLINE2,,,,,,,-FNUM);            <<U.RAO>>38122000
   WRITESIZE := 33;                                            <<U.RAO>>38124000
   END                                                         <<U.RAO>>38126000
ELSE WRITESIZE := 17;  <<BINARY>>                              <<U.RAO>>38128000
COMPLCODE := 0;                                                <<U.RAO>>38130000
P'GOTENTRY:=FALSE;                                             <<03.KM>>38132000
TOS := DIRECSCAN(D'TYPE,0D,D'ANAME,D'GNAME,ARRDB0,            <<00.GEN>>38134000
                 RCREPORT,RECIPPARMS,MVTABX);                  <<00086>>38136000
PUSH (STATUS);                                                 <<00086>>38138000
IF MOUNTED THEN                                                <<00086>>38140000
BEGIN                                                          <<00086>>38142000
    REQTYPE := CONDDISMOUNT;                                   <<00086>>38144000
    DISMOUNT (VSVNAME,VSGNAME,VSANAME,REQTYPE);                <<00086>>38146000
    IF <> AND REPORTSTATUS = CCE THEN                          <<00086>>38148000
    BEGIN                                                      <<00086>>38150000
        CIERR (ERRNUM := 0<<DISMOUNT PROBLEM>>);               <<00086>>38152000
        RETURN;                                                <<00086>>38154000
    END;                                                       <<00086>>38156000
END;<<OF MOUNTED>>                                             <<00086>>38158000
SET (STATUS);                                                  <<00086>>38160000
IF <> THEN                                                     <<U.RAO>>38162000
   BEGIN                                                       <<U.RAO>>38164000
   IF FNUM <> 2 THEN                                           <<U.RAO>>38166000
      FCLOSE(FNUM, 0, 0);                                      <<U.RAO>>38168000
   CYDIRERR'(*,%120000,ERRNUM);                                <<U.RAO>>38170000
   RETURN;                                                     <<U.RAO>>38172000
   END;                                                        <<U.RAO>>38174000
IF COMPLCODE <> 0 THEN LISTFSERR;                              <<U.RAO>>38176000
IF NOT LOGICAL(P'GOTENTRY) THEN CIERR(-NOGRPSLISTED);          <<04.KM>>38178000
             <<XPARENT TO PROGRAMMATIC CALL FOR UPWARD COMPAT>><<04.KM>>38180000
IF FNUM <> 2 THEN                                              <<U.RAO>>38182000
   BEGIN  <<CLOSE REAL FILE>>                                  <<U.RAO>>38184000
   FCLOSE(FNUM,CLOSEOPTION,0);                                 <<01067>>38186000
   IF CARRY THEN LISTFSERR;                                    <<U.RAO>>38188000
   END;                                                        <<U.RAO>>38190000
PARMNUM := 0;                                                  <<U.RAO>>38192000
END;  <<CXREPORT>>                                             <<U.RAO>>38194000
$CONTROL SEGMENT=CIALTORG                                      <<U.RAO>>38196000
INTEGER PROCEDURE RCRESETACCT (ELEMENT,LEVEL,PARMS,SIRINFO);            38198000
   VALUE LEVEL,PARMS,SIRINFO;                                           38200000
   INTEGER LEVEL, PARMS;                                                38202000
   ARRAY ELEMENT;                                                       38204000
   DOUBLE SIRINFO;                                                      38206000
   OPTION UNCALLABLE;                                                   38208000
BEGIN                                                                   38210000
   LOGICAL ARRAY     LARRQ0(*)         =Q-0;                            38212000
   DEFINE            FLAGS             = LARRQ0 (PARMS) #;              38214000
   LOGICAL           DADIRTY           =DB+145;                <<38.PV>>38216000
   PARMS := PARMS -INTEGER(DELTAQ);                                     38218000
   TOS := @ELEMENT + (IF LEVEL =2 THEN 18 ELSE 13);                     38220000
   IF FLAGS & LSR(1) THEN                                               38222000
      DPS0 := 0D;                                                       38224000
   TOS:=TOS+4;                                                          38226000
   IF FLAGS THEN                                                        38228000
      DPS0 := 0D;                                                       38230000
   DADIRTY := TRUE;                                                     38232000
   RCRESETACCT := 1;                                                    38234000
   END  << RCRESETACCT>>;                                               38236000
PROCEDURE CXRESETACCT EXECUTORHEAD;                                     38238000
   OPTION PRIVILEGED, UNCALLABLE;                                       38240000
BEGIN                                                                   38242000
   <<TYPE WORD: FIELD LENGTHS>>                                <<01.PV>>38244000
   EQUATE                                                      <<01.PV>>38246000
      FILLX  = 5,                                              <<01.PV>>38248000
      HITX   = 1,                                              <<01.PV>>38250000
      TOX    = 3,                                              <<01.PV>>38252000
      ALLX   = 1,                                              <<01.PV>>38254000
      ENDX   = 3,                                              <<01.PV>>38256000
      STARTX = 3;                                              <<01.PV>>38258000
   INTEGER           TYPE              := [HITX/TRUE,          <<01.PV>>38260000
                                           TOX/GROUPLEVEL,     <<01.PV>>38262000
                                           ALLX/TRUE,          <<01.PV>>38264000
                                           ENDX/ACCOUNTLEVEL,  <<01.PV>>38266000
                                           STARTX/FALSE];      <<01.PV>>38268000
LOGICAL FLAGS := 3;  <<INIT TO BOTH CPU AND CONNECT>>          <<U.RAO>>38270000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>38272000
BYTE POINTER ACCT = PARMS;                                     <<U.RAO>>38274000
BYTE ACCTNAMELEN = PARMS+1;                                    <<U.RAO>>38276000
INTEGER ACCTNAMEDATA = PARMS+1;                                <<U.RAO>>38278000
BYTE POINTER CPUCONNECT = PARMS+2;                             <<U.RAO>>38280000
BYTE CPUCONNECTLEN = PARMS+3;                                  <<U.RAO>>38282000
INTEGER CPUCONNECTDATA = PARMS+3;                              <<U.RAO>>38284000
BYTE POINTER EXTRAPARM = PARMS+4;                              <<U.RAO>>38286000
LOGICAL DL := COMMACR;                                         <<U.RAO>>38288000
INTEGER NUMPARMS;                                              <<U.RAO>>38290000
ARRAY LACCT(0:4);                                              <<U.RAO>>38292000
                                                               <<U.RAO>>38294000
LACCT := "  ";                                                 <<U.RAO>>38296000
MOVE LACCT(1) := LACCT,(4);                                    <<U.RAO>>38298000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>38300000
IF NUMPARMS > 0 THEN                                           <<U.RAO>>38302000
   BEGIN                                                       <<U.RAO>>38304000
   IF INTEGER(ACCTNAMELEN) > 0 THEN                            <<U.RAO>>38306000
      BEGIN   <<ACCOUNT NAME PRESENT>>                         <<U.RAO>>38308000
      IF ACCT <> "@" THEN                                      <<U.RAO>>38310000
         BEGIN  <<SPECIFIC ACCOUNT DESIRED>>                   <<U.RAO>>38312000
         TYPE.(ENDLEVELF) := GROUPLEVEL;                       <<U.RAO>>38314000
         IF ACCTNAMELEN > 8 THEN                               <<U.RAO>>38316000
            BEGIN                                              <<U.RAO>>38318000
            PARMNUM := 1;                                      <<U.RAO>>38320000
            CIERR(ERRNUM := ACCTNAMETOOLONG, ACCT);            <<U.RAO>>38322000
            RETURN                                             <<U.RAO>>38324000
            END;                                               <<U.RAO>>38326000
         IF ACCT <> ALPHA THEN                                 <<U.RAO>>38328000
            BEGIN                                              <<U.RAO>>38330000
            PARMNUM := 1;                                      <<U.RAO>>38332000
            CIERR(ERRNUM := ACCTEXPECTALPHA, ACCT);            <<U.RAO>>38334000
            RETURN;                                            <<U.RAO>>38336000
            END;                                               <<U.RAO>>38338000
         TOS := @LACCT&LSL(1);                                 <<U.RAO>>38340000
         MOVE * := ACCT,(INTEGER(ACCTNAMELEN));                <<U.RAO>>38342000
         END                                                   <<U.RAO>>38344000
      ELSE   <<ACCT IS "@">>                                   <<U.RAO>>38346000
         IF ACCTNAMELEN > 1 THEN                               <<U.RAO>>38348000
            BEGIN                                              <<U.RAO>>38350000
            PARMNUM := 1;                                      <<U.RAO>>38352000
            CIERR(ERRNUM := RESACCTJUSTAT, ACCT(1));           <<U.RAO>>38354000
            RETURN                                             <<U.RAO>>38356000
            END;                                               <<U.RAO>>38358000
      END;                                                     <<U.RAO>>38360000
   IF NUMPARMS > 1 THEN  <<CPU OR CONNECT>>                    <<U.RAO>>38362000
      BEGIN                                                    <<U.RAO>>38364000
      IF (INTEGER(CPUCONNECTLEN) = 3)  AND                     <<U.RAO>>38366000
            (CPUCONNECT = "CPU") THEN                          <<U.RAO>>38368000
         FLAGS := 2                                            <<U.RAO>>38370000
      ELSE IF (CPUCONNECTLEN = 7) AND                          <<U.RAO>>38372000
            (CPUCONNECT = "CONNECT") THEN                      <<U.RAO>>38374000
         FLAGS := 1                                            <<U.RAO>>38376000
      ELSE  <<???>>                                            <<U.RAO>>38378000
         BEGIN                                                 <<U.RAO>>38380000
         PARMNUM := 2;                                         <<U.RAO>>38382000
         CIERR(ERRNUM := RESACCTEXPECT, CPUCONNECT);           <<U.RAO>>38384000
         RETURN                                                <<U.RAO>>38386000
         END;                                                  <<U.RAO>>38388000
      IF NUMPARMS > 2 THEN   <<TOO MANY PARMS>>                <<U.RAO>>38390000
         BEGIN                                                 <<U.RAO>>38392000
         PARMNUM := 3;                                         <<U.RAO>>38394000
         CIERR(ERRNUM := RESACCT2MP, EXTRAPARM);               <<U.RAO>>38396000
         RETURN                                                <<U.RAO>>38398000
         END;                                                  <<U.RAO>>38400000
      END;                                                     <<U.RAO>>38402000
   END;  <<ALL PARMS NOW PARSED AND VERIFIED>>                 <<U.RAO>>38404000
TOS := DIRECSCAN (TYPE,0D,LACCT,ARRDB0,ARRDB0,                 <<38.PV>>38406000
                  RCRESETACCT,FLAGS);                          <<38.PV>>38408000
IF <> THEN CYDIRERR'(*,%120000,ERRNUM);                        <<U.RAO>>38410000
END;                                                           <<U.RAO>>38412000
$PAGE       "ERROR HANLDERS AND MISC ROUTINES"                          38414000
$CONTROL   SEGMENT  = CIERR                                             38416000
LOGICAL PROCEDURE JOBSESSIONMAIN;                              <<U.RAO>>38418000
   OPTION UNCALLABLE;                                          <<U.RAO>>38420000
COMMENT                                                        <<U.RAO>>38422000
   RETURNS TRUE IF CURRENT PROCESS IS J/S MAIN                 <<U.RAO>>38424000
;                                                              <<U.RAO>>38426000
IF PCB09.PCBPTYPE = PCBJSMAIN THEN JOBSESSIONMAIN:=TRUE;       <<U.RAO>>38428000
LOGICAL PROCEDURE CIBADFILENAME(ERRNUM,PARM);                  <<U.RAO>>38430000
VALUE PARM;                                                    <<U.RAO>>38432000
DOUBLE PARM;                                                   <<U.RAO>>38434000
INTEGER ERRNUM;                                                <<U.RAO>>38436000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>38438000
BEGIN                                                          <<U.RAO>>38440000
   <<THIS PROCEDURE IS AN INTERFACE ROUTINE BETWEEN>>          <<U.RAO>>38442000
   <<CHECKFILENAME' AND THOSE ROUTINES WHICH WANT A FILE NAME ><<U.RAO>>38444000
   <<CHECKED AND ANY SYNTACTIC ERRORS REPORTED.  IT ONLY >>    <<U.RAO>>38446000
   <<RETURNS TRUE IF AN ERROR WAS DETECTED AND ONLY RETURNS>>  <<U.RAO>>38448000
   <<FALSE IF THE FILE NAME WAS NOT BAD.  >>                   <<U.RAO>>38450000
   <<ERRNUM IS A POINTER TO THE PARAMETER ERRNUM KNOWN THROUGOU<<U.RAO>>38452000
   <<THE CI.  PARM IS A DOUBLE DESCRIBING THE FILE NAME IN>>   <<U.RAO>>38454000
   <<THE FORMAT RETURNED BY MYCOMMAND.  IN PARTICULAR, THE FIRS<<U.RAO>>38456000
   <<WORD IS THE BYTE ADDRESS OF THE NAME AND THE FIRST BYTE>> <<U.RAO>>38458000
   <<OF THE SECOND WORD IS THE LENGTH OF THE NAME>>            <<U.RAO>>38460000
                                                               <<U.RAO>>38462000
LOGICAL DUMMY;                                                 <<U.RAO>>38464000
BYTE POINTER ERRPTR;                                           <<U.RAO>>38466000
LOGICAL LERRPTR = ERRPTR;                                      <<U.RAO>>38468000
                                                               <<U.RAO>>38470000
TOS := CHECKFILENAME'(PARM&LSR(8), DUMMY, DUMMY, LERRPTR);     <<U.RAO>>38472000
IF < THEN                                                      <<U.RAO>>38474000
   BEGIN                                                       <<U.RAO>>38476000
   ERRNUM := S0;                                               <<U.RAO>>38478000
   CIERR(*,ERRPTR);                                            <<U.RAO>>38480000
   CIBADFILENAME := TRUE;                                      <<U.RAO>>38482000
   END                                                         <<U.RAO>>38484000
ELSE                                                           <<U.RAO>>38486000
   CIBADFILENAME := FALSE;                                     <<U.RAO>>38488000
END;  <<CIBADFILENAME>>                                        <<U.RAO>>38490000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>38492000
VALUE PDEF; DOUBLE PDEF;                                       <<U.RAO>>38494000
LOGICAL GPTR,APTR,ERRPTR;                                      <<U.RAO>>38496000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>38498000
BEGIN                                                          <<U.RAO>>38500000
COMMENT                                                                 38502000
  THIS PROCEDURE DOES A COMPLETE VALIDATION OF THE FORM OF AN           38504000
ACTUAL FILE DESIGNATOR, INCLUDING SPECIAL FILES.                        38506000
                                                                        38508000
PARAMETERS:                                                             38510000
  PDEF - THE FIRST WORD IS A BYTE POINTER TO THE START OF THE           38512000
         ACTUAL FILE DESIGNATOR AND THE SECOND WORD IS A COUNT          38514000
         OF THE NUMBER OF CHARACTERS IN THE NAME,                       38516000
         INCLUDING SPECIAL CHARACTERS IF ANY.  IT IS A DOUBLE           38518000
         BECAUSE THAT IS THE MOST CONVENIENT FORM FOR ROUTINES WHICH    38520000
         HAVE THEIR PARAMETERS PARSED BY MYCOMMAND.                     38522000
  GPTR - IF A REASONABLY VALID GROUP NAME IS PARSED, A BYTE POINTER     38524000
         TO THE START OF THAT NAME IS PASSED THROUGH THIS LOGICAL       38526000
         BY REFERENCE.  IF NO VALID GROUP NAME IS FOUND, THIS IS        38528000
         UNCHANGED.                                                     38530000
  APTR - AN ACCOUNT POINTER SIMILAR TO THE GPTR.                        38532000
  ERRPTR - A MEANS BY WHICH THIS PROCEDURE MAY RETURN A POINTER TO      38534000
           ANY ERROR FOUND IN THE BODY OF THE NAME.                     38536000
  CHECKFILENAME' - SEE CONDITION CODE FOR INTERPRETATION.               38538000
  CONDITION CODE:                                                       38540000
     CCE => FOUND NORMAL ACTUAL FILE DESIGNATOR, NO ERRORS, RETURNS     38542000
            A 0.                                                        38544000
     CCL => FOUND ERROR.  CHECKFILENAME' IS THE CIERROR NUMBER.         38546000
     CCG => NO ERRORS. FOUND BACKREFERENCED FILE NAME OR SYSTEM         38548000
            DEFINED FILE NAME.  IF CHECKFILENAME' = 0, THEN IS          38550000
            BACKREFERENCED FILE NAME. IF <> 0 THEN IS INDEX OF          38552000
            SYSTEM DEFINED FILE NAME, AS DEFINED IN THE DEFAULT         38554000
            DESIGNATOR FIELD OF THE FOPTION WORD IN FOPEN.              38556000
                                                                        38558000
ALGORITHM - THE SCHEME IS TO SIMPLY CRUNCH THROUGH, LOOKING AT EACH     38560000
         PART AS WE COME TO IT.                                         38562000
;                                                                       38564000
                                                               <<U.RAO>>38566000
INTEGER RESULTSPACE=CHECKFILENAME';                            <<U.RAO>>38568000
BYTE POINTER PARMPTR = PDEF;  <<POINTER TO CURRENT LOCATION IN NAME>>   38570000
INTEGER LENGTH = PDEF+1;                                       <<U.RAO>>38572000
BYTE ARRAY PSYSDEFLIST(0:1)=PB :=                              <<U.RAO>>38574000
  10, 8, "$STDLIST",                                           <<U.RAO>>38576000
  10, 8, "$NEWPASS",                                           <<U.RAO>>38578000
  10, 8, "$OLDPASS",                                           <<U.RAO>>38580000
   8, 6, "$STDIN",                                             <<U.RAO>>38582000
   9, 7, "$STDINX",                                            <<U.RAO>>38584000
   7, 5, "$NULL",                                              <<U.RAO>>38586000
   0;                                                          <<U.RAO>>38588000
EQUATE PSYSDEFLISTL = 55;                                      <<U.RAO>>38590000
BYTE ARRAY SYSDEFLIST(0:PSYSDEFLISTL-1);                       <<U.RAO>>38592000
LOGICAL LOCKWORD := FALSE;                                     <<U.RAO>>38594000
INTEGER TEMPLEN;                                               <<U.RAO>>38596000
                                                               <<U.RAO>>38598000
EQUATE EXPECTALPHA = 1,                                        <<U.RAO>>38600000
       NAMEMISSING = 2,                                        <<U.RAO>>38602000
       NAMETOOLONG = 3;                                        <<U.RAO>>38604000
                                                               <<U.RAO>>38606000
LOGICAL SUBROUTINE CHECKNAME(DELTA);                           <<U.RAO>>38608000
<<GENERAL PURPOSE NAME CHECKER>>                               <<U.RAO>>38610000
VALUE DELTA;INTEGER DELTA;                                     <<U.RAO>>38612000
                                                               <<U.RAO>>38614000
BEGIN                                                          <<U.RAO>>38616000
CHECKNAME := FALSE;                                            <<U.RAO>>38618000
@PARMPTR := @PARMPTR+1;  <<ELIMINATE DELIMITER>>               <<U.RAO>>38620000
ERRPTR := ERRPTR+1;                                            <<U.RAO>>38622000
LENGTH := LENGTH-1;                                            <<U.RAO>>38624000
IF = THEN                                                      <<U.RAO>>38626000
   BEGIN                                                       <<U.RAO>>38628000
   CC := CCL;  <<SET ERROR INDICATION>>                        <<U.RAO>>38630000
   CHECKFILENAME' := NAMEMISSING+DELTA                         <<U.RAO>>38632000
   END                                                         <<U.RAO>>38634000
ELSE IF PARMPTR <> ALPHA THEN                                  <<U.RAO>>38636000
   BEGIN                                                       <<U.RAO>>38638000
   CC := CCL;  <<SET ERROR INDICATION>>                        <<U.RAO>>38640000
   CHECKFILENAME' := EXPECTALPHA+DELTA                         <<U.RAO>>38642000
   END                                                         <<U.RAO>>38644000
ELSE                                                           <<U.RAO>>38646000
   BEGIN                                                       <<U.RAO>>38648000
   MOVE PARMPTR := PARMPTR WHILE ANS, 0;                       <<U.RAO>>38650000
   TEMPLEN := TOS-@PARMPTR;                                    <<U.RAO>>38652000
   IF = THEN                                                   <<U.RAO>>38654000
      BEGIN                                                    <<U.RAO>>38656000
      DEL;                                                     <<U.RAO>>38658000
      CHECKFILENAME' := NAMEMISSING+DELTA;                     <<U.RAO>>38660000
      CC := CCL;  <<SET ERROR INDICATION>>                     <<U.RAO>>38662000
      END                                                      <<U.RAO>>38664000
   ELSE IF TEMPLEN > 8 THEN                                    <<U.RAO>>38666000
      BEGIN                                                    <<U.RAO>>38668000
      DEL;                                                     <<U.RAO>>38670000
      CHECKFILENAME' := NAMETOOLONG+DELTA;                     <<U.RAO>>38672000
      CC := CCL;  <<SET ERROR INDICATION>>                     <<U.RAO>>38674000
      END                                                      <<U.RAO>>38676000
   ELSE  <<NAME OK>>                                           <<U.RAO>>38678000
      BEGIN                                                    <<U.RAO>>38680000
      @PARMPTR := S0;                                          <<U.RAO>>38682000
      ERRPTR := TOS;  <<FIXUP FOR NEXT ROUND>>                 <<U.RAO>>38684000
      CHECKNAME := TRUE;                                       <<U.RAO>>38686000
      END;                                                     <<U.RAO>>38688000
   END;                                                        <<U.RAO>>38690000
END;  <<SUBROUTINE CHECKNAME>>                                 <<U.RAO>>38692000
                                                               <<U.RAO>>38694000
ERRPTR := @PARMPTR;                                            <<U.RAO>>38696000
CHECKFILENAME' := 0;                                           <<U.RAO>>38698000
CC := CCE;  <<ASSUME NORMAL FILE NAME>>                        <<U.RAO>>38700000
IF LENGTH = 0 THEN                                             <<U.RAO>>38702000
   BEGIN                                                       <<U.RAO>>38704000
   CC := CCL;                                                  <<U.RAO>>38706000
   CHECKFILENAME' := FILENAMEMISSING                           <<U.RAO>>38708000
   END                                                         <<U.RAO>>38710000
ELSE IF PARMPTR = "$" THEN  <<SYSTEM DEFINED FILE>>            <<U.RAO>>38712000
   BEGIN                                                       <<U.RAO>>38714000
   CC := CCG;  <<SET SYSTEM DEFINED FILE>>                     <<U.RAO>>38716000
   MOVE SYSDEFLIST := PSYSDEFLIST,(PSYSDEFLISTL);              <<U.RAO>>38718000
   CHECKFILENAME' :=  SEARCH(PARMPTR,LENGTH,SYSDEFLIST);       <<U.RAO>>38720000
   IF RESULTSPACE = 0 THEN                                     <<U.RAO>>38722000
      BEGIN                                                    <<U.RAO>>38724000
      CC := CCL;  <<SEARCH FAILED>>                            <<U.RAO>>38726000
      CHECKFILENAME' := UNKNOWNSYSDEF;                         <<U.RAO>>38728000
      END;                                                     <<U.RAO>>38730000
   END                                                         <<U.RAO>>38732000
ELSE                                                           <<U.RAO>>38734000
   BEGIN                                                       <<U.RAO>>38736000
   IF PARMPTR <> "*" THEN  <<NOT BACK REFERENCED FILE>>        <<U.RAO>>38738000
      BEGIN  <<MUST FAKE DELIMITER>>                           <<U.RAO>>38740000
      @PARMPTR := @PARMPTR-1;                                  <<U.RAO>>38742000
      ERRPTR := ERRPTR-1;                                      <<U.RAO>>38744000
      LENGTH := LENGTH+1;                                      <<U.RAO>>38746000
      END                                                      <<U.RAO>>38748000
   ELSE                                                        <<U.RAO>>38750000
      CC := CCG;                                               <<U.RAO>>38752000
   << FIRST CHORE IS TO CHECK FILE NAME>>                      <<U.RAO>>38754000
   IF NOT CHECKNAME(FFNAMEBASE) THEN RETURN;                   <<U.RAO>>38756000
   LENGTH := LENGTH-TEMPLEN;                                   <<U.RAO>>38758000
   IF = THEN RETURN;  <<ENTIRE NAME PARSED SUCCESSFULLY>>      <<U.RAO>>38760000
   IF PARMPTR = "/" THEN  <<LOCKWORD?>>                        <<U.RAO>>38762000
      BEGIN                                                    <<U.RAO>>38764000
      IF NOT CHECKNAME(FLWORDBASE) THEN RETURN;  <<BAD LOCKWORD<<U.RAO>>38766000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>38768000
      IF = THEN RETURN; <<SUCCESS>>                            <<U.RAO>>38770000
      LOCKWORD := TRUE;  <<FLAG FOR LATER ERR MSG>>            <<U.RAO>>38772000
      END;                                                     <<U.RAO>>38774000
   <<CHECK GROUP NAME>>                                        <<U.RAO>>38776000
   IF PARMPTR = "." THEN  <<GROUP NAME>>                       <<U.RAO>>38778000
      BEGIN                                                    <<U.RAO>>38780000
      GPTR := @PARMPTR+1;                                      <<U.RAO>>38782000
      IF NOT CHECKNAME(FGNAMEBASE) THEN RETURN;                <<U.RAO>>38784000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>38786000
      IF = THEN RETURN;  <<SUCCESS>>                           <<U.RAO>>38788000
      END                                                      <<U.RAO>>38790000
   ELSE  <<SOME OTHER SPECIAL CHARACTER>>                      <<U.RAO>>38792000
      BEGIN                                                    <<U.RAO>>38794000
      CC := CCL;                                               <<U.RAO>>38796000
      IF LOCKWORD THEN CHECKFILENAME' := EXPECTPERIOD          <<U.RAO>>38798000
      ELSE CHECKFILENAME' := XPCTPERIODSLASH;                  <<U.RAO>>38800000
      RETURN                                                   <<U.RAO>>38802000
      END;                                                     <<U.RAO>>38804000
   IF PARMPTR = "." THEN  <<POSSIBLE ACCOUNT NAME>>            <<U.RAO>>38806000
      BEGIN                                                    <<U.RAO>>38808000
      APTR := @PARMPTR+1;                                      <<U.RAO>>38810000
      IF NOT CHECKNAME(FANAMEBASE) THEN RETURN;                <<U.RAO>>38812000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>38814000
      IF = THEN RETURN;                                        <<U.RAO>>38816000
      END                                                      <<U.RAO>>38818000
   ELSE  <<SOME OTHER SPECIAL CHARACTER>>                      <<U.RAO>>38820000
      BEGIN                                                    <<U.RAO>>38822000
      CC := CCL;                                               <<U.RAO>>38824000
      CHECKFILENAME' := EXPECTPERIOD;                          <<U.RAO>>38826000
      RETURN                                                   <<U.RAO>>38828000
      END;                                                     <<U.RAO>>38830000
   CHECKFILENAME' := EXTRANEOUSADESG;                          <<U.RAO>>38832000
   CC := CCL;  <<FAILED IF WE GOT TO HERE>>                    <<U.RAO>>38834000
   END;                                                        <<U.RAO>>38836000
END;  <<CHECKFILENAME'>>                                       <<U.RAO>>38838000
<< Returns values from specified stack marker. >>              <<04193>>38840000
                                                               <<04193>>38842000
PROCEDURE STACKMARK( WHICH, DELQ, STAT, RELP, XREG );          <<04193>>38844000
   VALUE   WHICH;                                              <<04193>>38846000
   INTEGER WHICH, DELQ, STAT, RELP, XREG;                      <<04193>>38848000
   OPTION VARIABLE, UNCALLABLE, PRIVILEGED;                    <<04193>>38850000
BEGIN                                                          <<04193>>38852000
                                                               <<04193>>38854000
<<*********************************************************>>  <<04193>>38856000
<<                                                         >>  <<04193>>38858000
<< This procedure traces back the caller's stack to the    >>  <<04193>>38860000
<< stack marker specified by WHICH--note that the call to  >>  <<04193>>38862000
<< this procedure is not counted; thus, if a procedure     >>  <<04193>>38864000
<< wants the previous stack marker, it should call this    >>  <<04193>>38866000
<< procedure with a value of 1 for WHICH.  This procedure  >>  <<04193>>38868000
<< will return the values stored in the specified marker.  >>  <<04193>>38870000
<<                                                         >>  <<04193>>38872000
<<    Since it is easy to get confused about how many      >>  <<04193>>38874000
<< stack markers back are traveled, please examine the     >>  <<04193>>38876000
<< following example.  Suppose CXLISTF calls CIERR and     >>  <<04193>>38878000
<< CIERR then calls PRINTCARET; further suppose that       >>  <<04193>>38880000
<< PRINTCARET wishes the STATUS and RELATIVE-P that        >>  <<04193>>38882000
<< indicates that CIERR was called by CXLISTF (i.e. the    >>  <<04193>>38884000
<< STATUS and RELATIVE-P should point into the system      >>  <<04193>>38886000
<< segment that contains CXLISTF).  While in PRINTCARET,   >>  <<04193>>38888000
<< the stack would look like this:                         >>  <<04193>>38890000
<<                                                         >>  <<04193>>38892000
<<    |                     |                              >>  <<04193>>38894000
<<    |  CXLISTF work area  |                              >>  <<04193>>38896000
<<    |                     |                              >>  <<04193>>38898000
<<    |---------------------|                              >>  <<04193>>38900000
<<    |                     |  Stack marker for CXLISTF.   >>  <<04193>>38902000
<<    |---------------------|                              >>  <<04193>>38904000
<<    |  CIERR work area    |                              >>  <<04193>>38906000
<<    |---------------------|                              >>  <<04193>>38908000
<<    |                     |  Stack marker for CIERR.     >>  <<04193>>38910000
<<    |---------------------|                              >>  <<04193>>38912000
<<    |  PRINTCARET work    |  <--Q+1                      >>  <<04193>>38914000
<<    |       area          |                              >>  <<04193>>38916000
<<    |                     |                              >>  <<04193>>38918000
<<                                                         >>  <<04193>>38920000
<< While in PRINTCARET, a call to STACK'MARK( 0, ...);     >>  <<04193>>38922000
<< would return values from the stack marker for CIERR.    >>  <<04193>>38924000
<< Therefore, in this example, PRINTCARET will need a call >>  <<04193>>38926000
<< of the form STACK'MARK( 1, ... ); in order to determine >>  <<04193>>38928000
<< that it was CXLISTF that called CIERR.                  >>  <<04193>>38930000
<<                                                         >>  <<04193>>38932000
<<    If the above example seems wrong and you feel that   >>  <<04193>>38934000
<< we should travel back 2 markers to get the desired      >>  <<04193>>38936000
<< information, please pretend that we are doing zero      >>  <<04193>>38938000
<< origin indexing.                                        >>  <<04193>>38940000
<<                                                         >>  <<04193>>38942000
<<                                                         >>  <<04193>>38944000
<< Parameters:                                             >>  <<04193>>38946000
<<    WHICH:  (required) specified how many stack markers  >>  <<04193>>38948000
<<            back from the caller to travel.              >>  <<04193>>38950000
<<    DELQ:   (optional) if there, gets the delta-Q value  >>  <<04193>>38952000
<<            of the specified marker.                     >>  <<04193>>38954000
<<    STAT:   (optional) if there, gets the status word    >>  <<04193>>38956000
<<            of the specified marker.                     >>  <<04193>>38958000
<<    RELP:   (optional) if there, gets the relative P     >>  <<04193>>38960000
<<            value of the specified marker.               >>  <<04193>>38962000
<<    XREG:   (optional) if there, gets the X register     >>  <<04193>>38964000
<<            value of the specified marker.               >>  <<04193>>38966000
<<                                                         >>  <<04193>>38968000
<< Condition code:  This procedure returns CCE if it was   >>  <<04193>>38970000
<<    able to access the specified marker.  It returns CCL >>  <<04193>>38972000
<<    if WHICH is less than -1 or if the procedure goes    >>  <<04193>>38974000
<<    past the stack's initial-Q value in the search for   >>  <<04193>>38976000
<<    the specified marker.                                >>  <<04193>>38978000
<<                                                         >>  <<04193>>38980000
<<*********************************************************>>  <<04193>>38982000
                                                               <<04193>>38984000
LOGICAL  PMASK  = Q-4;   << Parameter mask for variable    >>  <<04193>>38986000
                         <<    procedure option.           >>  <<04193>>38988000
DEFINE                                                         <<04193>>38990000
   WANTS'XREG  = PMASK.(15:1)#,   << These defines deter-  >>  <<04193>>38992000
   WANTS'RELP  = PMASK.(14:1)#,   << mine which parameters >>  <<04193>>38994000
   WANTS'STAT  = PMASK.(13:1)#,   << were present in the   >>  <<04193>>38996000
   WANTS'DELQ  = PMASK.(12:1)#,   << procedure call.       >>  <<04193>>38998000
   WHICH'MISSING  = ( NOT PMASK.(11:1) )#;                     <<04193>>39000000
                                                               <<04193>>39002000
INTEGER POINTER QINDEX;  << For referencing the markers.   >>  <<04193>>39004000
                                                               <<04193>>39006000
INTEGER I := -1;         << Counts stack markers.          >>  <<04193>>39008000
                                                               <<04193>>39010000
INTEGER INITQ;           << This stack's initial Q value.  >>  <<04193>>39012000
                                                               <<04193>>39014000
INTEGER IX = X;          << The index register is used in  >>  <<04193>>39016000
                         << the global defines needed to   >>  <<04193>>39018000
                         << determine this stack's INITQ.  >>  <<04193>>39020000
                                                               <<04193>>39022000
DEFINE                                                         <<04193>>39024000
   GET'INITQ = SETXPXFIXED;   << Initializes INITQ.        >>  <<04193>>39026000
               INITQ := DBARRAY( IX+PXFWQINIT ) #;             <<04193>>39028000
                                                               <<04193>>39030000
<< Start of STACKMARK's code.                              >>  <<04193>>39032000
                                                               <<04193>>39034000
<< Initialize.  Assume successful completion.              >>  <<04193>>39036000
   CC := CCE;                                                  <<04193>>39038000
   GET'INITQ;                                                  <<04193>>39040000
                                                               <<04193>>39042000
<< Check on WHICH.  If not present or out of bounds, then  >>  <<04193>>39044000
<<    produce an error return.                             >>  <<04193>>39046000
   IF WHICH'MISSING  OR  WHICH < -1 THEN                       <<04193>>39048000
   BEGIN                                                       <<04193>>39050000
      CC := CCL;                                               <<04193>>39052000
      RETURN;                                                  <<04193>>39054000
   END;                                                        <<04193>>39056000
                                                               <<04193>>39058000
<< Starting from STACK'MARKER's Q, trace back WHICH+1      >>  <<04193>>39060000
<<    stack markers if possible.  Recall that WHICH is     >>  <<04193>>39062000
<<    relative to this procedure's caller, thus WHICH+1.   >>  <<04193>>39064000
<<    This is performed because I is initialized to -1.    >>  <<04193>>39066000
   @QINDEX := @DELTAQ;           << STACK'MARKER's marker. >>  <<04193>>39068000
   WHILE @QINDEX <> INITQ  AND  I < WHICH DO                   <<04193>>39070000
   BEGIN                                                       <<04193>>39072000
      @QINDEX := @QINDEX - QINDEX;                             <<04193>>39074000
      I := I + 1;                                              <<04193>>39076000
   END;                                                        <<04193>>39078000
                                                               <<04193>>39080000
<< Check for falling off the stack.                        >>  <<04193>>39082000
   IF @QINDEX = INITQ                                          <<04193>>39084000
      THEN CC := CCL         << Fell off the stack.        >>  <<04193>>39086000
   ELSE                                                        <<04193>>39088000
   BEGIN                                                       <<04193>>39090000
                                                               <<04193>>39092000
   << Found the right stack.  Return the requested values. >>  <<04193>>39094000
      IF WANTS'DELQ  THEN DELQ := QINDEX;                      <<04193>>39096000
      IF WANTS'STAT  THEN STAT := QINDEX(-1);                  <<04193>>39098000
      IF WANTS'RELP  THEN RELP := QINDEX(-2);                  <<04193>>39100000
      IF WANTS'XREG  THEN XREG := QINDEX(-3);                  <<04193>>39102000
                                                               <<04193>>39104000
   END;                                                        <<04193>>39106000
                                                               <<04193>>39108000
END;  << STACKMARK >>                                          <<04193>>39110000
                                                               <<04193>>39112000
                                                               <<04193>>39114000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<U.RAO>>39116000
VALUE FNUM;                                                    <<U.RAO>>39118000
INTEGER FNUM,PARMNUM;                                          <<U.RAO>>39120000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>39122000
<<GENERATES FILESYS ERROR MESSAGE, RETURNS FCHECK #>>          <<U.RAO>>39124000
BEGIN                                                          <<U.RAO>>39126000
FCHECK(FNUM,PARMNUM);                                          <<U.RAO>>39128000
IF NOT (0<=FNUM<=2) THEN                                       <<U.RAO>>39130000
   FCLOSE(FNUM, -1, 0);                                        <<U.RAO>>39132000
IF JOBSESSIONMAIN THEN GENMSG(FSERRORMSGSET, PARMNUM);         <<02.RO>>39134000
END;  <<FERROR'>>                                              <<U.RAO>>39136000
PROCEDURE CXNOTYET EXECUTORHEAD;                                        39138000
   OPTION PRIVILEGED, UNCALLABLE;                                       39140000
   CIERR(ERRNUM:=NOTYETIMPLEMENTED);                                    39142000
$PAGE "SYSTEM INTERNAL ERROR HANDLER"                          <<04193>>39144000
<< Handles generation of System Internal Error messages. >>    <<04193>>39146000
                                                               <<04193>>39148000
PROCEDURE SYSINTERR( ERRN, BACK );                             <<04193>>39150000
   VALUE   ERRN, BACK;                                         <<04193>>39152000
   INTEGER ERRN, BACK;                                         <<04193>>39154000
   OPTION UNCALLABLE, PRIVILEGED;                              <<04193>>39156000
BEGIN                                                          <<04193>>39158000
                                                               <<04193>>39160000
<<*********************************************************>>  <<04193>>39162000
<<                                                         >>  <<04193>>39164000
<< This procedure handles the printing of system internal  >>  <<04193>>39166000
<< errors.  These are error messages for those circum-     >>  <<04193>>39168000
<< stances where a recovery is possible, but we wish to    >>  <<04193>>39170000
<< report the error, anyhow.                               >>  <<04193>>39172000
<<                                                         >>  <<04193>>39174000
<< Parameters:                                             >>  <<04193>>39176000
<<    ERRN:  The message number in the system internal     >>  <<04193>>39178000
<<           error message set.                            >>  <<04193>>39180000
<<    BACK:  If BACK >= -1, then the RELATIVE-P and the    >>  <<04193>>39182000
<<           STATUS value of the indicated stack marker    >>  <<04193>>39184000
<<           are printed.  See the header comment for      >>  <<04193>>39186000
<<           the procedure STACK'MARKER for further        >>  <<04193>>39188000
<<           information on the meaning of this parameter. >>  <<04193>>39190000
<<           Note, however, that this value is relative to >>  <<04193>>39192000
<<           SYSINTERR's caller, thus BACK is incremented  >>  <<04193>>39194000
<<           by one when STACK'MARKER is called.           >>  <<04193>>39196000
<<                                                         >>  <<04193>>39198000
<< Future Enhancements:                                    >>  <<04193>>39200000
<<    In the future, this procedure will be modified to    >>  <<04193>>39202000
<<    also log the occurences of system internal errors.   >>  <<04193>>39204000
<<                                                         >>  <<04193>>39206000
<<*********************************************************>>  <<04193>>39208000
                                                               <<04193>>39210000
INTEGER                                                        <<04193>>39212000
   CALLERSTAT,     << Status register of CIERR caller.>>       <<04193>>39214000
   CALLERSP;       << P offset of CIERR caller.       >>       <<04193>>39216000
                                                               <<04193>>39218000
BYTE ARRAY                                                     <<04193>>39220000
   OUTBUFF(0:21);  << For error msg in bounds viol.   >>       <<04193>>39222000
                                                               <<04193>>39224000
                                                               <<04193>>39226000
                                                               <<04193>>39228000
<< Print the initial error message.                        >>  <<04193>>39230000
   GENMSG( INTRNLERRSET, ERRN, , ,,,,, -2 );                   <<04193>>39232000
                                                               <<04193>>39234000
<< If BACK was specified, print the STATUS and RELATIVE-P  >>  <<04193>>39236000
<<    values of the stack marker indicated.                >>  <<04193>>39238000
   IF BACK >= -1 THEN                                          <<04193>>39240000
   BEGIN                                                       <<04193>>39242000
      STACKMARK( BACK+1, , CALLERSTAT, CALLERSP );             <<04193>>39244000
      IF = THEN     << Was able to find the appropriate >>     <<04193>>39246000
      BEGIN         <<    stack marker.                 >>     <<04193>>39248000
         OUTBUFF := 0;   MOVE OUTBUFF(1) := OUTBUFF, (21);     <<04193>>39250000
         OUTBUFF := "%";                                       <<04193>>39252000
         ASCII( CALLERSTAT, 8, OUTBUFF(1) );                   <<04193>>39254000
         OUTBUFF(11) := "%";                                   <<04193>>39256000
         ASCII( CALLERSP, 8, OUTBUFF(12) );                    <<04193>>39258000
         GENMSG( INTRNLERRSET, STATUS'AND'P, 0,                <<04193>>39260000
                 @OUTBUFF, @OUTBUFF(11), ,,, -2 );             <<04193>>39262000
      END;                                                     <<04193>>39264000
   END;                                                        <<04193>>39266000
                                                               <<04193>>39268000
<< Request that the user send in information so that we    >>  <<04193>>39270000
<<    later examine the cause of the internal error.       >>  <<04193>>39272000
                                                               <<04193>>39274000
   GENMSG( INTRNLERRSET, COPYSCREEN, 0, ,,,,, -2 );            <<04193>>39276000
   RETURN;                                                     <<04193>>39278000
                                                               <<04193>>39280000
END;  << SYSINTERR >>                                          <<04193>>39282000
                                                               <<04193>>39284000
                                                               <<04193>>39286000
PROCEDURE PRINTCARET(ERRADR);                                  <<01032>>39288000
BYTE ARRAY ERRADR;                                             <<01032>>39290000
OPTION INTERNAL;                                               <<01032>>39292000
                                                               <<01032>>39294000
BEGIN                                                          <<01032>>39296000
COMMENT                                                        <<01032>>39298000
    THE FOLLOWING ROUTINE PRINTS A CARET UNDER THE ITEM        <<01032>>39300000
    IN ERROR. IF THE COMMAND EXTENDED OVER SEVERAL LINES THEN  <<01032>>39302000
    THE OFFENDING LINE IS PRINTED WITH THE CARET UNDER THE     <<01032>>39304000
    GUILTY CHARACTER, AND A LINE NUMBER RELATIVE TO THE FIRST  <<01032>>39306000
    LINE OF THE COMMAND IS PRINTED OUT.                        <<01032>>39308000
                                                               <<01032>>39310000
    ERRADR - A BYTE POINTER TO THE OFFENDING CHARACTER.        <<01032>>39312000
    BCOMIMAGE - DB RELATIVE ARRAY CONTAINING THE ENTIRE        <<01032>>39314000
                COMMAND TO BE PASSED TO THE CI.                <<01032>>39316000
    LINELENSTACK - A GLOBAL ARRAY CONTAINING THE LENGTHS IN    <<01032>>39318000
                   BYTES OF ORGINAL AND ANY CONSCUTIVE CONTI-  <<01032>>39320000
                   NUATION LINES. THIS ARRAY IS TERMINATED BY  <<01032>>39322000
                   A BINARY ZERO.                              <<01032>>39324000
                                                               <<01032>>39326000
    OPERATION : IF THERE ARE NO CONTINUATION LINES THEN ADJUST <<01032>>39328000
               THE OFFSET WITHIN THE OUTPUT BUFFER AND PRINT   <<01032>>39330000
               IT OUT. OTHERWISE CALCULATE THE OFFSET AND THE  <<01032>>39332000
               LINE NUMBER WHERE THE ERROR OCCURED FORMAT THE  <<01032>>39334000
               LINE NUMBER AND PUT IT TOGETHER WITH THE CONTENT<<01032>>39336000
               OF THE LINE INTO THE OUTPUT BUFFER. IF THE OFFEN<<01032>>39338000
               DING LINE IS THE LAST ONE,DO NOT ECHO IT.       <<01032>>39340000
                                                                        39342000
    ;                                                          <<01032>>39344000
DEFINE LINE'LENGTH=LINELENSTACK(LINELENSPTR)#;                 <<01032>>39346000
INTEGER OFFSET,LINELENSPTR:=-1,                                <<01032>>39348000
        BYTE'COUNT:=0,LEN:=-1;                                 <<01032>>39350000
ARRAY WBUF(0:WCOMMANDBUFLEN-1);                                <<01517>>39352000
BYTE ARRAY BBUF(*)=WBUF;                                       <<01032>>39354000
BYTE POINTER BPTR;                                             <<01032>>39356000
                                                               <<01032>>39358000
<< Calculate the caret position and bounds-check. >>           <<04193>>39360000
OFFSET := @ERRADR - @BCOMIMAGE + 1;                            <<01032>>39362000
IF NOT ( 0 <= OFFSET <= BCOMMANDBUFLEN ) THEN                  <<04193>>39364000
BEGIN    << Offset not in bounds--CIERR calling error. >>      <<04193>>39366000
                                                               <<04193>>39368000
   SYSINTERR( PRINTCARETERR, 1 );                              <<04193>>39370000
   RETURN;                                                     <<04193>>39372000
                                                               <<04193>>39374000
END;                                                           <<04193>>39376000
                                                               <<04193>>39378000
IF LINELENSTACK(LINELENSPTR+1) <> 0 THEN                       <<01032>>39380000
    BEGIN                                                      <<01032>>39382000
        DO BEGIN                                               <<01032>>39384000
            LINELENSPTR := LINELENSPTR + 1;                    <<01032>>39386000
            BYTE'COUNT := BYTE'COUNT + LINE'LENGTH;            <<01032>>39388000
        END UNTIL BYTE'COUNT >= OFFSET OR LINE'LENGTH = 0;     <<01517>>39390000
        IF LINE'LENGTH <> 0 THEN                               <<01032>>39392000
            BEGIN                                              <<01032>>39394000
                @BPTR := @BCOMIMAGE(BYTE'COUNT - LINE'LENGTH); <<01032>>39396000
                BBUF := "(";                                   <<01032>>39398000
                LEN := ASCII(LINELENSPTR,10,BBUF(1));          <<01032>>39400000
                BBUF(LEN + 1) := ")";                          <<01032>>39402000
                MOVE BBUF(LEN+2) := BPTR,(LINE'LENGTH);        <<01032>>39404000
                PRINT(WBUF,-LINE'LENGTH-LEN-2,0);              <<01032>>39406000
                OFFSET := OFFSET - NUMBER'BLANKS;              <<04170>>39408000
            END;                                               <<01032>>39410000
        OFFSET := OFFSET-(BYTE'COUNT-LINE'LENGTH)+LEN+1;       <<01032>>39412000
    END;                                                       <<01032>>39414000
BBUF := " ";                                                   <<01032>>39416000
MOVE BBUF(1) := BBUF,(BCOMMANDBUFLEN-1);                       <<01517>>39418000
OFFSET := OFFSET + NUMBER'BLANKS;                              <<04170>>39420000
<<                  >>                                         <<01032>>39422000
BBUF(OFFSET) := "^";                                           <<01032>>39424000
PRINT(WBUF,-OFFSET-1,0);                                       <<01032>>39426000
                                                               <<01032>>39428000
END; << PROCEDURE PRINTCARET >>                                <<01032>>39430000
PROCEDURE CIERR(ERRNUM,ERRADR,PARMMASK,PARM);                  <<U.RAO>>39432000
VALUE ERRNUM,PARMMASK,PARM;                                    <<U.RAO>>39434000
INTEGER ERRNUM,PARMMASK,PARM;                                  <<U.RAO>>39436000
BYTE ARRAY ERRADR;                                             <<U.RAO>>39438000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                         <<U.RAO>>39440000
BEGIN                                                          <<U.RAO>>39442000
COMMENT                                                        <<U.RAO>>39444000
                                                               <<U.RAO>>39446000
  CAUSES ERROR MESSAGE TO BE PRINTED, HANDLES DETAILS RELATED  <<U.RAO>>39448000
    TO THE CONSEQUENCES OF MAKING AN ERROR.                    <<U.RAO>>39450000
                                                               <<U.RAO>>39452000
  ERRNUM - CIERROR NUMBER.   REQUIRED PARAMETER.   IF NEGATIVE,<<U.RAO>>39454000
    SIMPLY PRINT THE INDICATED MESSAGE AND RETURN.             <<U.RAO>>39456000
  ERRADR - BYTE ADDRESS WHERE PROBLEM DETECTED.  PASSED TO     <<U.RAO>>39458000
    PRINTCARET.  IF MISSING, DO NOT PRINT CARET.               <<U.RAO>>39460000
  PARMMASK -                                                   <<03.KM>>39462000
    %0000N => PARM IS BYTE ADDR.  IF N<=1, @PARM CONTAINS ONLY <<03.KM>>39464000
              ONE STRING.  IF N=2, @PARM CONTAINS TWO STRINGS. <<03.KM>>39466000
              STRINGS ARE TERMINATED BY NULL (0).              <<03.KM>>39468000
    %10000 => PARM IS INTEGER BY VALUE.                        <<U.RAO>>39470000
    %20000 => PARM IS DOUBLE INTEGER BY REFERENCE.             <<U.RAO>>39472000
    %30000 - %70000  ARE SPARES.                               <<U.RAO>>39474000
       (NOTE: BITS 4-15 ARE RESERVED)                          <<U.RAO>>39476000
    IF PARMMASK IS MISSING, NO PARAMETER WAS PASSED.           <<U.RAO>>39478000
  PARM - ACTUAL PARAMETER AS DESCRIBED UNDER PARMMASK.         <<U.RAO>>39480000
*************************************************************  <<06.RO>>39482000
WARNING:  In JOBs, CIERR attempts to abort the user, if he has <<06.RO>>39484000
not invoked the CONTINUE command and it is not just a warning. <<06.RO>>39486000
In such cases, CIERR does not ever return to the caller.  If   <<06.RO>>39488000
you have cleanup work which must be done before termination,   <<06.RO>>39490000
such as releasing SIRs, it must be done before calling CIERR.  <<06.RO>>39492000
*************************************************************  <<06.RO>>39494000
  ;                                                            <<U.RAO>>39496000
                                                               <<U.RAO>>39498000
DEFINE PFLAG=     VARMASK.(14:1) #,                            <<03.KM>>39500000
       NONSTRING= PARMMASK.(1:3)<>0 #,                         <<03.KM>>39502000
       ONESTRING= PARMMASK.(13:3)<=1 #;                        <<03.KM>>39504000
INTEGER PARM2;                                                 <<03.KM>>39506000
INTEGER COMLEN;                                                <<00617>>39508000
LOGICAL VARMASK=Q-4;  <<OPTION VARIABLE MASK WORD>>            <<U.RAO>>39510000
LOGICAL JUSTPRINT := FALSE;                                    <<U.RAO>>39512000
LOGICAL MODE;   <<RETURNED BY WHO INTRINSIC>>                  <<U.RAO>>39514000
BYTE ARRAY JCWNAME(0:7);  <<WILL HOLD JCW NAME "CIERROR">>     <<U.RAO>>39516000
                                                               <<U.RAO>>39518000
IF NOT JOBSESSIONMAIN THEN RETURN; <<PROGRAMMATIC CALL>>       <<U.RAO>>39520000
IF VARMASK.(12:1) AND ERRNUM<0 THEN <<JUST PRINT MSG>>         <<U.RAO>>39522000
   BEGIN                                                       <<U.RAO>>39524000
   ERRNUM := -ERRNUM;                                          <<U.RAO>>39526000
   JUSTPRINT := TRUE;                                          <<U.RAO>>39528000
   END;                                                        <<U.RAO>>39530000
                                                               <<U.RAO>>39532000
<<NOW CLEAN UP TERMINAL STATE>>                                <<U.RAO>>39534000
WHO(MODE);  <<GET DATA ON WHETHER JOB OR SESSION>>             <<U.RAO>>39536000
SETXPXGLOB+PXGWJOBLIST;  <<POINT TO LIST DEVICE>>              <<U.RAO>>39538000
IF MODE <<INTERACTIVE>> AND MODE.(12:2) <<SESSION>> THEN <<BREA<<U.RAO>>39540000
   <<ASSUME COULD BE IN BREAK, RESET BREAK BITS, CLEAR FLUSH FL<<U.RAO>>39542000
  ATTACHIO(DBARRAY(X).(8:8),0,0,0,25,0,%320,0,1);              <<U.RAO>>39544000
  <<CLEAR BREAK/IO FLUSH FLAGS, ENABLE WRITE>>                 <<U.RAO>>39546000
SETSERVICE(0);  <<ENABLE BREAK>>                               <<U.RAO>>39548000
                                                               <<U.RAO>>39550000
<< IF UDC AND NOT OPTION LIST AND NOT OPTION NOHELP THEN >>    <<00617>>39552000
<< PRINT THE LINE IN WHICH THE ERROR OCCURED.            >>    <<00617>>39554000
IF UDC4.NESTLEVEL <> 0 AND NOT UDC3.OPTLIST                    <<00617>>39556000
                       AND NOT UDC3.OPTNOHELP                  <<00733>>39558000
                       AND NOT UDC4.UDCNOPRINT                 <<01361>>39560000
                       AND (ERRNUM <> STORE'FAILED)            <<04660>>39562000
                       AND (ERRNUM <> PGMABORT) THEN           <<00733>>39564000
   BEGIN                                                       <<00617>>39566000
   SCAN BCOMIMAGE UNTIL %6400,1;                               <<00710>>39568000
   COMLEN := TOS - @BCOMIMAGE;                                 <<00617>>39570000
   PRINT(WCOMIMAGE,-COMLEN,0);                                 <<00617>>39572000
   NUMBER'BLANKS := 0;                                         <<04170>>39574000
   END;                                                        <<00617>>39576000
<<NOW ON WITH THE MESSAGE>>                                    <<U.RAO>>39578000
IF VARMASK.(12:1) THEN   <<MESSAGE NUMBER PRESENT>>            <<U.RAO>>39580000
   BEGIN   <<PUT OUT MESSAGE>>                                 <<U.RAO>>39582000
   MOVE JCWNAME := "CIERROR ";                                 <<U.RAO>>39584000
   TOS := 0;                                                   <<U.RAO>>39586000
   PUTJCW(JCWNAME, ERRNUM, S0);                                <<U.RAO>>39588000
   DEL;                                                        <<U.RAO>>39590000
IF VARMASK.(13:1) AND (UDC4.NESTLEVEL=0 OR NOT UDC3.OPTNOHELP) <<00617>>39592000
      THEN PRINTCARET(ERRADR);                                 <<00538>>39594000
   IF NOT PFLAG THEN NEXTMSG:=GENMSG(CIERRMSGSET,ERRNUM)       <<03.KM>>39596000
   ELSE IF NONSTRING OR ONESTRING THEN                         <<03.KM>>39598000
      BEGIN                                                    <<03.KM>>39600000
      NEXTMSG:=GENMSG(CIERRMSGSET,ERRNUM,PARMMASK,PARM);       <<03.KM>>39602000
      END                                                      <<03.KM>>39604000
   ELSE                                                        <<03.KM>>39606000
      BEGIN                                                    <<03.KM>>39608000
      TOS:=PARM;                                               <<03.KM>>39610000
      SCAN * UNTIL 0,1;                                        <<03.KM>>39612000
      PARM2:=TOS+LOGICAL(1);                                   <<03.KM>>39614000
      NEXTMSG:=GENMSG(CIERRMSGSET,ERRNUM,0,PARM,PARM2);        <<03.KM>>39616000
      END;                                                     <<03.KM>>39618000
   END;  <<OF MESSAGE GENERATION STEP>>                        <<U.RAO>>39620000
                                                               <<U.RAO>>39622000
<<FINALLY WE MUST DISPOSE OF THE JOB/SESSION>>                 <<U.RAO>>39624000
IF JUSTPRINT THEN RETURN;                                      <<U.RAO>>39626000
IF CONTINUESTATE <> 0 THEN <<CONTINUE IN EFFECT, IGNORE ERROR>><<08.RO>>39628000
   RETURN;                                                     <<08.RO>>39630000
IF UDC4.NESTLEVEL <> 0 THEN   <<PROCESSING A UDC.>>            <<08.RO>>39632000
   BEGIN                                                       <<08.RO>>39634000
   UDC4.UDCFATALCIERR := TRUE;  <<MARK UDC AS DAMAGED.>>       <<08.RO>>39636000
   IF CONTINUSTATESTK <> 0D THEN <<CONTINUE AT PREVIOUS LEVEL>><<08.RO>>39638000
      RETURN;  <<DON'T KILL JOB>>                              <<08.RO>>39640000
   END;                                                        <<08.RO>>39642000
IF MODE.(12:2) = 1 THEN   <<SESSION, DON'T TERMINATE>>         <<08.RO>>39644000
   RETURN;  <<NOTE THAT IF IN UDC, THERE IS NO PENDING >>      <<08.RO>>39646000
            <<CONTINUE, SO WE FLUSH BACK TO REGULAR CI LEVEL>> <<08.RO>>39648000
                                                               <<U.RAO>>39650000
<<FROM HERE ON OUT, THE JOB IS DOWN THE TUBES>>                <<U.RAO>>39652000
GENMSG(CIGENERALMSGSET,JOBFLUSHED);                            <<U.RAO>>39654000
SETXPXFIXED+PXFWQINIT;                                         <<U.RAO>>39656000
TOS := DBARRAY(X)-4;  <<DB REL PTR TO QINIT-4>>                <<U.RAO>>39658000
PS0 := 4;  <<FLAG FOR PROCEDURE CLEANUPJOB>>                   <<U.RAO>>39660000
SETXPXFIXED+PXFWBREAK;                                         <<U.RAO>>39662000
IF DBARRAY(X) THEN FUNBREAK(TRUE);                             <<U.RAO>>39664000
SETJCW(%100000); <<SET ABORT BIT>>                             <<00243>>39666000
TERMINATE;                                                     <<U.RAO>>39668000
END;                                                           <<U.RAO>>39670000
PROCEDURE CYDIRERR'(DIRECRETURN,OKMASK,ERRNUM);                <<U.RAO>>39672000
VALUE DIRECRETURN,OKMASK;                                      <<U.RAO>>39674000
DOUBLE DIRECRETURN;                                            <<U.RAO>>39676000
INTEGER ERRNUM;                                                <<U.RAO>>39678000
LOGICAL OKMASK;                                                <<U.RAO>>39680000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>39682000
<<CONVERTS DIRECRETURN TO CIERROR, RETURNS IT TO>>             <<U.RAO>>39684000
<<ERRNUM, CALLS CIERR>>                                        <<U.RAO>>39686000
BEGIN                                                          <<U.RAO>>39688000
INTEGER DERR1 = DIRECRETURN,                                   <<U.RAO>>39690000
        DERR0 = DIRECRETURN+1;                                 <<U.RAO>>39692000
X := DERR0;                                                    <<U.RAO>>39694000
TOS := OKMASK;                                                 <<U.RAO>>39696000
ASSEMBLE(TBC 0,X);                                             <<U.RAO>>39698000
IF = THEN  SUDDENDEATH(506);  <<DIRECTORY PROBLEM>>            <<U.RAO>>39700000
CASE *(X) OF                                                   <<U.RAO>>39702000
   BEGIN                                                       <<U.RAO>>39704000
   TOS := DIRIOERR;                                            <<U.RAO>>39706000
   TOS := DIRDUPLNAME;                                         <<U.RAO>>39708000
   CASE *(DERR1) OF <<NON EXISTENT ...>>                       <<U.RAO>>39710000
      BEGIN                                                    <<U.RAO>>39712000
      TOS := DIRNOSUCHFILE;                                    <<U.RAO>>39714000
      TOS := DIRNOSUCHGROUP;                                   <<U.RAO>>39716000
      TOS := DIRNOSUCHACCT;                                    <<U.RAO>>39718000
      TOS := DIRNOSUCHUSER;                                    <<U.RAO>>39720000
      TOS := DIRNOSUCHVSD;                                     <<U.RAO>>39722000
      TOS := DIRNOSUCHVSL;                                     <<U.RAO>>39724000
      END;                                                     <<U.RAO>>39726000
   IF DERR1 = 1 THEN TOS := DIRNOSAVEGROUP                     <<U.RAO>>39728000
                ELSE TOS := DIRNOSAVEACCT;                     <<U.RAO>>39730000
   TOS := DIROVERFLOW;                                         <<U.RAO>>39732000
   TOS := DIROVERFLOW;                                         <<U.RAO>>39734000
   TOS := DIROVERFLOW;                                         <<U.RAO>>39736000
   TOS := DIRINUSE;                                            <<U.RAO>>39738000
   IF DERR1 = 1 THEN TOS := DIRGRPFSPACE                       <<U.RAO>>39740000
                ELSE TOS := DIRACCTFSPACE;                     <<U.RAO>>39742000
   END;  <<CASE ON MASTER ERROR TYPE>>                         <<U.RAO>>39744000
ERRNUM := TOS;                                                 <<U.RAO>>39746000
CIERR(ERRNUM);                                                 <<U.RAO>>39748000
END;                                                           <<U.RAO>>39750000
PROCEDURE LOADERROR(ERRNUM);                                   <<U.RAO>>39752000
VALUE ERRNUM;                                                  <<U.RAO>>39754000
INTEGER ERRNUM;                                                <<U.RAO>>39756000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>39758000
<<THIS PROCEDURE PRINTS OUT THE LOADER ERROR MESSAGE AND,>>    <<U.RAO>>39760000
<<OPTIONALLY, THE FILE SYSTEM ERROR MESSAGE ASSOCIATED>>       <<U.RAO>>39762000
BEGIN                                                          <<U.RAO>>39764000
INTEGER FSERRNUM;  <<FILE SYSTEM ERROR NUMBER>>                <<U.RAO>>39766000
IF NOT JOBSESSIONMAIN THEN RETURN;  <<AVOID MESSAGES>>         <<U.RAO>>39768000
IF 50 <= ERRNUM <= 64 THEN    <<FILE ERROR RELATED>>           <<U.RAO>>39770000
   BEGIN                                                       <<U.RAO>>39772000
   FSERRNUM := ERRORGET(1).(8:8);                              <<U.RAO>>39774000
   IF FSERRNUM <> 0 THEN                                       <<U.RAO>>39776000
      GENMSG(FSERRORMSGSET,FSERRNUM);                          <<07.RO>>39778000
   END;                                                        <<U.RAO>>39780000
GENMSG(LOADERRMSGSET,ERRNUM);                                  <<U.RAO>>39782000
END;                                                           <<U.RAO>>39784000
LOGICAL PROCEDURE CREATEERROR;                                 <<U.RAO>>39786000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>39788000
<<IF CREATE ERROR, RETURN TRUE                     >>          <<U.RAO>>39790000
<<ELSE IS LOAD ERROR (DURING CREATE), RETURN FALSE>>           <<U.RAO>>39792000
<<IN ANY CASE, PRINT THE APPROPRIATE ERROR MESSAGE>>           <<U.RAO>>39794000
BEGIN                                                          <<U.RAO>>39796000
INTEGER ERRNUM, FSERRNUM;                                      <<U.RAO>>39798000
IF NOT JOBSESSIONMAIN THEN RETURN;  <<AVOID MESSAGES>>         <<U.RAO>>39800000
CREATEERROR := TRUE;                                           <<U.RAO>>39802000
ERRNUM := ERRORGET (1);                                        <<01244>>39804000
IF ERRNUM = 30 THEN      <<LOAD ERROR ACTUALLY>>               <<U.RAO>>39806000
   BEGIN                                                       <<U.RAO>>39808000
   CREATEERROR := FALSE;                                       <<01244>>39810000
   ERRNUM := ERRORGET (2);                                     <<01426>>39812000
   IF 50 <= ERRNUM <= 64 THEN  <<FURTHER COMPLICATED BY >>     <<U.RAO>>39814000
      BEGIN   <<FILE SYSTEM DETECTED ERROR>>                   <<U.RAO>>39816000
      FSERRNUM := ERRORGET (3).(8:8);                          <<01426>>39818000
      IF FSERRNUM <> 0 THEN                                    <<U.RAO>>39820000
         GENMSG(FSERRORMSGSET,FSERRNUM)                        <<U.RAO>>39822000
      ELSE                                                     <<U.RAO>>39824000
         GENMSG(CIGENERALMSGSET, ENDOFFILEMSG);                <<U.RAO>>39826000
      END;                                                     <<U.RAO>>39828000
   GENMSG(LOADERRMSGSET,ERRNUM);                               <<U.RAO>>39830000
   END                                                         <<U.RAO>>39832000
ELSE                                                           <<U.RAO>>39834000
   GENMSG(CREATEERRMSGSET,ERRNUM);                             <<U.RAO>>39836000
END;   <<CREATEERROR>>                                         <<01452>>39838000
                                                               <<01452>>39840000
PROCEDURE HARD'LOADERR(ERRNUM);                                <<01452>>39842000
   INTEGER ERRNUM;                                             <<01452>>39844000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01452>>39846000
                                                               <<01452>>39848000
COMMENT                                                        <<01452>>39850000
   This procedure can be called to print the LOADER/FILE       <<01452>>39852000
SYSTEM error messages when the error returned from             <<01452>>39854000
CREATEPROCESS is 16.  ERRNUM is set to the LOADER error number.<<01452>>39856000
;                                                              <<01452>>39858000
                                                               <<01452>>39860000
BEGIN                                                          <<01452>>39862000
   INTEGER FSERR;                                              <<01452>>39864000
                                                               <<01452>>39866000
   ERRNUM := ERRORGET(2);  << LOAD ERR >>                      <<01452>>39868000
   IF 50 <= ERRNUM <= 64 THEN                                  <<01452>>39870000
      BEGIN  << ALSO A FILESYSTEM ERROR >>                     <<01452>>39872000
      FSERR := ERRORGET(3).(8:8);                              <<01452>>39874000
      IF FSERR <> 0 THEN                                       <<01452>>39876000
         GENMSG( FSERRORMSGSET, FSERR )                        <<01452>>39878000
      ELSE                                                     <<01452>>39880000
         GENMSG( CIGENERALMSGSET, ENDOFFILEMSG );              <<01452>>39882000
      END;                                                     <<01452>>39884000
   GENMSG( LOADERRMSGSET, ERRNUM );                            <<01452>>39886000
                                                               <<01452>>39888000
END;  << OF HARD'LOADERR >>                                    <<01452>>39890000
                                                               <<01452>>39892000
                                                               <<01452>>39894000
LOGICAL PROCEDURE CREATEPROC'ERR(ERROR,ERRNUM);                <<01452>>39896000
   VALUE ERROR; INTEGER ERROR,ERRNUM;                          <<01452>>39898000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01452>>39900000
                                                               <<01452>>39902000
COMMENT                                                        <<01452>>39904000
   This procedure breaks down the error code returned by       <<01452>>39906000
CREATEPROCESS (which is passed in ERROR) into CIERROR messages.<<01452>>39908000
                                                               <<01452>>39910000
   If ERROR = 16, then a hard loader error has occured.  If    <<01452>>39912000
this is the case, another procedure is called which prints     <<01452>>39914000
the appropriate LOADER/FILE SYSTEM error messages.             <<01452>>39916000
                                                               <<01452>>39918000
   The logical value returned by this procedure tells the      <<01452>>39920000
calling procedure whether a hard loader error has occured.  If <<01452>>39922000
ERROR = 16, then the procedure returns FALSE.  In all other    <<01452>>39924000
cases, the procedure returns TRUE.  ERRNUM is set to the       <<01452>>39926000
appropriate CIERROR number.                                    <<01452>>39928000
;                                                              <<01452>>39930000
                                                               <<01452>>39932000
BEGIN                                                          <<01452>>39934000
   LOGICAL RESULT = CREATEPROC'ERR;                            <<01452>>39936000
                                                               <<01452>>39938000
   RESULT := TRUE;                                             <<01452>>39940000
                                                               <<01452>>39942000
   CASE ERROR OF                                               <<01452>>39944000
      BEGIN                                                    <<01452>>39946000
                                                               <<01452>>39948000
      << 0 = NO ERROR >>                                       <<01452>>39950000
      ;                                                        <<01452>>39952000
                                                               <<01452>>39954000
      << 1 = NO PH CAPABILITY -- SHOULDN'T HAPPEN >>           <<01452>>39956000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>39958000
                                                               <<01452>>39960000
      << 2 = ERROR PARAMETER OMITTED -- SHOULDN'T HAPPEN >>    <<01452>>39962000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>39964000
                                                               <<01452>>39966000
      << 3 = PIN/PROGRAM NAME BAD -- SHOULDN'T HAPPEN >>       <<01452>>39968000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>39970000
                                                               <<01452>>39972000
      << 4 = OUT OF PCB'S >>                                   <<01452>>39974000
      CIERR( ERRNUM := OUTOFPCBS );                            <<01452>>39976000
                                                               <<01452>>39978000
      << 5 = INVALID OPTION -- SHOULDN'T HAPPEN >>             <<01452>>39980000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>39982000
                                                               <<01452>>39984000
      << 6 = UNKNOWN PROGRAM FILE -- CALLER SHOULD HANDLE >>   <<01452>>39986000
      ;                                                        <<01452>>39988000
                                                               <<01452>>39990000
      << 7 = FILE IS NOT A VALID PROGRAM FILE >>               <<01452>>39992000
      CIERR( ERRNUM := INVALIDPROG );                          <<01452>>39994000
                                                               <<01452>>39996000
      << 8 = NO SUCH ENTRY POINT >>                            <<01452>>39998000
      CIERR( ERRNUM := BADENTRYPT );                           <<01452>>40000000
                                                               <<01452>>40002000
   << Errors 9 - 14 are actually warnings and are      >>      <<01452>>40004000
   << returned as negative numbers by CREATEPROCESS.   >>      <<01452>>40006000
   << The caller should ensure that error is positive. >>      <<01452>>40008000
                                                               <<01452>>40010000
      << 9 = PROGRAM FILE STACK SIZE USED >>                   <<01452>>40012000
      CIERR(-DFLTSTACK);                                       <<01452>>40014000
                                                               <<01452>>40016000
      << 10 = PROGRAM FILE DL SIZE USED >>                     <<01452>>40018000
      CIERR(-DFLTDL);                                          <<01452>>40020000
                                                               <<01452>>40022000
      << 11 = PROGRAM FILE MAXDATA USED >>                     <<01452>>40024000
      CIERR(-DFLTMAXD);                                        <<01452>>40026000
                                                               <<01452>>40028000
      << 12 = DLSIZE ROUNDED UP 128 WORDS >>                   <<01452>>40030000
      CIERR(-DLRNDED);                                         <<01452>>40032000
                                                               <<01452>>40034000
      << 13 = CONFIGURATION MAXDATA USED >>                    <<01452>>40036000
      CIERR(-CONFMAXD);                                        <<01452>>40038000
                                                               <<01452>>40040000
      << 14 = MAXDATA ROUNDED UP TO REQUIRED SPACE >>          <<01452>>40042000
      CIERR(-STKRNDEDUP);                                      <<01452>>40044000
                                                               <<01452>>40046000
   << End of warning sublist. >>                               <<01452>>40048000
                                                               <<01452>>40050000
      << 15 = STACK SPACE TOO BIG >>                           <<01452>>40052000
      CIERR( ERRNUM := STACKTOOBIG );                          <<01452>>40054000
                                                               <<01452>>40056000
      << 16 = HARD LOADER ERROR.  In this case, ERRNUM is   >> <<01452>>40058000
      << set to the LOADER error number.  Therefore, it is  >> <<01452>>40060000
      << expected that the calling procedure will call      >> <<01452>>40062000
      << CIERR to print a more general loading error        >> <<01452>>40064000
      << message and to set ERRNUM to this error number.    >> <<01452>>40066000
      BEGIN                                                    <<01452>>40068000
         RESULT := FALSE;  << HARD LOADER ERROR >>             <<01452>>40070000
         HARD'LOADERR(ERRNUM);                                 <<01452>>40072000
      END;                                                     <<01452>>40074000
                                                               <<01452>>40076000
      << 17 = BAD PRIORITY SPECIFIED -- SHOULDN'T HAPPEN >>    <<01452>>40078000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>40080000
                                                               <<01452>>40082000
      << 18 = COULDN'T OPEN $STDIN FOR PROGRAM >>              <<01452>>40084000
      CIERR( ERRNUM := BADSTDIN );                             <<01452>>40086000
                                                               <<01452>>40088000
      << 19 = COULDN'T OPEN $STDLIST FOR PROGRAM >>            <<01452>>40090000
      CIERR( ERRNUM := BADSTDLIST );                           <<01452>>40092000
                                                               <<01452>>40094000
      << 20 = INVALID STRING -- SHOULDN'T HAPPEN >>            <<01452>>40096000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>40098000
                                                               <<01452>>40100000
      END; << OF CASE STATEMENT >>                             <<01452>>40102000
                                                               <<01452>>40104000
END;  << OF CREATEPROC'ERR >>                                  <<01452>>40106000
      LOGICAL PROCEDURE REQUESTSERVICE;                        <<01452>>40108000
      OPTION PRIVILEGED;                                       <<01.EB>>40110000
      BEGIN                                                             40112000
      TOS:=ABSOLUTE(ABSOLUTE(4)+9).(10:1);<<GET HARD KILL BIT>>         40114000
      TOS:=ABSOLUTE(X).(11:1);<<GET SOFT KILL BIT>>                     40116000
       IF ABSOLUTE(X).(6:2)=1 THEN                                      40118000
         BEGIN  <<IN MAIN>>                                             40120000
         PUSH(DL,DB,SBANK);                                             40122000
         ASSEMBLE(CAB,DEL;   <<DELETE CURRENT DB BANK>>                 40124000
                  CAB,CAB;   <<ARRANGE SBANK,REL DL,DB AT TOP>>         40126000
                  ADD;       <<CALCULATE ABSOLUTE DL>>                  40128000
                  DDUP,DECA; <<DUP SBANK AND DL>>                       40130000
                  LSEA;DELB; <<LOAD DL-@PCBX>>                          40132000
                  DELB,SUB); <<CALCULATE  ABS PCBX>>                    40134000
         TOS := TOS + PXGWJOBIN;                                        40136000
         ASSEMBLE(LSEA;DELB;DELB);                                      40138000
         TOS := TOS LAND %377;<<LDEV # OF $STDIN>>                      40140000
         TOS := TOS&LSL(1)+1; <<INDEX INTO  LPDT>>                      40142000
         TOS := LPDT(TOS).(10:1); <<BREAK BIT>>                         40144000
         END                                                            40146000
       ELSE TOS := 0; <<NOT IN MAIN,DON'T CHECK BREAK>>                 40148000
      REQUESTSERVICE:=TOS LOR TOS LOR TOS;                              40150000
      END;<<REQUESTSERVICE>>                                            40152000
      PROCEDURE SETSERVICE(DISP);                                       40154000
      VALUE DISP;                                                       40156000
      LOGICAL DISP;                                                     40158000
      OPTION PRIVILEGED,UNCALLABLE;                                     40160000
      BEGIN                                                             40162000
         PUSH(DL,DB,SBANK);                                             40164000
         ASSEMBLE(CAB,DEL;    <<DELETE CURRENT DB BANK>>                40166000
                  CAB,CAB;    <<ARRANGE SBANK,REL DL,DB AT S0>>         40168000
                  ADD;        <<CALCULATE ABSOLUTE DL>>                 40170000
                  DDUP,DECA;  <<DUP SBANK AND DL>>                      40172000
                  LSEA;DELB;  <<LOAD DL-@PCBX>>                         40174000
                  DELB,SUB);  <<CALCULATE ABS PCBX>>                    40176000
         TOS := TOS + PXGWJOBIN;                                        40178000
         ASSEMBLE(LSEA;DELB;DELB);                                      40180000
         TOS := TOS LAND %377; <<LDEV # OF $STDIN>>                     40182000
         TOS := TOS&LSL(1)+1;  <<INDEX INTO LPDT>>                      40184000
         DISABLE;                                                       40186000
         TOS := LPDT(TOS); <<GET FLAGS WORD>>                           40188000
         TOS.(10:1) := DISP;                                            40190000
         LPDT(X) := TOS;                                                40192000
         ENABLE;                                                        40194000
      END;<<SETSERVICE>>                                                40196000
PROCEDURE WELCOMEMES (WDST, FUNNYTERMINAL);                   <<A00.04>>40198000
   VALUE WDST,FUNNYTERMINAL;                                  <<A00.04>>40200000
   INTEGER WDST;  <<WELCOME MESSAGE DATA SEGMENT>>            <<A00.04>>40202000
   LOGICAL FUNNYTERMINAL; <<IF TRUE, INDICATES APL TERMINAL>> <<A00.04>>40204000
   OPTION PRIVILEGED, UNCALLABLE;                             <<A00.04>>40206000
<<PRINTS CURRENT WELCOME MESSAGE, OBTAINED FROM <WDST> -                40208000
   STOPS AT END, OR BREAK.  IF APL TERMINAL, TRANSLATES                 40210000
   CHARACTER SETS>>                                           <<A00.04>>40212000
BEGIN                                                         <<A00.04>>40214000
<< WELCOME MSG DATA SEG STRUCTURE >>                          <<A00.04>>40216000
   INTEGER USECOUNT        = DB+0;  <<0:1 => CURRENT>>        <<A00.04>>40218000
   ARRAY FIRSTLINE (*)     = DB+3;  <<1'ST RECORD>>           <<A00.04>>40220000
<< DB+1 IS THE LENGTH OF THE DATA SEGMENT             >>      <<A00.04>>40222000
<< DB+2.(0:8) IS THE CHARACTER "#"                    >>      <<A00.04>>40224000
<< DB+2.(8:8) IS THE LENGTH OF THE FIRST LINE         >>      <<A00.04>>40226000
<< EACH SUBSEQUENT LINE HAS THE FOLLOWING STRUCTURE:  >>      <<A00.04>>40228000
<<   THEY START ON A WORD BOUNDARY, THE BYTE PRECEEDING>>     <<A00.04>>40230000
<<   IS THE LINE LENGTH IN BYTES, WHICH IS ALWAYS ODD.>>      <<A00.04>>40232000
<<   IF NECESSARY, THE LINE IS PADDED WITH A BLANK.   >>      <<A00.04>>40234000
<< LOCALS >>                                                  <<A00.04>>40236000
   INTEGER POINTER LINEP; <<KEEPS CURRENT POINTER IN DSEG>>   <<A00.04>>40238000
   DEFINE LINELEN =LINEP(-1).(8:8)#; <<LINE LENGTH>>          <<A00.04>>40240000
   INTEGER ARRAY LOCCOPY(0:127); <<LOCAL ARRAY FOR APL TRANS>><<A00.04>>40242000
   INTEGER LINELENAPL;  <<WHEN FUNNYTERMINAL, IS LINE LENGTH>><<A00.04>>40244000
   LOGICAL CRIT'STATE,  << OLD CRITICAL STATE >>               <<02318>>40246000
           OLDSIR;      << OLD SIR STATE      >>               <<02318>>40248000
                                                               <<02318>>40250000
   EQUATE WELCOMESIR = %27;  << WELCOME DST SIR >>             <<02318>>40252000
                                                              <<A00.04>>40254000
<<  >>                                                        <<A00.04>>40256000
   @LINEP := @FIRSTLINE;  <<SETUP LINEP>>                     <<A00.04>>40258000
   EXCHANGEDB(WDST);                                          <<A00.04>>40260000
   << MUST PROTECT THE USECOUNT WORD OF THE WELCOME DATA   >>  <<02318>>40262000
   << SEGMENT SO THAT 1) TWO PROCESSES CANNOT ACCESS THAT  >>  <<02318>>40264000
   << WORD CONCURRENTLY, AND 2) ONCE THE COUNT HAS BEEN    >>  <<02318>>40266000
   << INCREMENTED, THE PROCESS CANNOT BE ABORTED UNTIL THE >>  <<02318>>40268000
   << COUNT HAS BEEN DECREMENTED.  DON'T WANT TO HOLD SIR  >>  <<02318>>40270000
   << WHILE WELCOME MESSAGE PRINTING SO OTHERS CAN LOGON.  >>  <<02318>>40272000
   OLDSIR := GETSIR(WELCOMESIR);                               <<02318>>40274000
   USECOUNT := USECOUNT+1; <<BUMP USER COUNT>>                <<A00.04>>40276000
   CRIT'STATE := SETCRITICAL;  << NO ABORT 'TIL DEC. COUNT >>  <<02318>>40278000
   RELSIR(WELCOMESIR,OLDSIR);                                  <<02318>>40280000
   IF FUNNYTERMINAL THEN  <<BEGIN - APL TRANSLATION REQ'D>>   <<A00.04>>40282000
      BEGIN                                                   <<A00.04>>40284000
      TOS := LINELEN;  <<GET LENGTH OF FIRST LINE>>           <<A00.04>>40286000
      EXCHANGEDB(0);  <<SET BACK TO STACK>>                   <<A00.04>>40288000
      LINELENAPL := TOS;  <<SAVE LENGTH OF FIRST LINE>>       <<A00.04>>40290000
      <<NOW SET UP FOR MOVE FROM DATA SEG>>                   <<A00.04>>40292000
      TOS := @LOCCOPY;                                        <<A00.04>>40294000
      TOS := WDST;                                            <<A00.04>>40296000
      TOS := @LINEP;                                          <<A00.04>>40298000
      FUNNYTERMINAL := FUNNYTERMINAL.(13:2);<<EXTRACT TERMTYPE>>        40300000
      WHILE (LINELENAPL<>255) <<NOT END>>                     <<A00.04>>40302000
            AND (NOT(REQUESTSERVICE)) DO  <<NO BREAK>>        <<A00.04>>40304000
         BEGIN                                                <<A00.04>>40306000
            S2 := @LOCCOPY;                                   <<A00.04>>40308000
            TOS := (LINELENAPL+1)&ASR(1);  <<LENGTH OF MOVE>> <<A00.04>>40310000
            ASSEMBLE(MFDS 1);  <<ONLY POP DEAD COUNT>>        <<A00.04>>40312000
            APLTRANSLATEOUT(LOCCOPY,LINELENAPL,FUNNYTERMINAL);<<A00.04>>40314000
            FWRITE(2,LOCCOPY,-LINELENAPL,0);                  <<A00.04>>40316000
            IF <> THEN  <<FWRITE FAILED FOR SOME REASON>>     <<A00.04>>40318000
               LINELENAPL := 255  <<SET EXIT FLAG>>           <<A00.04>>40320000
            ELSE  <<EVERYTHING OK, GO TO TOP>>                <<A00.04>>40322000
               LINELENAPL := LOCCOPY(LINELENAPL&ASR(1)).(8:8);<<A00.04>>40324000
         END;                                                 <<A00.04>>40326000
         EXCHANGEDB(WDST);                                    <<A00.04>>40328000
      END                                                     <<A00.04>>40330000
   ELSE  <<REGULAR TERMINAL>>                                 <<A00.04>>40332000
      BEGIN                                                   <<A00.04>>40334000
      WHILE (LINELEN<>255)  <<NOT END>>                       <<A00.04>>40336000
            AND (NOT(REQUESTSERVICE)) DO  <<NO BREAK>>        <<A00.04>>40338000
         BEGIN  <<EMIT LINE AND ADVANCE POINTER>>             <<A00.04>>40340000
         FWRITE(2,LINEP,-LINELEN,0);                          <<A00.04>>40342000
         IF <> THEN GOTO LEAVE;                               <<A00.04>>40344000
         @LINEP := @LINEP+((LINELEN+1)&ASR(1));               <<A00.04>>40346000
         END;                                                 <<A00.04>>40348000
      END;                                                    <<A00.04>>40350000
LEAVE:                                                        <<A00.04>>40352000
   OLDSIR := GETSIR(WELCOMESIR);                               <<02318>>40354000
   USECOUNT := USECOUNT-1;  <<ONE LESS USER>>                 <<A00.04>>40356000
   RELSIR(WELCOMESIR,OLDSIR);                                  <<02318>>40358000
   RESETCRITICAL(CRIT'STATE);  << CAN NOW ABORT >>             <<02318>>40360000
   EXCHANGEDB(0);                                             <<A00.04>>40362000
   END;    <<WELCOMMES>>                                      <<A00.04>>40364000
$PAGE       "COMSEARCH - COMMAND DICTIONARY"                   <<08.RO>>40366000
$CONTROL SEGMENT= CIINIT                                                40368000
                                                                        40370000
LOGICAL PROCEDURE COMSEARCH (COMMAND, COMLEN, CAP, ACCESS,     <<U.RAO>>40372000
   EXECPLABEL, CAPERR);                                        <<U.RAO>>40374000
   VALUE COMLEN;                                               <<U.RAO>>40376000
   BYTE ARRAY COMMAND;                                         <<U.RAO>>40378000
   INTEGER COMLEN;                                             <<U.RAO>>40380000
   DOUBLE CAP;                                                 <<U.RAO>>40382000
   INTEGER EXECPLABEL;                                         <<U.RAO>>40384000
   DOUBLE ACCESS;                                              <<U.RAO>>40386000
   INTEGER CAPERR;                                             <<U.RAO>>40388000
   OPTION PRIVILEGED, UNCALLABLE;                              <<U.RAO>>40390000
                                                               <<U.RAO>>40392000
COMMENT:                                                       <<U.RAO>>40394000
   FINDS A COMMAND.                                            <<U.RAO>>40396000
   INPUT PARAMETERS:                                           <<U.RAO>>40398000
      <COMMAND> IS BYTE ARRAY CONTAINING COMMAND NAME.         <<U.RAO>>40400000
      <COMLEN> IS LENGTH OF NAME.                              <<U.RAO>>40402000
   RETURNS:                                                    <<U.RAO>>40404000
<CAP> - Capability mask required to use command.  format is    <<U.RAO>>40406000
   identical to that used in the Directory routines.           <<U.RAO>>40408000
      user attributes & file attributes required               <<U.RAO>>40410000
      0  sm                                                    <<U.RAO>>40412000
      1  am                                                    <<U.RAO>>40414000
      2  al                                                    <<U.RAO>>40416000
      3  gl                                                    <<U.RAO>>40418000
      4  di                                                    <<U.RAO>>40420000
      5  op                                                    <<U.RAO>>40422000
      6  cv                                                    <<U.RAO>>40424000
      7  uv                                                    <<U.RAO>>40426000
      8  LG     (USER LOGGING)                                 <<U.RAO>>40428000
      9  not used                                              <<U.RAO>>40430000
      10  not used                                             <<U.RAO>>40432000
      11  not used                                             <<U.RAO>>40434000
      12  not used                                             <<U.RAO>>40436000
      13  cs                                                   <<U.RAO>>40438000
      14  ND                                                   <<U.RAO>>40440000
      15  SF                                                   <<U.RAO>>40442000
      command access restrictions / resource capabilities      <<U.RAO>>40444000
      0  NOT USED                                              <<U.RAO>>40446000
      1  NOT USED                                              <<U.RAO>>40448000
      2  NOT USED                                              <<U.RAO>>40450000
      3  NOT USED                                              <<U.RAO>>40452000
      4  not USED                                              <<U.RAO>>40454000
      5  not USED                                              <<U.RAO>>40456000
      6  NOT USED                                              <<U.RAO>>40458000
      7  ba                                                    <<U.RAO>>40460000
      8  ia                                                    <<U.RAO>>40462000
      9  pm                                                    <<U.RAO>>40464000
      10  NOT USED                                             <<U.RAO>>40466000
      11  not used                                             <<U.RAO>>40468000
      12  mr                                                   <<U.RAO>>40470000
      13  NOT USED                                             <<U.RAO>>40472000
      14  ds                                                   <<U.RAO>>40474000
      15  ph                                                   <<U.RAO>>40476000
<COMSEARCH>  FALSE IMPLIES COMMAND NOT IN DIRECTORY            <<U.RAO>>40478000
<ACCESS> - LIMITATIONS ON USE OF INDIVIDUAL COMMAND.           <<U.RAO>>40480000
     FIRST WORD DEFINED AS FOLLOWS:                            <<00552>>40482000
        10:6 = OPERATOR COMMAND MASK INDEX                     <<00552>>40484000
         10:2 IS THE WORD INDEX                                <<00552>>40486000
         12:4 IS THE BIT INDEX                                 <<00552>>40488000
      SECOND WORD DEFINED AS FOLLOWS:                          <<U.RAO>>40490000
         15:1 = 1  NOT PERMITTED DURING BREAK,                 <<U.RAO>>40492000
         14:1 = 1  NOT PERMITTED PROGRAMMATICALLY,             <<U.RAO>>40494000
         12:2 = 0  NO CAP CHECK REQUIRED.  OTHERWISE:          <<U.RAO>>40496000
              = 1  AND CHECK  (ALL BITS REQUIRED),             <<U.RAO>>40498000
              = 2  OR CHECK (ANY ONE REQUIRED).                <<U.RAO>>40500000
         11:1 = 1  NOT PERMITTED DURING BATCH JOB,             <<U.RAO>>40502000
         10:1 = 1  NOT PERMITTED DURING SESSION.               <<U.RAO>>40504000
         9:1 = 1  ABORTABLE COMMAND                            <<U.RAO>>40506000
         8:1 = 0  NOT PERMITTED WITH APL CHARACTER SET         <<U.RAO>>40508000
         7:1 = 1  execute even if flushing for if command      <<U.RAO>>40510000
         6:1 = 1 NOT PERMITTED IN USER DEFINED COMMAND.        <<U.RAO>>40512000
         5:1 = 1 COMMAND CANNOT BE REDONE WITH REDO.           <<08.RO>>40514000
        4:1 = 1 COMMAND IS AN OPERATOR ONLY COMMAND (USER MUST <<00552>>40516000
                BEEN 'ALLOW'ED ACCESS.                         <<00552>>40518000
         3:1 = 1 COMMAND PERMITTED DURING SPECIAL BREAK                 40520000
<EXECPLABEL> - PLABEL FOR EXECUTOR.                            <<U.RAO>>40522000
<CAPERR> - THE CI ERROR NUMBER TO BE USED IF THE SUBROUTINE    <<U.RAO>>40524000
   PERMITACCESS IN COMMANDINTERP DETECTS A CAPABILITY PROBLEM. <<U.RAO>>40526000
   ;                                                           <<U.RAO>>40528000
COMMENT  *************************************************     <<U.RAO>>40530000
   ***  TO ADD A NEW COMMAND TO THE DIRECTORY  ***********     <<U.RAO>>40532000
   *******************************************************     <<U.RAO>>40534000
STEP 1:  DETERMINE THE CAPABILITIES REQUIRED TO USE THIS NEW   <<U.RAO>>40536000
  COMMAND, SUCH AS SM, AM, AL, UV, BA.  THE COMMENT ABOVE WILL <<U.RAO>>40538000
  HELP YOU FORMAT THIS INFORMATION INTO A DOUBLE WORD.         <<U.RAO>>40540000
  INCIDENTALLY, THIS DOUBLE WORD EXACTLY MATCHES THE USER      <<U.RAO>>40542000
  CAPABILITY ENTRY IN THE DIRECTORY IN ITS PLACEMENT OF BITS.  <<U.RAO>>40544000
  IF YOU ADD A NEW CAPABILITY, YOU MUST MAINTAIN THIS          <<U.RAO>>40546000
  CORRESPONDENCE.                                              <<U.RAO>>40548000
STEP 2:  DECIDE WHEN YOU WISH THIS COMMAND TO BE ILLEGAL.  FOR <<U.RAO>>40550000
  EXAMPLE, YOU MAY NOT WISH TO ALLOW ITS USE IN BATCH, OR      <<U.RAO>>40552000
  PROGRAMMATICALLY, OR YOU MAY WISH IT TO BE BREAKABLE.  YOU   <<U.RAO>>40554000
  MAY ALSO DECIDE WHETHER YOU WISH AN "AND" MATCH ON THE       <<U.RAO>>40556000
  CAPABILITIES DOUBLE WORD OR AND "OR" MATCH.  "OR" IMPLIES    <<U.RAO>>40558000
  ANY ONE OF THE CAPABILIES IS SUFFICIENT, "AND" REQUIRES THAT <<U.RAO>>40560000
  THE USER HAVE ALL THE CAPABILITIES.  THE COMMENT ABOVE WILL  <<U.RAO>>40562000
  HELP YOU IN FORMATTING THE ACCESS RESTRICTIONS DOUBLE WORD.  <<U.RAO>>40564000
  NOTE THAT IF YOU ADD ANY NEW ACCESS RESTRICTIONS, THE SUBROUTINE      40566000
  "PERMIT" IN COMMANDINTERP MUST BE CHANGED TO CHECK THE       <<U.RAO>>40568000
  RESTRICTION.                                                 <<U.RAO>>40570000
STEP 3:  FIND THE APPROPRIATE HASH BUCKET FOR YOUR COMMAND.  IF<<U.RAO>>40572000
  YOU WISH, YOU MAY CALCULATE IT OUT BY HAND.  HOWEVER, THE    <<U.RAO>>40574000
  EASIEST WAY IS TO GET ON A STAND-ALONE MACHINE, SET A        <<U.RAO>>40576000
  BREAKPOINT IN THIS ROUTINE AT THE LABEL NEXTDDEL, ENTER      <<U.RAO>>40578000
  YOUR FULL COMMAND, AND EXAMINE THE INDEX REGISTER WHEN YOU   <<U.RAO>>40580000
  HIT THE BREAKPOINT.  THAT REGISTER WILL CONTAIN THE INDEX OF <<U.RAO>>40582000
  THE HASH BUCKET YOU NEED.                                    <<U.RAO>>40584000
STEP 4:  ADD THE COMMAND TO THE COMMAND DIRECTORY.  USING ONE OF        40586000
  THE COMMANDS ALREADY THERE AS A TEMPLATE, FORMAT AND ENTER YOUR       40588000
  COMMAND IN THE TABLE.  IF THE HASH BUCKET IS CURRENTLY EMPTY,<<U.RAO>>40590000
  THE ENTRY FOR THAT BUCKET IN COMMANDDICT WILL BE 0 AND THE   <<U.RAO>>40592000
  LABEL WILL BE ABSENT.  SIMPLY CREATE THE NECESSARY LABEL AND <<U.RAO>>40594000
  ENTER IT IN COMMANDDICT.  NOTE THE LINKING SCHEME WITHIN THE <<U.RAO>>40596000
  BUCKETS.  A LINK OF 0 TERMINATES A BUCKET.  ALSO NOTE THAT THE        40598000
  COMMAND EXECUTOR MUST BE ADDED TO THE SYSTEM AT THE SAME TIME<<U.RAO>>40600000
  THAT THE MODIFIED PROCEDURE COMSEARCH IS ADDED, SO THAT THE  <<U.RAO>>40602000
  LLBL CAN BE EXECUTED.  OTHERWISE THE CI WILL ABORT.          <<U.RAO>>40604000
;                                                              <<U.RAO>>40606000
                                                               <<U.RAO>>40608000
                                                               <<U.RAO>>40610000
BEGIN                                                          <<U.RAO>>40612000
DEFINE W = :CON#, Y=;LLBL#, Z=;CON#;   <<FOR DICTIONARY>>      <<U.RAO>>40614000
DEFINE   <<CAPABILITY EQUATES>>                                <<U.RAO>>40616000
   NOTB = 0,0,0,1,0#,  << Not allowed in break >>              <<01999>>40618000
   NOTPB = 0,0,0,3,0#,              <<NOT PROG, NOT IN BREAK>> <<U.RAO>>40620000
   OP = %2000,0,0,4,CAPREQ'OP'#,  <<OP CAP, "AND" CHECK>>      <<U.RAO>>40622000
   OPNBR = %2000,0,0,7,CAPREQ'OP'#,  <<AND, NOT IN BRK OR PROG><<U.RAO>>40624000
   OPNOTBRK = %2000,0,0,5,CAPREQ'OP'#, <<OP, NOT IN BRK>>      <<U.RAO>>40626000
   MGR = %100000, 0, 0, 4, CAPREQ'SM'#, <<SM, AND CHECK >>     <<U.RAO>>40628000
   OPBR = %2000,0,0,%104,CAPREQ'OP'#,  <<OP, "AND", BREAKABLE>><<U.RAO>>40630000
   AMGR = %40000, 0, 0, 4, CAPREQ'AM'#, <<AM, AND CHECK>>      <<U.RAO>>40632000
   MGRSA = %140000,0,0,%110,CAPREQSMORAM#,<<OR CHECK, BREAKABLE<<U.RAO>>40634000
   CS = 4,0,0,4,CAPREQ'CS'#,  <<CS, AND CHECK>>                <<U.RAO>>40636000
   OPNOTPB = %2000,0,0,6,CAPREQ'OP'#, <<OP, AND CHECK, NOT PROG<<U.RAO>>40638000
   OPSYSPROG = %102000,0,0,%33,CAPREQSMOROP#,<<NOT JOB/PRG,OR>><<01724>>40640000
   UVCAP = %1400, 0, 0, %12,CAPREQUVORCV#,  <<OR CHK, NOT PROG.<<U.RAO>>40642000
   UVCAPB = %1400, 0, 0, %112,CAPREQUVORCV#, <<OR, NOT PROG, BREAKABLE>>40644000
   UVCAPBPROG = %1400,0,0,%110,CAPREQUVORCV#, <<UV,CV,PROG>>   <<U.RAO>>40646000
   CVCAP = %1000, 0, 0, 4, CAPREQ'CV'#,  <<CV, AND CHECK>>     <<U.RAO>>40648000
   IFSTATEMENT = 0,0,0,%402,0#,  <<EVEN IN IF STMT, NOT PROG>> <<U.RAO>>40650000
   OPORSMNB = %102000,0,0,%10,CAPREQSMOROP#, <<OR CHECK>>      <<01724>>40652000
   BREAKABLE = 0,0,0, %100, 0#,  <<ANYTHING, IS BREAKABLE>>    <<U.RAO>>40654000
   USERLOGGING = %102200,0,0,%110,CAPREQ'LG'#,                 <<00596>>40656000
   UNRESTRICTED = 0,0,0,0,0#;  <<ANYTHING, NOT BREAKABLE>>     <<U.RAO>>40658000
   EQUATE HASHVAL = 49;                                        <<U.RAO>>40660000
EQUATE NPOP=%4000;      <<OPERATOR ONLY>>                      <<00552>>40662000
EQUATE NPOPNOTB = %4001;  << Operator only, not in break >>    <<01999>>40664000
EQUATE NP=%0;           <<OPERATOR COMMAND, NO RESTRICTION>>   <<00552>>40666000
EQUATE NPOPAB=%4100; <<OPERATOR COMM., NO RESTRIC, ABORTABLE>> <<00552>>40668000
$PAGE                                                          <<00552>>40670000
<<FOLLOWING EQUATES DEFINE THE MASK BIT FOR EACH OP. COMMAND>> <<00552>>40672000
<< THE FIRST "M'DEVICE" COMMANDS DEFINE THE OPERATOR COMMANDS>><<00552>>40674000
<< DEALING WITH DEVICES                                      >><<00552>>40676000
                                                               <<00552>>40678000
EQUATE M'ABORTIO=0,              <<ABORTIO ALLOW MASK BIT>>    <<00552>>40680000
       M'ACCEPT=M'ABORTIO+1,     <<ACCEPT ALLOW MASK BIT>>     <<00552>>40682000
       M'DOWN=M'ACCEPT+1,        <<DOWN ALLOW MASK BIT>>       <<00552>>40684000
       M'GIVE=M'DOWN+1,          <<GIVE ALLOW MASK BIT>>       <<00552>>40686000
       M'HEADOFF=M'GIVE+1,       <<HEADOFF ALLOW MASK BIT>>    <<00552>>40688000
       M'HEADON=M'HEADOFF+1,     <<HEADON ALLOW MASK BIT>>     <<00552>>40690000
       M'REFUSE=M'HEADON+1,      <<REFUSE ALLOW MASK BIT>>     <<00552>>40692000
       M'REPLY=M'REFUSE+1,       <<REPLY ALLOW MASK BIT>>      <<00552>>40694000
       M'STARTSPOOL=M'REPLY+1,   <<STARTSPOOL ALLOW MASK BIT>> <<00552>>40696000
       M'TAKE=M'STARTSPOOL+1,    <<TAKE ALLOW MASK BIT>>       <<00552>>40698000
       M'UP=M'TAKE+1,            <<UP ALLOW MASK BIT>>         <<00552>>40700000
       M'MPLINE=M'UP+1,          <<MPLINE ALLOW MASK BIT>>     <<00552>>40702000
       M'DSCONTROL=M'MPLINE+1,   <<DSCONTROL ALLOW MASK BIT>>  <<00552>>40704000
                                                               <<00552>>40706000
       M'DEVICE=M'DSCONTROL, <<UPPER LIMIT OF DEVICE COMMANDS>><<00552>>40708000
                                                               <<00552>>40710000
       M'ABORTJOB=M'DEVICE+1,    <<ABORTJOB ALLOW MASK BIT>>   <<00552>>40712000
       M'ALLOW=M'ABORTJOB+1,     <<ALLOW ALLOW MASK BIT>>      <<00552>>40714000
       M'ALTSPOOLFILE=M'ALLOW+1, <<ALTFILE ALLOW MASK BIT>>    <<00552>>40716000
       M'ALTJOB=M'ALTSPOOLFILE+1,<<ALTJOB ALLOW MASK BIT>>     <<00552>>40718000
       M'BREAKJOB=M'ALTJOB+1,    <<BREAKJOB ALLOW MASK BIT>>   <<00552>>40720000
       M'DELETESPOOLFILE=M'BREAKJOB+1,<<DELETE ALLOW MASK>>    <<00552>>40722000
       M'DISALLOW=M'DELETESPOOLFILE+1,<<DISALLOW MASK BIT>>    <<00552>>40724000
       M'JOBFENCE=M'DISALLOW+1,  <<JOBFENCE ALLOW MASK BIT>>   <<00552>>40726000
       M'LIMIT=M'JOBFENCE+1,     <<LIMIT ALLOW MASK BIT>>      <<00552>>40728000
       M'STOPSPOOL=M'LIMIT+1,    <<STOPSPOOL ALLOW MASK BIT>>  <<00552>>40730000
       M'SUSPENDSPOOL=M'STOPSPOOL+1,<<SUSPENDSPOOL ALLOW BIT>> <<00552>>40732000
       M'OUTFENCE=M'SUSPENDSPOOL+1, <<OUTFENCE ALLOW MASK BIT>><<00552>>40734000
       M'RECALL=M'OUTFENCE+1,    <<RECALL ALLOW MASK BIT>>     <<00552>>40736000
       M'RESUMEJOB=M'RECALL+1,   <<RESUMEJOB ALLOW MASK BIT>>  <<00552>>40738000
       M'RESUMESPOOL=M'RESUMEJOB+1,<<RESUMESPOOL ALLOW MASK>>  <<00552>>40740000
       M'STREAMS=M'RESUMESPOOL+1,  <<STREAMS ALLOW MASK BIT>>  <<00552>>40742000
       M'CONSOLE=M'STREAMS+1,    <<CONSOLE  ALLOW MASK BIT>>   <<00552>>40744000
       M'WARN=M'CONSOLE+1,       <<WARN ALLOW MASK BIT>>       <<00552>>40746000
       M'WELCOME=M'WARN+1,       <<WELCOME ALLOW MASK BIT>>    <<00552>>40748000
       M'MON=M'WELCOME+1,        <<MON ALLOW MASK BIT>>        <<00552>>40750000
       M'MOFF=M'MON+1,           <<MOFF ALLOW MASK BIT>>       <<00552>>40752000
       M'VMOUNT=M'MOFF+1,        <<VMOUNT ALLOW MASK BIT>>     <<00552>>40754000
       M'LMOUNT=M'VMOUNT+1,      <<LMOUNT ALLOW MASK BIT>>     <<00552>>40756000
       M'LDISMOUNT=M'LMOUNT+1,   <<LDISMOUNT ALLOW MASK BIT>>  <<00552>>40758000
       M'MRJECNTRL=M'LDISMOUNT+1,<<MRJECNTRL ALLOW MASK BIT>> <<OP.01>> 40760000
       M'JOBSCRTY=M'MRJECNTRL+1, <<JOBSECURITY ALLOW MASK BI>> <<00552>>40762000
       M'DOWNLOAD=M'JOBSCRTY+1,  <<DOWNLOAD ALLOW BITMASK BIT>><<00575>>40764000
       M'MIOENABLE=M'DOWNLOAD+1,  <<MIOENABLE ALLOW MASK BIT>> <<00575>>40766000
       M'MIODISABLE=M'MIOENABLE+1,<<MIODISABLE ALLOW MASK BIT>><<00601>>40768000
       M'LOG=M'MIODISABLE+1,  << LOG ALLOW MASK BIT >>         <<01424>>40770000
       M'FOREIGN=M'LOG+1,     <<FOREIGN ALLOW MASK BIT>>       <<01115>>40772000
       M'IMLCONTROL=M'LOG+2, << ALLOW MASK BIT, SORRY >>       <<01424>>40774000
       M'SHOWCOM=M'IMLCONTROL+1, <<SHOWCOM ALLOW MASK BIT>>             40776000
$PAGE                                                          <<00552>>40778000
       END'OF'M'S=0;                                           <<01424>>40780000
DEFINE C'ABORTIO=UNRESTRICTED#,                      <<OP.01>> <<00552>>40782000
       C'ACCEPT=UNRESTRICTED#,                       <<OP.01>> <<00552>>40784000
       C'DOWN=UNRESTRICTED#,                         <<OP.01>> <<00552>>40786000
       C'GIVE=UNRESTRICTED#,                         <<OP.01>> <<00552>>40788000
       C'HEADOFF=UNRESTRICTED#,                      <<OP.01>> <<00552>>40790000
       C'HEADON=UNRESTRICTED#,                       <<OP.01>> <<00552>>40792000
       C'REFUSE=UNRESTRICTED#,                       <<OP.01>> <<00552>>40794000
       C'REPLY=0,0,0,%10000,0#,  <<UNRESTRICTED, OK IN SPECIAL <<00594>>40796000
       C'RESUME=0,0,0,%10022,0#,                               <<00594>>40798000
       C'STARTSPOOL=UNRESTRICTED#,                             <<00552>>40800000
       C'TAKE=UNRESTRICTED#,                         <<OP.01>> <<00552>>40802000
       C'UP=UNRESTRICTED#,                           <<OP.01>> <<00552>>40804000
       C'MPLINE=NOTB#,      << Not in break >>                 <<01999>>40806000
       C'DSCONTROL=NOTB#,   << Not in break >>                 <<01999>>40808000
                                                               <<00552>>40810000
       C'ABORTJOB=UNRESTRICTED#,                     <<OP.01>> <<00552>>40812000
       C'ALLOW=0,0,M'ALLOW,NPOPAB,0#,<<         ALLOW>>        <<00552>>40814000
       C'ALTSPOOLFILE=UNRESTRICTED#,                           <<00552>>40816000
       C'ALTSP=C'ALTSPOOLFILE#,                                <<00552>>40818000
       C'ALTJOB=UNRESTRICTED#,                       <<OP.01>> <<00552>>40820000
       C'BREAKJOB=UNRESTRICTED#,                     <<OP.01>> <<00552>>40822000
       C'DELETESPOOLFILE=UNRESTRICTED#,                        <<00552>>40824000
       C'DISALLOW=0,0,M'DISALLOW,NPOPAB,0#,<<         ALLOW>>  <<00552>>40826000
       C'JOBFENCE=0,0,M'JOBFENCE,NPOP,0#,<<           ALLOW>>  <<00552>>40828000
       C'LIMIT=0,0,M'LIMIT,NPOP,0#,<<           ALLOW>>        <<00552>>40830000
       C'STOPSPOOL=UNRESTRICTED#,                              <<00552>>40832000
       C'SUSPENDSPOOL=UNRESTRICTED#,                           <<00552>>40834000
       C'OUTFENCE=UNRESTRICTED#,                                        40836000
       C'RECALL=0,0,0,%10000,0#, <<UNRESTRICTED, OK IN SPECIAL <<00594>>40838000
       C'RESUMEJOB=UNRESTRICTED#,                    <<OP.01>> <<00552>>40840000
       C'RESUMESPOOL=UNRESTRICTED#,                            <<00552>>40842000
       C'RESUMESP=C'RESUMESPOOL#,                              <<00552>>40844000
       C'STREAMS=0,0,M'STREAMS,NPOP,0#,<<           ALLOW>>    <<00552>>40846000
       C'CONSOLE=UNRESTRICTED#,                                <<01043>>40848000
       C'WARN=0,0,M'WARN,NPOP,0#,<<           ALLOW>>          <<00552>>40850000
       C'WELCOME=0,0,M'WELCOME,NPOP,0#,<<           ALLOW>>    <<00552>>40852000
       C'MON=0,0,M'MON,NPOP,0#,<<           ALLOW>>            <<00552>>40854000
       C'MOFF=0,0,M'MOFF,NPOP,0#,<<           ALLOW>>          <<00552>>40856000
       C'VMOUNT=0,0,M'VMOUNT,NPOP,0#,<<           ALLOW>>      <<00552>>40858000
       C'LMOUNT=0,0,M'LMOUNT,NPOP,0#,<<           ALLOW>>      <<00552>>40860000
       C'LDISMOUNT=0,0,M'LDISMOUNT,NPOP,0#,<<          ALLOW>> <<00552>>40862000
       C'MRJECNTRL=0,0,M'MRJECNTRL,NPOPNOTB,0#,                <<01999>>40864000
       C'JOBSCRTY=0,0,M'JOBSCRTY,NPOP,0#,                      <<00552>>40866000
       C'LOG=0,0,M'LOG,NPOP,0#,                                <<00601>>40868000
       C'DOWNLOAD=UNRESTRICTED#,                               <<00575>>40870000
       C'MIOENABLE=0,0,M'MIOENABLE,NPOP,0#,<<    ALLOW>>       <<00575>>40872000
       C'MIODISABLE=0,0,M'MIODISABLE,NPOP,0#,<<  ALLOW>>       <<01424>>40874000
       C'FOREIGN=UNRESTRICTED#,                                <<01115>>40876000
       C'IMLCONTROL=0,0,M'IMLCONTROL,NPOPNOTB,0#,              <<01999>>40878000
       C'SHOWCOM=UNRESTRICTED#,                                         40880000
                                                               <<00575>>40882000
       END'OF'C'S=0#;                                          <<01424>>40884000
$PAGE                              <<OP.01>>                   <<00552>>40886000
   TOS := COMLEN;                                              <<U.RAO>>40888000
   IF > THEN                                                   <<U.RAO>>40890000
      BEGIN   <<GET HASH INDEX>>                               <<U.RAO>>40892000
      << HASH VALUE = HASH KEY MOD HASH BASE (49) >>           <<U.RAO>>40894000
      << KEY IS CONSTRUCTED FROM THE LENGTH OF THE COMMAND>>   <<U.RAO>>40896000
      << AND THE FIRST, MIDDLE AND LAST CHARACTERS OF THE>>    <<U.RAO>>40898000
      << NAME.  THAT IS,                                 >>    <<U.RAO>>40900000
      << BYTE 0 = LENGTH, BYTE 1 = FIRST CHARACTER       >>    <<U.RAO>>40902000
      << BYTE 2 = MIDDLE CHAR (ROUND DOWN), BYTE 3 = LAST>>    <<U.RAO>>40904000
      TOS := @COMMAND;                                         <<U.RAO>>40906000
      ASSEMBLE (STBX);                                         <<U.RAO>>40908000
      TOS := LOGICAL (X) & LSL(8) LOR LOGICAL (COMMAND);       <<U.RAO>>40910000
      TOS := LOGICAL (COMMAND (X:=X-1)) LOR                    <<U.RAO>>40912000
            LOGICAL (COMMAND ((X +1) & ASR(1))) & LSL(8);      <<U.RAO>>40914000
      TOS := HASHVAL;                                          <<U.RAO>>40916000
      ASSEMBLE (LDIV, XAX);                                    <<U.RAO>>40918000
      <<XREG NOW HAS HASH INDEX  (REMAINDER)>>                 <<U.RAO>>40920000
      << S-0, S-1 ARE GARBAGE FROM CALCULATION>>               <<U.RAO>>40922000
                                                               <<U.RAO>>40924000
                                                               <<U.RAO>>40926000
   NEXTDDEL:                                                   <<U.RAO>>40928000
      ASSEMBLE ( DDEL;                                         <<U.RAO>>40930000
                                                               <<U.RAO>>40932000
   NEXT:                                                       <<U.RAO>>40934000
      << S-1 = COMLEN, >>                                      <<U.RAO>>40936000
      << S-0 = @COMMAND,  >>                                   <<U.RAO>>40938000
      << X = COMMANDDICT DISPL OF LAST ENTRY.  >>              <<U.RAO>>40940000
                                                               <<U.RAO>>40942000
         LOAD COMMANDDICT, X;          <<P-REL DISPL OF NEXT COMMAND>>  40944000
         BNE NOTEND;   <<SOMETHING IN BUCKET POINTER, LOOK FURTHER>>    40946000
         EXIT 6;  <<BUCKET POINTER EMPTY, NO SUCH COMMAND>>    <<U.RAO>>40948000
NOTEND:                                                        <<U.RAO>>40950000
            ADAX, DDUP;   <<GET OFFSET TO NEXT CANDIDATE IN DIRECTORY>> 40952000
            LRA COMMANDDICT, X;   <<ADDRESS OF BUCKET ENTRY>>  <<U.RAO>>40954000
            INCA;   <<SKIP OVER HASH LINK>>                    <<U.RAO>>40956000
            LSL 1;   <<GET BYTE ADDRESS OF COMMAND NAME IN DIRECTORY>>  40958000
            CAB;  <<PUT LENGTH OF COMMAND NAME ON TOS>>        <<U.RAO>>40960000
            CMPB PB, 1;  <<SEE IF MATCH WITH DIRECTORY NAME>>  <<U.RAO>>40962000
            BNE NEXTDDEL;   <<NO MATCH, TRY AGAIN>>            <<U.RAO>>40964000
            LRA S-1;   <<SUCCESSFUL MATCH, LOOK TO SEE IF DATA><<U.RAO>>40966000
            LSL 1;   <<IS SUBSET OF ACTUAL ENTRY IN DIRECTORY>><<U.RAO>>40968000
            XCH;  <<DONE BY CHECKING NEXT CHARACTER IN DIRECTORY>>      40970000
            LDI 1;   <<IS ALPHABETIC CHARACTER>>               <<U.RAO>>40972000
            MVB PB, 3;                                         <<U.RAO>>40974000
            LSR 8;                                             <<U.RAO>>40976000
            BTST, DEL;                                         <<U.RAO>>40978000
            BE NEXT;                                           <<U.RAO>>40980000
         << FOUND >>                                           <<U.RAO>>40982000
            DEL, INCA;                                         <<U.RAO>>40984000
               ASR 1;                  <<COM WORD LEN (ROUNDED DOWN)>>  40986000
               INCA, ADAX;                                     <<U.RAO>>40988000
               LOAD COMMANDDICT, X;    << LLBL >>              <<U.RAO>>40990000
               XEQ 0;                  << P-LABEL >>           <<U.RAO>>40992000
               INCX;                                           <<U.RAO>>40994000
               LOAD COMMANDDICT, X;    << CAP(0) >>            <<U.RAO>>40996000
               INCX;                                           <<U.RAO>>40998000
               LOAD COMMANDDICT, X;   << CAP(1) >>             <<U.RAO>>41000000
               INCX;                                           <<U.RAO>>41002000
               LOAD COMMANDDICT, X;  << ACCESS(0) >>           <<U.RAO>>41004000
               INCX;                                           <<U.RAO>>41006000
               LOAD COMMANDDICT, X;  << ACCESS(1) >>           <<U.RAO>>41008000
               INCX;                                           <<U.RAO>>41010000
               LOAD COMMANDDICT, X); << CAPERR >>              <<U.RAO>>41012000
               CAPERR := TOS;  <<CAPABILITY ERROR CODE>>       <<U.RAO>>41014000
               ACCESS := TOS;                                  <<U.RAO>>41016000
               CAP := TOS;                                     <<U.RAO>>41018000
               EXECPLABEL := TOS;  <<EXECUTOR PLABEL>>         <<U.RAO>>41020000
               COMSEARCH := TRUE;  <<FOUND LEGAL COMMAND>>     <<U.RAO>>41022000
      END;                                                     <<U.RAO>>41024000
   RETURN;   <<LOGICAL END OF EXECUTABLE CODE>>                <<U.RAO>>41026000
                                                               <<U.RAO>>41028000
<< BUCKET HEADS >>                                                      41030000
                                                                        41032000
COMMANDDICT:  ASSEMBLE (                                                41034000
      CON                                                               41036000
  BUCKET0 ,BUCKET1 ,0       ,BUCKET3 ,BUCKET4 ,BUCKET5 ,BUCKET6 ,       41038000
  BUCKET7 ,BUCKET8 ,BUCKET9 ,BUCKET10,BUCKET11,BUCKET12,BUCKET13,       41040000
                                                               <<01.EB>>41042000
  BUCKET14,BUCKET15,BUCKET16,BUCKET17,BUCKET18,BUCKET19,BUCKET20,       41044000
  BUCKET21,BUCKET22,BUCKET23,BUCKET24,BUCKET25,BUCKET26,BUCKET27,       41046000
  BUCKET28,BUCKET29,BUCKET30,BUCKET31,BUCKET32,BUCKET33,BUCKET34,       41048000
  BUCKET35,BUCKET36,BUCKET37,BUCKET38,BUCKET39,BUCKET40,0       ,       41050000
  BUCKET42,BUCKET43,BUCKET44,BUCKET45,BUCKET46,BUCKET47,BUCKET48;       41052000
                                                                        41054000
<< DICTIONARY ENTRIES                                          <<U.RAO>>41056000
<< 1. P-RELATIVE HASH LINK,                                    <<U.RAO>>41058000
<< 2. COMMAND NAME,                                            <<U.RAO>>41060000
<< 3. LLBL EXECUTOR,                                           <<U.RAO>>41062000
<< 4. CAPABILITY AND ACCESS DATA.  SEE COMMENT ABOVE FOR FORMAT<<U.RAO>>41064000
<<    THE FIRST TWO WORDS ARE THE CAPABILITIES REQUIRED >>     <<U.RAO>>41066000
<<    (RETURNED IN THE DOUBLE <CAP> DEFINED ABOVE) AND  >>     <<U.RAO>>41068000
<<    THE SECOND TWO WORDS ARE THE ACCESS RESTRICTIONS  >>     <<U.RAO>>41070000
<<    (RETURNED IN THE DOUBLE <ACCESS> DEFINED ABOVE).  >>     <<U.RAO>>41072000
<<    IN GENERAL YOU WILL FIND IT MORE CONVENIENT TO    >>     <<U.RAO>>41074000
<<    CREATE A DEFINE FOR THIS FIELD OF THE DICTIONARY. >>     <<U.RAO>>41076000
<<    THE FIFTH WORD IS THE CI ERROR NUMBER TO BE USED IFF     <<U.RAO>>41078000
<<    SUBROUTINE PERMITACCESS IN THE CI ENCOUNTERS A CAPABILITY<<U.RAO>>41080000
<<    ERROR.                                                   <<U.RAO>>41082000
<< NOTE: COMMANDS WHICH ARE BEGINNING SUBSTRINGS OF OTHER      <<U.RAO>>41084000
<<       COMMANDS IN THE SAME BUCKET, MUST APPEAR BEFORE THOSE <<U.RAO>>41086000
<<       COMMANDS IN THE BUCKET CHAIN.                         <<U.RAO>>41088000
<< <X>,<Y> AND <Z> BELOW ARE DEFINES FOR DELIMITERS.           <<U.RAO>>41090000
                                                                        41092000
<< <LOCATION> :CON <HASHLINK> ,"<COMMAND>" ;LLBL <EXEC>   ;CON <DATA>;>>41094000
<<           14            28             43             58    <<U.RAO>>41096000
                                                               <<U.RAO>>41098000
BUCKET0:                                                       <<U.RAO>>41100000
TUNE         W ALTLOG      ,"TUNE"        Y CXTUNE       Z OPORSMNB;    41102000
ALTLOG       W DEBUG'L     ,"ALTLOG"      Y CXALTLOG     Z USERLOGGING; 41104000
DEBUG'L      W EOD         ,"DEBUG"       Y CXDEBUG      Z 0,%100,0,%26,41106000
                                                           CAPREQ'PM';  41108000
EOD          W STREAM      ,"EOD "        Y CXEOD        Z NOTPB       ;41110000
STREAM       W RJE         ,"STREAM"      Y CXSTREAM     Z BREAKABLE   ;41112000
RJE          W SETDUMP'L   ,"RJE "        Y CXRJE        Z NOTPB       ;41114000
SETDUMP'L    W SYSDUMP     ,"SETDUMP "    Y CXSETDUMP    Z UNRESTRICTED;41116000
SYSDUMP      W 0           ,"SYSDUMP "    Y CXSYSDUMP    Z OPNBR       ;41118000
                                                               <<U.RAO>>41120000
BUCKET1:                                                       <<DS0.0>>41122000
DISASSOCIATE W ABORTJOB ,"DISASSOCIATE" Y CXDISASSOCIATE Z UNRESTRICTED;41124000
ABORTJOB     W REDO        ,"ABORTJOB"    Y CXABORTJOB   Z C'ABORTJOB;  41126000
REDO         W RFA         ,"REDO"        Y CXREDO             <<01455>>41128000
                                          Z 0,0,0,%3102,0;     <<01455>>41130000
RFA          W 0           ,"RFA "        Y CXRFAD      Z 0,0,0,%2400,0;41132000
                                                               <<DS0.0>>41134000
                                                           <<00815>>    41136000
BUCKET3:                                                       <<U.RAO>>41138000
PASCALGO     W DISALLOW    ,"PASCALGO"    Y CXPASCALGO         <<02844>>41140000
                                          Z NOTPB;             <<02844>>41142000
DISALLOW     W SHOWIN      ,"DISALLOW"    Y CXDISALLOW   Z C'DISALLOW;  41144000
<<SPOOL        W SHOWIN      ,"SPOOL"       Y CXSPOOL      Z C'SPOOL;>> 41146000
SHOWIN       W NEWACCT     ,"SHOWIN"      Y CXSHOWIN     Z BREAKABLE   ;41148000
NEWACCT      W CLINE       ,"NEWACCT "    Y CXNEWACCT    Z MGR         ;41150000
CLINE        W 0           ,"CLINE "      Y CXCLINE      Z CS          ;41152000
                                                               <<U.RAO>>41154000
BUCKET4:                                                       <<U.RAO>>41156000
FOREIGN      W REPLY       ,"FOREIGN"     Y CXFOREIGN    Z C'FOREIGN;   41158000
REPLY        W ELSE'       ,"REPLY"       Y CXREPLY      Z C'REPLY;     41160000
ELSE'        W FREERIN     ,"ELSE"        Y CXELSE       Z IFSTATEMENT; 41162000
                                                               <<U.RAO>>41164000
FREERIN      W SHOWLOG     ,"FREERIN "    Y CXFREERIN    Z NOTPB       ;41166000
SHOWLOG      W 0           ,"SHOWLOG "    Y CXSHOWLOG    Z OPBR        ;41168000
                                                               <<U.RAO>>41170000
BUCKET5:                                                       <<U.RAO>>41172000
TELLOP       W 0           ,"TELLOP"      Y CXTELLOP     Z UNRESTRICTED;41174000
                                                               <<U.RAO>>41176000
BUCKET6:                                                       <<U.RAO>>41178000
                                                               <<00506>>41180000
LISTLOG      W EOJ         ,"LISTLOG "    Y CXLISTLOG    Z USERLOGGING; 41182000
EOJ          W BASICGO     ,"EOJ "        Y CXEOJ        Z 0,0,0,%42,0; 41184000
BASICGO      W BASICPREP   ,"BASICGO "    Y CXBASICGO    Z NOTPB       ;41186000
BASICPREP    W PASCAL      ,"BASICPREP"   Y CXBASICPREP        <<02844>>41188000
                                          Z NOTPB;             <<02844>>41190000
PASCAL       W 0           ,"PASCAL"      Y CXPASCAL           <<02844>>41192000
                                          Z NOTPB;             <<02844>>41194000
                                                               <<U.RAO>>41196000
BUCKET7:                                                       <<U.RAO>>41198000
LDISMOUNT    W VMOUNT      ,"LDISMOUNT"   Y CXLDISMOUNT  Z C'LDISMOUNT; 41200000
VMOUNT       W HELP        ,"VMOUNT"      Y CXVMOUNT     Z C'VMOUNT;    41202000
HELP         W 0           ,"HELP"        Y CXHELP       Z BREAKABLE   ;41204000
                                                               <<01.EB>>41206000
BUCKET8:                                                       <<U.RAO>>41208000
ALLOW        W SHOWQ       ,"ALLOW"       Y CXALLOW      Z C'ALLOW;     41210000
SHOWQ        W JOBPRI      ,"SHOWQ"       Y CXSHOWQ      Z OPBR;        41212000
JOBPRI       W 0           ,"JOBPRI"      Y CXJOBPRI     Z OP; <<U.RAO>>41214000
                                                               <<U.RAO>>41216000
BUCKET9:                                                       <<U.RAO>>41218000
PURGE        W PURGEUSER   ,"PURGE "      Y CXPURGE      Z UNRESTRICTED;41220000
PURGEUSER    W 0           ,"PURGEUSER "  Y CXPURGEUSER  Z AMGR        ;41222000
                                                               <<U.RAO>>41224000
BUCKET10:                                                      <<U.RAO>>41226000
IMFMGR       W SHOWCOM     ,"IMFMGR"      Y CX3270MGR          <<02845>>41228000
                                          Z NOTPB;             <<02845>>41230000
SHOWCOM      W A3270MGR    ,"SHOWCOM"     Y CXSHOWCOM    Z C'SHOWCOM;   41232000
A3270MGR     W LISTVS      ,"IMLMGR"      Y CX3270MGR    Z NOTPB       ;41234000
LISTVS       W 0           ,"LISTVS"      Y CXLISTVS     Z UVCAPBPROG  ;41236000
                                                                        41238000
BUCKET11:                                                               41240000
                                                               <<01436>>41242000
MRJECONTROL  W RPGPREP     ,"MRJECONTROL" Y CXMRJECONTROL Z C'MRJECNTRL;41244000
                                                               <<01436>>41246000
RPGPREP      W PURGEACCT   ,"RPGPREP "    Y CXRPGPREP    Z NOTPB       ;41248000
PURGEACCT    W PURGEVSET   ,"PURGEACCT "  Y CXPURGEACCT  Z MGR         ;41250000
PURGEVSET    W FCOPY       ,"PURGEVSET "  Y CXPURGEVSET        <<01453>>41252000
                                          Z CVCAP;             <<01453>>41254000
FCOPY        W 0           ,"FCOPY "      Y CXFCOPY            <<01453>>41256000
                                          Z NOTPB;             <<01453>>41258000
                                                                        41260000
BUCKET12:                                                               41262000
PREPRUN      W QUANTUM'L   ,"PREPRUN "    Y CXPREPRUN    Z NOTPB       ;41264000
QUANTUM'L    W 0           ,"QUANTUM "    Y CXQUANTUM    Z OP          ;41266000
                                                                        41268000
BUCKET13:                                                               41270000
ALLOCATE     W  0           ,"ALLOCATE"    Y CXALLOCATE   Z OPNOTPB    ;41272000
                                                                        41274000
BUCKET14:                                                               41276000
OUTFENCE     W STREAMS     ,"OUTFENCE"    Y CXOUTFENCE   Z C'OUTFENCE;  41278000
STREAMS      W HELLO       ,"STREAMS"     Y CXSTREAMS    Z C'STREAMS;   41280000
HELLO        W LISTACCT    ,"HELLO "      Y CXHELLO     Z 0,%200,0,%133,41282000
                                                           CAPREQ'IA';  41284000
LISTACCT     W 0           ,"LISTACCT"    Y CXLISTACCT   Z MGRSA       ;41286000
                                                                        41288000
BUCKET15:                                                               41290000
FORTGO       W JOB         ,"FORTGO"      Y CXFORTGO     Z NOTPB       ;41292000
JOB          W GETRIN      ,"JOB "        Y CXJOB       Z 0,%400,0,%113,41294000
                                                           CAPREQ'BA';  41296000
GETRIN       W DSTAT       ,"GETRIN"      Y CXGETRIN     Z UNRESTRICTED;41298000
DSTAT        W 0           ,"DSTAT "      Y CXDSTAT      Z UNRESTRICTED;41300000
                                                                        41302000
BUCKET16:                                                               41304000
RESUMESPOOL  W TAKE        ,"RESUMESPOOL" Y CXRESUMESPOOL Z C'RESUMESP; 41306000
TAKE         W SETJCW'L    ,"TAKE"        Y CXTAKE       Z C'TAKE;      41308000
SETJCW'L     W PREP        ,"SETJCW"      Y CXSETJCW     Z UNRESTRICTED;41310000
PREP         W SAVE        ,"PREP"        Y CXPREP       Z NOTPB       ;41312000
SAVE         W 0           ,"SAVE"        Y CXSAVE       Z 1,0,0,4,     41314000
                                                           CAPREQ'SF';  41316000
                                                                        41318000
BUCKET17:                                                               41320000
LOG          W SHOWOUT     ,"LOG"        Y CXLOG         Z C'LOG;       41322000
SHOWOUT      W 0           ,"SHOWOUT "    Y CXSHOWOUT    Z BREAKABLE   ;41324000
                                                                        41326000
BUCKET18:                                                               41328000
PTAPE        W 0           ,"PTAPE "      Y CXPTAPE      Z 0,0,0,%20,0 ;41330000
                                                                        41332000
BUCKET19:                                                               41334000
JOBSECURITY  W SHOWDEV     ,"JOBSECURITY" Y CXJOBSECURITY Z C'JOBSCRTY; 41336000
SHOWDEV      W RPG        ,"SHOWDEV "     Y CXSHOWDEV    Z BREAKABLE   ;41338000
RPG          W 0          ,"RPG "         Y CXRPG        Z NOTPB       ;41340000
                                                                        41342000
BUCKET20:                                                               41344000
SHOWJCW      W ALTUSER     ,"SHOWJCW "    Y CXSHOWJCW    Z BREAKABLE;   41346000
                                                               <<U.RAO>>41348000
ALTUSER      W VINIT       ,"ALTUSER "    Y CXALTUSER    Z AMGR        ;41350000
VINIT        W 0           ,"VINIT "      Y CXVINIT      Z OPSYSPROG   ;41352000
                                                                        41354000
BUCKET21:                                                               41356000
WELCOME      W ASSOCIATE   ,"WELCOME"     Y CXWELCOME    Z C'WELCOME;   41358000
ASSOCIATE    W SECURE      ,"ASSOCIATE"   Y CXASSOCIATE Z UNRESTRICTED; 41360000
SECURE       W 0           ,"SECURE"      Y CXSECURE     Z UNRESTRICTED;41362000
                                                                        41364000
BUCKET22:                                                               41366000
                                                               <<01177>>41368000
DSCONTROL    W LMOUNT      ,"DSCONTROL"   Y CXDSCONTROL  Z C'DSCONTROL; 41370000
                                                               <<01177>>41372000
LMOUNT       W ALTJOB      ,"LMOUNT"      Y CXLMOUNT     Z C'LMOUNT;    41374000
ALTJOB       W FORTRAN     ,"ALTJOB"      Y CXALTJOB     Z C'ALTJOB;    41376000
FORTRAN      W SPLGO       ,"FORTRAN "    Y CXFORTRAN    Z NOTPB       ;41378000
SPLGO        W RESETDUMP'L ,"SPLGO "      Y CXSPLGO      Z NOTPB       ;41380000
RESETDUMP'L  W DSCOPY      ,"RESETDUMP"   Y CXRESETDUMP        <<01452>>41382000
                                          Z UNRESTRICTED;      <<01452>>41384000
DSCOPY       W 0           ,"DSCOPY"      Y CXDSCOPY           <<01452>>41386000
                                          Z NOTPB;             <<01452>>41388000
                                                                        41390000
BUCKET23:                                                               41392000
IMF          W BREAKJOB    ,"IMF "        Y CX3270             <<02845>>41394000
                                          Z NOTPB;             <<02845>>41396000
BREAKJOB     W RENAME      ,"BREAKJOB"    Y CXBREAKJOB   Z C'BREAKJOB;  41398000
RENAME       W 0           ,"RENAME"      Y CXRENAME     Z UNRESTRICTED;41400000
                                                                        41402000
BUCKET24:                                                               41404000
LIMIT        W WARN        ,"LIMIT"       Y CXLIMIT      Z C'LIMIT;     41406000
WARN         W ALTSEC      ,"WARN"        Y CXWARN       Z C'WARN;      41408000
ALTSEC       W 0           ,"ALTSEC"      Y CXALTSEC     Z UNRESTRICTED;41410000
                                                                        41412000
BUCKET25:                                                               41414000
APL          W NEWUSER     ,"APL "        Y CXAPL        Z NOTPB       ;41416000
NEWUSER      W 0           ,"NEWUSER "    Y CXNEWUSER    Z AMGR        ;41418000
                                                                        41420000
BUCKET26:                                                               41422000
MIOENABLE    W RELEASE     ,"MIOENABLE"   Y CXMIOENABLE  Z C'MIOENABLE; 41424000
RELEASE      W SHOWTIME    ,"RELEASE "    Y CXRELEASE    Z BREAKABLE   ;41426000
SHOWTIME     W RESETACCT   ,"SHOWTIME"    Y CXSHOWTIME   Z BREAKABLE   ;41428000
RESETACCT    W 0           ,"RESETACCT "  Y CXRESETACCT  Z MGR         ;41430000
                                                                        41432000
BUCKET27:                                                               41434000
LISTF        W CONTINUE    ,"LISTF "      Y CXLISTF      Z BREAKABLE   ;41436000
CONTINUE     W 0           ,"CONTINUE"    Y CXCONTINUE   Z 0,0,0,%2,0;  41438000
                                                                        41440000
BUCKET28:                                                               41442000
BUILD        W 0           ,"BUILD "      Y CXBUILD      Z UNRESTRICTED;41444000
                                                                        41446000
BUCKET29:                                                               41448000
A3270        W RESUMEJOB   ,"IML "        Y CX3270       Z NOTPB       ;41450000
RESUMEJOB    W SEGMENTER'L ,"RESUMEJOB"   Y CXRESUMEJOB  Z C'RESUMEJOB; 41452000
SEGMENTER'L  W COMMENTL    ,"SEGMENTER"   Y CXSEGMENTER  Z NOTPB;       41454000
COMMENTL     W 0           ,"COMMENT "    Y CXCOMMENT    Z UNRESTRICTED;41456000
                                                                        41458000
BUCKET30:                                                               41460000
ALTSPOOLFILE W STOPSPOOL   ,"ALTSPOOLFILE" Y CXALTSPOOLFILE Z C'ALTSP;  41462000
STOPSPOOL    W RECALL      ,"STOPSPOOL"    Y CXSTOPSPOOL  Z C'STOPSPOOL;41464000
RECALL       W REMOTE      ,"RECALL"      Y CXRECALL     Z C'RECALL;    41466000
REMOTE       W COBOLPREP   ,"REMOTE"      Y CXREMOTED    Z UNRESTRICTED;41468000
COBOLPREP    W 0           ,"COBOLPREP "  Y CXCOBOLPREP  Z NOTPB       ;41470000
                                                                        41472000
BUCKET31:                                                               41474000
CONSOLE      W HEADOFF     ,"CONSOLE"     Y CXCONSOLE    Z C'CONSOLE;   41476000
HEADOFF      W HEADON      ,"HEADOFF"     Y CXHEADOFF    Z C'HEADOFF;   41478000
HEADON       W COBOL       ,"HEADON"      Y CXHEADON     Z C'HEADON;    41480000
COBOL        W 0           ,"COBOL "      Y CXCOBOL      Z NOTPB       ;41482000
                                                                        41484000
BUCKET32:                                                               41486000
RUN          W RESET       ,"RUN "        Y CXRUN        Z NOTPB       ;41488000
RESET        W SPEED       ,"RESET "      Y CXRESET      Z UNRESTRICTED;41490000
SPEED        W VSUSER      ,"SPEED "      Y CXSPEED            <<01724>>41492000
                                          Z 0,0,0,%20,0;       <<01724>>41494000
VSUSER       W 0           ,"VSUSER"      Y CXVSUSER     Z UVCAP       ;41496000
                                                                        41498000
                                                                        41500000
BUCKET33:                                                               41502000
DOWNLOAD     W ABORTIO     ,"DOWNLOAD"    Y CXDOWNLOAD   Z C'DOWNLOAD;  41504000
ABORTIO      W SETMSG      ,"ABORTIO"     Y CXABORTIO    Z C'ABORTIO;   41506000
SETMSG       W DISMOUNTC   ,"SETMSG"      Y CXSETMSG     Z UNRESTRICTED;41508000
DISMOUNTC    W ALTVSET     ,"DISMOUNT"    Y CXDISMOUNT   Z UVCAP       ;41510000
ALTVSET      W 0           ,"ALTVSET"     Y CXALTVSET    Z CVCAP       ;41512000
                                                                        41514000
BUCKET34:                                                               41516000
ACCEPT       W DOWN        ,"ACCEPT"      Y CXACCEPT     Z C'ACCEPT;    41518000
DOWN         W GIVE        ,"DOWN"        Y CXDOWN       Z C'DOWN;      41520000
GIVE         W DSLINE      ,"GIVE"        Y CXGIVE       Z C'GIVE;      41522000
DSLINE       W SPLPREP     ,"DSLINE"      Y CXDSLINED    Z UNRESTRICTED;41524000
SPLPREP      W TELL        ,"SPLPREP "    Y CXSPLPREP    Z NOTPB       ;41526000
TELL         W RESUMELOG   ,"TELL"        Y CXTELL       Z UNRESTRICTED;41528000
RESUMELOG    W DEALLOCATE  ,"RESUMELOG "  Y CXRESUMELOG  Z OPBR        ;41530000
DEALLOCATE   W 0           ,"DEALLOCATE"  Y CXDEALLOCATE Z OPNOTBRK;    41532000
                                                                        41534000
BUCKET35:                                                               41536000
SHOWLOGSTAT W LISTGROUP,"SHOWLOGSTATUS " Y CXSHOWLOGSTATUS Z 0,0,0,%2,0;41538000
                                                               <<00506>>41540000
LISTGROUP    W 0           ,"LISTGROUP "  Y CXLISTGROUP  Z MGRSA       ;41542000
                                                                        41544000
BUCKET36:                                                               41546000
DELETESPOOLFILE W SUSPENDSPOOL,                                <<00552>>41548000
             "DELETESPOOLFILE" Y CXDELETESPOOLFILE Z C'DELETESPOOLFILE; 41550000
SUSPENDSPOOL W IF'         ,                                   <<00552>>41552000
             "SUSPENDSPOOL"    Y CXSUSPENDSPOOL Z C'SUSPENDSPOOL;       41554000
IF'          W LISTUSER    ,"IF"          Y CXIF         Z IFSTATEMENT; 41556000
                                                               <<U.RAO>>41558000
LISTUSER     W 0           ,"LISTUSER"    Y CXLISTUSER   Z MGRSA       ;41560000
                                                                        41562000
BUCKET37:                                                               41564000
FORTPREP     W DATA        ,"FORTPREP"    Y CXFORTPREP   Z NOTPB       ;41566000
DATA         W PURGEGROUP  ,"DATA"        Y CXDATA       Z NOTPB       ;41568000
PURGEGROUP   W MOUNTC      ,"PURGEGROUP"  Y CXPURGEGROUP Z AMGR        ;41570000
MOUNTC       W 0           ,"MOUNT "      Y CXMOUNT      Z UVCAP       ;41572000
                                                                        41574000
BUCKET38:                                                               41576000
STARTSPOOL   W ABORT       ,                                            41578000
              "STARTSPOOL"     Y CXSTARTSPOOL   Z C'STARTSPOOL;         41580000
ABORT        W CRESET      ,"ABORT "      Y CXABORT      Z 0,0,0,%22,0 ;41582000
CRESET       W NEWVSET     ,"CRESET"      Y CXCRESET     Z UNRESTRICTED;41584000
NEWVSET      W 0           ,"NEWVSET"     Y CXNEWVSET    Z CVCAP       ;41586000
                                                                        41588000
BUCKET39:                                                               41590000
SHOWALLOW    W SHOWCATALOG ,"SHOWALLOW"   Y CXSHOWALLOW  Z UNRESTRICTED;41592000
SHOWCATALOG  W BASIC       ,"SHOWCATALOG " Y CXSHOWCATALOG Z 0D,%102D,0;41594000
BASIC        W 0           ,"BASIC "      Y CXBASIC      Z NOTPB       ;41596000
                                                              <<MRJE>>  41598000
BUCKET40:                                                     <<MRJE>>  41600000
MIODISABLE   W UP          ,"MIODISABLE"  Y CXMIODISABLE Z C'MIODISABLE;41602000
UP           W MRJE        ,"UP"          Y CXUP         Z C'UP;        41604000
MRJE         W GETLOG      ,"MRJE"        Y CXMRJE       Z NOTPB    ;   41606000
GETLOG       W 0           ,"GETLOG"      Y CXGETLOG     Z USERLOGGING; 41608000
                                                              <<MRJE>>  41610000
                                                                        41612000
BUCKET42:                                                               41614000
BYE          W RPGGO       ,"BYE "        Y CXBYE        Z 0,0,0,%123,0;41616000
RPGGO        W ALTGROUP    ,"RPGGO "      Y CXRPGGO      Z NOTPB       ;41618000
ALTGROUP     W 0           ,"ALTGROUP"    Y CXALTGROUP   Z AMGR        ;41620000
                                                                        41622000
BUCKET43:                                                               41624000
PASCALPREP   W SHOWME      ,"PASCALPREP"  Y CXPASCALPREP       <<02844>>41626000
                                          Z NOTPB;             <<02844>>41628000
SHOWME       W 0           ,"SHOWME"      Y CXSHOWME     Z BREAKABLE;   41630000
                                                               <<U.RAO>>41632000
BUCKET44:                                                               41634000
SETCATALOG   W EDITOR      ,"SETCATALOG"  Y CXSETCATALOG Z 0,0,0,2,0   ;41636000
EDITOR       W RESTORE     ,"EDITOR"      Y CXEDITOR     Z NOTPB       ;41638000
RESTORE      W ENDIF       ,"RESTORE "    Y CXRESTORE    Z BREAKABLE   ;41640000
ENDIF        W 0           ,"ENDIF "      Y CXENDIF      Z IFSTATEMENT; 41642000
                                                               <<U.RAO>>41644000
                                                                        41646000
BUCKET45:                                                               41648000
                                                               <<01208>>41650000
MPLINE       W STORE       ,"MPLINE"      Y CXMPLINE     Z C'MPLINE;    41652000
                                                               <<01208>>41654000
STORE        W REPORT      ,"STORE "      Y CXSTORENEW         <<04660>>41656000
                                          Z NOTB;              <<04660>>41658000
REPORT       W SWITCHLOG   ,"REPORT"      Y CXREPORT     Z BREAKABLE   ;41660000
SWITCHLOG    W 0           ,"SWITCHLOG "  Y CXSWITCHLOG  Z OPBR        ;41662000
                                                                        41664000
BUCKET46:                                                               41666000
MOFF         W JOBFENCE    ,"MOFF"        Y CXMOFF       Z C'MOFF;      41668000
JOBFENCE     W COBOLGO'L   ,"JOBFENCE"    Y CXJOBFENCE   Z C'JOBFENCE;  41670000
COBOLGO'L    W 0           ,"COBOLGO "    Y CXCOBOLGO    Z NOTPB       ;41672000
                                                                        41674000
BUCKET47:                                                               41676000
IMFCONTROL   W A3270CONTROL,"IMFCONTROL"  Y CX3270CONTROL      <<02845>>41678000
                                          Z C'IMLCONTROL;      <<02845>>41680000
A3270CONTROL W MON         ,"IMLCONTROL" Y CX3270CONTROL Z C'IMLCONTROL;41682000
MON          W REFUSE      ,"MON"         Y CXMON        Z C'MON;       41684000
REFUSE       W SPL         ,"REFUSE"      Y CXREFUSE     Z C'REFUSE;    41686000
SPL          W RESUME      ,"SPL "        Y CXSPL        Z NOTPB       ;41688000
RESUME       W BASICOMP    ,"RESUME"      Y CXRESUME     Z C'RESUME;    41690000
BASICOMP     W NEWGROUP    ,"BASICOMP"    Y CXBASICOMP   Z NOTPB       ;41692000
NEWGROUP     W ALTACCT     ,"NEWGROUP"    Y CXNEWGROUP   Z AMGR        ;41694000
ALTACCT      W 0           ,"ALTACCT "    Y CXALTACCT    Z MGR         ;41696000
                                                                        41698000
BUCKET48:                                                               41700000
RELLOG       W FILE        ,"RELLOG"      Y CXRELLOG     Z USERLOGGING; 41702000
                                                               <<00506>>41704000
FILE         W SHOWJOB     ,"FILE"        Y CXFILE       Z UNRESTRICTED;41706000
SHOWJOB      W 0           ,"SHOWJOB "    Y CXSHOWJOB    Z BREAKABLE   ;41708000
   );                                                          <<U.RAO>>41710000
END    <<COMSEARCH>>;                                          <<U.RAO>>41712000
$PAGE "COMMANDINTERP - MAIN BODY OF CI"                        <<08.RO>>41714000
PROCEDURE COMMANDINTERP(EXPCODE);                              <<02.EB>>41716000
   VALUE EXPCODE;                                              <<02.EB>>41718000
   LOGICAL EXPCODE;                                            <<02.EB>>41720000
   OPTION UNCALLABLE;                                          <<02.EB>>41722000
BEGIN                                                                   41724000
      ENTRY                                                    <<U.RAO>>41726000
          UDCCI,  <<REENTRY POINT FOR UDC'S>>                  <<03.RO>>41728000
          COMMAND',  <<ENTRY FOR COMMAND INTRINSIC>>           <<03.RO>>41730000
          SYSBREAK;  <<ENTRY FOR TERMINAL BREAK FUNCTION>>     <<03.RO>>41732000
                                                               <<01.PV>>41734000
      DOUBLE                                                   <<01.PV>>41736000
          ACCESS,  <<ACCESS RESTRICTIONS FROM COMSEARCH>>      <<U.RAO>>41738000
          CAP;   <<EXEC CAPABILITY FROM COMSEARCH>>            <<03.RO>>41740000
                                                               <<01.PV>>41742000
      LOGICAL                                                  <<01.PV>>41744000
          CAP0 = CAP,                                          <<01.PV>>41746000
          CAP1 = CAP0+1,                                       <<01.PV>>41748000
         ACCESS0=ACCESS,   <<10:6 =OPERATOR COMMAND INDEX>>    <<00552>>41750000
          ACCESS1 = ACCESS+1,  <<ACCESS RESTRICTIONS>>         <<U.RAO>>41752000
          PROGCALL := FALSE,  <<PROGRAMMATICALLY INVOKED>>     <<03.RO>>41754000
         SPECIAL'BREAK:=FALSE, <<ENTERED THRU RIT BREAK FLAG>> <<00594>>41756000
          STAT2 = Q-5,  <<FOR PROGRAMMATIC CALL STATUS RTN>>   <<03.RO>>41758000
          PROMPT := ": ",   <<PROMPT FOR SESSION>>             <<03.RO>>41760000
          CONTFLG := FALSE,  <<EXPECTING CONTINUATION RECORD>> <<03.RO>>41762000
          JOBFLG,  <<PROCESSING "JOB" COMMAND, NO ECHO>>       <<03.RO>>41764000
          EXECPLABEL,  <<PLABEL OF COMMAND EXECUTOR TO CALL>>  <<03.RO>>41766000
          NONABORTABLE; <<COMMAND CAN BE BROKEN WITH BREAK>>   <<03.RO>>41768000
                                                               <<01.PV>>41770000
      ARRAY                                                    <<01.PV>>41772000
          WMESNO(0:15);   <<ANSWER HOLDER FOR ABORT QUESTION>> <<U.RAO>>41774000
                                                               <<01.PV>>41776000
      INTEGER ARRAY ALLOWMASK(0:2); <<HOLDER OF ALLOW MASK>>   <<00552>>41778000
                                 <<OP.01>>                              41780000
      INTEGER                                                  <<01.PV>>41782000
          ERRNUM,  <<ERROR NUMBER RETURNED FROM EXECUTOR>>     <<03.RO>>41784000
          PARMNUM, <<PARAMETER INDEX FROM EXECUTOR>>           <<03.RO>>41786000
          LENGTH,  <<LENGTH OF THE RECORD JUST READ.>>         <<03.RO>>41788000
          COMLEN,  <<LENGTH OF THE CURRENT COMMAND NAME>>      <<03.RO>>41790000
          LEFT,  <<SPACE LEFT IN THE INPUT BUFFER>>            <<03.RO>>41792000
          CAPCHECKERR,  <<CIERR IF CAPABILITY CHECK FAILED>>   <<03.RO>>41794000
          BYTE'INDEX, << INDEX INTO TEMP ARRAY FOR ECHO  >>    <<04212>>41796000
          TEMP'COMLENGTH,<< TEMP COMMAND STRING LENGTHY>>      <<04212>>41798000
          TEMP'BYTE'INDX,<<SAVES BYTE INDX TO LOCKWORD START>> <<04212>>41800000
          LEN'STRING'LEFT,<<LENGTH OF STRING AFTER LOCKWORD>>  <<04212>>41802000
          WHOLELENGTH, <<SAVES WHOLE STRING LENGTH>>           <<04212>>41804000
          TEMP'COUNT,<<FIGURED COUNT OF CHARS COMPACTED>>      <<04212>>41806000
          NCHAR; <<NUMBER OF CHARACTERS READ FOR ABORT REPLY>> <<03.RO>>41808000
                                                               <<01.PV>>41810000
      POINTER                                                  <<01.PV>>41812000
          ERRPARM = Q-9,  <<ERRNUM FROM COMMAND INTRINSIC>>    <<03.RO>>41814000
          PARMPARM = Q-8, <<PARMNUM FROM COMMAND INTRINSIC>>   <<03.RO>>41816000
          JFLAGS,  <<JOB FLAGS FROM PXGLOB>>                   <<03.RO>>41818000
          PXGLOB;  <<DB RELATIVE POINTER TO PXGLOB>>           <<03.RO>>41820000
      INTEGER IOERRCOUNT;  <<COUNT OF READ ERRORS ENCOUNTERED>><<03.RO>>41822000
      EQUATE IOERRLIMIT = 3;  <<BEFORE TERMINATING SESSION>>   <<03.RO>>41824000
      LOGICAL UDCEXECED := FALSE;  <<FLAG BETWEEN CI & UDC>>   <<03.EB>>41826000
INTEGER LINELENSPTR;  <<STACK POINTER INTO LINE LENGTH STACK>> <<U.RAO>>41828000
      BYTE POINTER                                             <<03.RO>>41830000
          COMARRAY = Q-10,  <<COMMAND STRING FROM COMMAND>>    <<03.RO>>41832000
                         <<INTRINSIC.  POINTS TO COMMAND NAME>><<03.RO>>41834000
          PNTR,  <<CURRENT END OF INPUT BUFFER (SEE GETIMAGE)>><<03.RO>>41836000
           TEMP'PNTR,<<POINTS TO START IF ECHO TEMP ARRAY>>    <<04212>>41838000
           B'POINTER, << POINTS TO WHERE SLASH IS FOUND>>      <<04212>>41840000
          PARMSP;  <<START OF COMMAND PARAMETERS>>             <<03.RO>>41842000
      LOGICAL                                                  <<00257>>41844000
          LCOMARRAY = COMARRAY;<<USED TO GET ADDR OF COMARRAY>><<00257>>41846000
      EQUATE                                                   <<00257>>41848000
          CR'CR = %6415;                                       <<00257>>41850000
      BYTE ARRAY MESNO(*) = WMESNO;   <<FOR MESSAGES>>         <<U.RAO>>41852000
       BYTE SAVEECHOBYTE;                                      <<04212>>41854000
       BYTE ARRAY TEMP'COMIMAGE (0:BCOMMANDBUFLEN);            <<04212>>41856000
DEFINE    <<FOR ACCESS RESTRICTIONS>>                          <<U.RAO>>41858000
   OPCOMMANDWRD=ACCESS0.(10:2)#, <<ALLOW MASK WORD INDEX>>     <<00552>>41860000
   OPCOMMANDINX=ACCESS0.(12:4)#, <<ALLOW MASK BIT INDEX>>      <<00552>>41862000
   ANOTINBREAK = ACCESS1#,  <<NOT ALLOWED IN BREAK>>           <<U.RAO>>41864000
   ANOTINPROG = ACCESS1.(14:1)#, <<NOT ALLOWED PROGRAMMATICALLY<<U.RAO>>41866000
   CAPCHECK = ACCESS1.(12:2)<>0#, <<CAP CHECK REQUIRED>>       <<U.RAO>>41868000
   ANDCAPCHECK = ACCESS1.(12:2)=1#,  <<DO "AND" CHECK>>        <<U.RAO>>41870000
   ORCAPCHECK = ACCESS1.(12:2)=2#,  <<DO "OR" CHECK>>          <<U.RAO>>41872000
   ANOTINJOB = ACCESS1.(11:1)#,  <<NOT ALLOWED IN BATCH>>      <<U.RAO>>41874000
   ANOTINSESSION = ACCESS1.(10:1)#, <<NOT ALLOWED IN SESSION>> <<U.RAO>>41876000
   ACANBREAK = ACCESS1.(9:1)#,  <<CAN BREAK COMMAND LISTING>>  <<U.RAO>>41878000
   ACAN'TWITHAPL = ACCESS1.(8:1)#,  <<CAN'T USE WITH APL>>     <<U.RAO>>41880000
   AEXECEVENINIF = ACCESS1.(7:1)#,  <<DON'T FLUSH IN IF>>      <<U.RAO>>41882000
   ANOTINUDC = ACCESS1.(6:1)#, <<NOT ALLOWED IN USER DEF CMD>> <<08.RO>>41884000
    SPECIALBREAK'COM=ACCESS1.(3:1)#,   <<COMMAND OK IN SPECIAL <<00594>>41886000
   OPCOMMAND=ACCESS1.(4:1)#,    <<USER MUST HAVE BEEN ALLOWED>><<00552>>41888000
   ANOTREDOABLE = ACCESS1.(5:1)#;  <<CAN'T REDO>>              <<08.RO>>41890000
EQUATE JOBFLAG = 2,                                            <<U.RAO>>41892000
       SESSIONFLAG = 1;  <<JOB/SESSION FIELD IN JOB NUMBERS>>  <<U.RAO>>41894000
      EQUATE PROMPTL=-1;  <<PROMPT LENGTH IS ONE BYTE>>        <<03.RO>>41896000
      DEFINE CCC=STAT2.(6:2)#,  <<FOR COMMAND INTRINSIC>>      <<03.RO>>41898000
      DUPLF=JFLAGS.(PXGFDUP)#,   <<DUPLICATIVE FLAG>>          <<03.RO>>41900000
      INTERACTF=JFLAGS.(PXGFINTER)#;   <<INTERACTIVE FLAG>>    <<03.RO>>41902000
      DEFINE INSTANTLOGON =  <<FOR ONE COMMAND LOGONS>>        <<03.RO>>41904000
         TOS := 0;                                             <<02.EB>>41906000
         TOS := @S0; << TARGET >>                              <<02.EB>>41908000
         TOS := JMATDST;                                       <<02.EB>>41910000
         TOS := PXGLOB(PXGWJMATX).(0:8) *JMATLEN +24;          <<02.EB>>41912000
         TOS := 1; << 24TH WORD FROM JMAT ENTRY >>             <<02.EB>>41914000
         ASSEMBLE(MFDS 4);                                     <<02.EB>>41916000
         TOS := TOS.(3:2);                                     <<U.RAO>>41918000
         PASSEDCOMMAND := TOS&LSL(1)#;                         <<U.RAO>>41920000
      LOGICAL PASSEDCOMMAND:=0;  <<STATUS WORD FOR PASSED COM><<A00.04>>41922000
      DEFINE FUNNYTERMINAL=PASSEDCOMMAND.(15:1)#,<<APL TERMINAL<A00.04>>41924000
             COMMANDPASSED=PASSEDCOMMAND.(0:1)#, <<ONE SEEN>> <<A00.04>>41926000
             COMMANDEXECED=PASSEDCOMMAND.(1:1)#, <<ONE DONE>> <<A00.04>>41928000
             APLTERMTYPE  =PASSEDCOMMAND.(13:2)#;             <<A00.04>>41930000
DOUBLE OLDSEQNUM := 0D,  <<LAST VALID SEQUENCE NUMBER>>        <<01.RO>>41932000
       NEWSEQNUM;   <<CANDIDATE SEQUENCE NUMBER>>              <<01.RO>>41934000
INTEGER                                                        <<00419>>41936000
   STDLISTLENB,                                                <<00419>>41938000
   STDLISTLENW;                                                <<00419>>41940000
POINTER                                                        <<00419>>41942000
   PRINTPOS;   << USED IN SUBR. ECHO >>                        <<00419>>41944000
LOGICAL                                                        <<00540>>41946000
   OLDCRITICAL,                                                <<04169>>41948000
   DUMMY,                                                      <<01455>>41950000
   LOCKWORD'SLASH := %6457,  <<CARRIAGE RETURN,SLASH>>         <<04212>>41952000
   HARDEOF'THEN'BRK := FALSE; <<HIT BRK AFTER :EOF:>>          <<00540>>41954000
                                                               <<00835>>41956000
<< SAVE AREA FOR UDC AND IF NESTING GLOBALS DURING BREAK >>    <<00835>>41958000
LOGICAL                                                        <<00835>>41960000
   SAVE'UDC3,                                                  <<00835>>41962000
   SAVE'UDC4,                                                  <<00835>>41964000
   SAVE'IFNESTING,                                             <<00835>>41966000
   SAVE'IFSKIP,                                                <<00835>>41968000
   SAVE'ELSESEEN;                                              <<00835>>41970000
DOUBLE                                                         <<00835>>41972000
   SAVE'CONTINUSTATESTK;                                       <<00835>>41974000
                                                               <<00835>>41976000
                                                               <<01.RO>>41978000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<01.RO>>41980000
                                                               <<01.RO>>41982000
                                                                        41984000
<<                 *********************                   >>  <<U.RAO>>41986000
<<                 *   ABORTREFUSED    *                   >>  <<U.RAO>>41988000
<<                 *********************                   >>  <<U.RAO>>41990000
                                                               <<U.RAO>>41992000
LOGICAL SUBROUTINE ABORTREFUSED (COMLEN);                               41994000
   VALUE COMLEN;                                                        41996000
   INTEGER COMLEN;    <<LENGTH OF COMMAND (IN COMIMAGE) 2 B SAVED>>     41998000
                                                                        42000000
<< CALLED WHEN PROGRAM-ABORTING COMMAND DETECTED (INCL EOF).            42002000
   IF NOT IN BREAK MODE, THEN RETURNS FALSE.                            42004000
   IF IN BREAK MODE, THEN                                               42006000
      IF USER CONFIRMS "ABORT?", THEN                                   42008000
         SAVE COMLEN (IN PENDINGCOMLEN),                                42010000
         ABORT PROGRAM, AND                                             42012000
         (PROCEDURE) EXIT TO BREAK CODE (PSEUDO INT ROUTINE).           42014000
      IF USER DECLINES "ABORT?", THEN                                   42016000
         WARNING ("NOT VALID IN BREAK") EMITTED, AND                    42018000
         TRUE RETURNED TO CALLER.    >>                                 42020000
                                                                        42022000
BEGIN                                                                   42024000
   SETXPXFIXED +PXFWBREAK;    << CHECK FOR BREAK >>                     42026000
   IF NOT (DBARRAY (XREG)) THEN                                         42028000
      ABORTREFUSED := FALSE    << NOT EVEN IN BREAK MODE >>             42030000
   ELSE                                                                 42032000
      IF SPECIAL'BREAK THEN <<IGNORE EOF'S IN SPECIAL BREAK>>  <<00594>>42034000
      BEGIN                                                    <<00594>>42036000
         CIERR(ERRNUM:=SPECIALCOM);                            <<00594>>42038000
         ABORTREFUSED:=TRUE;                                   <<00594>>42040000
         FRESETEOF;                                            <<00594>>42042000
         LPDT((PXGLOB(3).(8:8))&ASL(1)+1).(7:3):=0;            <<00594>>42044000
      END                                                      <<00594>>42046000
      ELSE                                                     <<00594>>42048000
ASK:  BEGIN    << BREAK MODE: ASK USER FOR ABORT >>                     42050000
      GENMSG(CIGENERALMSGSET,ABORTQ,,,,,,,,,,,%100000);        <<U.RAO>>42052000
      SETXPXGLOB +PXGWJOBIN;                                            42054000
      TOS := ATTACHIO (DBARRAY (XREG).(8:8), 0, 0,                      42056000
            @WMESNO, 0, -4, 5, 0, 1);                                   42058000
      ASSEMBLE (NEG, XCH);    <<FIX COUNT & CHECK COMPLETION>>          42060000
      ASSEMBLE(DUP); << duplicate attachio status >>           <<02849>>42062000
      IF TOS.(13:3) <> 1 THEN << i/o error >>                  <<02849>>42064000
         BEGIN                                                 <<02849>>42066000
         IF TOS.(9:7) <> %173 THEN << broken read OK. (DS) >>  <<02849>>42068000
            BEGIN                                              <<02849>>42070000
            FUNBREAK(TRUE);                                    <<02849>>42072000
            TERMINATE;                                         <<02849>>42074000
            END;                                               <<02849>>42076000
         END                                                   <<02849>>42078000
      ELSE                                                     <<02849>>42080000
         DEL;                                                  <<02849>>42082000
      NCHAR := TOS;                                                     42086000
      MOVE MESNO := MESNO WHILE AS;    <<UPSHIFT>>                      42088000
      IF (NCHAR = 3) AND (MESNO = "YES") THEN                           42090000
         BEGIN    <<ABORT REQUESTED>>                                   42092000
         SETXPXFIXED +PXFWBREAK;    <<SAVE COMLEN IN PCBX>>             42094000
         DBARRAY(XREG) := 0;   <<CLEAR BREAK FLAG>>            <<U.RAO>>42096000
         PENDINGCOMLEN := COMLEN;   <<FLAG FOR GETIMAGE>>      <<U.RAO>>42098000
         FUNBREAK(TRUE);                                                42100000
         ABORTPROG;                                                     42102000
         UDC4.EXITBREAK := TRUE;                               <<09.EB>>42104000
         ABORTREFUSED := TRUE;                                 <<03.EB>>42106000
         RETURN;                                               <<03.EB>>42108000
         END;                                                           42110000
      IF (NCHAR <> 2) OR (MESNO <> "NO") THEN                           42112000
         BEGIN    << RESPONSE WAS NEITHER "YES" NOR "NO" >>             42114000
         CIERR(-BRKINVLDRESP);                                 <<U.RAO>>42116000
         <<FIX UP BREAK FLAGS BEFORE TRYING AGAIN>>            <<04.RO>>42118000
         SETXPXGLOB+PXGWJOBIN;                                 <<04.RO>>42120000
         ATTACHIO(DBARRAY(XREG).(8:8),0,0,0,28,0,0,0,1);<<QUIES<<04.RO>>42122000
         SETSERVICE(TRUE);                                     <<04.RO>>42124000
         ATTACHIO(DBARRAY(XREG := XREG+1).(8:8),0,0,0,         <<04.RO>>42126000
               25,0,%320,0,1);   <<CLEAR FLUSH FLAGS>>         <<04.RO>>42128000
         GOTO ASK;    <<AND TRY AGAIN>>                                 42130000
         END;                                                           42132000
      << USER DECLINED "ABORT?" >>                                      42134000
      CIERR(-NOTINBREAK);                                      <<U.RAO>>42136000
      ABORTREFUSED := TRUE;                                             42138000
      END;                                                              42140000
   END;    <<ABORTREFUSED>>                                             42142000
                                                                        42144000
<<                 *********************                   >>  <<U.RAO>>42146000
<<                 *       ECHO        *                   >>  <<U.RAO>>42148000
<<                 *********************                   >>  <<U.RAO>>42150000
                                                               <<U.RAO>>42152000
SUBROUTINE ECHO(LEN);                                                   42154000
VALUE LEN;                                                              42156000
INTEGER LEN;                                                            42158000
<<If STDIN and STDLIST are DUPLICATIVE, don't echo line>>      <<03.RO>>42160000
BEGIN                                                                   42162000
IF NOT(DUPLF) THEN                                                      42164000
   BEGIN                                                       <<00419>>42166000
TEMP'COMLENGTH := WHOLELENGTH :=LEN; <<LENGTH OF CMD STRING>>  <<04212>>42168000
@TEMP'PNTR := @TEMP'COMIMAGE; <<BYTE PTR TO STRING START>>     <<04212>>42170000
TEMP'COMIMAGE :=" "; <<BLANK OUT TEMP BUFFER>>                 <<04212>>42172000
MOVE TEMP'COMIMAGE(1):= TEMP'COMIMAGE,(BCOMMANDBUFLEN-1);      <<04212>>42174000
MOVE TEMP'COMIMAGE:= PNTR,(LEN+1); <<PUT CMND FROM BCOMIMAGE>> <<04212>>42176000
    << COMMAND MOVED TO TEMPORARY BUFFER >>                    <<04212>>42178000
IF SEQUENCED AND LEN > 8 THEN                                  <<04212>>42180000
     BEGIN                                                     <<04212>>42182000
     LEN := LEN - 8;                                           <<04212>>42184000
     NEWSEQNUM := DBINARY(TEMP'PNTR(LEN),8);<<VALID SEQ #?>>   <<04212>>42186000
     IF = THEN BEGIN <<VALID NUMBER >>                         <<04212>>42188000
            SAVEECHOBYTE:= TEMP'PNTR(LEN);<<SAVE BYTE BEFORE SE<<04212>>42190000
            TEMP'PNTR(LEN) := %15;<< PUT IN CARRIAGE RETURN >> <<04212>>42192000
            END                                                <<04212>>42194000
     ELSE LEN := WHOLELENGTH;<<DON'T PRINTCOMMAND YET,# UNSEQ?><<04212>>42196000
     END;                                                      <<04212>>42198000
TOS := @TEMP'COMIMAGE; <<SET UP FOR SCAN FOR SLASH >>          <<04212>>42200000
                                                               <<04212>>42202000
REPEATSCAN:                                                    <<04212>>42204000
     SCAN * UNTIL LOCKWORD'SLASH,1;                            <<04212>>42206000
     IF CARRY THEN <<NO/NO MORE LOCKWORDS FOUND>>              <<04212>>42208000
         BEGIN                                                 <<04212>>42210000
         DEL;                                                  <<04212>>42212000
         IF (TEMP'COUNT:= WHOLELENGTH -LEN-8) > 0 THEN BEGIN   <<04212>>42214000
             MOVE TEMP'PNTR(LEN) := " ";                       <<04212>>42216000
          MOVE TEMP'PNTR(LEN+1):=TEMP'PNTR(LEN),(TEMP'COUNT-1);<<04212>>42218000
             END;<<BLANKS RESIDUAL AFTER LOCKWORD COMPRESSION D<<04212>>42220000
         GOTO PRINTCOMMAND;                                    <<04212>>42222000
         END                                                   <<04212>>42224000
 <<          SLASH FOUND,  LOCK/PASSWORD FOLLOWS  >>           <<04212>>42226000
     ELSE                                                      <<04212>>42228000
        BEGIN                                                  <<04212>>42230000
        @B'POINTER := TOS;                                     <<04212>>42232000
        BYTE'INDEX:= LOGICAL(@B'POINTER - @TEMP'COMIMAGE) + 1; <<04212>>42234000
        TEMP'BYTE'INDX:= BYTE'INDEX; << SAVE BYTE INDEX>>      <<04212>>42236000
        WHILE TEMP'PNTR(BYTE'INDEX) <> SPECIAL                 <<04212>>42238000
            DO BEGIN                                           <<04212>>42240000
            MOVE TEMP'PNTR(BYTE'INDEX):= " "; <<BLANK LOCKWORD><<04212>>42242000
            BYTE'INDEX:= BYTE'INDEX + 1;                       <<04212>>42244000
            END;                                               <<04212>>42246000
        IF TEMP'PNTR(BYTE'INDEX) = %15 <<GOT CARRIAGE RETURN>> <<04212>>42248000
            << END OF COMMAND STRING   >>                      <<04212>>42250000
            THEN GOTO PRINTCOMMAND                             <<04212>>42252000
        ELSE BEGIN      <<COMPACT STRING >>                    <<04212>>42254000
            LEN'STRING'LEFT := LEN-BYTE'INDEX;                 <<04212>>42256000
            MOVE TEMP'PNTR(TEMP'BYTE'INDX) :=                  <<04212>>42258000
                TEMP'PNTR(BYTE'INDEX),(LEN'STRING'LEFT);       <<04212>>42260000
            LEN := LEN- (BYTE'INDEX-TEMP'BYTE'INDX);           <<04212>>42262000
     <<           NEW STRING LENGTH COMPUTED           >>      <<04212>>42264000
            TOS := @B'POINTER +1; <<POINT AT BYTE AFTER SLASH>><<04212>>42266000
            GOTO REPEATSCAN;                                   <<04212>>42268000
        END;                                                   <<04212>>42270000
     END;                                                      <<04212>>42272000
                                                               <<04212>>42274000
PRINTCOMMAND:                                                  <<04212>>42276000
   IF WHOLELENGTH > LEN THEN                                   <<04212>>42278000
       BEGIN                                                   <<04212>>42280000
       LEN := WHOLELENGTH;                                     <<04212>>42282000
       TEMP'PNTR(WHOLELENGTH-8) := SAVEECHOBYTE; <<REPLACE BYTE<<04212>>42284000
       END;                                                    <<04212>>42286000
   @PRINTPOS := @TEMP'PNTR&LSR(1);<< PNTR=START OF TEMPBUFFER <<04212>>42288000
   IF LEN > STDLISTLENB THEN                                   <<00419>>42290000
      DO BEGIN   << BREAK LINE INTO PRINTABLE PIECES >>        <<00419>>42292000
         PRINT(PRINTPOS,STDLISTLENW,0);                        <<00419>>42294000
         IF > THEN CIERR(ERRSTDLISTEOF)                        <<00419>>42296000
         ELSE IF < THEN CIERR(ERRSTDLISTIO);                   <<00419>>42298000
         LEN := LEN-STDLISTLENB;                               <<00419>>42300000
         @PRINTPOS := @PRINTPOS+STDLISTLENW;                   <<00419>>42302000
         END                                                   <<00419>>42304000
      UNTIL LEN <= STDLISTLENB;                                <<00419>>42306000
   PRINT(PRINTPOS,-LEN,0);                                     <<00419>>42308000
   IF > THEN CIERR(ERRSTDLISTEOF)                              <<00419>>42310000
   ELSE IF < THEN CIERR(ERRSTDLISTIO);                         <<00419>>42312000
   END;                                                        <<00419>>42314000
END;<<ECHO>>                                                            42316000
                                                               <<00607>>42318000
<<               **************************                >>  <<00607>>42320000
<<               *  CLEAN'TERMINAL'STATE  *                >>  <<00607>>42322000
<<               **************************                >>  <<00607>>42324000
                                                               <<00607>>42326000
SUBROUTINE CLEAN'TERMINAL'STATE (PROMPTUSER);                  <<00607>>42328000
   VALUE PROMPTUSER;                                           <<00607>>42330000
   LOGICAL PROMPTUSER;                                         <<00607>>42332000
BEGIN                                                          <<00607>>42334000
COMMENT:                                                       <<00607>>42336000
   THIS SUBROUTINE DISALLOWS BREAK, CLEARS THE FLUSH           <<00607>>42338000
   FLAG TO ALLOW READ/WRITE TO TERMINAL, AND PRINTS            <<00607>>42340000
   ":" IF PROMPTUSER IS TRUE.;                                 <<00607>>42342000
ATTACHIO(PXGLOB(3).(8:8),0,0,0,28,0,0,0,1);                    <<00607>>42344000
<<QUIESCE I/O TO WAIT UNTIL ALL OTHER I/O IS COMPLETED>>       <<00607>>42346000
<<BEFORE BREAK IS DISALLOWED ON $STDIN                >>       <<00607>>42348000
SETSERVICE(TRUE); <<DON'T ALLOW BREAK>>                        <<00607>>42350000
IF PROMPTUSER THEN                                             <<00607>>42352000
   ATTACHIO(PXGLOB(4).(8:8),0,0,@PROMPT,25,PROMPTL,            <<00607>>42354000
            %320,0,1)  <<WRITE OUT PROMPT>>                    <<00607>>42356000
ELSE  <<NO PROMPT--BUT CLEAR FLUSH>>                           <<00607>>42358000
   ATTACHIO(PXGLOB(4).(8:8),0,0,0,25,0,%320,0,1);              <<00607>>42360000
END;<<CLEAN'TERMINAL'STATE>>                                   <<00607>>42362000
<<                 *********************                   >>  <<U.RAO>>42364000
<<                 *     GETIMAGE      *                   >>  <<U.RAO>>42366000
<<                 *********************                   >>  <<U.RAO>>42368000
                                                               <<U.RAO>>42370000
SUBROUTINE GETIMAGE;                                                    42372000
<<This subroutine is responsible for getting the next command>><<03.RO>>42374000
<<image from the user, except for UDC's and the COMMAND >>     <<03.RO>>42376000
<<intrinsic.  When it returns a completed command image will>> <<03.RO>>42378000
<<be found in the COMIMAGE buffer.  The subroutine is primarily<<03.RO>>42380000
<<a giant loop which reads and processes each record until>>   <<03.RO>>42382000
<<it decides that there are no more continuation records to>>  <<03.RO>>42384000
<<be read.>>                                                   <<03.RO>>42386000
<<The first part of the loop (before label HAVECOMMAND) is>>   <<03.RO>>42388000
<<involved with the I/O aspects of getting the record.>>       <<03.RO>>42390000
<<First, if STDIN is a terminal, it quiesces the terminal,>>   <<03.RO>>42392000
<<clears the BREAK bits, then prompts the user.>>              <<03.RO>>42394000
<<Second it manages a stack called LINELENSTACK.  This stack>> <<03.RO>>42396000
<<holds the processed lengths of each of the lines read.  >>   <<03.RO>>42398000
<<This information is used when CIERR calculates where in >>   <<03.RO>>42400000
<<world to put a caret.  This is an imperfect mechanism since>><<03.RO>>42402000
<<it requires a lot of coordination between the executors and>><<03.RO>>42404000
<<CIERR.  It should be replaced with a better one.  >>         <<03.RO>>42406000
<<Third a READ is issued against STDIN.  This read is followed><<03.RO>>42408000
<<by a lot of code to handle I/O errors and EOF's.  Not very>> <<03.RO>>42410000
<<interesting stuff.  One thing to note, however, is that>>    <<03.RO>>42412000
<<with terminals we usually try to continue.  In some cases>>  <<03.RO>>42414000
<<this will cause the CI to loop until it finally gets aborted><<03.RO>>42416000
<<from elsewhere or for some other reason.>>                   <<03.RO>>42418000
<<The second part of the command (after HAVECOMMAND) we process<<03.RO>>42420000
<<the read record into what will later be passed to the >>     <<03.RO>>42422000
<<command executor.  In particular it deletes leading and>>    <<03.RO>>42424000
<<trailing blanks, handles sequence numbers, checks for the>>  <<03.RO>>42426000
<<leading colon, checks the current length of the command>>    <<03.RO>>42428000
<<for a fit with our buffer and several other fairly obvious>> <<03.RO>>42430000
<<tasks.  Finally the subroutine returns to the outer block>>  <<03.RO>>42432000
<<of the procedure.  One other related thing to be aware of>>  <<03.RO>>42434000
<<is the fact that sometimes the first record of the command>> <<03.RO>>42436000
<<has been pre-read.  In particular this occurs if a user>>    <<03.RO>>42438000
<<program was reading data from STDIN in a job.  In this>>     <<03.RO>>42440000
<<case the CI tries to flush all remaining user data until>>   <<03.RO>>42442000
<<it finds an MPE command (leading colon) to execute.>>        <<03.RO>>42444000
<<The procedure doing the flush (CISUBSYSFINISH) then >>       <<03.RO>>42446000
<<stuffs the MPE command it stopped on into COMIMAGE and >>    <<03.RO>>42448000
<<leaves the length in PENDINGCOMLEN.  Obviously then we>>     <<03.RO>>42450000
<<must branch around the code which does the read the first>>  <<03.RO>>42452000
<<time through.  Hence HAVECOMMAND.  >>                        <<03.RO>>42454000
<<There are also some scattered flags for UDC for handling>>   <<03.RO>>42456000
<<REDO and error message generation on UDC's.>>                <<03.RO>>42458000
BEGIN                                                                   42460000
NEXTCOM:                                                                42462000
      @PNTR := @BCOMIMAGE;        <<BUFFER POINTER>>                    42464000
      COMMENT:                                                 <<00287>>42466000
         INITIALIZE "SPACE LEFT" TO NUM OF ALLOWED CHAR+1,     <<00287>>42468000
         IN ORDER TO CATCH 'COMMAND TOO LONG';                 <<00287>>42470000
      LEFT := BCOMMANDBUFLEN-1;                                <<00287>>42472000
      UDC4.IMAGEADJUST := FALSE;                               <<09.EB>>42474000
      CONTFLG := JOBFLG := FALSE;                              <<03.RO>>42476000
      SETXPXGLOB;                                                       42478000
      @JFLAGS := (@PXGLOB := X) +PXGWFLAGS;                             42480000
   << CHECK FOR ENTIRE COM (BREAK) OR PARTIAL COM (FLUSH) PENDING>>     42482000
      LENGTH := PENDINGCOMLEN;  <<LENGTH OF ALREADY READ COMMAN<<U.RAO>>42484000
      IF > THEN                                                         42486000
         BEGIN    <<SOMETHING PENDING>>                                 42488000
         PENDINGCOMLEN := 0;  <<CLEAR ALREADY READ FLAG>>      <<U.RAO>>42490000
         IF COMMANDPASSED THEN COMMANDEXECED:=TRUE; <<IMAGED>>          42492000
         LINELENSPTR := 0;  << INITIALIZE FOR (CMD) LOGONS >>  <<00240>>42494000
         <<DISABLE BREAK & CLEAR FLUSH FLAG>>                  <<00607>>42496000
         IF INTERACTF THEN CLEAN'TERMINAL'STATE(FALSE);        <<00607>>42498000
         GOTO HAVECOMMAND;                                              42500000
         END;                                                           42502000
      LINELENSPTR := -1;   <<INITIALIZE STACK POINTER>>        <<U.RAO>>42504000
      DO                                                                42506000
         BEGIN                                                          42508000
         IF INTERACTF THEN                                              42510000
           BEGIN                                                        42512000
           <<DISABLE BREAK,CLEAR FLUSH,WRITE PROMPT IF NEC.>>  <<00607>>42514000
           IF LPDT(PXGLOB(3).(8:8)&LSL(1)+1).(7:3)=0 THEN               42516000
              CLEAN'TERMINAL'STATE(TRUE) <<WRITE PROMPT>>      <<00607>>42518000
           ELSE  <<NO PROMPT>>                                 <<00607>>42520000
              CLEAN'TERMINAL'STATE(FALSE);                     <<00607>>42522000
           END;                                                         42524000
           <<PREPARE TO UPDATE LINELENGTH STACK>>              <<U.RAO>>42526000
           LINELENSPTR := LINELENSPTR+1;                       <<U.RAO>>42528000
IF LINELENSPTR > MAXNUMLINES THEN                              <<01032>>42530000
    BEGIN                                                      <<01032>>42532000
        CIERR(COMTOOMANYLINES);                                <<01032>>42534000
        GO TO NEXTCOM;                                         <<01032>>42536000
    END;                                                       <<01032>>42538000
            IF LINELENSPTR <> 0 THEN UDC4.IMAGEADJUST := TRUE; <<09.EB>>42540000
            TOS := 0;                                                   42542000
            TOS := @PNTR & ASR(1);     <<STACK < 16K>>                  42544000
            LENGTH := READ (*, -LEFT);                                  42546000
            IF <> THEN                                                  42548000
               BEGIN    << ERROR OR EOF >>                              42550000
            IF < THEN   <<IO ERROR ON STDIN>>                  <<U.RAO>>42552000
               BEGIN                                           <<U.RAO>>42554000
               CIERR(ERRSTDINIO);                              <<U.RAO>>42556000
               IF (IOERRCOUNT:=IOERRCOUNT+1) > IOERRLIMIT THEN <<03.RO>>42558000
                  BEGIN                                        <<03.RO>>42560000
                  SETSERVICE(FALSE);                           <<03.RO>>42562000
                  TERMINATE;                                   <<03.RO>>42564000
                  END;  <<TOO MANY IO ERRORS ON READ FROM STDIN<<03.RO>>42566000
               GO TO NEXTCOM;                                  <<U.RAO>>42568000
               END;                                            <<U.RAO>>42570000
               << EOF: PHYSICAL OR JOB-DELIMITING COMMAND >>            42572000
                IF HARDEOF'THEN'BRK THEN                       <<00540>>42574000
                   BEGIN                                       <<00540>>42576000
                   COMMENT:                                    <<00540>>42578000
                      HIT BREAK AFTER :EOF:. IGNORE BREAK      <<00540>>42580000
                      AND END SESSION;                         <<00540>>42582000
                   SETXPXFIXED + PXFWBREAK;                    <<00540>>42584000
                   DBARRAY(XREG) := 0;   <<CLEAR BREAK FLAG>>  <<00540>>42586000
                   PENDINGCOMLEN := 0;                         <<00540>>42588000
                   FUNBREAK(TRUE);                             <<00540>>42590000
                   ABORTPROG;                                  <<00540>>42592000
                   UDC4.EXITBREAK := TRUE;                     <<00540>>42594000
                   GO NEXT;                                    <<00540>>42596000
                   END;                                        <<00540>>42598000
               IF NOT (CONTFLG) THEN                                    42600000
                  BEGIN    <<NO PARTIAL COMMAND: "PURE EOF">>           42602000
                  IF ABORTREFUSED (0) THEN                              42604000
                     BEGIN    << ABORT REFUSED IN BREAK >>              42606000
                     IF UDC4.EXITBREAK THEN GO NEXT;           <<09.EB>>42608000
                     FRESETEOF;    <<CLEAR FSYS' EOF STUFF>>            42610000
                     LEFT := PXGLOB (3).(8:8);    <<JIN DEV>>           42612000
                     << CHECK FOR BACKSPACED COMMAND & CLEAR >>         42614000
                     IF NOT (LOGICAL (LPDT (LEFT &ASL(1)+1).(9:1))) THEN42616000
                        ATTACHIO (LEFT,0,0,0,0,0,0,0,1)                 42618000
                     ELSE                                               42620000
                        << JUST CLEAR LPDT EOF INDICATOR >>             42622000
                        LPDT (LEFT &ASL(1) +1).(7:3) := 0;              42624000
                     GOTO NEXTCOM;    <<CONTINUE SESSION>>              42626000
                     END;                                               42628000
                  <<NOT IN BREAK MODE (INCL ALL BATCH)>>                42630000
                  IF PXGLOB(PXGWFLAGS).(PXGFJOBTYPE)=2 AND LPDT(        42632000
                    PXGLOB(3).(8:8)&LSL(1)+1).(7:3)=7 THEN              42634000
                    BEGIN <<EOJ READ IN JOB MODE>>                      42636000
                    MOVE PNTR := ":EOJ";                                42638000
                    ECHO(4);                                            42640000
                    END;                                                42642000
                  SETSERVICE(FALSE);<<CLEAR BREAK BIT IN LPDT>>         42644000
                  TERMINATE;    <<EOF TERMINATES DIRECTLY>>             42646000
                  END;                                                  42648000
               LENGTH := 0;    <<EOF AS CONTINUED COMMAND DELIM>>       42650000
               END;                                                     42652000
               IOERRCOUNT := 0;  <<SINCE SUCCESSFUL READ>>     <<03.RO>>42654000
HAVECOMMAND:                                                            42656000
            PNTR(LENGTH) := %15;  <<TERMINATOR>>               <<01.RO>>42658000
            NUMBER'BLANKS := 0; << no. blanks in last line >>  <<04170>>42660000
            IF NOT (INTERACTF) AND NOT (CONTFLG) THEN          <<01.RO>>42662000
               BEGIN                                           <<01.RO>>42664000
               <<NEXT FIND CMD NAME, SINCE MIGHT BE JOB CMD.>> <<01.RO>>42666000
               <<IF SO, DON'T WANT TO ECHO>>                   <<01.RO>>42668000
               SCAN PNTR(1) WHILE %6440,1;<<SKIP BLANKS TO NAME<<01.RO>>42670000
               ASSEMBLE(DUP);                                  <<01.RO>>42672000
               MOVE BPS0 := BPS0 WHILE AS,1;                   <<01.RO>>42674000
               ASSEMBLE(SUB);  <<NEG OF COMMAND NAME LENGTH>>  <<01.RO>>42676000
               IF TOS = -3 THEN   <<LENGTH IS RIGHT FOR :JOB>> <<01.RO>>42678000
                  IF *="JOB" THEN                              <<01.RO>>42680000
                     JOBFLG := TRUE   <<DON'T ECHO>>           <<01.RO>>42682000
                  ELSE                                         <<01.RO>>42684000
               ELSE DEL;  <<POP POINTER TO COMMAND NAME>>      <<01.RO>>42686000
               END;                                            <<01.RO>>42688000
            IF NOT JOBFLG THEN   <<NOT IN MIDDLE OF JOB CMD>>  <<01.RO>>42690000
               ECHO(LENGTH);                                   <<01.RO>>42692000
            IF SEQUENCED AND LENGTH > 8 THEN                   <<01.RO>>42694000
               BEGIN  <<HANDLE SEQUENCE NUMBER>>               <<01.RO>>42696000
               LENGTH := LENGTH-8;  <<DELETE SEQUENCE NUMBER>> <<01.RO>>42698000
               NEWSEQNUM := DBINARY(PNTR(LENGTH), 8);          <<01.RO>>42700000
               IF = THEN   <<VALID NUMBER>>                    <<01.RO>>42702000
                  IF NEWSEQNUM >= OLDSEQNUM THEN  <<IN SEQUENCE<<01.RO>>42704000
                     OLDSEQNUM := NEWSEQNUM                    <<01.RO>>42706000
                  ELSE <<OUT OF SEQUENCE>>                     <<01.RO>>42708000
                     CIERR(-BADSEQUENCEORDR, PNTR(LENGTH))     <<01.RO>>42710000
               ELSE  <<NON-NUMERIC, CHECK FOR BLANKS>>         <<01.RO>>42712000
                  IF PNTR(LENGTH) <> "        " THEN           <<01.RO>>42714000
                     BEGIN                                     <<01.RO>>42716000
                     CIERR(-BADSEQUENCENUM, PNTR(LENGTH));     <<01.RO>>42718000
                     LENGTH := LENGTH+8;                       <<01.RO>>42720000
                     END;                                      <<01.RO>>42722000
               PNTR(LENGTH) := %15;  <<TRAILING CR>>           <<01.RO>>42724000
               END;                                            <<01.RO>>42726000
            IF (LENGTH > 0) AND (PNTR (LENGTH -1) = " ") THEN  <<00581>>42728000
               BEGIN    <<STRIP TRAILING BALNKS>>              <<01.RO>>42730000
               TOS := @PNTR (X);                               <<01.RO>>42732000
               ASSEMBLE (DUP, DECA);                           <<01.RO>>42734000
               TOS := -X;                                      <<01.RO>>42736000
               ASSEMBLE (CMPB 0);                              <<01.RO>>42738000
               LENGTH := -TOS;                                 <<01.RO>>42740000
               DDEL;                                           <<01.RO>>42742000
               PNTR(LENGTH) := %15;  <<TRAILING CR>>           <<00581>>42744000
               END;                                            <<01.RO>>42746000
         IF NOT INTERACTF THEN   <<IS JOB>>                    <<01.RO>>42748000
            BEGIN  <<USER MUST PROVIDE LEADING COLON>>         <<01.RO>>42750000
            IF PNTR <> ":" THEN                                <<01.RO>>42752000
                       <<COLON MISSING, MIGHT BE DATA, NOT CMD><<01.RO>>42754000
               IF IFSKIP THEN  <<NOT PARSING ANYHOW>>          <<07.RO>>42756000
                  GO TO NEXTCOM   <<IGNORE>>                   <<07.RO>>42758000
               ELSE  <<FATAL ERROR>>                           <<07.RO>>42760000
                  BEGIN                                        <<00255>>42762000
                  CIERR(NOCOLON, BCOMIMAGE);                   <<07.RO>>42764000
                  GO TO NEXTCOM; <<IN CASE OF PREV :CONTINUE>> <<00255>>42766000
                  END;                                         <<00255>>42768000
            IF LENGTH=1 AND NOT CONTFLG THEN <<NULL COMMAND>>  <<U.RAO>>42770000
               GO TO NEXTCOM;  <<TRY AGAIN>>                   <<U.RAO>>42772000
            PNTR := " ";  <<WIPE OUT COLON>>                   <<U.RAO>>42774000
            NUMBER'BLANKS := -1;                               <<04170>>42776000
            END                                                <<U.RAO>>42778000
         ELSE  <<IN SESSION JUST CHECK FOR BLANK COMMAND>>     <<U.RAO>>42780000
            IF (LENGTH=0) AND NOT CONTFLG THEN                 <<U.RAO>>42782000
               GO TO NEXTCOM;  <<ZERO LENGTH READ>>            <<U.RAO>>42784000
         <<NOW DELETE ANY LEADING BLANKS>>                     <<U.RAO>>42786000
         IF PNTR=" " THEN                                      <<U.RAO>>42788000
            BEGIN   <<AT LEAST ONE THERE>>                     <<U.RAO>>42790000
            TOS := @PNTR;                                      <<U.RAO>>42792000
            SCAN PNTR WHILE %6440,1;  <<SCAN UNTIL NOT BLANK>> <<U.RAO>>42794000
            ASSEMBLE(DDUP, SUB);  <<NEG # OF BLANKS TO DELETE>><<U.RAO>>42796000
            NUMBER'BLANKS := -S0 + NUMBER'BLANKS;              <<04170>>42798000
            LENGTH := TOS+LENGTH;  <<ACTUAL LENGTH OF COMMAND>><<U.RAO>>42800000
            MOVE * := *, (LENGTH);                             <<U.RAO>>42802000
            PNTR(LENGTH) := %15;  <<MARK END OF COMMAND>>      <<U.RAO>>42804000
            UDC4.IMAGEADJUST := TRUE;                          <<09.EB>>42806000
            END;                                               <<U.RAO>>42808000
         IF LENGTH=LEFT THEN   <<COMMAND TOO LONG FOR BUFFER>> <<U.RAO>>42810000
            BEGIN                                              <<U.RAO>>42812000
            CIERR(COMMAND'GT'BUFFER,                           <<U.RAO>>42814000
                  BCOMIMAGE(BCOMMANDBUFLEN-LEFT));             <<U.RAO>>42816000
            GO TO NEXTCOM;                                     <<U.RAO>>42818000
            END;                                               <<U.RAO>>42820000
         << IGNORE LINE IF: 1) NOT A CONTINUATION LINE AND >>  <<01309>>42822000
         <<                 2) ONLY CHARACTER IS A "&".    >>  <<01309>>42824000
         IF (NOT CONTFLG) AND                                  <<01309>>42826000
            (LENGTH=1) AND (PNTR="&") THEN                     <<01309>>42828000
            GO TO NEXTCOM;                                     <<01309>>42830000
         IF NOT CONTFLG THEN                                   <<U.RAO>>42832000
            BEGIN   <<IDENTIFY COMMAND>>                       <<U.RAO>>42834000
            IF PNTR = ALPHA                                    <<00184>>42836000
              THEN MOVE PNTR := PNTR WHILE AS,0                <<00184>>42838000
              ELSE MOVE PNTR := PNTR WHILE ANS,0;              <<00184>>42840000
            @PARMSP := TOS;                                    <<U.RAO>>42842000
            COMLEN := TOS-@PNTR;                               <<U.RAO>>42844000
            END;                                               <<U.RAO>>42846000
         @PNTR := @PNTR+LENGTH;                                <<U.RAO>>42848000
         IF PNTR(-1)="&" THEN   <<WILL EXPECT CONTINUATION>>   <<U.RAO>>42850000
            BEGIN                                              <<U.RAO>>42852000
            CONTFLG := TRUE;                                   <<U.RAO>>42854000
            PNTR(-1) := " ";  <<WIPE OUT "&">>                 <<U.RAO>>42856000
            END                                                <<U.RAO>>42858000
         ELSE  <<NO CONTINUATION EXPECTED>>                    <<U.RAO>>42860000
            CONTFLG := FALSE;                                  <<U.RAO>>42862000
         IF LOGICAL(@PNTR) THEN  <<ON ODD BYTE BOUNDARY>>      <<U.RAO>>42864000
            BEGIN  <<ADJUST TO WORD BOUNDARY>>                 <<U.RAO>>42866000
            PNTR := " ";                                       <<U.RAO>>42868000
            @PNTR := @PNTR+1;                                  <<U.RAO>>42870000
            LENGTH := LENGTH+1;                                <<U.RAO>>42872000
            END;                                               <<U.RAO>>42874000
         LINELENSTACK(LINELENSPTR) := LENGTH;                  <<U.RAO>>42876000
         LEFT := LEFT-LENGTH;                                  <<U.RAO>>42878000
         END                                                   <<U.RAO>>42880000
      UNTIL NOT CONTFLG;  <<UNTIL NO MORE CONTINUATIONS>>      <<U.RAO>>42882000
   PNTR := %15;  <<MARK END WITH CR>>                          <<U.RAO>>42884000
   LINELENSTACK(LINELENSPTR) := 0;  <<STACK TERMINATOR>>       <<U.RAO>>42886000
END   <<GETIMAGE>>;                                                     42888000
<<                 *********************                   >>  <<U.RAO>>42890000
<<                 *   PERMITACCESS    *                   >>  <<U.RAO>>42892000
<<                 *********************                   >>  <<U.RAO>>42894000
                                                               <<U.RAO>>42896000
LOGICAL SUBROUTINE PERMITACCESS;                               <<U.RAO>>42898000
BEGIN                                                          <<U.RAO>>42900000
<<THIS SUBROUTINE PROCESSES THE ACCESS MASK PASSED BACK>>      <<U.RAO>>42902000
<<BY COMSEARCH.  TO SEE THE EXPLICIT ASSIGNMENT OF BITS>>      <<U.RAO>>42904000
<<TO RESTRICTIONS AND CAPABILITIES, SEE THE COMMENT TO>>       <<U.RAO>>42906000
<<THAT PROCEDURE.  THIS SUBROUTINE DOES NOTHING OF GREAT>>     <<U.RAO>>42908000
<<DIFFICULTY.  NOTE THAT IT IS ASSUMED THAT THE CALLER>>       <<U.RAO>>42910000
<<WILL COPE WITH ANY DIFFICULTIES ASSOCIATED WITH HANDLING>>   <<U.RAO>>42912000
<<PROGRAMMATIC CALLS, SUCH AS RETURNING ERROR CODES.>>         <<U.RAO>>42914000
IF NOT PROGCALL AND IFSKIP AND NOT AEXECEVENINIF THEN          <<U.RAO>>42916000
   RETURN;  <<FLUSH, IN NON-EXECUTING BLOCK OF IF COMMAND>>    <<U.RAO>>42918000
IF ACANBREAK THEN <<SET FLAG, SO OUTER BLOCK CAN INITIALIZE>>  <<U.RAO>>42920000
   NONABORTABLE := FALSE  <<ITSELF TO HOLD OFF BREAK>>         <<U.RAO>>42922000
ELSE  <<CAN'T BE BROKEN>>                                      <<U.RAO>>42924000
   NONABORTABLE := TRUE;  <<SORRY FOR THE DOUBLE NEGATIVES>>   <<U.RAO>>42926000
<< THE CHECK FOR NOT REDOABLE HAS BEEN REMOVED FROM >>         <<01455>>42928000
<< PERMITACCESS AND MOVED TO XEQIT.                 >>         <<01455>>42930000
IF ANOTINBREAK THEN  <<CHECK TO SEE IF USER IN BREAK>>         <<U.RAO>>42932000
   BEGIN                                                       <<U.RAO>>42934000
   TOS := 0;  <<RETURN SPACE FOR ABORTREFUSED>>                <<U.RAO>>42936000
   SCAN BCOMIMAGE UNTIL %6415,1;  <<GET LENGTH OF WHOLE COMMAND<<U.RAO>>42938000
   TOS := TOS-@BCOMIMAGE;  <<COMMAND LENGTH>>                  <<U.RAO>>42940000
   IF ABORTREFUSED(*) THEN                                     <<U.RAO>>42942000
      BEGIN                                                    <<02366>>42944000
      IF UDC4.NESTLEVEL <> 0 THEN                              <<02366>>42946000
         UDC4.UDCFATALCIERR := TRUE;                           <<02366>>42948000
      RETURN;  <<ABORT REFUSED IN BREAK MODE>>                 <<U.RAO>>42950000
      END;                                                     <<02366>>42952000
   END;                                                        <<U.RAO>>42954000
IF PROGCALL AND ANOTINPROG THEN                                <<U.RAO>>42956000
   BEGIN  <<CAN'T BE USED PROGRAMMATICALLY>>                   <<U.RAO>>42958000
   ERRNUM := ERRNOTPROGRAMAT;                                  <<U.RAO>>42960000
   RETURN                                                      <<U.RAO>>42962000
   END;                                                        <<U.RAO>>42964000
IF UDCEXECED AND ANOTINUDC THEN                                <<01455>>42966000
   BEGIN  << NOT ALLOWED IN UDC >>                             <<01455>>42968000
   CIERR(ERRNUM := NOTINUDC, BCOMIMAGE);                       <<01455>>42970000
   RETURN                                                      <<01455>>42972000
   END;                                                        <<01455>>42974000
IF ANOTINJOB AND PXGLOB(PXGWFLAGS).(PXGFJOBTYPE) = JOBFLAG THEN<<U.RAO>>42976000
   BEGIN  <<NOT ALLOWED IN JOB>>                               <<U.RAO>>42978000
   CIERR(ERRNUM := NOTINJOB, BCOMIMAGE);                       <<U.RAO>>42980000
   RETURN                                                      <<U.RAO>>42982000
   END;                                                        <<U.RAO>>42984000
IF ANOTINSESSION AND PXGLOB(PXGWFLAGS).(PXGFJOBTYPE) =         <<U.RAO>>42986000
      SESSIONFLAG THEN                                         <<U.RAO>>42988000
   BEGIN  <<NOT ALLOWED IN SESSION>>                           <<U.RAO>>42990000
   CIERR(ERRNUM := NOTINSESSION, BCOMIMAGE);                   <<U.RAO>>42992000
   RETURN                                                      <<U.RAO>>42994000
   END;                                                        <<U.RAO>>42996000
IF FUNNYTERMINAL AND ACAN'TWITHAPL THEN                        <<U.RAO>>42998000
   BEGIN                                                       <<U.RAO>>43000000
   CIERR(ERRNUM := APLTERM, BCOMIMAGE(1));                     <<U.RAO>>43002000
   RETURN                                                      <<U.RAO>>43004000
   END;                                                        <<U.RAO>>43006000
IF CAPCHECK THEN                                               <<U.RAO>>43008000
   BEGIN                                                       <<U.RAO>>43010000
   <<STRATEGY IS TO LOAD USER'S CAP LIST, USE REQUESTED>>      <<U.RAO>>43012000
   <<COMPARISON, SEND USER'S ERROR MESSAGE AS SUPPLIED IN>>    <<U.RAO>>43014000
   <<COMSEARCH.>>                                              <<U.RAO>>43016000
   TOS := CAP0 LAND PXGLOB(PXGWATTRIBUTE);                     <<U.RAO>>43018000
   SETXPXFIXED;                                                <<U.RAO>>43020000
   TOS := CAP1 LAND DBARRAY(X+PXFWRESOURCE);                   <<U.RAO>>43022000
   IF ORCAPCHECK AND TOS=0D OR ANDCAPCHECK AND TOS<>CAP THEN  <<U.RAO>> 43024000
      BEGIN                                                    <<U.RAO>>43026000
      CIERR(ERRNUM := CAPCHECKERR, BCOMIMAGE);                 <<U.RAO>>43028000
      RETURN                                                   <<U.RAO>>43030000
      END;                                                     <<U.RAO>>43032000
   END;                                                        <<U.RAO>>43034000
IF OPCOMMAND AND NOT MASTEROP THEN                             <<00552>>43036000
BEGIN                                                          <<00552>>43038000
   TOS:=@ALLOWMASK;                                            <<00552>>43040000
   SETJIT;           <<GET USER'S JIT'S DST #>>                <<00552>>43042000
   MOVEFROMDSEG(*,*,JITALLOW,JITALLOW'L);<<GET ALLOW MASK>>    <<00552>>43044000
   IF (ALLOWMASK(OPCOMMANDWRD)&LSL(OPCOMMANDINX))>=0 THEN      <<00552>>43046000
   BEGIN                                                       <<00552>>43048000
      CIERR(ERRNUM:=OPCOMNOTALLOW,BCOMIMAGE);                  <<00552>>43050000
      RETURN;                                                  <<00552>>43052000
   END;                                                        <<00552>>43054000
END;                                                           <<00552>>43056000
   IF SPECIAL'BREAK AND NOT SPECIALBREAK'COM THEN              <<00594>>43058000
   BEGIN                                                       <<00594>>43060000
      CIERR(ERRNUM:=SPECIALCOM,BCOMIMAGE);                     <<00594>>43062000
      RETURN;                                                  <<00594>>43064000
   END; <<COMMAND NOT ALLOWED DURING SPECIAL BREAK>>           <<00594>>43066000
PERMITACCESS := TRUE;                                          <<U.RAO>>43068000
END;  <<SUBROUTINE PERMITACCESS>>                              <<U.RAO>>43070000
                                                                        43072000
<<                 *********************                   >>  <<U.RAO>>43074000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>43076000
<<                 *********************                   >>  <<U.RAO>>43078000
                                                               <<U.RAO>>43080000
                                                               <<03.RO>>43082000
<<The main body of the procedure is really split up into>>     <<03.RO>>43084000
<<two pieces, a part which fires up the job/session and>>      <<03.RO>>43086000
<<a part which iterates, getting commands and sending>>        <<03.RO>>43088000
<<them to the appropriate executor.   Most of the first>>      <<03.RO>>43090000
<<part is done by procedure INITJSMP in NURSERY.>>             <<03.RO>>43092000
<<As a sidelight, it should be noted that this is where the>>  <<03.RO>>43094000
<<WELCOME message is sent to the user.>>                       <<03.RO>>43096000
<<The bulk of the work is done by the second part of the main>><<03.RO>>43098000
<<body.  There are five major sections.  The first four are>>  <<03.RO>>43100000
<<all involved with making sure we get the command image from>><<03.RO>>43102000
<<the right place.  The last one is concerned with trying to>> <<03.RO>>43104000
<<execute the command that was found.  Therefore we will deal>><<03.RO>>43106000
<<with the last section, XEQIT, first.  This block must do >>  <<03.RO>>43108000
<<three things.  First, it calls procedure COMSEARCH to>>      <<03.RO>>43110000
<<decide if this is a valid MPE command.  It is decided>>      <<03.RO>>43112000
<<elsewhere if this is a UDC, so we don't worry about it here.><<03.RO>>43114000
<<Assuming it to be a valid command, we call the executor,>>   <<03.RO>>43116000
<<the plabel of which was returned by COMSEARCH.  >>           <<03.RO>>43118000
<<Finally we must decide where to go next.  If we entered>>    <<03.RO>>43120000
<<from the COMMAND intrinsic we return to the user.  If we>>   <<03.RO>>43122000
<<entered from UDC then we return there.  Otherwise we must>>  <<03.RO>>43124000
<<go back to the user for another command.  The entry >>       <<03.RO>>43126000
<<UDCCI is called from UDC to process the putative MPE>>       <<03.RO>>43128000
<<command found in the UDC being processed.  The primary>>     <<03.RO>>43130000
<<item of interest here is that it provides for the >>         <<03.RO>>43132000
<<possibility that the command being processed is actually>>   <<03.RO>>43134000
<<another UDC (nested).  The entry COMMAND' is the entry>>     <<03.RO>>43136000
<<from the COMMAND intrinsic.  It's primary function is >>     <<03.RO>>43138000
<<to set some flags indicating that we were actually called>>  <<03.RO>>43140000
<<programmatically.  The entry SYSBREAK is called whenever>>   <<03.RO>>43142000
<<the system decides that BREAK has been hit (either the key>> <<03.RO>>43144000
<<or the intrinsic CAUSEBREAK).  Note that it runs on the>>    <<03.RO>>43146000
<<CI stack, not the users stack.  COMMAND' runs on the >>      <<03.RO>>43148000
<<user's stack.  Label NEXT is branched to as the "normal" >>  <<03.RO>>43150000
<<place whenever we are doing the normal CI thing.>>           <<03.RO>>43152000
<<It has three claims to fame.  First it is the code>>         <<03.RO>>43154000
<<which handles the decay of a :CONTINUE.  >>                  <<03.RO>>43156000
<<Second it is the origination of the call to UDC.>>           <<03.RO>>43158000
<<Third it is the only place where GETIMAGE is called.>>       <<03.RO>>43160000
                                                               <<03.RO>>43162000
PUSH(STATUS);                                                  <<02.EB>>43164000
TOS.(2:1) := 0; << TURN OFF TRAPS >>                           <<02.EB>>43166000
SET(STATUS);                                                   <<02.EB>>43168000
UDCSPACE:=0; MOVE UDCSPACE(1):=UDCSPACE,(4);                   <<WH.26>>43170000
INITJSMP(EXPCODE);                                             <<02.EB>>43172000
IFNESTING := IFSKIP := ELSESEEN := 0;  <<FOR IF COMMAND>>      <<U.RAO>>43174000
CIFLAGS := PENDINGCOMLEN := 0;                                 <<U.RAO>>43176000
CONTINUSTATESTK := 0D;                                         <<08.RO>>43178000
LINELENSTACK := 0;                                             <<01517>>43180000
MOVE LINELENSTACK(1) := LINELENSTACK,(MAXNUMLINES);            <<01517>>43182000
NUMBER'BLANKS := 0;                                            <<04170>>43184000
SPECIAL'BREAK:=FALSE;                                          <<00594>>43186000
IOERRCOUNT := 0;  <<INITIALIZE IO ERROR COUNTER>>              <<03.RO>>43188000
@BCOMIMAGE := @WCOMIMAGE&LSL(1);<<INIT POINTER>>               <<03.EB>>43190000
@BLASTCOMIMAGE := @LASTCOMIMAGE&LSL(1);  <<INIT POINTER>>      <<U.RAO>>43192000
BCOMIMAGE := BLASTCOMIMAGE := %15;  <<FOR INITIAL REDO>>                43194000
                                                               <<06.EB>>43196000
   << PREVENT BREAK IN EVENT OF (RUN)USER.ACCT OR A >>         <<08.EB>>43198000
   << OPTION LOGON UDC THAT RUNS A PROGRAM          >>         <<08.EB>>43200000
SETXPXGLOB;                                                    <<08.EB>>43202000
@PXGLOB := X;                                                  <<08.EB>>43204000
@JFLAGS := X +PXGWFLAGS;                                       <<08.EB>>43206000
                                                               <<00850>>43208000
   << HANDLE (CMD)USER.ACCT LOGON & APL CHAR SET >>            <<00850>>43210000
INSTANTLOGON;                                                  <<00850>>43212000
IF APLTERMTYPE <> 0 THEN                                       <<00850>>43214000
BEGIN                                                          <<00850>>43216000
   COMMANDPASSED := TRUE;                                      <<00850>>43218000
   IF APLTERMTYPE <> 1 THEN  <<NON-ASCII CHARACTERS>>          <<00850>>43220000
      FUNNYTERMINAL := TRUE                                    <<00850>>43222000
   ELSE   <<ASCII TERMINAL, JUST A SPECIAL LOGON>>             <<00850>>43224000
      APLTERMTYPE := 0;  <<CLEAR.  HENCEFORTH THIS>>           <<00850>>43226000
   <<FIELD JUST INDICATES WHICH APL TERMINAL IS IN USE>>       <<00850>>43228000
END;                                                           <<00850>>43230000
   << RESOLVE WELCOME MESSAGE >>                               <<00850>>43232000
X := ABSOLUTE(WELCOMEDST);                                     <<00850>>43234000
IF > THEN WELCOMEMES(X,PASSEDCOMMAND);                         <<00850>>43236000
                                                               <<00850>>43238000
                                                               <<02848>>43240000
IF GET'DSDEVICE( PXGLOB(3).(8:8) ) = 3 THEN                    <<02848>>43242000
                                                               <<02848>>43244000
      << Job/session $STDIN device is a DS pseudo terminal,  >><<02848>>43246000
      << so this is a slave session.  Perform the appropriate>><<02848>>43248000
      << DS initialization by calling the CXRFA procedure    >><<02848>>43250000
      << (in the DSSEG4 segment) with a fake "RFA" command.  >><<02848>>43252000
                                                               <<02848>>43254000
   BEGIN                                                       <<02848>>43256000
   WCOMIMAGE(0) := "RF";                                       <<02848>>43258000
   WCOMIMAGE(1) := "A ";                                       <<02848>>43260000
   WCOMIMAGE(2) := %27;                                        <<02848>>43262000
   CXRFAD(BCOMIMAGE(3) <<after RFA parsed>>, ERRNUM, PARMNUM); <<02848>>43264000
   END;                                                        <<02848>>43266000
IF INTERACTF THEN << JFLAGS INDICATES SESSION >>               <<08.EB>>43268000
BEGIN                                                          <<08.EB>>43270000
   ATTACHIO(PXGLOB(3).(8:8),0,0,0,28,0,0,0,1);                 <<08.EB>>43272000
     <<QUIESCE I/O BEFORE BREAK DISALLOWED>>                   <<08.EB>>43274000
   SETSERVICE(TRUE);  <<DISABLE CI BREAK>>                     <<08.EB>>43276000
   ATTACHIO(PXGLOB(4).(8:8),0,0,0,25,0,%320,0,1);              <<08.EB>>43278000
     <<CLEAR BREAK FLAGS IN LDT IF SET>>                       <<08.EB>>43280000
END;                                                           <<08.EB>>43282000
TOS:=ABSOLUTE(SYSUDCFLAG);  <<GET SYSTEM LEVEL UDC FLAG>>      <<00416>>43284000
SETXPXFIXED;                                                   <<06.EB>>43286000
X:=X+PXFUDC;                                                   <<00416>>43288000
TOS:=TOS LOR DBARRAY(X).(0:1) LOR DBARRAY(X).(7:1);            <<00416>>43290000
IF TOS THEN INITUDC(FALSE); <<INIT UDC'S IF THEY EXIST>>       <<00416>>43292000
                                                               <<00416>>43294000
   << PXGLOB MUST BE SET AFTER INITUDC. PXFILE EXPANSION >>    <<06.EB>>43296000
SETXPXGLOB;                                                    <<02.EB>>43298000
@PXGLOB := X;                                                  <<02.EB>>43300000
@JFLAGS := X + PXGWFLAGS;                                      <<03.EB>>43302000
                                                               <<11.EB>>43304000
   << TURN BREAK OFF AGAIN IN CASE BREAK OCCURRED          >>  <<11.EB>>43306000
   << DURING LOGON UDC.                                    >>  <<11.EB>>43308000
IF UDC0 <> 0 AND INTERACTF THEN                                <<11.EB>>43310000
BEGIN                                                          <<11.EB>>43312000
   ATTACHIO(PXGLOB(3).(8:8),0,0,0,28,0,0,0,1);                 <<11.EB>>43314000
     <<QUIESCE I/O BEFORE BREAK DISALLOWED>>                   <<11.EB>>43316000
   ATTACHIO(PXGLOB(4).(8:8),0,0,0,25,0,%320,0,1);              <<11.EB>>43318000
     <<CLEAR BREAK FLAGS IN LDT IF SET>>                       <<11.EB>>43320000
END;                                                           <<11.EB>>43322000
                                                               <<02.EB>>43324000
<<NEXT SET A FLAG WHICH INDICATES IF SEQUENCED RECORDS ARE>>   <<01.RO>>43326000
<<EXPECTED.  THIS COMES FROM THE JMAT, SET BY SPOOLING, AND>>  <<01.RO>>43328000
<<CAUSES THE LAST 8 BYTES TO BE STRIPPED FROM EACH JOB RECORD>><<01.RO>>43330000
<<BEFORE INTERPRETATION.  THIS IS ONLY VALID FOR JOBS.>>       <<01.RO>>43332000
IF NOT INTERACTF THEN                                          <<01.RO>>43334000
   BEGIN                                                       <<01.RO>>43336000
   TOS := 0;  <<RETURN SPACE FOR MOVE FROM JMAT>>              <<01.RO>>43338000
   MOVEFROMDSEG(@S0, JMATDST,                                  <<01.RO>>43340000
      PXGLOB(PXGWJMATX).(0:8)*JMATLEN+JMATSEQUENCE,  1);       <<01.RO>>43342000
   TOS := TOS.(2:1);  <<EXTRACT FLAG FROM JMAT WORD>>          <<01.RO>>43344000
   SEQUENCED := TOS;  <<STORE FLAG IN CIFLAGS>>                <<01.RO>>43346000
   END;                                                        <<01.RO>>43348000
                                                               <<01.RO>>43350000
      @BCOMIMAGE := @WCOMIMAGE&LSL(1);  <<INIT POINTER>>       <<U.RAO>>43352000
      IF COMMANDPASSED THEN  <<FAKE OUT CI GETIMAGE ROUTINE>> <<A00.04>>43354000
         BEGIN <<SEE PROCEDURE CIFINISH IN SUBSYSTEM SECTION>><<A00.04>>43356000
         IF NOT CILOGTABLE(1,PXGLOB(3).(0:8)*JMATLEN,LENGTH,   <<02.EB>>43358000
            WCOMIMAGE) THEN SUDDENDEATH(509);                  <<02.EB>>43360000
         PENDINGCOMLEN := LENGTH.(2:14);  <<PASSED COMMAND>>   <<U.RAO>>43362000
         IF = THEN TERMINATE;  <<NO COMMAND PASSED>>          <<A00.04>>43364000
         END;                                                 <<A00.04>>43366000
<< GET RECORD SIZE OF STDLIST FOR USE IN SUBR. ECHO >>         <<00419>>43368000
FGETINFO(2,,,,STDLISTLENB);                                    <<00419>>43370000
STDLISTLENB := -STDLISTLENB;  << CONVERT LEN FROM - TO + >>    <<00419>>43372000
<< CONVERT LENGTH TO EVEN NUMBER <= ACTUAL LENGTH >>           <<00419>>43374000
STDLISTLENB.(15:1) := 0;                                       <<00419>>43376000
STDLISTLENW := STDLISTLENB/2;                                  <<00419>>43378000
      GO TO NEXT;                                                       43380000
                                                                        43382000
                                                                        43384000
<<             **********************               >>         <<U.RAO>>43386000
<<             *   ENTRY UDCCI      *               >>         <<U.RAO>>43388000
<<             **********************               >>         <<U.RAO>>43390000
                                                               <<U.RAO>>43392000
UDCCI:                                                         <<03.EB>>43394000
   IF ABSOLUTE(ABSOLUTE(CPCB)).(15:1)=1 THEN <<SPEC BRK>>      <<01549>>43396000
   BEGIN                                                       <<00831>>43398000
      SPECIAL'BREAK:=TRUE;                                     <<00831>>43400000
      SETSERVICE(0);  <<CLEAR BREAK IN LPDT, NOT REAL BREAK>>  <<00831>>43402000
   END                                                         <<00831>>43404000
   ELSE SPECIAL'BREAK:=FALSE;                                  <<00831>>43406000
      UDC4.UDCFATALCIERR := FALSE; << STOP FLUSHING UDC >>     <<06.EB>>43408000
      UDC4.BREAKDETECTED := FALSE;                             <<00835>>43410000
      UDC2.FLUSHUDC := FALSE;                                  <<00884>>43412000
      TOS := 0; << FOR ZSIZE RETURN >>                         <<03.EB>>43414000
      PUSH(S);                                                 <<03.EB>>43416000
      TOS := S0 -(INTEGER(UDC1));<<TOTAL STACK FOR UDC'S>>     <<03.EB>>43418000
      IF > THEN                                                <<03.EB>>43420000
      BEGIN << NEED MORE >>                                    <<03.EB>>43422000
         TOS := TOS + TOS; << NEEDS FOR ANOTHER CALL >>        <<03.EB>>43424000
         TOS := ZSIZE(*);                                      <<03.EB>>43426000
         IF > THEN                                             <<03.EB>>43428000
         BEGIN                                                 <<03.EB>>43430000
            CIERR(UDCSTACKOVRFLOW);                            <<08.RO>>43432000
            RETURN;                                            <<03.EB>>43434000
         END;                                                  <<03.EB>>43436000
         PUSH(S); UDC1 := TOS; <<SAVE CURRENT S AGAIN>>        <<03.EB>>43438000
         DEL;<<TRICK:USED TO MAKE S SAME AS WHEN S PUSHED>>    <<03.EB>>43440000
      END                                                      <<03.EB>>43442000
      ELSE ASSEMBLE(DDEL); << POP 0 & SIZE >>                  <<03.EB>>43444000
      IF CONTINUESTATE >= 1 THEN   <<CONTINUE IN EFFECT>>      <<08.RO>>43446000
         IF = THEN  <<JUST SAW IT>>                            <<08.RO>>43448000
            CONTINUESTATE := 2                                 <<08.RO>>43450000
         ELSE  <<JUST EXECUTED NON-:CONTINUE, >>               <<08.RO>>43452000
            CONTINUESTATE := 0;  <<CLEAR THE CONDITION>>       <<08.RO>>43454000
      << IF RFA CALLED FROM WITHIN UDC BODY BYPASS IT >>       <<01100>>43456000
      IF BCOMIMAGE <> "RFA" THEN                               <<01100>>43458000
         IF UDC(BCOMIMAGE,EXPCODE) THEN                        <<01100>>43460000
            RETURN; << UDC NEST ? >>                           <<01100>>43462000
      UDCEXECED := TRUE;                                       <<03.EB>>43464000
      SETXPXGLOB;                                              <<03.EB>>43466000
      @PXGLOB := X;                                            <<03.EB>>43468000
      @JFLAGS := X +PXGWFLAGS;                                 <<03.EB>>43470000
      IF INTERACTF THEN << JFLAGS INDICATES SESSION >>         <<00451>>43472000
      BEGIN                                                    <<00451>>43474000
         ATTACHIO(PXGLOB(3).(8:8),0,0,0,28,0,0,0,1);           <<00451>>43476000
           <<QUIESCE I/O BEFORE BREAK DISALLOWED>>             <<00451>>43478000
         SETSERVICE(TRUE);  <<DISABLE CI BREAK>>               <<00451>>43480000
         ATTACHIO(PXGLOB(4).(8:8),0,0,0,25,0,%320,0,1);        <<00451>>43482000
           <<CLEAR BREAK FLUSH FLAG IN DIT IF SET>>            <<00451>>43484000
      END;                                                     <<00451>>43486000
      TOS := 0; <<RETURN SPACE FOR COMSEARCH>>                 <<U.RAO>>43488000
      TOS := @BCOMIMAGE;                                       <<03.EB>>43490000
      ASSEMBLE(DUP,DDUP);                                      <<03.EB>>43492000
      IF BPS0 = ALPHA                                          <<00184>>43494000
        THEN MOVE * := * WHILE AS,0                            <<00184>>43496000
        ELSE MOVE * := * WHILE ANS,0;                          <<00184>>43498000
      @PARMSP := TOS; << PARM PTR >>                           <<03.EB>>43500000
      ASSEMBLE(XCH,SUB); << LENGTH >>                          <<03.EB>>43502000
      GO XEQIT;                                                <<03.EB>>43504000
                                                               <<03.EB>>43506000
                                                               <<03.EB>>43508000
<<             **********************               >>         <<U.RAO>>43510000
<<             *   ENTRY COMMAND'   *               >>         <<U.RAO>>43512000
<<             **********************               >>         <<U.RAO>>43514000
                                                               <<U.RAO>>43516000
COMMAND':                                                               43518000
      SPECIAL'BREAK:=FALSE;                                    <<00594>>43520000
      PROGCALL := TRUE;                                                 43522000
      SETXPXGLOB;                                                       43524000
      @PXGLOB := X;                                                     43526000
      X := X + PXGWFLAGS;                                               43528000
      @JFLAGS := X;                                                     43530000
    << CHECK FOR CR AT END OF COMMAND IMAGE >>                 <<00257>>43532000
      TOS := @COMARRAY;      << SAVE VALUE >>                  <<00257>>43534000
      ASSEMBLE(DUP);                                           <<00257>>43536000
      << NOTE: COMARRAY IS LOCATED AT Q-10 AND IS THE >>       <<00257>>43538000
      << FIRST PARAMETER STACKED FROM THE 'COMMAND' CALL >>    <<00257>>43540000
      @COMARRAY := CR'CR;  << STOPPER IN CASE OF MISSING CR >> <<00257>>43542000
      SCAN * UNTIL CR'CR,1; << GET BYTE ADDR OF CR >>          <<00257>>43544000
      << CHECK IF SCAN STOP ADDR = STOPPER ADDR >>             <<00257>>43546000
      IF TOS = @LCOMARRAY&LSL(1) THEN                          <<00257>>43548000
         BEGIN                                                 <<00257>>43550000
         ERRPARM := ERRMISSINGCR;                              <<00257>>43552000
         CCC := CCG;                                           <<00257>>43554000
         RETURN 0;                                             <<00257>>43556000
         END;                                                  <<00257>>43558000
      @COMARRAY := TOS;      << RESTORE VALUE >>               <<00257>>43560000
      TOS := 0;  <<RETURN SPACE FOR COMSEARCH>>                <<U.RAO>>43562000
      TOS := @COMARRAY;                                                 43564000
      ASSEMBLE(DUP,DDUP);                                               43566000
      MOVE * := * WHILE AS, 0;                                          43568000
      @PARMSP := TOS;                                                   43570000
      ASSEMBLE(XCH,SUB);                                                43572000
      GO TO XEQIT;                                                      43574000
                                                                        43576000
                                                                        43578000
<<             **********************               >>         <<U.RAO>>43580000
<<             *   ENTRY SYSBREAK   *               >>         <<U.RAO>>43582000
<<             **********************               >>         <<U.RAO>>43584000
                                                               <<U.RAO>>43586000
SYSBREAK:                                                               43588000
   COMMENT:  IF A SON PROCESS HAS ENABLED BREAK IN  A          <<00851>>43590000
      NOBREAK UDC, IGNORE BREAK AND RETURN--TEMPORARY KLUDGE   <<01279>>43592000
      DOES NOT HANDLE DS--SHOULD BE FIXED;                     <<01279>>43594000
   OLDCRITICAL := SETCRITICAL;                                 <<04169>>43596000
   IF UDC3.OPTNOBREAK THEN                                     <<00851>>43598000
      BEGIN                                                    <<00851>>43600000
      FBREAK;                                                  <<01279>>43602000
      SETXPXGLOB; @PXGLOB := X;                                <<01279>>43604000
      CLEAN'TERMINAL'STATE(FALSE); << CLEAR FLUSH FLAGS >>     <<00851>>43606000
      FCONTROL(1,DISABLEBREAK,DUMMY);                          <<01455>>43608000
      FUNBREAK (FALSE);                                        <<01279>>43610000
      RESETCRITICAL(OLDCRITICAL);                              <<04169>>43612000
      RETURN 0;                                                <<00851>>43614000
      END;                                                     <<00851>>43616000
   IF ABSOLUTE(ABSOLUTE(CPCB)).(15:1)=1 THEN <<SPEC BRK>>      <<01549>>43618000
   BEGIN                                                       <<00594>>43620000
      SPECIAL'BREAK:=TRUE;                                     <<00594>>43622000
      SETSERVICE(0); <<CLEAR BREAK FLAG IN LPDT...NOT REAL BREA<<00594>>43624000
   END                                                         <<00594>>43626000
   ELSE SPECIAL'BREAK:=FALSE;                                  <<00594>>43628000
      SETXPXFIXED + PXFWBREAK;                                          43630000
      DBARRAY(X) := -1;                                                 43632000
      SETXPXGLOB;                                                       43634000
      @PXGLOB := X;                                                     43636000
      X := X + PXGWFLAGS;                                               43638000
      @JFLAGS := X;                                                     43640000
      FBREAK;                                                           43642000
      RESETCRITICAL(OLDCRITICAL);                              <<04169>>43644000
      IF LPDT(PXGLOB(3).(8:8)&LSL(1)+1).(7:3)=1 THEN           <<00540>>43646000
         HARDEOF'THEN'BRK:=TRUE; <<BREAK HIT AFTER :EOF:>>     <<00540>>43648000
                                                               <<00835>>43650000
      << SAVE UDC AND IF NESTING GLOBALS >>                    <<00835>>43652000
      SAVE'UDC3 := UDC3;                                       <<00835>>43654000
      SAVE'UDC4 := UDC4;                                       <<00835>>43656000
      SAVE'IFNESTING := IFNESTING;                             <<00835>>43658000
      SAVE'IFSKIP := IFSKIP;                                   <<00835>>43660000
      SAVE'ELSESEEN := ELSESEEN;                               <<00835>>43662000
      SAVE'CONTINUSTATESTK := CONTINUSTATESTK;                 <<00835>>43664000
                                                               <<00835>>43666000
      << RESET UDC AND IF NESTING GLOBALS FOR BREAK >>         <<00835>>43668000
      UDC3 := UDC4 := IFNESTING := IFSKIP := ELSESEEN := 0;    <<00835>>43670000
      CONTINUSTATESTK := 0D;                                   <<00835>>43672000
                                                                        43674000
<<             **********************               >>         <<U.RAO>>43676000
<<             *      NEXT          *               >>         <<U.RAO>>43678000
<<             **********************               >>         <<U.RAO>>43680000
                                                               <<U.RAO>>43682000
NEXT:                                                                   43684000
   IF COMMANDEXECED THEN TERMINATE; <<HAVE DONE PASSED COMMAND<<A00.04>>43686000
   IF UDCEXECED THEN RETURN; << UDC CALL >>                    <<03.EB>>43688000
   IF UDC4.EXITBREAK THEN                                               43690000
   BEGIN << ABORT FLAG SET >>                                           43692000
      UDC4.EXITBREAK := FALSE;                                          43694000
      IF SPECIAL'BREAK THEN SETSERVICE(0);                     <<00835>>43696000
                                                               <<00835>>43698000
      << RESTORE UDC AND IF NESTING GLOBALS TO SAVED VALUES >> <<00835>>43700000
      UDC3 := SAVE'UDC3;                                       <<00835>>43702000
      UDC4 := SAVE'UDC4;                                       <<00835>>43704000
      IFNESTING := SAVE'IFNESTING;                             <<00835>>43706000
      IFSKIP := SAVE'IFSKIP;                                   <<00835>>43708000
      ELSESEEN := SAVE'ELSESEEN;                               <<00835>>43710000
      CONTINUSTATESTK := SAVE'CONTINUSTATESTK;                 <<00835>>43712000
                                                               <<00835>>43714000
      RETURN 0;                                                         43716000
   END;                                                                 43718000
   PUSH(S);                                                    <<03.EB>>43720000
   UDC1 := TOS;    << SAVE CURRENT S >>                        <<03.EB>>43722000
   IF CONTINUESTATE >= 1 THEN  <<CONTINUE IN EFFECT>>          <<U.RAO>>43724000
      IF = THEN                                                <<U.RAO>>43726000
         CONTINUESTATE := 2   <<CONTINUE JUST READ>>           <<U.RAO>>43728000
      ELSE  <<JUST EXECUTED NON-:CONTINUE>>                    <<U.RAO>>43730000
         CONTINUESTATE := 0;  <<CLEAR CONTINUE FLAG>>          <<U.RAO>>43732000
   GETIMAGE;                                                            43734000
   << BYPASS UDC SEARCH IF COMMAND NAME IS RFA >>              <<01100>>43736000
   IF UDC0 <> 0 AND BCOMIMAGE <> "RFA" THEN                    <<01100>>43738000
      IF UDC(BCOMIMAGE,0) THEN                                 <<01100>>43740000
         GO NEXT;                                              <<01100>>43742000
   TOS := 0;  <<RETURN SPACE FOR COMSEARCH>>                   <<U.RAO>>43744000
   TOS := @BCOMIMAGE;  <<ADDRESS OF COMMAND NAME>>             <<U.RAO>>43746000
   TOS := COMLEN;                                                       43748000
                                                                        43750000
                                                                        43752000
<<             **********************               >>         <<U.RAO>>43754000
<<             *      XEQIT         *               >>         <<U.RAO>>43756000
<<             **********************               >>         <<U.RAO>>43758000
                                                               <<U.RAO>>43760000
XEQIT:                                                                  43762000
   ERRNUM := 0;                                                <<U.RAO>>43764000
   PARMNUM := APLTERMTYPE;  <<0 UNLESS (APL) COMMAND>>         <<U.RAO>>43766000
   DUMMY := COMSEARCH(*,*,CAP,ACCESS,EXECPLABEL,CAPCHECKERR);  <<01455>>43768000
                                                               <<01455>>43770000
   << IF REDO ALLOWED, MOVE IMAGE INTO REDO BUFFER. >>         <<01455>>43772000
   IF NOT PROGCALL AND NOT UDCEXECED AND                       <<01455>>43774000
      NOT ( DUMMY LAND ANOTREDOABLE ) THEN                     <<01455>>43776000
      MOVE LASTCOMIMAGE := WCOMIMAGE, (WCOMMANDBUFLEN);        <<01455>>43778000
                                                               <<01455>>43780000
   IF NOT DUMMY THEN     << UNKNOWN COMMAND >>                 <<01455>>43782000
      IF PROGCALL THEN                                         <<U.RAO>>43784000
         BEGIN   <<NO SUCH COMMAND AND PROGRAMMATIC>>          <<U.RAO>>43786000
         CCC := CCL;                                           <<U.RAO>>43788000
         ERRPARM := ERRUNDEF;                                  <<U.RAO>>43790000
         END                                                   <<U.RAO>>43792000
      ELSE                                                     <<U.RAO>>43794000
         BEGIN                                                 <<00856>>43796000
         IF NOT IFSKIP THEN                                    <<00856>>43798000
            CIERR(ERRUNDEF, BCOMIMAGE)                         <<00856>>43800000
         END                                                   <<00856>>43802000
   ELSE  <<IS VALID COMMAND, TRY TO EXECUTE IT>>               <<U.RAO>>43804000
      IF PERMITACCESS THEN                                     <<U.RAO>>43806000
         BEGIN  <<LEGAL FOR THIS USER, IN THIS CASE>>          <<U.RAO>>43808000
         TOS := @PARMSP;                                       <<U.RAO>>43810000
         TOS := @ERRNUM;                                       <<U.RAO>>43812000
         TOS := @PARMNUM;                                      <<U.RAO>>43814000
         TOS := EXECPLABEL;                                    <<U.RAO>>43816000
         SETSERVICE(NONABORTABLE);  <<SET BREAK STATUS>>       <<U.RAO>>43818000
         ASSEMBLE(PCAL 0);                                     <<U.RAO>>43820000
         IF NOT PROGCALL AND NOT NONABORTABLE AND              <<U.RAO>>43822000
            UDC4.NESTLEVEL <> 0 AND REQUESTSERVICE THEN        <<09.EB>>43824000
            UDC4.BREAKDETECTED := TRUE;                                 43826000
         IF PROGCALL THEN  <<MUST SET CONDITION CODE>>         <<U.RAO>>43828000
            IF ERRNUM = 0 THEN                                 <<00525>>43830000
               CCC := CCE   <<SUCCESSFUL COMMAND>>             <<U.RAO>>43832000
            ELSE   <<COMMAND FAILED, RETURN CODES>>            <<U.RAO>>43834000
               BEGIN                                           <<U.RAO>>43836000
               ERRPARM := ERRNUM;                              <<U.RAO>>43838000
               PARMPARM := PARMNUM;                            <<U.RAO>>43840000
               CCC := CCG;                                     <<U.RAO>>43842000
               END;                                            <<U.RAO>>43844000
         END                                                   <<U.RAO>>43846000
      ELSE   <<PERMITACCESS FAILED>>                           <<U.RAO>>43848000
         IF PROGCALL THEN                                      <<U.RAO>>43850000
            BEGIN                                              <<U.RAO>>43852000
            ERRPARM := ERRNUM;                                 <<U.RAO>>43854000
            CCC := CCG;                                        <<U.RAO>>43856000
            END;                                               <<U.RAO>>43858000
IF PROGCALL THEN RETURN 0;   <<NO PARAMETERS>>                 <<U.RAO>>43860000
GO TO NEXT;     <<LOOP>>                                       <<U.RAO>>43862000
END  <<COMMANDINTERP>>;                                                 43864000
PROCEDURE HELP; OPTION EXTERNAL;                               <<03.EB>>43866000
PROCEDURE CALLHELP; OPTION INTERNAL; HELP;                     <<04.RO>>43868000
PROCEDURE COMMAND(COMIMAGE,ERROR,PARM);                                 43870000
   BYTE ARRAY COMIMAGE;                                                 43872000
   INTEGER ERROR,PARM;                                                  43874000
BEGIN                                                                   43876000
   ERRORON;                                                             43878000
   CHEK([10/68,6/3],3,%53D);                                            43880000
   ERROR := PARM := 0;  <<INITIALIZE RETURN VALUES>>          <<A01.01>>43882000
   COMMAND'(*);                                                         43884000
   ERROREXIT([10/68,6/3],0,0);                                          43886000
END;    <<COMMAND>>                                                     43888000
$CONTROL SEGMENT=MAIN                                                   43890000
END.                                                                    43892000
