$CONTROL USLINIT,CODE,MAP                                      <<01549>>00010000
<< CIMAIN of the Command Interpreter.   Module 5B >>           <<04849>>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
                                                               <<04710>>00032000
<<*********************************************************>>  <<04710>>00034000
<<                                                         >>  <<04710>>00036000
<<              CIMAIN  --  Module 5B                      >>  <<04710>>00038000
<<                                                         >>  <<04710>>00040000
<<*********************************************************>>  <<04710>>00042000
                                                               <<04710>>00044000
                                                               <<04710>>00046000
                                                               <<04710>>00048000
<<*************************************************************<<U.RAO>>00050000
<<*****************  Command Interpreter IMS  *****************<<U.RAO>>00052000
<<*************************************************************<<U.RAO>>00054000
<<                                                             <<U.RAO>>00056000
<<*************************************************************<<U.RAO>>00058000
<<************************  OVERVIEW  *************************<<U.RAO>>00060000
<<*************************************************************<<U.RAO>>00062000
<<                                                             <<U.RAO>>00064000
<<WHO:                                                         <<U.RAO>>00066000
<<   Larry Birenbaum designed the basic structures of the      <<U.RAO>>00068000
<<Command Interpreter for VERSION A of MPE.  Work was begun in <<U.RAO>>00070000
<<1970 or 1971.                                                <<U.RAO>>00072000
<<   Bob Olson substantially redesigned the parsers of the     <<U.RAO>>00074000
<<Command Interpreter for VERSION B of MPE II.  Work was begun <<U.RAO>>00076000
<<in November 1976 and completed in late 1977.  The basic      <<U.RAO>>00078000
<<algorithms for executing the commands remained essentially   <<U.RAO>>00080000
<<the same even though the parsers were rewritten.  Several    <<U.RAO>>00082000
<<new commands were added at this time, as were User Defined   <<U.RAO>>00084000
<<Commands.                                                    <<U.RAO>>00086000
<<   Other people who have added commands or modified existing <<U.RAO>>00088000
<<commands for MPE IIB are Ron Hoyt and Bob Vannucci (Private  <<U.RAO>>00090000
<<Volumes, including modification of the accounting commands   <<U.RAO>>00092000
<<and STORE/RESTORE), Neal Mack (Transaction Logging user      <<U.RAO>>00094000
<<commands), Mike Philben (revision of DS commands), Ed Basart <<U.RAO>>00096000
<<(revision of HELLO, JOB, and DATA and the addition of User   <<U.RAO>>00098000
<<Defined Commands), and Bob Gerstmeyer (CLINE command).       <<U.RAO>>00100000
<<                                                             <<U.RAO>>00102000
<<WHERE:                                                       <<U.RAO>>00104000
<<   Pieces of the Command Interpreter are scattered all over  <<U.RAO>>00106000
<<the system.  This module contains the bulk of the executors. <<U.RAO>>00108000
<<The spooling commands (SHOWJOB, SHOWOUT, STREAM, and SHOWIN) <<U.RAO>>00110000
<<may be found in the SPOOLCOMS module.  The DS commands       <<U.RAO>>00112000
<<(RFA, DSLINE, REMOTE) will be found in the DS code.  STORE   <<U.RAO>>00114000
<<and RESTORE have a module of their own.  The bulk of the work<<U.RAO>>00116000
<<for User Defined Commands is done in a module called UDC.    <<U.RAO>>00118000
<<HELP resides in module HELPUSER.  JOB, HELLO and DATA are    <<U.RAO>>00120000
<<parsed by code in module NURSERY.  In general, it is better  <<U.RAO>>00122000
<<to put the executors in the same module as the routines which<<U.RAO>>00124000
<<do the work.  This will reduce confusion and simplify        <<U.RAO>>00126000
<<maintenance.  There is no inherent benefit to accumulating   <<U.RAO>>00128000
<<executors in common segments, assuming that there is         <<U.RAO>>00130000
<<non-trivial work to do.                                      <<U.RAO>>00132000
<<                                                             <<U.RAO>>00134000
<<WHY:                                                         <<U.RAO>>00136000
<<   The purpose served by the Command Interpreter is to       <<U.RAO>>00138000
<<provide the user access to the operating system functions    <<U.RAO>>00140000
<<without requiring him/her to go through the irritation of    <<U.RAO>>00142000
<<writing a program to do so.  There are three primary function<<U.RAO>>00144000
<<provided by the commands.  Most important is the ability to  <<U.RAO>>00146000
<<execute programs, evidenced by the RUN command and the variou<<U.RAO>>00148000
<<compiler commands.  Second is the ability to manage one's    <<U.RAO>>00150000
<<resources, such as files.  Finally there are a large number o<<U.RAO>>00152000
<<utility functions, primarily for status checking.  When a new<<U.RAO>>00154000
<<capability is added to the system, the user should be given  <<U.RAO>>00156000
<<commands which allow him to manipulate the capability and to <<U.RAO>>00158000
<<determine the status of the new resource created by the      <<U.RAO>>00160000
<<capability.                                                  <<U.RAO>>00162000
<<                                                             <<U.RAO>>00164000
$PAGE                                                                   00166000
<<*************************************************************<<U.RAO>>00168000
<<****************  ADDING A COMMAND TO THE CI  ***************<<U.RAO>>00170000
<<*************************************************************<<U.RAO>>00172000
<<                                                             <<U.RAO>>00174000
<<Step 1:  Designing the command.                              <<U.RAO>>00176000
<<   A reasonable and parseable command syntax is one of the   <<U.RAO>>00178000
<<important parts of designing a good command.  Your goal is   <<U.RAO>>00180000
<<to minimize user irritation when using the command.  Always  <<U.RAO>>00182000
<<remember that for most users the problem for which they are  <<U.RAO>>00184000
<<using a computer is probably solved within an application    <<U.RAO>>00186000
<<program of some sort and the Command Interpreter in general  <<U.RAO>>00188000
<<and your command in particular are necessary annoyances.     <<U.RAO>>00190000
<<You must strive to limit that annoyance to the unavoidable.  <<U.RAO>>00192000
<<   Unfortunately, there are a wide variety of ways in which  <<U.RAO>>00194000
<<you can annoy people.  Some of the solutions are mutually    <<U.RAO>>00196000
<<incompatible.  The following is a list of the issues you     <<U.RAO>>00198000
<<should consider.                                             <<U.RAO>>00200000
<<   1)  Verbose versus terse command names                    <<U.RAO>>00202000
<<       In general it is desireable to have command names     <<U.RAO>>00204000
<<       which accurately reflect the function of the          <<U.RAO>>00206000
<<       command.  The tradeoff is that verbose command        <<U.RAO>>00208000
<<       names which describe the command are easier to        <<U.RAO>>00210000
<<       pick out in documentation whereas terse names are     <<U.RAO>>00212000
<<       easier to type.  Thus the deciding factor should      <<U.RAO>>00214000
<<       be how often the user will use the command.  A        <<U.RAO>>00216000
<<       side consideration is that the use of archaic         <<U.RAO>>00218000
<<       English or bizarre abbreviations will work a          <<U.RAO>>00220000
<<       hardship on our users who are not native English      <<U.RAO>>00222000
<<       speakers.                                             <<U.RAO>>00224000
<<   2)  Keyword versus positional parameters                  <<U.RAO>>00226000
<<       Positional parameters can be dangerous, especially    <<U.RAO>>00228000
<<       when the parameters can be similar data types.        <<U.RAO>>00230000
<<       For example, a positional string of numbers can       <<U.RAO>>00232000
<<       result in erroneous operation due to the accidental   <<U.RAO>>00234000
<<       omission of a delimiter.  Keyworded parameters        <<U.RAO>>00236000
<<       can be very verbose, especially on complex commands.  <<U.RAO>>00238000
<<       They can also work a hardship when a user uses a      <<U.RAO>>00240000
<<       particular command heavily, since it drastically      <<U.RAO>>00242000
<<       enlarges the amount of typing.  This last objection   <<U.RAO>>00244000
<<       can be gotten around through the agency of User       <<U.RAO>>00246000
<<       Defined Commands.  Another major objection to         <<U.RAO>>00248000
<<       keywords is that it requires several different        <<U.RAO>>00250000
<<       delimiters, often leading to typing errors and        <<U.RAO>>00252000
<<       mental confusion.                                     <<U.RAO>>00254000
<<   3)  Delimiters & other special characters                 <<U.RAO>>00256000
<<       The typical delimiters in commands are commas to      <<U.RAO>>00258000
<<       separate positional parameters and semicolons to      <<U.RAO>>00260000
<<       separate keywords.  The file command shows this       <<U.RAO>>00262000
<<       in full generality.  Periods are sometimes            <<U.RAO>>00264000
<<       terminators (as in the LABEL option on the FILE       <<U.RAO>>00266000
<<       command) and sometimes separators, as in the logon    <<U.RAO>>00268000
<<       user ID and file names.  Blanks are tough to deal     <<U.RAO>>00270000
<<       with and should be avoided as delimiters.             <<U.RAO>>00272000
<<       Non-printing characters should be avoided at all      <<U.RAO>>00274000
<<       costs.  All commands will be terminated with a        <<U.RAO>>00276000
<<       carriage return when passed to the command parser.    <<U.RAO>>00278000
<<   4)  Hardware/software peculiarities                       <<U.RAO>>00280000
<<       Too frequently the command syntax reflects some       <<U.RAO>>00282000
<<       strange and unpleasant aspect of the mechanism        <<U.RAO>>00284000
<<       underlying the command.  We should not require the    <<U.RAO>>00286000
<<       user to be cognizant of our design problems.  To      <<U.RAO>>00288000
<<       do so violates the principle of lowering the          <<U.RAO>>00290000
<<       annoyance factor.                                     <<U.RAO>>00292000
<<   5)  Extensibility                                         <<U.RAO>>00294000
<<       No matter how well your command does its job, one     <<U.RAO>>00296000
<<       of these days someone will want to modify or          <<U.RAO>>00298000
<<       extend it.  In particular, one should be careful      <<U.RAO>>00300000
<<       about the use of delimiters in ways other than the    <<U.RAO>>00302000
<<       "traditional" way.  For example, periods, commas,     <<U.RAO>>00304000
<<       semicolons and others have fairly standardized        <<U.RAO>>00306000
<<       meanings, and to use them in a different way reduces  <<U.RAO>>00308000
<<       the options of your successor to extend your command. <<U.RAO>>00310000
<<       Another related issue is that listing formats should  <<U.RAO>>00312000
<<       be extensible.                                        <<U.RAO>>00314000
<<   6)  Defaults                                              <<U.RAO>>00316000
<<       Defaults are vital, dangerous and difficult to choose.<<U.RAO>>00318000
<<       The design goal is that the command should be simple  <<U.RAO>>00320000
<<       for simple minded users.  This implies restraint in   <<U.RAO>>00322000
<<       the use of defaults which vary depending on some other<<U.RAO>>00324000
<<       parameter to the command.  Too smart defaults can be  <<U.RAO>>00326000
<<       just as bad as no defaults, since many users will     <<U.RAO>>00328000
<<       use the command defensively to avoid surprises from   <<U.RAO>>00330000
<<       the default mechanism.  Good luck.                    <<U.RAO>>00332000
<<   7)  Ambiguity                                             <<U.RAO>>00334000
<<       Careful design will avoid the need for lookahead to   <<U.RAO>>00336000
<<       resolve abiguous situations.  Lookahead should be     <<U.RAO>>00338000
<<       avoided if at all possible, as it results in          <<U.RAO>>00340000
<<       much code with complicated data structures.           <<U.RAO>>00342000
<<   8)  Computerese                                           <<U.RAO>>00344000
<<       Keywords should be couched in English, not computerese<<U.RAO>>00346000
<<                                                             <<U.RAO>>00348000
<<In summary, the user of your command will probably not be a  <<U.RAO>>00350000
<<computer professional and probably will be annoyed at the nee<<U.RAO>>00352000
<<to use your command at all.  Simplicity, understandability an<<U.RAO>>00354000
<<regularity are the keys to good command syntax.              <<U.RAO>>00356000
<<                                                             <<U.RAO>>00358000
<<Step 2: Code the Executor.                                   <<U.RAO>>00360000
<<   For the most part this is quite straightforward.  Most of <<U.RAO>>00362000
<<the existing executors can be used as models.  There are a fe<<U.RAO>>00364000
<<good concepts to keep in mind, however.                      <<U.RAO>>00366000
<<   Generating good error messages is just as important as    <<U.RAO>>00368000
<<executing the command.  The whole error message issue is deal<<U.RAO>>00370000
<<with below.                                                  <<U.RAO>>00372000
<<   The code of the command should be easily extensible.  This<<U.RAO>>00374000
<<implies the use of a simple parsing scheme with very obvious <<U.RAO>>00376000
<<techniques.  Probably more often than any other part of the  <<U.RAO>>00378000
<<system, the CI is modified by people who have no proprietary <<U.RAO>>00380000
<<interest in it.  In the interests of reliability and         <<U.RAO>>00382000
<<maintainability, it is desireable to start with as clean code<<U.RAO>>00384000
<<as possible.  Unfortunately, no universal parsing scheme has <<U.RAO>>00386000
<<yet been developed for the CI.                               <<U.RAO>>00388000
<<   A trap to avoid is called the "parse a little, execute a  <<U.RAO>>00390000
<<little" syndrome.  It results in the need to back out of a   <<U.RAO>>00392000
<<situation when an error is detected further down stream.  A  <<U.RAO>>00394000
<<secondary problem is that it tends to result in the          <<U.RAO>>00396000
<<partial destruction of the context of the error.  A command  <<U.RAO>>00398000
<<should be parsed completely before being executed at all.    <<U.RAO>>00400000
<<   Don't worry about having particularly efficient code.  The<<U.RAO>>00402000
<<CI's execution time is trivial compared to the time it takes <<U.RAO>>00404000
<<for the user to recover from a poorly designed error message <<U.RAO>>00406000
<<or even from a poorly designed syntax.  The customer always  <<U.RAO>>00408000
<<comes first.                                                 <<U.RAO>>00410000
<<   The use of global storage is discouraged.  Most important <<U.RAO>>00412000
<<is the fact that there are some performance consequences     <<U.RAO>>00414000
<<related to the need to constantly enlarge the CI's stack.    <<U.RAO>>00416000
<<If you find you do need global storage, be sure to initialize<<U.RAO>>00418000
<<it in procedure COMMANDINTERP, as the CI is procreated and   <<U.RAO>>00420000
<<thus has no global initialization capability.  Be careful    <<U.RAO>>00422000
<<about where you put new globals.  Certain other modules such <<U.RAO>>00424000
<<as UDC know about the CI global space.                       <<U.RAO>>00426000
<<   In general, the execution part of the command should simpl<<U.RAO>>00428000
<<be a call to the appropriate user callable intrinsic.  The   <<U.RAO>>00430000
<<CI usually should not provide the user any special services  <<U.RAO>>00432000
<<that are not available programmatically.  In this way we avoi<<U.RAO>>00434000
<<such undesireable situations as users getting their accountin<<U.RAO>>00436000
<<information through a call to the REPORT command and setting <<U.RAO>>00438000
<<up their files through a call to the FILE command through the<<U.RAO>>00440000
<<COMMAND intrinsic.  See the SETJCW command for an example of <<U.RAO>>00442000
<<this.                                                        <<U.RAO>>00444000
<<   EXCHANGEDB is to be avoided if at all possible, even if   <<U.RAO>>00446000
<<you have to do data segment moves iteratively.  The speed cos<<U.RAO>>00448000
<<is nothing compared to the cost of the crash which is        <<U.RAO>>00450000
<<inevitable when doing split stack operations.  All of the CI <<U.RAO>>00452000
<<utility routines assume no split stack operation.            <<U.RAO>>00454000
<<   Similarly there is rarely any valid reason for accessing  <<U.RAO>>00456000
<<system primitives directly from the CI.  The CI should be a  <<U.RAO>>00458000
<<very high level module.  It rarely has any business rooting  <<U.RAO>>00460000
<<around in some system table.  This principle unfortunately ha<<U.RAO>>00462000
<<been rather imperfectly adhered to.                          <<U.RAO>>00464000
<<   These almost random thoughts about writing executors hardl<<U.RAO>>00466000
<<provide a good framework for writing code.  Cursory          <<U.RAO>>00468000
<<examination of some of the executors currently in the module <<U.RAO>>00470000
<<probably will give you a better idea of the tricks of the    <<U.RAO>>00472000
<<trade.  A few ideas stand out.                               <<U.RAO>>00474000
<<                                                             <<U.RAO>>00476000
<<      Code assuming someone else will be changing it.        <<U.RAO>>00478000
<<                                                             <<U.RAO>>00480000
<<      Code for good error messages, not speed.               <<U.RAO>>00482000
<<                                                             <<U.RAO>>00484000
<<      It is far better to detect a problem at the            <<U.RAO>>00486000
<<      time the command is put in than when it is             <<U.RAO>>00488000
<<      executed.  That is, at parse time as opposed           <<U.RAO>>00490000
<<      to execution time.                                     <<U.RAO>>00492000
<<                                                             <<U.RAO>>00494000
<<      Cleverness will get you in trouble, usually for        <<U.RAO>>00496000
<<      no good reason.                                        <<U.RAO>>00498000
<<                                                             <<U.RAO>>00500000
<<Step 3:  Add the command to the Command Interpreter.         <<U.RAO>>00502000
<<   Other than physically adding the executor to the system,  <<U.RAO>>00504000
<<the only task is to add the command name to the list in      <<U.RAO>>00506000
<<procedure COMSEARCH.  This procedure is called for each      <<U.RAO>>00508000
<<command to determine if it is one of the ones known to the   <<U.RAO>>00510000
<<system.  The mechanics of this process are described in that <<U.RAO>>00512000
<<procedure.  If the executor is physically outside the CI     <<U.RAO>>00514000
<<module, don't forget to add the OPTION EXTERNAL declaration. <<U.RAO>>00516000
<<Congratulations.  Now all you need to do is make sure it     <<U.RAO>>00518000
<<works.                                                       <<U.RAO>>00520000
<<                                                             <<U.RAO>>00522000
$PAGE                                                                   00524000
<<*************************************************************<<U.RAO>>00526000
<<**************  ERROR MESSAGES FROM THE CI  **************** <<U.RAO>>00528000
<<*************************************************************<<U.RAO>>00530000
<<                                                             <<U.RAO>>00532000
<<Philosophical aspects:                                       <<U.RAO>>00534000
<<     The essential goal of an error message from the CI is to<<U.RAO>>00536000
<<help the user quickly recover from his problem.  In general, <<U.RAO>>00538000
<<a good error message should indicate:                        <<U.RAO>>00540000
<<    1)  What the CI did not like.  On syntax errors this     <<U.RAO>>00542000
<<        typically is done with a caret underneath where the  <<U.RAO>>00544000
<<        problem was detected.  If the caret isn't sufficient <<U.RAO>>00546000
<<        to identify the problem then some of the text of the <<U.RAO>>00548000
<<        message should further elaborate.  On semantic errors<<U.RAO>>00550000
<<        this usually is done with the text of the message.   <<U.RAO>>00552000
<<    2)  How to recover.  This usually will take the form of  <<U.RAO>>00554000
<<        telling the user what the valid input might be.  For <<U.RAO>>00556000
<<        example, on an invalid record type in the :FILE      <<U.RAO>>00558000
<<        command, the CI will put out a message something like<<U.RAO>>00560000
<<        EXPECTED RECORD TYPE TO BE F, V OR U.                <<U.RAO>>00562000
<<        This serves to identify to the user very quickly what<<U.RAO>>00564000
<<        the valid syntax is and thus how to get on with his  <<U.RAO>>00566000
<<        business.  Sometimes it is hard to figure out what th<<U.RAO>>00568000
<<        user had in mind.  For example, it isn't really      <<U.RAO>>00570000
<<        possible to second guess the user on an unknown      <<U.RAO>>00572000
<<        command name.  In these relatively rare cases, it is <<U.RAO>>00574000
<<        sufficient to tell the user just what was wrong.     <<U.RAO>>00576000
<<        In general, if it is a syntax error of any sort, it  <<U.RAO>>00578000
<<        is possible to give a good error message outlining   <<U.RAO>>00580000
<<        what was expected.  A cop-out on this is really      <<U.RAO>>00582000
<<        sloppy workmanship.                                  <<U.RAO>>00584000
<<    3)  In many cases it is desireable to tell the user what <<U.RAO>>00586000
<<        was done about the error.  This is particularly true <<U.RAO>>00588000
<<        in the case of warnings, where the user may be left  <<U.RAO>>00590000
<<        wondering whether some default was taken.  For exampl<<U.RAO>>00592000
<<        in the accounting structure commands we ignore many  <<U.RAO>>00594000
<<        errors.  In each case it is necessary to tell the use<<U.RAO>>00596000
<<        what default we took so that he can then do an ALTxxx<<U.RAO>>00598000
<<        to fix up the particular error, if necessary.  Of    <<U.RAO>>00600000
<<        course, in each case we try to pick a reasonable     <<U.RAO>>00602000
<<        default so that he doesn't have to do any recovery.  <<U.RAO>>00604000
<<                                                             <<U.RAO>>00606000
<<In any case, messages should be very specific.  Given the    <<U.RAO>>00608000
<<very simple mechanism for generating error and warning       <<U.RAO>>00610000
<<messages, there is no acceptable excuse for generic messages.<<U.RAO>>00612000
<<Examples:                                                    <<U.RAO>>00614000
<<   "INVALID NUMBER" is unacceptable.  Such messages should be<<U.RAO>>00616000
<<of the form "EXPECTED <item> TO BE BETWEEN <n1> AND <n2>."   <<U.RAO>>00618000
<<This message should be used only once in the CI.             <<U.RAO>>00620000
<<   "UNKNOWN KEYWORD" is unacceptable.  The proper form is    <<U.RAO>>00622000
<<"EXPECTED ONE OF <item1>, <item2>....".                      <<U.RAO>>00624000
<<   In general, "<item>", "<n1>" and so forth should not be   <<U.RAO>>00626000
<<passed to CIERR as parameters but rather be embedded as part <<U.RAO>>00628000
<<of the error message.  The reason for this is that you will  <<U.RAO>>00630000
<<need to give a fuller description of the error in the Error  <<U.RAO>>00632000
<<Messages part of the MPE manual.  It is awkward at best and  <<U.RAO>>00634000
<<embarrassing at worst to have to tell the manual writer "Well<<U.RAO>>00636000
<<it could be this, or it could be that, or even this third    <<U.RAO>>00638000
<<thing."  The one exception is where truly dynamic information<<U.RAO>>00640000
<<is involved.  Examples might include configuration data and  <<U.RAO>>00642000
<<user supplied information like file names.>>                 <<U.RAO>>00644000
<<   In most cases, redundantly specified parameters should    <<U.RAO>>00646000
<<result not in a fatal error but in a warning.  If a value is <<U.RAO>>00648000
<<associated with the redundant keyword then the message should<<U.RAO>>00650000
<<specify that the last value found was used.                  <<U.RAO>>00652000
<<   Similarly unacceptable messages are                       <<U.RAO>>00654000
<<   "INSUFFICIENT PARAMETERS" - what is missing?              <<U.RAO>>00656000
<<   "INSUFFICIENT CAPABILITY" should say what capability is   <<U.RAO>>00658000
<<missing.                                                     <<U.RAO>>00660000
<<   "INSUFFICIENT RESOURCES" should say what resources are    <<U.RAO>>00662000
<<lacking.                                                     <<U.RAO>>00664000
<<And so forth for all messages.                               <<U.RAO>>00666000
<<                                                             <<U.RAO>>00668000
<<Mechanical aspects of adding error messages:                 <<U.RAO>>00670000
<<                                                             <<U.RAO>>00672000
<<1)  Numbering                                                <<U.RAO>>00674000
<<    The number chosen for a message is largely irrelevant.  I<<U.RAO>>00676000
<<    is nice, however, if it is near the other messages       <<U.RAO>>00678000
<<    associated with the same command.  Be sure to declare it <<U.RAO>>00680000
<<    as an equate in the CI globals (or SPOOLCOMS or whatever)<<U.RAO>>00682000
<<    Note that the message should be tagged as to whether it i<<U.RAO>>00684000
<<    a CIERR or CIWARN or whatever.  Put it in message set 2. <<U.RAO>>00686000
<<2)  Generation                                               <<U.RAO>>00688000
<<    There is a procedure called CIERR which is responsible fo<<U.RAO>>00690000
<<    processing related to the handling of errors.  In        <<U.RAO>>00692000
<<    particular this procedure decides whether to print the   <<U.RAO>>00694000
<<    message, abort the job, and other related cleanup        <<U.RAO>>00696000
<<    problems.  Note that it always returns to the caller if  <<U.RAO>>00698000
<<    the job is not aborted.  It is the responsibility of the <<U.RAO>>00700000
<<    caller to assure that the job is clean enough to be      <<U.RAO>>00702000
<<    aborted at the time of the call.  CIERR cannot be called <<U.RAO>>00704000
<<    in split stack mode.  See the listing of CIERR for the   <<U.RAO>>00706000
<<    details of the call.                                     <<U.RAO>>00708000
<<3)  Errors detected by other parts of the system.            <<U.RAO>>00710000
<<    Errors such as file system errors, loader errors, DS     <<U.RAO>>00712000
<<    runtime errors and private volume errors are really of   <<U.RAO>>00714000
<<    little meaning in the context of the CI.  Accordingly,   <<U.RAO>>00716000
<<    when such errors are detected, several messages may be   <<U.RAO>>00718000
<<    displayed.  This is done through the agency of routines  <<U.RAO>>00720000
<<    like FERROR', CYDIRERR', LOADERROR, and CREATEERROR.     <<U.RAO>>00722000
<<    The development of such routines is encouraged whenever  <<U.RAO>>00724000
<<    message sets outside the CI error message set is         <<U.RAO>>00726000
<<    involved.  When such a message is output, the CI should  <<U.RAO>>00728000
<<    also print a message translating the error into the      <<U.RAO>>00730000
<<    context of the command which failed.  For example, when  <<U.RAO>>00732000
<<    a purge fails for an unusual reason, we print the file   <<U.RAO>>00734000
<<    system error message as well as a message saying that the<<U.RAO>>00736000
<<    purge was not done.                                      <<U.RAO>>00738000
<<4)  General purpose parsing routines                         <<U.RAO>>00740000
<<    Some parses, such as file names, are done so often that  <<U.RAO>>00742000
<<    generalized routines exist.  Usually these will be found <<U.RAO>>00744000
<<    in the neighborhood of the error handling routines.      <<U.RAO>>00746000
<<5)  Programmatically callable commands                       <<U.RAO>>00748000
<<    For errors in programmatically callable commands you must<<U.RAO>>00750000
<<    also return the error number to the caller of the COMMAND<<U.RAO>>00752000
<<    intrinsic.  This is done by returning the number through <<U.RAO>>00754000
<<    the ERRNUM parameter to all executors.  Also it is       <<U.RAO>>00756000
<<    required that you return the parameter number in the     <<U.RAO>>00758000
<<    PARMNUM parameter.  Parameter number is roughly defined  <<U.RAO>>00760000
<<    as one for each entity such as a keyword or value past   <<U.RAO>>00762000
<<    the command name.  In other words, 1 is the first        <<U.RAO>>00764000
<<    parameter past the command name, 2 might be the value to <<U.RAO>>00766000
<<    be associated with the keyword which was parameter 1.    <<U.RAO>>00768000
<<                                                             <<U.RAO>>00770000
<<   Error message generation is one of the most important     <<U.RAO>>00772000
<<tasks to be performed by the Command Interpreter.  The best  <<U.RAO>>00774000
<<error messages are generated when the coder tries to envision<<U.RAO>>00776000
<<the user's perception of the error.  For example, in many    <<U.RAO>>00778000
<<cases it seems to the user that it was obvious what he meant <<U.RAO>>00780000
<<even though it was not expressed in correct form.  This      <<U.RAO>>00782000
<<includes redundantly specified keywords like NOCCTL in the   <<U.RAO>>00784000
<<file command.  The user does not think highly of a command   <<U.RAO>>00786000
<<parser which gives him an error message on something like tha<<U.RAO>>00788000
<<which is obviously non-fatal.  The key to success with error <<U.RAO>>00790000
<<messages is to identify errors in the user's frame of        <<U.RAO>>00792000
<<reference, not the system programmer's.                      <<U.RAO>>00794000
<<                                                             <<U.RAO>>00796000
$TITLE "GLOBAL DECLARATIONS"                                            00798000
$PAGE "GLOBAL DECLARATIONS"                                             00800000
$CONTROL MAIN=COMMAND'INTERP                                   <<06.EB>>00802000
BEGIN                                                                   00804000
      <<MISCELLANEOUS DECLARATIONS >>                                   00806000
      INTEGER                                                           00808000
      DELTAQ=Q-0,                                                       00810000
      S0=S-0,                                                           00812000
      S1=S-1,                                                           00814000
      S2=S-2,                                                           00816000
      S3=S-3,                                                           00818000
      S15=S-15,                                                         00820000
      XREG = X,                                                         00822000
      X=X;                                                              00824000
                                                                        00826000
      LOGICAL                                                           00828000
      LS0=S-0,                                                          00830000
      STATUS=Q-1;                                                       00832000
                                                                        00834000
      DOUBLE                                                            00836000
      DS1=S-1,                                                          00838000
      DS3=S-3,                                                          00840000
      DS13=S-13,                                                        00842000
      DS15=S-15;                                                        00844000
                                                                        00846000
      BYTE POINTER                                                      00848000
      BPS0=S-0;                                                << I.A >>00850000
                                                                        00852000
      INTEGER POINTER                                                   00854000
      PS0=S-0,                                                          00856000
      LPDT =08;   <<LPDT TABLE POINTER>>                       <<U.RAO>>00858000
                                                                        00860000
                                                                        00862000
      ARRAY DBARRAY(*)=DB+0;                                            00864000
      INTEGER ARRAY ARRDB0(*)=DB+0;                                     00866000
      INTEGER ARRAY ARRDB6(*)=DB+6;                                     00868000
$INCLUDE INCLCIS                                               << I.A >>00870000
$PAGE "GLOBAL DECLARATIONS"                                    << I.A >>00872000
                                                               <<09.EB>>00874000
      <<EQUATES USED THROUGHOUT>>                                       00876000
                                                                        00878000
      EQUATE                                                            00880000
      <<CONDITION CODES>>                                               00882000
      CCE=2,                                                            00884000
      CCL=1,                                                            00886000
      CCG=0,                                                            00888000
      <<CI MESSAGE SET NUMBERS>>                               <<U.RAO>>00890000
      CIERRMSGSET=2,                                           <<U.RAO>>00892000
      CIGENERALMSGSET=7,                                       <<U.RAO>>00894000
      FSERRORMSGSET = 8,                                       <<U.RAO>>00896000
      LOADERRMSGSET = 9,                                       <<U.RAO>>00898000
      CREATEERRMSGSET = 10,                                    <<U.RAO>>00900000
      PVERRMSGSET = 15,                                        <<RH.PV>>00902000
      INTRNLERRSET = 27,  << System internal error. >>         <<04193>>00904000
   <<EQUATES FOR GENERAL MESSAGES (NOT ERROR MESSAGES)>>       <<U.RAO>>00906000
   OPWARN=9,         <<OPERATOR WARNING MESSAGE #>>            <<00552>>00908000
   JOBFLUSHED      = 2,                                        <<U.RAO>>00910000
   TELLFROM        = 3,                                        <<U.RAO>>00912000
ENDOFFILEMSG    =  9,  <<END OF FILE DETECTED>>                <<00527>>00914000
   TELLNOTACCEPT   =  25,   <<! NOT ACCEPTING MESSAGES>>       <<U.RAO>>00916000
   ABORTQ          =  26,   <<ABORT?>>                         <<U.RAO>>00918000
   << END OF PREPARE = 51, >>                                  <<U.RAO>>00920000
   << END OF SUBSYSTEM = 52, >>                                <<U.RAO>>00922000
   << END OF COMPILE = 53, >>                                  <<U.RAO>>00924000
   << END OF REMOTE PROGRAM = 54>>                             <<U.RAO>>00926000
   SHOWJCWMSG      = 55,  << <jcw> = <value> >>                <<U.RAO>>00928000
   <<JCW = WARN, MSG 56>>                                      <<U.RAO>>00930000
   <<JCW = FATAL, MSG 57>>                                     <<U.RAO>>00932000
   <<JCW = SYSTEM, MSG 58>>                                    <<U.RAO>>00934000
   <<DS MESSAGE, MSG 59>>                                      <<U.RAO>>00936000
   <<DS MESSAGE, MSG 60>>                                      <<U.RAO>>00938000
   SHOWME1BRK      = 61,                                       <<U.RAO>>00940000
   SHOWME2         =  62,                                      <<U.RAO>>00942000
   SHOWME3         =  63,                                      <<U.RAO>>00944000
   SHOWME4         =  64,                                      <<U.RAO>>00946000
   SHOWME5         =  65,                                      <<U.RAO>>00948000
   SHOWME1NOBRK    = 70,                                       <<U.RAO>>00950000
   SHOWME6         = 71,                                       <<U.RAO>>00952000
   CONDITION'TRUE  = 40,                                       <<00849>>00954000
   CONDITION'FALSE = 41,                                       <<00849>>00956000
   RESUME'EXEC     = 42,                                       <<00849>>00958000
   IGNORE'COMM     = 43,                                       <<00849>>00960000
   SHOWME33        = 72,                                       <<00492>>00962000
   SHOWME55        = 74,                                       <<01403>>00964000
   SHOWMEINPROG    = 76,                                       <<04738>>00966000
   SHOWMEPROGCPU   = 77,                                       <<04738>>00968000
      <<ERROR EQUATES REFER TO C.I. ERROR NUMBER>>                      00970000
                                                                        00972000
                                                                        00974000
                                                                        00976000
      <<COMMAND RELATED ERRORS>>                                        00978000
      ERRNOTPROGRAMAT = 12,  <<DISALLOWED PROGRAMMATICALLY>>   <<U.RAO>>00980000
   ERRMISSINGCR    = 13,  << NO CR AT END OF COMMAND IMAGE >>  <<00257>>00982000
   NOSTACKSPACE    =  15,  << NOT ENOUGH STACK FOR COMMAND >>  <<01895>>00984000
<< FILE NAME ERRORS>>                                          <<U.RAO>>00986000
   FILEEXPECTALPHA = 530  ,                                    <<U.RAO>>00988000
   FFNAMEBASE=FILEEXPECTALPHA-1,                               <<U.RAO>>00990000
   FILENAMEMISSING = 531  ,                                    <<U.RAO>>00992000
<< GROUP NAME ERRORS >>                                        <<U.RAO>>00994000
   GRPEXPECTALPHA  = 540  ,                                    <<U.RAO>>00996000
   FGNAMEBASE=GRPEXPECTALPHA-1,                                <<U.RAO>>00998000
<< ACCOUNT NAME ERRORS >>                                      <<U.RAO>>01000000
   ACCTEXPECTALPHA = 550  ,                                    <<U.RAO>>01002000
   FANAMEBASE=ACCTEXPECTALPHA-1,                               <<U.RAO>>01004000
   ACCTNAMEMISSING = 551  ,                                    <<U.RAO>>01006000
   ACCTNAMETOOLONG = 552  ,                                    <<U.RAO>>01008000
   ACCTEXPECTNAMENOTAT= 553,                                   <<U.RAO>>01010000
<< LOCKWORD NAME ERRORS >>                                     <<U.RAO>>01012000
   LWDEXPECTALPHA  = 560  ,                                    <<U.RAO>>01014000
   FLWORDBASE=LWDEXPECTALPHA-1,                                <<U.RAO>>01016000
<< MISCELLANEOUS NAMING ERRORS >>                              <<U.RAO>>01018000
   UNKNOWNSYSDEF   = 580  ,                                    <<U.RAO>>01020000
   EXPECTPERIOD    = 581  ,                                    <<U.RAO>>01022000
   XPCTPERIODSLASH = 582  ,                                    <<U.RAO>>01024000
   EXTRANEOUSADESG = 583  ,                                    <<U.RAO>>01026000
<< USER NAME ERRORS >>                                         <<U.RAO>>01028000
   USEREXPECTALPHA = 590,                                      <<U.RAO>>01030000
   USERNAMEMISSING = 591,                                      <<U.RAO>>01032000
   USERNAMETOOLONG = 592,                                      <<U.RAO>>01034000
   OUTOFPCBS       = 629,  <<NO PCB, ETC. FOR CREATEPROCESS>>  <<01200>>01036000
   INVALIDPROG     = 630,  <<INVALID PROGRAM FILE>>            <<01200>>01038000
   BADENTRYPT      = 631,  <<UNKNOWN ENTRY POINT>>             <<01200>>01040000
   DFLTSTACK       = 632,  <<DEFAULT STACKSIZE USED>>          <<01200>>01042000
   DFLTDL          = 633,  <<DEFAULT DLSIZE USED>>             <<01200>>01044000
   DFLTMAXD        = 634,  <<DEFAULT MAXDATA USED>>            <<01200>>01046000
   DLRNDED         = 635,  <<DLSIZE ROUNDED TO 128 WRD MULT>>  <<01200>>01048000
   CONFMAXD        = 636,  <<CONFIGURATION MAXDATA USED>>      <<01200>>01050000
   STKRNDEDUP      = 637,  <<STACK SPACE SET TO CONF MAXDATA>> <<01200>>01052000
   STACKTOOBIG     = 638,  <<STACK SPACE > CONF MAXDATA>>      <<01200>>01054000
   APLTERM         = 658,  <<ERROR TRYING TO USE APL TERM>>    <<U.RAO>>01056000
<< ADDITIONAL ERRORS FOR :RUN COMMAND >>                       <<01200>>01058000
   BADSTDIN        = 684,  <<COULN'T OPEN $STDIN FOR :RUN>>    <<01200>>01060000
   BADSTDLIST      = 685,  <<COULN'T OPEN $STDLIST FOR :RUN>>  <<01200>>01062000
   OTHERCREATERR   = 686,  << GENERAL CREATEPROC. ERROR >>     <<01452>>01064000
                           << TO TRAP INTERNAL PROBLEMS.>>     <<01452>>01066000
<< ERRORS ON $STDIN >>                                         <<U.RAO>>01068000
   ERRSTDINIO     =  901,     <<I/O ERROR ON $STDIN>>          <<U.RAO>>01070000
<< DIRECTORY PROBLEMS >>                                       <<U.RAO>>01072000
   DIRIOERR        = 905,                                      <<U.RAO>>01074000
   DIRDUPLNAME     = 906,  <<DUPLICATE NAME>>                  <<U.RAO>>01076000
   DIRNOSUCHFILE   = 907,  <<NON-EXISTENT NAME>>               <<U.RAO>>01078000
   DIRNOSUCHGROUP  = 908,  <<NON-EXISTENT GROUP>>              <<U.RAO>>01080000
   DIRNOSUCHACCT   = 909,  <<NO SUCH ACCOUNT>>                 <<U.RAO>>01082000
   DIRNOSUCHUSER   = 910,  <<NON-EXISTENT USER>>               <<U.RAO>>01084000
   DIRNOSUCHVSD    = 911,  <<NON-EXISTENT VSD>>                <<U.RAO>>01086000
   DIRNOSUCHVSL    = 912,  <<NON-EXISTENT VSL>>                <<U.RAO>>01088000
   DIRNOSAVEGROUP  = 913,  <<NO GROUP SAVE ACCESS>>            <<U.RAO>>01090000
   DIRNOSAVEACCT   = 914,  <<NO ACCT SAVE ACCESS>>             <<U.RAO>>01092000
   DIROVERFLOW     = 915,  <<DIRECTORY OUT OF SPACE>>          <<U.RAO>>01094000
   DIRINUSE        = 916,  <<SOMETHING IN USE, CAN'T BE PURGED><<U.RAO>>01096000
   DIRGRPFSPACE    = 917,  <<WOULD EXCEED GROUP FILE SPACE>>   <<U.RAO>>01098000
   DIRACCTFSPACE   = 918,  <<WOULD EXCEED ACCOUNT FILE SPACE>> <<U.RAO>>01100000
<< ERRORS ON $STDLIST >>                                       <<U.RAO>>01102000
   ERRSTDLISTEOF  =  950,     <<EOF ON $STDLIST>>              <<U.RAO>>01104000
   ERRSTDLISTIO   =  951,     <<I/O ERROR ON $STDLIST>>        <<U.RAO>>01106000
<< CAPABILITY ERRORS >>                                        <<U.RAO>>01108000
   CAPREQ'OP'      = 955,  <<REQUIRES OP CAPABILITY>>          <<U.RAO>>01110000
   CAPREQ'SM'      = 956,  <<REQUIRES SM CAPABILITY>>          <<U.RAO>>01112000
   CAPREQ'AM'      = 957,  <<REQUIRES AM CAPABILITY>>          <<U.RAO>>01114000
   CAPREQSMORAM    = 958,  <<REQUIRES SM OR AM CAPABILITY>>    <<U.RAO>>01116000
   CAPREQ'CS'      = 959,  <<REQUIRES CS CAPABILITY>>          <<U.RAO>>01118000
   CAPREQUVORCV    = 960,  <<REQUIRES UV OR CV CAPABILITY>>    <<U.RAO>>01120000
   CAPREQ'CV'      = 961,  <<REQUIRES CV CAPABILITY>>          <<U.RAO>>01122000
   CAPREQ'PM'      = 962,  <<REQUIRES PM CAPABILITY>>          <<U.RAO>>01124000
   CAPREQ'IA'      = 963,  <<REQUIRES IA CAPABILITY>>          <<U.RAO>>01126000
   CAPREQ'BA'      = 964,  <<REQUIRES BA CAPABILITY>>          <<U.RAO>>01128000
   CAPREQ'SF'      = 965,  <<REQUIRES SF CAPABILITY>>          <<U.RAO>>01130000
   CAPREQ'LG'      = 966,  <<REQUIRES LOGGING CAPABILITY>>     <<00506>>01132000
   CAPREQSMOROP    = 967,  <<REQUIRES SM OR OP CAPABILITY>>    <<01724>>01134000
   ERRUNDEF        = 975, <<UNKNOWN COMMAND>>                  <<U.RAO>>01136000
   NOTINSESSION    = 977, <<NOT ALLOWED IN SESSION>>           <<U.RAO>>01138000
   NOTINJOB        = 978, <<NOT ALLOWED IN A JOB>>             <<U.RAO>>01140000
   NOTINUDC        = 979, <<NOT ALLOWED FROM WITHIN A UDC>>    <<01455>>01142000
   COMMAND'GT'BUFFER=980, <<COMMAND > 268 CHARACTERS>>         <<00287>>01144000
   NOCOLON         = 981, <<COMMAND LACKS LEADING COLON>>      <<U.RAO>>01146000
   BADSEQUENCEORDR = 982, <<COMMAND SEQNUM NOT NUMERIC OR BLANK<<01.RO>>01148000
   BADSEQUENCENUM  = 983, <<COMMAND SEQNUM OUT OF SEQUENCE>>   <<01.RO>>01150000
   NOTINBREAK      = 986, <<NOT ALLOWED IN BREAK>>             <<U.RAO>>01152000
   NOTYETIMPLEMENTED=987,                                      <<U.RAO>>01154000
   COMTOOMANYLINES = 988,  <<COMMAND HAS > 28 CONTINUATIONS>>  <<U.RAO>>01156000
   PGMABORT        = 989,  <<PROGRAM ABORTED BY USER>>         <<U.RAO>>01158000
   BRKINVLDRESP    = 990,  <<EXPECT "YES" OR "NO">>            <<U.RAO>>01160000
   NOABORTPARMS    = 991, << DISALLOW PARAMETERS WITH ABORT>>  <<01308>>01162000
<< 1000'S RESERVED FOR STORE/RESTORE >>                        <<U.RAO>>01164000
   STORE'FAILED    = 1090, << STORE FAILED >>                  <<04695>>01166000
<< 1100'S RESERVED FOR PRIVATE VOLUMES MESSAGES >>             <<U.RAO>>01168000
   <<1126-1135 RESERVED FOR IMPLICITMNT ERRORS>>               <<03.KM>>01170000
<< 1200'S RESERVED FOR USER LOGGING >>                         <<U.RAO>>01172000
<< 1300'S RESERVED FOR DS >>                                   <<U.RAO>>01174000
<< 1400'S RESERVED FOR STARTDEVICE (HELLO, JOB, DATA)>>        <<U.RAO>>01176000
<< 1500 - 1529 RESERVED FOR SHOWJOB >>                         <<U.RAO>>01178000
<< 1530 - 1579 RESERVED FOR SHOWIN AND SHOWOUT >>              <<U.RAO>>01180000
<< 1580 - 1589 RESERVED FOR SHOWDEV >>                         <<U.RAO>>01182000
<< 1590 - 1609 RESERVED FOR STREAM >>                          <<U.RAO>>01184000
<< TELL COMMAND >>                                             <<U.RAO>>01186000
   TELLINVSNUM     = 1611, <<INVALID SESSION NUMBER>>          <<U.RAO>>01188000
   TELLXPCTJORS    = 1612, <<EXPECT "J" OR "S">>               <<U.RAO>>01190000
   TELLXPCTJSORAT  = 1613, <<EXPECT "@J" OR "@S" OR "@">>      <<U.RAO>>01192000
   TELLJXPCTJUSTAT = 1614, <<JOB NAME CAN'T BE "@XX">>         <<U.RAO>>01194000
   TELLJNAME2LONG  = 1615, <<NAME > 8 CHARACTERS>>             <<U.RAO>>01196000
   TELLJXPCTALPHA  = 1616, <<JOB NAME MUST START WITH ALPHA>>  <<U.RAO>>01198000
   TELLXPCTPERIOD  = 1617, <<EXPECTED "." BETWEEN USER&ACCT>>  <<U.RAO>>01200000
   TELLJOBIDMISSIN = 1618, <<MISSING JOBID>>                   <<U.RAO>>01202000
   TELLNOSUCHJOBS  = 1619, <<NO MATCH ON JOBID>>               <<U.RAO>>01204000
   TELLSENDONLYTARGET                                          <<01652>>01206000
                   = 1620,  << ONLY TARGET IS SENDER >>        <<01652>>01208000
   TELLJOBINVALID  = 1627,     << TELL TO JOB INVALID>>        <<04208>>01210000
<< TELLOP COMMAND >>                                           <<U.RAO>>01212000
   TELLOPMSGPROBLEM= 1626,<<PROBLEM WITH GENMSG>>              <<U.RAO>>01214000
<< PTAPE COMMAND >>                                            <<U.RAO>>01216000
   PTAPE2MP        = 1630, <<PTAPE MORE THAN 1 PARAMETER>>     <<U.RAO>>01218000
   PTAPENOFILE     = 1631, <<NO TARGET FILE WAS SPECIFIED>>    <<U.RAO>>01220000
   PTAPEOPENFAILED = 1632, <<UNABLE TO OPEN DISC FILE>>        <<U.RAO>>01222000
   PTAPEFSERR      = 1633, <<READ ERROR ON PAPER TAPE>>        <<U.RAO>>01224000
   PTAPETOFSERR    = 1634, <<WRITE ERROR ON DISC FILE>>        <<U.RAO>>01226000
   PTAPECLOSEERR   = 1635, <<UNABLE TO CLOSE DISC FILE>>       <<U.RAO>>01228000
   PTAPETERMFILE   = 1636, <<TERMINAL IO ERROR>>               <<U.RAO>>01230000
<< SPEED COMMAND >>                                            <<U.RAO>>01232000
   SPEED2MP        = 1640, <<MORE THAN 2 PARAMETERS FOR SPEED>><<U.RAO>>01234000
   SPEEDNOTENUF    = 1641, <<NEITHER INPUT NOR OUTPUT SPEEDS>> <<U.RAO>>01236000
   ERRINSPEED      = 1642,<<ILLEGAL INPUT SPEED>>              <<U.RAO>>01238000
   ERROUTSPEED     = 1643,<<ILLEGAL OUTPUT SPEED>>             <<U.RAO>>01240000
   NOTVER          = 1644,<<SPEED CHANGE NOT VERIFIED>>        <<U.RAO>>01242000
   SPEEDINEQUALOUT = 1645,  <<WARN. IN = OUT. SERIES 33>>      <<0306>> 01244000
   SPEEDNOTEQUAL   = 1646,  <<IN MUST EQUAL OUT. SERIES 33>>   <<0306>> 01246000
<< SHOWQ COMMAND >>                                            <<U.RAO>>01248000
   WARNXPARMSIGNORED=1670, <<COMMAND HAS NO PARMS, PARMS IGNORE<<U.RAO>>01250000
<< EOD COMMAND >>                                              <<U.RAO>>01252000
      BADLOGONSTRING = 1684,  << BAD HELLO/JOB/DATA >>         <<02329>>01254000
   IGNORED         = 1685,<<:EOD IGNORED>>                     <<U.RAO>>01256000
<< RESUME COMMAND >>                                           <<U.RAO>>01258000
   ONLYINBREAK     = 1686,<<ONLY ALLOWED IN BREAK>>            <<U.RAO>>01260000
<< GETRIN AND FREERIN COMMANDS >>                              <<U.RAO>>01262000
   GETRINNOPASS    = 1690, <<NO RIN PASSWORD SUPPLIED>>        <<U.RAO>>01264000
   FREERINNORIN    = 1691, <<NO RIN NUMBER TO FREERIN>>        <<U.RAO>>01266000
   RINTABFULL      = 1692, <<RIN TABLE FULL>>                  <<U.RAO>>01268000
   RINNOTAL        = 1693, <<RIN NOT ALLOCATED, CAN'T BE FREED><<U.RAO>>01270000
   RININUSE        = 1694, <<RIN IN USE, CAN'T DEALLOCATE>>    <<U.RAO>>01272000
   RININVINT       = 1695, <<BAD INTEGER AS RIN NUMBER>>       <<U.RAO>>01274000
   RINPASS2LONG    = 1696, << PASSWORD LONGER THEN 8 CHARS>>   <<02367>>01276000
   RINPASSSPECHAR  = 1697, << " " CONTAINS SPECIAL CHARS  >>   <<02367>>01278000
   RINPASSTALPHA   = 1698, << MUST START W. ALPHA CHAR. >>     <<02367>>01280000
<< SETJCW COMMAND >>                                           <<U.RAO>>01282000
   SETJCWNONAME    = 1710, <<JCW NAME NOT FOUND>>              <<U.RAO>>01284000
   SETJCWNOVALUE   = 1711, <<VALUE NOT PRESENT>>               <<U.RAO>>01286000
   SETJCWNUM2LARGE = 1712, <<EXCEEDS 65535>>                   <<U.RAO>>01288000
   SETJCWINVOCTDGT = 1713, <<FOUND 8 OR 9>>                    <<U.RAO>>01290000
   SETJCWOKVAL2BIG = 1714, <<MAX OK IS 65535>>                 <<U.RAO>>01292000
   SETJCWWARNVAL   = 1715, <<MAX WARN IS 49151>>               <<U.RAO>>01294000
   SETJCWFATALVAL  = 1716, <<MAX FATAL IS 32767>>              <<U.RAO>>01296000
   SETJCWSYSTEMVAL = 1717, <<MAX SYSTEM IS 16383>>             <<U.RAO>>01298000
   SETJCWNAME2LONG = 1718, <<NAME > 255 CHAR.>>                <<U.RAO>>01300000
   SETJCWNAMENOALP = 1719, <<NO LEADING ALPHA>>                <<U.RAO>>01302000
   SETJCWNOSUCHJCW = 1720, <<VALUE JCW DOES NOT EXIST>>        <<U.RAO>>01304000
   SETJCW2MP       = 1721, <<EXTRANEOUS PARM TO SETJCW>>       <<U.RAO>>01306000
   JCWTABOVERFLOW  = 1722, <<JDT OVERFLOW>>                    <<U.RAO>>01308000
   SETJCWFATINUDC  = 1723, << UDC MAY FLUSH. >>                <<01893>>01310000
   SETJCWFATINJOB  = 1724, << JOB MAY FLUSH. >>                <<01893>>01312000
   SETJCWUNKNOWN   = 1725, << EXTRANEOUS CHAR >>               <<04708>>01314000
   SETJCWNAMERESV  = 1725, <<NAME HAS A RESERVED JCW MEANING>> <<04688>>01316000
<< SHOWJCW COMMAND >>                                          <<U.RAO>>01318000
   SHOWJCW2MP      = 1730, <<EXTRANEOUS PARM TO SHOWJCW>>      <<U.RAO>>01320000
   SHOWJCWNOSCHJCW = 1731, <<JCW NAMED NOT FOUND>>             <<U.RAO>>01322000
<< IF, ELSE, ENDIF COMMANDS >>                                 <<U.RAO>>01324000
   IFXPCTRELATION  = 1735, <<REST OF RELATIONAL MISSING>>      <<U.RAO>>01326000
   IFXPCTRELOP     = 1736, <<EXPECTED RELATIONAL OPERATOR>>    <<U.RAO>>01328000
   IFNOSUCHJCW     = 1737, <<JCW UNDEFINED>>                   <<U.RAO>>01330000
   IFXPCTJCWVAL    = 1738, <<EXPECTED A SECOND JCW>>           <<U.RAO>>01332000
   IFXPCTCLOSPAREN = 1739, <<EXPECTED A MATCHING ")">>         <<U.RAO>>01334000
   IFNOPARMS       = 1740, <<NO PARMS TO IF COMMAND>>          <<U.RAO>>01336000
   IFNOTHEN        = 1741, <<NO THEN FOUND>>                   <<U.RAO>>01338000
   IFEXTRANEOUS    = 1742, <<EXTRANEOUS PARMS TO IF>>          <<U.RAO>>01340000
   IFNESTINGTOOGREAT=1743, <<GT 15 LEVELS OF IF'S>>            <<U.RAO>>01342000
   ELSE2MP         = 1744, <<ELSE HAS NO PARMS>>               <<U.RAO>>01344000
   ELSEUNPAIRED    = 1745, <<UNPAIRED ELSE FOUND>>             <<U.RAO>>01346000
   ENDIF2MP        = 1746, <<ENDIF HAS NO PARMS>>              <<U.RAO>>01348000
   ENDIFUNPAIRED   = 1747, <<UNPAIRED IF FOUND>>               <<U.RAO>>01350000
   ELSE2MANYELSES  = 1748, <<REDUNDANT IF FOUND>>              <<U.RAO>>01352000
   IFS'NEQ'ENDIFS  = 1749, <<IFS <> ENDIFS WHEN EXITING BREAK>><<00835>>01354000
<< REDO COMMAND >>                                             <<U.RAO>>01356000
   REDOITOOLONG    = 1755, <<EXCEEDS MAX BUF LENGTH>>          <<U.RAO>>01358000
   REDODELGARBAGE  = 1756, <<GARBAGE IN DELETE FIELD>>         <<U.RAO>>01360000
<< HELP MESSAGES >>                                            <<01.EB>>01362000
   HELPOFFSET      =1751, << HELP RETURNS 50-60 >>             <<01.EB>>01364000
   OPENCATFAIL     = 1800,                                     <<01.EB>>01366000
   HELPTERMINATED  = 1801,                                     <<01.EB>>01368000
<< 1900 - 1999 RESERVED FOR USER DEFINED COMMANDS (UDC) >>     <<09.EB>>01370000
<< 3000-4000 ARE RESERVED FOR OPERATOR COMMANDS>>              <<00552>>01372000
                                                               <<00552>>01374000
OPCOMNOTALLOW=3000,      <<OPERATOR COMMAND IS NOT ALLOWED>>   <<00552>>01376000
   SPECIALCOM=3800,         <<ONLY RECALL,REPLY & RESUME ALLOWE<<00594>>01378000
   UDCSTACKOVRFLOW   = 1907,  <<STACK OVERFLOW WHILE>>         <<08.RO>>01380000
<< System Internal Errors.  Alternatives to SUDDENDEATH. >>    <<04193>>01382000
   COPYSCREEN         = 1,   << Request to send in screen. >>  <<04193>>01384000
   STATUS'AND'P       = 2,   << Reports caller's stack parms. ><<04193>>01386000
   PRINTCARETERR      = 101, << PRINTCARET bounds error. >>    <<04193>>01388000
                                                               <<04193>>01390000
      <<DST ENTRIES USED THROUGHOUT>>                                   01392000
                                                                        01394000
      JMATDST=25,                                                       01396000
                                                               <<00851>>01398000
      DISABLEBREAK = 14,                                       <<00851>>01400000
                                                                        01402000
     <<TABLE LENGTHS USED THROUGHOUT>>                                  01404000
                                                                        01406000
     JMATLEN=26,                                                        01408000
                                                                        01410000
      <<SIRS USED THROUGHOUT>>                                          01412000
                                                                        01414000
                                                                        01416000
      <<WORDS/FLAGS>>                                                   01418000
                                                                        01420000
   JMATTIMESTAMP   = 19,  <<OFFSET IN JMAT ENTRY OF TIME STAMP><<U.RAO>>01422000
JMATSEQUENCE = 24,  <<OFFSET IN JMAT TO SEQUENCED BIT>>        <<01.RO>>01424000
   JITCPUTIME      = 50,  <<DOUBLE IN JIT FO JOB CPU TIME>>    <<U.RAO>>01426000
JITALLOW=40,         <<ALLOW TABLE >>                          <<00552>>01428000
JITALLOW'L=3,        <<ALLOW TABLE LENGTH>>                    <<00552>>01430000
      WELCOMEDST = %1277,                                               01432000
   SYSUDCFLAG=%1376,      <<SYSTEM LEVEL UDC FLAG>>            <<00416>>01434000
   SYSVERSION      = %1116,  <<MPE VERSION LETTER>>            <<U.RAO>>01436000
   SYSUPDATE       = %1114,  <<MPE UPDATE LEVEL (ASCII)>>      <<U.RAO>>01438000
   SYSFIX          = %1115,  <<MPE FIX LEVEL>>                 <<U.RAO>>01440000
      PXGWATTRIBUTE = 2 ,                                               01442000
      PXFWBREAK = 32 ,                                                  01444000
      PXFWQINIT=3,   <<OFFSET IN PCBX OF QINIT VALUE>>         <<U.RAO>>01446000
      PXFCPUTIME   = 24,   <<OFFSET TO CPUTIME DOUBLE>>        <<U.RAO>>01448000
      PXFUDC       = 22,   <<UDC FLAG>>                        <<U.RAO>>01450000
      PXGWFLAGS = 6,                                                    01452000
      PXGWJMATX=3,                                                      01454000
      PXGWJDT = 5,                                                      01456000
      PXGWJIT = 6,                                                      01458000
      PXGWJOBIN = 3 ,                                                   01460000
      CPCB = 4,                                                         01462000
      PCBB = 3,                                                         01464000
      PCBSIZE = 16,                                                     01466000
      PCBJSMAIN=2,  <<JOB/SESSION MAIN PROCESS TYPE IN PCB>>   <<U.RAO>>01468000
      PXFWRESOURCE = 5,                                                 01470000
      PXGWJOBLIST = 4;                                                  01472000
                                                                        01474000
      <<DEFINES USED THROUGHOUT>>                                       01476000
                                                                        01478000
      <<CODE DEFINITIONS>>                                              01480000
                                                                        01482000
      DEFINE                                                            01484000
      DISABLE=ASSEMBLE(SED 0)#,                                         01486000
      ENABLE=ASSEMBLE(SED 1)#,                                          01488000
      CC = STATUS . (6:2)#,                                             01490000
      NEXTLINE=ASSEMBLE (ZERO,DZRO);                           <<01881>>01492000
               PRINT (*, *, *)#,                               <<01881>>01494000
                                                               <<01709>>01496000
      PCBNUM = ((ABSOLUTE(CPCB)-ABSOLUTE(PCBB))/PCBSIZE)#,              01498000
      PCB09=ABSOLUTE(ABSOLUTE(CPCB)+9)#,  <<WORD 9 OF CURRENT P<<U.RAO>>01500000
      PCBPTYPE=(6:3)#,  <<PROCESS TYPE FIELD IN PCB09>>        <<U.RAO>>01502000
      SETXPXGLOB=PUSH (DL);                                             01504000
                 X := TOS -PS0 (-1)#,                                   01506000
      SETXPXFIXED=PUSH(DL);                                             01508000
                  X := TOS - PS0(-2) #,                                 01510000
      SETJIT=PUSH(DL);                                                  01512000
             TOS:=ARRDB6(TOS-PS0(-1)).(6:10)#,                          01514000
<<        DEF'MOVEFROMDSEG          >>                         <<U.RAO>>01516000
<< To use, declare SUBROUTINE DEF'MOVEFROMDSEG >>              <<U.RAO>>01518000
   DEF'MOVEFROMDSEG =                                          <<U.RAO>>01520000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                  <<U.RAO>>01522000
         VALUE TARGET,DSTN,OFFSET,COUNT;                       <<U.RAO>>01524000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                     <<U.RAO>>01526000
      BEGIN                                                    <<U.RAO>>01528000
         X := TOS; << SAVE RETURN ADDRESS >>                   <<U.RAO>>01530000
         ASSEMBLE(MFDS 0);                                     <<U.RAO>>01532000
         TOS := X; << RESTORE RETURN ADDRESS >>                <<U.RAO>>01534000
      END #,                                                   <<U.RAO>>01536000
                                                               <<U.RAO>>01538000
      << FIELDS/FLAGS>>                                                 01540000
                                                                        01542000
      PXGFJOBTYPE = 2:2 #,                                              01544000
      PXGFDUP  = 4:1 #,                                                 01546000
      PXGFINTER = 5:1 #,                                                01548000
                                                                        01550000
<<TEST FOR INTERACTIVE USER.  LEAVES TRUE ON TOS IF>>          <<02.RO>>01552000
<<USER WAS INTERACTIVE.  GETS IT FROM PXGLOB>>                 <<02.RO>>01554000
                                                               <<02.RO>>01556000
INTERACTIVETEST =   SETXPXGLOB+PXGWFLAGS;                      <<02.RO>>01558000
                    TOS := ARRDB0(X).(PXGFINTER)#,             <<02.RO>>01560000
                                                               <<02.RO>>01562000
<<DELIMITER ARRAY DECLARATIONS>>                               <<U.RAO>>01564000
                                                               <<U.RAO>>01566000
COMMASEMICR = [8/",",8/";",8/%15,8/0]D#,                       <<U.RAO>>01568000
                                                               <<U.RAO>>01570000
      <<EXECUTOR PROCEDURE HEADING>>                                    01572000
                                                                        01574000
      EXECUTORHEAD =                                                    01576000
      (PARMSP,ERRNUM,PARMNUM);                                          01578000
      BYTE ARRAY PARMSP;                                                01580000
      INTEGER ERRNUM,PARMNUM #;                                << I.A >>01582000
$PAGE   "EXTERNAL DECLARATIONS"                                         01584000
<<                                                                      01586000
   EXTERNAL MPE INTRINSICS                                              01588000
                           >>                                           01590000
   PROCEDURE DATE'LINE(STRING);                                <<0U.EB>>01592000
      BYTE ARRAY STRING; OPTION EXTERNAL;                      <<0U.EB>>01594000
                                                               <<0U.EB>>01596000
INTRINSIC ZSIZE;                                               << I.A >>01598000
                                                               <<00.EB>>01600000
INTRINSIC SETJCW,FCONTROL;                                     << I.A >>01602000
   LOGICAL PROCEDURE BINARY (STRING, LENGTH);                           01604000
   VALUE LENGTH;                                                        01606000
   BYTE ARRAY STRING;                                                   01608000
   INTEGER LENGTH;                                                      01610000
   OPTION EXTERNAL;                                                     01612000
                                                                        01614000
   INTEGER PROCEDURE EXCHANGEDB(DSTNO);                                 01616000
   VALUE DSTNO;                                                         01618000
   INTEGER DSTNO;                                                       01620000
   OPTION EXTERNAL;                                                     01622000
                                                                        01624000
   DOUBLE PROCEDURE DBINARY(STRING,LENGTH);                             01626000
   VALUE LENGTH;                                                        01628000
   BYTE ARRAY STRING;  INTEGER LENGTH;                                  01630000
   OPTION EXTERNAL;                                                     01632000
                                                                        01634000
   INTEGER PROCEDURE ASCII (WORD, BASE, STRING);                        01636000
   VALUE WORD, BASE;                                                    01638000
   LOGICAL WORD;                                                        01640000
   INTEGER BASE;                                                        01642000
   BYTE ARRAY STRING;                                                   01644000
   OPTION EXTERNAL;                                                     01646000
                                                                        01648000
   INTEGER PROCEDURE READ (STRING, EXPECTEDL);                          01650000
   VALUE EXPECTEDL;                                                     01652000
   ARRAY STRING;                                                        01654000
   INTEGER EXPECTEDL;                                                   01656000
   OPTION EXTERNAL;                                                     01658000
                                                                        01660000
   PROCEDURE PRINT (STRING, LENGTH, TYPE);                              01662000
   VALUE LENGTH, TYPE;                                                  01664000
   ARRAY STRING;                                                        01666000
   INTEGER LENGTH;                                                      01668000
   LOGICAL TYPE;                                                        01670000
   OPTION EXTERNAL;                                                     01672000
                                                                        01674000
   INTEGER PROCEDURE SEARCH (TARGET, LENGTH, DICT, DEFN);               01676000
   VALUE LENGTH;                                                        01678000
   BYTE ARRAY TARGET, DICT;                                             01680000
   INTEGER LENGTH;                                                      01682000
   BYTE POINTER DEFN;                                                   01684000
   OPTION EXTERNAL, VARIABLE;                                           01686000
                                                               <<01.01>>01688000
PROCEDURE CLEAN'MESSAGE(MSG,LEN);                              <<01.01>>01690000
VALUE LEN;                                                     <<01.01>>01692000
INTEGER LEN;                                                   <<01.01>>01694000
BYTE ARRAY MSG;                                                <<U.RAO>>01696000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<01.01>>01698000
                                                                        01700000
   PROCEDURE DEBUG;                                                     01702000
   OPTION EXTERNAL;                                                     01704000
                                                                        01706000
   INTEGER PROCEDURE MYCOMMAND                                          01708000
   (COMIMAGE,DELIMS,MAXPARMS,NUMPARMS,PARMS,DICT,DEFN);                 01710000
   VALUE MAXPARMS;                                                      01712000
   BYTE ARRAY COMIMAGE,DELIMS,DICT;                                     01714000
   INTEGER MAXPARMS, NUMPARMS;                                          01716000
   DOUBLE ARRAY PARMS;                                                  01718000
   BYTE POINTER DEFN;                                                   01720000
   OPTION VARIABLE,EXTERNAL;                                            01722000
                                                                        01724000
   PROCEDURE WHO(MODE,CAP,LATTR,USERN,GROUPN,ACCTN,HOMEN,TERMNUM);      01726000
   LOGICAL MODE;                                                        01728000
   DOUBLE CAP,LATTR;                                                    01730000
   BYTE ARRAY USERN,GROUPN,ACCTN,HOMEN;                                 01732000
   LOGICAL TERMNUM;                                                     01734000
   OPTION VARIABLE,EXTERNAL;                                            01736000
                                                                        01738000
   LOGICAL PROCEDURE PARSE'DENSITY(PARM,PARMLEN,DEN'VALUE);    <<02569>>01740000
   VALUE PARMLEN;                                              <<02569>>01742000
   INTEGER DEN'VALUE,PARMLEN;                                  <<02569>>01744000
   BYTE ARRAY PARM;                                            <<02569>>01746000
   OPTION EXTERNAL;                                            <<02569>>01748000
                                                               <<02569>>01750000
   INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS, AOPTIONS, RECSIZE, 01752000
   DEVICE, FORMMSG, RECMODE, BLOCKFACTOR, NUMBUFFERS, FILESIZE,         01754000
   NUMEXTENTS, INITALLOC, FILECODE);                                    01756000
   VALUE FOPTIONS, AOPTIONS, RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, 01758000
   FILESIZE, NUMEXTENTS, INITALLOC, FILECODE;                           01760000
   BYTE ARRAY FILEDESIGNATOR,  DEVICE, FORMMSG;                         01762000
   LOGICAL FOPTIONS, AOPTIONS;                                          01764000
   INTEGER RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, NUMEXTENTS,       01766000
   INITALLOC, FILECODE;                                                 01768000
   DOUBLE FILESIZE;                                                     01770000
   OPTION VARIABLE, EXTERNAL;                                           01772000
                                                               <<00098>>01774000
   PROCEDURE FCLOSE (FILENUM, DISPOSITION, SECCODE);                    01776000
   VALUE FILENUM, DISPOSITION, SECCODE;                                 01778000
   INTEGER FILENUM, DISPOSITION, SECCODE;                               01780000
   OPTION EXTERNAL;                                                     01782000
                                                                        01784000
   PROCEDURE FWRITE(FNUM,TARGET,COUNT,CONT);                            01786000
   VALUE FNUM,COUNT,CONT;                                               01788000
   INTEGER FNUM,COUNT,CONT;                                             01790000
   ARRAY TARGET;                                                        01792000
   OPTION EXTERNAL;                                                     01794000
                                                                        01796000
   PROCEDURE FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);             01798000
   VALUE FILENUM;                                                       01800000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              01802000
   DOUBLE BLKNUM;                                                       01804000
   OPTION VARIABLE,EXTERNAL;                                            01806000
                                                                        01808000
   PROCEDURE FGETINFO                                                   01810000
   (FNUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,DEVTYPE,LDNUM,HDADDR,       01812000
    FILECODE,RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,BLKSIZE,EXTSIZE,       01814000
    NUMEXTENTS,USERLABELS,CREATORID,LABADDR);                           01816000
   VALUE FNUM;                                                          01818000
   INTEGER FNUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,USERLABELS; 01820000
   BYTE ARRAY FILENAME,CREATORID;                                       01822000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      01824000
   DOUBLE RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,LABADDR;                  01826000
   OPTION VARIABLE,EXTERNAL;                                            01828000
                                                                        01830000
   PROCEDURE FBREAK;                                                    01832000
   OPTION EXTERNAL;                                                     01834000
                                                                        01836000
   PROCEDURE FRESETEOF;                                                 01838000
   OPTION EXTERNAL;                                                     01840000
                                                                        01842000
   PROCEDURE FUNBREAK(DONOTREADFLAG);                                   01844000
   VALUE DONOTREADFLAG;                                                 01846000
   LOGICAL DONOTREADFLAG;                                               01848000
   OPTION EXTERNAL;                                                     01850000
                                                                        01852000
                                                               <<02318>>01854000
LOGICAL PROCEDURE SETCRITICAL;                                 <<02318>>01856000
OPTION EXTERNAL;                                               <<02318>>01858000
                                                                        01860000
   PROCEDURE RESETCRITICAL(PARM);                                       01862000
   VALUE PARM; LOGICAL PARM;                                            01864000
   OPTION EXTERNAL;                                                     01866000
                                                                        01868000
   LOGICAL PROCEDURE CALENDAR;                                          01870000
   OPTION EXTERNAL;                                                     01872000
                                                                        01874000
   DOUBLE PROCEDURE CLOCK;                                              01876000
   OPTION EXTERNAL;                                                     01878000
                                                                        01880000
   PROCEDURE TERMINATE;                                                 01882000
   OPTION EXTERNAL;                                                     01884000
                                                                        01886000
PROCEDURE FINDJCW(JCW, JCWVALUE, ERROR);                       <<U.RAO>>01888000
BYTE ARRAY JCW;                                                <<U.RAO>>01890000
LOGICAL JCWVALUE;                                              <<01461>>01892000
INTEGER ERROR;                                                 <<01461>>01894000
OPTION EXTERNAL;                                               <<U.RAO>>01896000
                                                               <<U.RAO>>01898000
PROCEDURE PUTJCW(JCW, JCWVALUE, ERROR);                        <<U.RAO>>01900000
BYTE ARRAY JCW;                                                <<U.RAO>>01902000
LOGICAL JCWVALUE;                                              <<01461>>01904000
INTEGER ERROR;                                                 <<01461>>01906000
OPTION EXTERNAL;                                               <<U.RAO>>01908000
                                                               <<U.RAO>>01910000
   LOGICAL PROCEDURE GETSIR (N);                                        01912000
   VALUE N;                                                             01914000
   LOGICAL N;                                                           01916000
   OPTION EXTERNAL;                                                     01918000
                                                                        01920000
   PROCEDURE RELSIR (N,T);                                              01922000
   VALUE N, T;                                                          01924000
   LOGICAL N, T;                                                        01926000
   OPTION EXTERNAL;                                                     01928000
                                                                        01930000
   PROCEDURE PTAPE(TF,DF);                                              01932000
   VALUE TF,DF;                                                         01934000
   INTEGER TF,DF;                                                       01936000
   OPTION EXTERNAL;                                                     01938000
                                                                        01940000
   DOUBLE PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);01942000
   VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     01944000
   INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                   01946000
   OPTION EXTERNAL;                                                     01948000
                                                                        01950000
   INTEGER PROCEDURE ALLORIN(RCODE,UNAM,PASS);                          01952000
   VALUE RCODE;                                                         01954000
   INTEGER RCODE;                                                       01956000
   ARRAY UNAM,PASS;                                                     01958000
   OPTION VARIABLE,EXTERNAL;                                            01960000
                                                                        01962000
   PROCEDURE DEALLORIN(RIN,UNAM);                                       01964000
   VALUE RIN;                                                           01966000
   INTEGER RIN;                                                         01968000
   ARRAY UNAM;                                                          01970000
   OPTION VARIABLE,EXTERNAL;                                            01972000
                                                                        01974000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<0U.EB>>01976000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>01978000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<0U.EB>>01980000
      DST,IOTYPE;                                              <<0U.EB>>01982000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<0U.EB>>01984000
      DST,IOTYPE;                                              <<0U.EB>>01986000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>01988000
                                                               <<U.RAO>>01990000
LOGICAL PROCEDURE PARSEJOBID(JOBID, RESULT);                   <<U.RAO>>01992000
BYTE ARRAY JOBID;                                              <<U.RAO>>01994000
INTEGER ARRAY RESULT;                                          <<U.RAO>>01996000
OPTION EXTERNAL;                                               <<U.RAO>>01998000
                                                               <<U.RAO>>02000000
LOGICAL PROCEDURE SCANJMAT(NEXTINDEX, JOBID, RESULT);          <<U.RAO>>02002000
INTEGER NEXTINDEX;                                             <<U.RAO>>02004000
INTEGER ARRAY JOBID;                                           <<U.RAO>>02006000
INTEGER ARRAY RESULT;                                          <<U.RAO>>02008000
OPTION EXTERNAL;                                               <<U.RAO>>02010000
                                                                        02012000
   INTEGER PROCEDURE ERRORGET(L);                                       02014000
   VALUE L;                                                             02016000
   INTEGER L;                                                           02018000
   OPTION EXTERNAL;                                                     02020000
                                                                        02022000
   PROCEDURE ERRORON;                                                   02024000
   OPTION EXTERNAL;                                                     02026000
                                                                        02028000
   PROCEDURE ABORTPROG;                                                 02030000
   OPTION EXTERNAL;                                                     02032000
                                                                        02034000
   PROCEDURE ERROREXIT(INTRINEXIT,ERRBYTES,PARAM);                      02036000
   VALUE INTRINEXIT,ERRBYTES,PARAM;                                     02038000
   LOGICAL INTRINEXIT,ERRBYTES,PARAM;                                   02040000
   OPTION EXTERNAL;                                                     02042000
                                                                        02044000
   DOUBLE PROCEDURE CHEK(INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK);          02046000
   VALUE INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK;                           02048000
   LOGICAL INTRIN,FLAGS,OPTVMASK;                                       02050000
   DOUBLE PARMS,CAPMASK;                                                02052000
   OPTION VARIABLE,EXTERNAL;                                            02054000
                                                               <<02.EB>>02056000
INTEGER PROCEDURE FORMNAME(TYPE,TARGET,BA1,BA2,BA3,BA4);       <<02.EB>>02058000
   VALUE TYPE; INTEGER TYPE;                                   <<02.EB>>02060000
   BYTE ARRAY TARGET,BA1,BA2,BA3,BA4; OPTION EXTERNAL;         <<02.EB>>02062000
                                                               <<02.EB>>02064000
PROCEDURE INITJSMP(EXPCODE); INTEGER EXPCODE;                  <<02.EB>>02066000
   OPTION EXTERNAL;                                            <<02.EB>>02068000
                                                                        02070000
PROCEDURE FMTDATE(CALENDAR',CLOCK',USERID);                    <<U.RAO>>02072000
VALUE CALENDAR', CLOCK';                                       <<U.RAO>>02074000
LOGICAL CALENDAR';                                             <<U.RAO>>02076000
DOUBLE CLOCK';                                                 <<U.RAO>>02078000
BYTE ARRAY USERID;                                             <<U.RAO>>02080000
OPTION EXTERNAL;                                               <<U.RAO>>02082000
                                                               <<U.RAO>>02084000
   PROCEDURE SUDDENDEATH(ERRORNUMBER);                                  02086000
   VALUE ERRORNUMBER;                                                   02088000
   INTEGER ERRORNUMBER;                                                 02090000
   OPTION EXTERNAL;                                                     02092000
                                                                        02094000
   PROCEDURE CXRESTORE                                                  02096000
   EXECUTORHEAD;                                                        02098000
   OPTION EXTERNAL;                                                     02100000
                                                               <<04695>>02102000
   PROCEDURE CXSTORENEW EXECUTORHEAD;                          <<04695>>02104000
            OPTION EXTERNAL;                                   <<04695>>02106000
                                                                        02108000
   PROCEDURE CXSTORE                                                    02110000
   EXECUTORHEAD;                                                        02112000
   OPTION EXTERNAL;                                                     02114000
                                                                        02116000
PROCEDURE CXSHOWALLOW EXECUTORHEAD;                            <<00894>>02118000
OPTION EXTERNAL;                                               <<00894>>02120000
                                                               <<00894>>02122000
   PROCEDURE CXSHOWJOB EXECUTORHEAD;                                    02124000
   OPTION EXTERNAL;                                                     02126000
                                                                        02128000
   PROCEDURE CXSHOWIN EXECUTORHEAD;                                     02130000
   OPTION EXTERNAL;                                                     02132000
                                                                        02134000
   PROCEDURE CXSET EXECUTORHEAD;                                        02136000
   OPTION EXTERNAL;                                                     02138000
                                                                        02140000
   PROCEDURE CXSHOWOUT EXECUTORHEAD;                                    02142000
   OPTION EXTERNAL;                                                     02144000
                                                                        02146000
   PROCEDURE CXSHOWDEV EXECUTORHEAD;                                    02148000
   OPTION EXTERNAL;                                                     02150000
                                                                        02152000
   PROCEDURE CXSTREAM EXECUTORHEAD;                                     02154000
   OPTION EXTERNAL;                                                     02156000
LOGICAL PROCEDURE CILOGTABLE(CODE,JMATP,CNTWORD,COMMAND);    <<A00.04>> 02158000
   VALUE CODE,JMATP;                                          <<A00.04>>02160000
   INTEGER CODE,JMATP,CNTWORD;                                <<A00.04>>02162000
   INTEGER ARRAY COMMAND;                                     <<A00.04>>02164000
   OPTION EXTERNAL;                                           <<A00.04>>02166000
                                                               <<RH.PV>>02168000
INTEGER PROCEDURE GET'DSDEVICE( LDEV );                        <<02848>>02170000
   VALUE   LDEV;                                               <<02848>>02172000
   INTEGER LDEV;                                               <<02848>>02174000
   OPTION  PRIVILEGED, UNCALLABLE, EXTERNAL;                   <<02848>>02176000
                                                               <<02848>>02178000
PROCEDURE MOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,GEN,           <<00211>>02180000
                 PVINFO,SOME'OTHER'PIN);                       <<00211>>02182000
   VALUE GEN,SOME'OTHER'PIN;                                   <<00211>>02184000
   INTEGER REQTYPE,GEN,PVINFO,SOME'OTHER'PIN;                  <<00211>>02186000
   BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                          <<RH.PV>>02188000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>02190000
                                                               <<RH.PV>>02192000
PROCEDURE DISMOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,            <<00211>>02194000
                    MVTABX,SOME'OTHER'PIN);                    <<00211>>02196000
   VALUE MVTABX,SOME'OTHER'PIN;                                <<00211>>02198000
   INTEGER REQTYPE,MVTABX,SOME'OTHER'PIN;                      <<00211>>02200000
   BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                          <<RH.PV>>02202000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>02204000
                                                               <<RH.PV>>02206000
INTEGER PROCEDURE VSUSERCOM(REQTYPE,NUMPARMS,VSNAME);          <<RH.PV>>02208000
   VALUE REQTYPE,NUMPARMS;                                     <<RH.PV>>02210000
   INTEGER REQTYPE,NUMPARMS;                                   <<RH.PV>>02212000
   BYTE ARRAY VSNAME;                                          <<RH.PV>>02214000
   OPTION EXTERNAL;                                            <<RH.PV>>02216000
                                                               <<RH.PV>>02218000
INTEGER PROCEDURE DSTATCOM(REQTYPE,LDEV);                      <<RH.PV>>02220000
   VALUE REQTYPE,LDEV;                                         <<RH.PV>>02222000
   INTEGER REQTYPE,LDEV;                                       <<RH.PV>>02224000
   OPTION EXTERNAL;                                            <<RH.PV>>02226000
                                                               <<RH.PV>>02228000
PROCEDURE INITUDC( SHOW, COMFN );                              <<03737>>02230000
   VALUE    SHOW, COMFN;                                       <<03737>>02232000
   LOGICAL  SHOW;                                              <<03737>>02234000
   INTEGER  COMFN;                                             <<03737>>02236000
   OPTION   VARIABLE, EXTERNAL;                                <<03737>>02238000
                                                               <<06.EB>>02240000
LOGICAL PROCEDURE UDC(COMIMAGE,OFFSET);                        <<06.EB>>02242000
   VALUE OFFSET; INTEGER OFFSET;                               <<06.EB>>02244000
   BYTE ARRAY COMIMAGE; OPTION EXTERNAL;                       <<06.EB>>02246000
                                                               <<06.EB>>02248000
PROCEDURE CXSETCATALOG EXECUTORHEAD;                           <<06.EB>>02250000
   OPTION EXTERNAL;                                            <<06.EB>>02252000
                                                               <<06.EB>>02254000
PROCEDURE CXSHOWCATALOG EXECUTORHEAD;                          <<06.EB>>02256000
   OPTION EXTERNAL;                                            <<06.EB>>02258000
PROCEDURE CXALTLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>02260000
PROCEDURE CXLISTLOG EXECUTORHEAD; OPTION EXTERNAL;             <<00506>>02262000
PROCEDURE CXSHOWLOGSTATUS EXECUTORHEAD; OPTION EXTERNAL;       <<00506>>02264000
PROCEDURE CXGETLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>02266000
PROCEDURE CXRELLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>02268000
                                                               <<00506>>02270000
                                                               <<06.EB>>02272000
                                                               <<00256>>02274000
INTEGER PROCEDURE THISCPU;                                     <<0306>> 02276000
   OPTION EXTERNAL;                                            <<0306>> 02278000
PROCEDURE CXOUTFENCE EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>02280000
                                                               <<00552>>02282000
PROCEDURE CXRECALL EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>02284000
                                                               <<00552>>02286000
PROCEDURE CXREFUSE EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>02288000
                                                               <<00552>>02290000
PROCEDURE CXREPLY EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>02292000
                                                               <<00552>>02294000
PROCEDURE CXRESUMEJOB EXECUTORHEAD;OPTION EXTERNAL;            <<00552>>02296000
                                                               <<00552>>02298000
<<PROCEDURE CXSPOOL EXECUTORHEAD; OPTION EXTERNAL;>>           <<00552>>02300000
                                                               <<00552>>02302000
PROCEDURE CXSTREAMS EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>02304000
                                                               <<00552>>02306000
PROCEDURE CXCONSOLE  EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>02308000
                                                               <<00552>>02310000
PROCEDURE CXTAKE EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>02312000
                                                               <<00552>>02314000
PROCEDURE CXUP EXECUTORHEAD; OPTION EXTERNAL;                  <<00552>>02316000
                                                               <<00552>>02318000
PROCEDURE CXWELCOME EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>02320000
                                                               <<00552>>02322000
PROCEDURE CXASSOCIATE EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>02324000
                                                               <<00552>>02326000
LOGICAL PROCEDURE MASTEROP; OPTION EXTERNAL;                   <<00552>>02328000
                                                               <<00552>>02330000
PROCEDURE CXMPLINE EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>02332000
                                                               <<00552>>02334000
PROCEDURE CXDSCONTROL EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>02336000
                                                               <<00552>>02338000
PROCEDURE CXMON EXECUTORHEAD; OPTION EXTERNAL;                 <<00552>>02340000
                                                               <<00552>>02342000
PROCEDURE CXMOFF EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>02344000
                                                               <<00552>>02346000
PROCEDURE CXVMOUNT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>02348000
                                                               <<00552>>02350000
PROCEDURE CXLMOUNT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>02352000
                                                               <<00552>>02354000
PROCEDURE CXLDISMOUNT EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>02356000
                                                               <<00552>>02358000
PROCEDURE CXMRJECONTROL EXECUTORHEAD; OPTION EXTERNAL;         <<00552>>02360000
                                                               <<00552>>02362000
PROCEDURE CXJOBSECURITY EXECUTORHEAD; OPTION EXTERNAL;         <<00552>>02364000
                                                               <<00552>>02366000
PROCEDURE CXDISASSOCIATE EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>02368000
PROCEDURE CXSTARTSPOOL EXECUTORHEAD; OPTION EXTERNAL;          <<00552>>02370000
PROCEDURE CXSTOPSPOOL  EXECUTORHEAD; OPTION EXTERNAL;          <<00552>>02372000
PROCEDURE CXSUSPENDSPOOL EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>02374000
PROCEDURE CXRESUMESPOOL  EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>02376000
PROCEDURE CXALTSPOOLFILE EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>02378000
PROCEDURE CXDELETESPOOLFILE EXECUTORHEAD; OPTION EXTERNAL;     <<00552>>02380000
                                                               <<00552>>02382000
PROCEDURE CXDOWNLOAD EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>02384000
                                                               <<00552>>02386000
PROCEDURE CXABORTIO EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>02388000
                                                               <<00552>>02390000
PROCEDURE CXABORTJOB EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>02392000
                                                               <<00552>>02394000
PROCEDURE CXACCEPT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>02396000
                                                               <<00552>>02398000
PROCEDURE CXALLOW EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>02400000
                                                               <<00552>>02402000
<<PROCEDURE CXALTFILE EXECUTORHEAD; OPTION EXTERNAL;>>         <<00552>>02404000
                                                               <<00552>>02406000
PROCEDURE CXALTJOB EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>02408000
                                                               <<00552>>02410000
PROCEDURE CXBREAKJOB EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>02412000
                                                               <<00552>>02414000
<<PROCEDURE CXDELETE EXECUTORHEAD; OPTION EXTERNAL;>>          <<00552>>02416000
                                                               <<00552>>02418000
PROCEDURE CXDISALLOW EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>02420000
                                                               <<00552>>02422000
PROCEDURE CXDOWN EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>02424000
                                                               <<00552>>02426000
PROCEDURE CXGIVE EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>02428000
                                                               <<00552>>02430000
PROCEDURE CXHEADOFF EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>02432000
                                                               <<00552>>02434000
PROCEDURE CXHEADON EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>02436000
                                                               <<00552>>02438000
PROCEDURE CXJOBFENCE EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>02440000
                                                               <<00552>>02442000
PROCEDURE CXLIMIT EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>02444000
                                                               <<00552>>02446000
PROCEDURE CRUNCH(N1,N2,N3,DEST,NWORDS);                        <<02554>>02448000
   INTEGER NWORDS;                                             <<02554>>02450000
   INTEGER ARRAY DEST;                                         <<02554>>02452000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>02454000
   OPTION EXTERNAL;                                            <<02554>>02456000
PROCEDURE CXLOG EXECUTORHEAD; OPTION EXTERNAL;                 <<00601>>02458000
PROCEDURE CXMIOENABLE EXECUTORHEAD; OPTION EXTERNAL;           <<00575>>02460000
                                                               <<00575>>02462000
PROCEDURE CXMIODISABLE EXECUTORHEAD; OPTION EXTERNAL;          <<00575>>02464000
                                                               <<00575>>02466000
PROCEDURE CXTUNE EXECUTORHEAD; OPTION EXTERNAL;                <<01549>>02468000
                                                               << I.A >>02470000
PROCEDURE APLTRANSLATEOUT(MESSAGE,LENGTH,TRANSTYPE);           << I.A >>02472000
  VALUE LENGTH,TRANSTYPE;                                      << I.A >>02474000
  INTEGER LENGTH,TRANSTYPE;                                    << I.A >>02476000
  BYTE ARRAY MESSAGE;                                          << I.A >>02478000
  OPTION EXTERNAL;                                             << I.A >>02480000
                                                               << I.A >>02482000
PROCEDURE CXRJE EXECUTORHEAD;                                  << I.A >>02484000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02486000
         EXTERNAL;                                             << I.A >>02488000
                                                               << I.A >>02490000
PROCEDURE CXSETDUMP EXECUTORHEAD;                              << I.A >>02492000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02494000
         EXTERNAL;                                             << I.A >>02496000
                                                               << I.A >>02498000
PROCEDURE CXSYSDUMP EXECUTORHEAD;                              << I.A >>02500000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02502000
         EXTERNAL;                                             << I.A >>02504000
                                                               << I.A >>02506000
PROCEDURE CXNEWACCT EXECUTORHEAD;                              << I.A >>02508000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02510000
         EXTERNAL;                                             << I.A >>02512000
                                                               << I.A >>02514000
PROCEDURE CXCLINE EXECUTORHEAD;                                << I.A >>02516000
  OPTION PRIVILEGED,                                           << I.A >>02518000
         EXTERNAL;                                             << I.A >>02520000
                                                               << I.A >>02522000
PROCEDURE CXSHOWLOG EXECUTORHEAD;                              << I.A >>02524000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02526000
         EXTERNAL;                                             << I.A >>02528000
                                                               << I.A >>02530000
PROCEDURE CXBASICGO EXECUTORHEAD;                              << I.A >>02532000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02534000
         EXTERNAL;                                             << I.A >>02536000
                                                               << I.A >>02538000
PROCEDURE CXBASICPREP EXECUTORHEAD;                            << I.A >>02540000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02542000
         EXTERNAL;                                             << I.A >>02544000
                                                               << I.A >>02546000
PROCEDURE CXSHOWQ EXECUTORHEAD;                                << I.A >>02548000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02550000
         EXTERNAL;                                             << I.A >>02552000
                                                               << I.A >>02554000
PROCEDURE CXJOBPRI EXECUTORHEAD;                               << I.A >>02556000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02558000
         EXTERNAL;                                             << I.A >>02560000
                                                               << I.A >>02562000
PROCEDURE CXPURGE EXECUTORHEAD;                                << I.A >>02564000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02566000
         EXTERNAL;                                             << I.A >>02568000
                                                               << I.A >>02570000
PROCEDURE CXPURGEUSER EXECUTORHEAD;                            << I.A >>02572000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02574000
         EXTERNAL;                                             << I.A >>02576000
                                                               << I.A >>02578000
PROCEDURE CX3270MGR EXECUTORHEAD;                              << I.A >>02580000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02582000
         EXTERNAL;                                             << I.A >>02584000
                                                               << I.A >>02586000
PROCEDURE CXLISTVS EXECUTORHEAD;                               << I.A >>02588000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02590000
         EXTERNAL;                                             << I.A >>02592000
                                                               << I.A >>02594000
PROCEDURE CXRPGPREP EXECUTORHEAD;                              << I.A >>02596000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02598000
         EXTERNAL;                                             << I.A >>02600000
                                                               << I.A >>02602000
PROCEDURE CXPURGEACCT EXECUTORHEAD;                            << I.A >>02604000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02606000
         EXTERNAL;                                             << I.A >>02608000
                                                               << I.A >>02610000
PROCEDURE CXPURGEVSET EXECUTORHEAD;                            << I.A >>02612000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02614000
         EXTERNAL;                                             << I.A >>02616000
                                                               << I.A >>02618000
PROCEDURE CXFCOPY EXECUTORHEAD;                                << I.A >>02620000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02622000
         EXTERNAL;                                             << I.A >>02624000
                                                               << I.A >>02626000
PROCEDURE CXPREPRUN EXECUTORHEAD;                              << I.A >>02628000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02630000
         EXTERNAL;                                             << I.A >>02632000
                                                               << I.A >>02634000
PROCEDURE CXQUANTUM EXECUTORHEAD;                              << I.A >>02636000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02638000
         EXTERNAL;                                             << I.A >>02640000
                                                               << I.A >>02642000
PROCEDURE CXALLOCATE EXECUTORHEAD;                             << I.A >>02644000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02646000
         EXTERNAL;                                             << I.A >>02648000
                                                               << I.A >>02650000
PROCEDURE CXLISTACCT EXECUTORHEAD;                             << I.A >>02652000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02654000
         EXTERNAL;                                             << I.A >>02656000
                                                               << I.A >>02658000
PROCEDURE CXFORTGO EXECUTORHEAD;                               << I.A >>02660000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02662000
         EXTERNAL;                                             << I.A >>02664000
                                                               << I.A >>02666000
PROCEDURE CXPREP EXECUTORHEAD;                                 << I.A >>02668000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02670000
         EXTERNAL;                                             << I.A >>02672000
                                                               << I.A >>02674000
PROCEDURE CXSAVE EXECUTORHEAD;                                 << I.A >>02676000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02678000
         EXTERNAL;                                             << I.A >>02680000
                                                               << I.A >>02682000
PROCEDURE CXRPG EXECUTORHEAD;                                  << I.A >>02684000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02686000
         EXTERNAL;                                             << I.A >>02688000
                                                               << I.A >>02690000
PROCEDURE CXALTUSER EXECUTORHEAD;                              << I.A >>02692000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02694000
         EXTERNAL;                                             << I.A >>02696000
                                                               << I.A >>02698000
PROCEDURE CXVINIT EXECUTORHEAD;                                << I.A >>02700000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02702000
         EXTERNAL;                                             << I.A >>02704000
                                                               << I.A >>02706000
PROCEDURE CXSECURE EXECUTORHEAD;                               << I.A >>02708000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02710000
         EXTERNAL;                                             << I.A >>02712000
                                                               << I.A >>02714000
PROCEDURE CXFORTRAN EXECUTORHEAD;                              << I.A >>02716000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02718000
         EXTERNAL;                                             << I.A >>02720000
                                                               << I.A >>02722000
PROCEDURE CXSPLGO EXECUTORHEAD;                                << I.A >>02724000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02726000
         EXTERNAL;                                             << I.A >>02728000
                                                               << I.A >>02730000
PROCEDURE CXRESETDUMP EXECUTORHEAD;                            << I.A >>02732000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02734000
         EXTERNAL;                                             << I.A >>02736000
                                                               << I.A >>02738000
PROCEDURE CXDSCOPY EXECUTORHEAD;                               << I.A >>02740000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02742000
         EXTERNAL;                                             << I.A >>02744000
                                                               << I.A >>02746000
PROCEDURE CXRENAME EXECUTORHEAD;                               << I.A >>02748000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02750000
         EXTERNAL;                                             << I.A >>02752000
                                                               << I.A >>02754000
PROCEDURE CXALTSEC EXECUTORHEAD;                               << I.A >>02756000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02758000
         EXTERNAL;                                             << I.A >>02760000
                                                               << I.A >>02762000
PROCEDURE CXAPL EXECUTORHEAD;                                  << I.A >>02764000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02766000
         EXTERNAL;                                             << I.A >>02768000
                                                               << I.A >>02770000
PROCEDURE  CXNEWUSER EXECUTORHEAD;                             << I.A >>02772000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02774000
         EXTERNAL;                                             << I.A >>02776000
                                                               << I.A >>02778000
PROCEDURE CXRELEASE EXECUTORHEAD;                              << I.A >>02780000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02782000
         EXTERNAL;                                             << I.A >>02784000
                                                               << I.A >>02786000
PROCEDURE CXRESETACCT EXECUTORHEAD;                            << I.A >>02788000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02790000
         EXTERNAL;                                             << I.A >>02792000
                                                               << I.A >>02794000
PROCEDURE CXLISTF EXECUTORHEAD;                                << I.A >>02796000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02798000
         EXTERNAL;                                             << I.A >>02800000
                                                               << I.A >>02802000
PROCEDURE CXBUILD EXECUTORHEAD;                                << I.A >>02804000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02806000
         EXTERNAL;                                             << I.A >>02808000
                                                               << I.A >>02810000
PROCEDURE CX3270 EXECUTORHEAD;                                 << I.A >>02812000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02814000
         EXTERNAL;                                             << I.A >>02816000
                                                               << I.A >>02818000
PROCEDURE CXSEGMENTER EXECUTORHEAD;                            << I.A >>02820000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02822000
         EXTERNAL;                                             << I.A >>02824000
                                                               << I.A >>02826000
PROCEDURE CXCOBOLPREP EXECUTORHEAD;                            << I.A >>02828000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02830000
         EXTERNAL;                                             << I.A >>02832000
                                                               << I.A >>02834000
PROCEDURE CXCOBOL EXECUTORHEAD;                                << I.A >>02836000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02838000
         EXTERNAL;                                             << I.A >>02840000
                                                               << I.A >>02842000
PROCEDURE CXRUN EXECUTORHEAD;                                  << I.A >>02844000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02846000
         EXTERNAL;                                             << I.A >>02848000
                                                               << I.A >>02850000
PROCEDURE CXRESET EXECUTORHEAD;                                << I.A >>02852000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02854000
         EXTERNAL;                                             << I.A >>02856000
                                                               << I.A >>02858000
PROCEDURE CXSETMSG EXECUTORHEAD;                               << I.A >>02860000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02862000
         EXTERNAL;                                             << I.A >>02864000
                                                               << I.A >>02866000
PROCEDURE CXALTVSET EXECUTORHEAD;                              << I.A >>02868000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02870000
         EXTERNAL;                                             << I.A >>02872000
                                                               << I.A >>02874000
PROCEDURE CXSPLPREP EXECUTORHEAD;                              << I.A >>02876000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02878000
         EXTERNAL;                                             << I.A >>02880000
                                                               << I.A >>02882000
PROCEDURE CXRESUMELOG EXECUTORHEAD;                            << I.A >>02884000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02886000
         EXTERNAL;                                             << I.A >>02888000
                                                               << I.A >>02890000
PROCEDURE CXDEALLOCATE EXECUTORHEAD;                           << I.A >>02892000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02894000
         EXTERNAL;                                             << I.A >>02896000
                                                               << I.A >>02898000
PROCEDURE CXLISTGROUP EXECUTORHEAD;                            << I.A >>02900000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02902000
         EXTERNAL;                                             << I.A >>02904000
                                                               << I.A >>02906000
PROCEDURE CXLISTUSER EXECUTORHEAD;                             << I.A >>02908000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02910000
         EXTERNAL;                                             << I.A >>02912000
                                                               << I.A >>02914000
PROCEDURE CXFORTPREP EXECUTORHEAD;                             << I.A >>02916000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02918000
         EXTERNAL;                                             << I.A >>02920000
                                                               << I.A >>02922000
PROCEDURE CXPURGEGROUP EXECUTORHEAD;                           << I.A >>02924000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02926000
         EXTERNAL;                                             << I.A >>02928000
                                                               << I.A >>02930000
PROCEDURE CXCRESET EXECUTORHEAD;                               << I.A >>02932000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02934000
         EXTERNAL;                                             << I.A >>02936000
                                                               << I.A >>02938000
PROCEDURE CXNEWVSET EXECUTORHEAD;                              << I.A >>02940000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02942000
         EXTERNAL;                                             << I.A >>02944000
                                                               << I.A >>02946000
PROCEDURE CXBASIC EXECUTORHEAD;                                << I.A >>02948000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02950000
         EXTERNAL;                                             << I.A >>02952000
                                                               << I.A >>02954000
PROCEDURE CXMRJE EXECUTORHEAD;                                 << I.A >>02956000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02958000
         EXTERNAL;                                             << I.A >>02960000
                                                               << I.A >>02962000
PROCEDURE CXRPGGO EXECUTORHEAD;                                << I.A >>02964000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02966000
         EXTERNAL;                                             << I.A >>02968000
                                                               << I.A >>02970000
PROCEDURE CXALTGROUP EXECUTORHEAD;                             << I.A >>02972000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02974000
         EXTERNAL;                                             << I.A >>02976000
                                                               << I.A >>02978000
PROCEDURE CXEDITOR EXECUTORHEAD;                               << I.A >>02980000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02982000
         EXTERNAL;                                             << I.A >>02984000
                                                               << I.A >>02986000
PROCEDURE CXREPORT EXECUTORHEAD;                               << I.A >>02988000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02990000
         EXTERNAL;                                             << I.A >>02992000
                                                               << I.A >>02994000
PROCEDURE CXSWITCHLOG;                                         << I.A >>02996000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>02998000
         EXTERNAL;                                             << I.A >>03000000
                                                               << I.A >>03002000
PROCEDURE CXCOBOLGO EXECUTORHEAD;                              << I.A >>03004000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>03006000
         EXTERNAL;                                             << I.A >>03008000
                                                               << I.A >>03010000
PROCEDURE CX3270CONTROL EXECUTORHEAD;                          << I.A >>03012000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>03014000
         EXTERNAL;                                             << I.A >>03016000
                                                               << I.A >>03018000
PROCEDURE CXSPL EXECUTORHEAD;                                  << I.A >>03020000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>03022000
         EXTERNAL;                                             << I.A >>03024000
                                                               << I.A >>03026000
PROCEDURE CXBASICOMP EXECUTORHEAD;                             << I.A >>03028000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>03030000
         EXTERNAL;                                             << I.A >>03032000
                                                               << I.A >>03034000
PROCEDURE CXNEWGROUP EXECUTORHEAD;                             << I.A >>03036000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>03038000
         EXTERNAL;                                             << I.A >>03040000
                                                               << I.A >>03042000
PROCEDURE CXALTACCT EXECUTORHEAD;                              << I.A >>03044000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>03046000
         EXTERNAL;                                             << I.A >>03048000
                                                               << I.A >>03050000
PROCEDURE CXFILE EXECUTORHEAD;                                 << I.A >>03052000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>03054000
         EXTERNAL;                                             << I.A >>03056000
                                                               << I.A >>03058000
PROCEDURE CXPASCAL EXECUTORHEAD;                               << I.A >>03060000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>03062000
         EXTERNAL;                                             << I.A >>03064000
                                                               << I.A >>03066000
PROCEDURE CXPASCALPREP EXECUTORHEAD;                           << I.A >>03068000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>03070000
         EXTERNAL;                                             << I.A >>03072000
                                                               << I.A >>03074000
PROCEDURE CXPASCALGO EXECUTORHEAD;                             << I.A >>03076000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>03078000
         EXTERNAL;                                             << I.A >>03080000
                                                               << I.A >>03082000
INTEGER PROCEDURE XRETJTENTRY(N1,N2,N3,SIZE,INFO);             <<02554>>03084000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>03086000
   INTEGER SIZE;                                               <<02554>>03088000
   INTEGER ARRAY INFO;                                         <<02554>>03090000
   OPTION EXTERNAL;                                            <<02554>>03092000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<U.RAO>>03094000
VALUE FNUM;                                                    <<U.RAO>>03096000
INTEGER FNUM,PARMNUM;                                          <<U.RAO>>03098000
OPTION PRIVILEGED, UNCALLABLE,FORWARD;                         <<U.RAO>>03100000
                                                                        03102000
   PROCEDURE CIERR(ERRNUM,ERRADR,PARMMASK,PARM);               <<U.RAO>>03104000
   VALUE ERRNUM,PARMMASK,PARM;                                 <<U.RAO>>03106000
   INTEGER ERRNUM,PARMMASK,PARM;                               <<U.RAO>>03108000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>03110000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE,FORWARD;              <<U.RAO>>03112000
                                                               <<U.RAO>>03114000
   PROCEDURE PRINTCARET(ERRADR);                               <<U.RAO>>03116000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>03118000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                       <<U.RAO>>03120000
                                                               <<U.RAO>>03122000
                                                                        03124000
PROCEDURE CYDIRERR'(DIRECRETURN,OKMASK,ERRNUM);                <<U.RAO>>03126000
VALUE DIRECRETURN,OKMASK;                                      <<U.RAO>>03128000
DOUBLE DIRECRETURN;                                            <<U.RAO>>03130000
INTEGER ERRNUM;                                                <<U.RAO>>03132000
LOGICAL OKMASK;                                                <<U.RAO>>03134000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>03136000
                                                                        03138000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>03140000
VALUE PDEF; DOUBLE PDEF;                                       <<U.RAO>>03142000
LOGICAL GPTR,APTR,ERRPTR;                                      <<U.RAO>>03144000
OPTION PRIVILEGED, UNCALLABLE, FORWARD;                        <<U.RAO>>03146000
                                                               <<U.RAO>>03148000
LOGICAL PROCEDURE CIBADFILENAME(ERRNUM,PARM);                  <<U.RAO>>03150000
VALUE PARM;                                                    <<U.RAO>>03152000
INTEGER ERRNUM;                                                <<U.RAO>>03154000
DOUBLE PARM;                                                   <<U.RAO>>03156000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>03158000
                                                               <<U.RAO>>03160000
LOGICAL PROCEDURE CREATEERROR;                                 <<U.RAO>>03162000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>03164000
                                                               <<U.RAO>>03166000
PROCEDURE CONDEXP(EXP,EVALUE,ERRNUM,ENDADR,PARMNUM);           <<U.RAO>>03168000
BYTE ARRAY EXP;                                                <<U.RAO>>03170000
LOGICAL EVALUE;                                                <<U.RAO>>03172000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>03174000
OPTION FORWARD;                                                <<U.RAO>>03176000
PROCEDURE TRANSJCWEQUATE(PARM, VAL, ERR, ADR);                 <<U.RAO>>03178000
BYTE ARRAY PARM;                                               <<U.RAO>>03180000
INTEGER VAL;                                                   <<U.RAO>>03182000
INTEGER ERR,ADR;                                               <<U.RAO>>03184000
OPTION FORWARD;                                                <<U.RAO>>03186000
                                                                        03188000
   LOGICAL PROCEDURE REQUESTSERVICE;                                    03190000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                03192000
                                                                        03194000
   PROCEDURE SETSERVICE(DISP);                                          03196000
   VALUE DISP;                                                          03198000
   LOGICAL DISP;                                                        03200000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                03202000
                                                                        03204000
   PROCEDURE WELCOMEMES(WDST,FUNNYTERMINAL);                  <<A00.04>>03206000
   VALUE WDST,FUNNYTERMINAL;                                  <<A00.04>>03208000
   LOGICAL FUNNYTERMINAL;                                     <<A00.04>>03210000
   INTEGER WDST;                                                        03212000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                03214000
                                                               <<DS0.0>>03216000
   PROCEDURE CXDSLINED EXECUTORHEAD;                           <<DS0.0>>03218000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                      << I.A >>03220000
                                                               <<DS0.0>>03222000
   PROCEDURE CXREMOTED EXECUTORHEAD;                           <<DS0.0>>03224000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                      << I.A >>03226000
                                                               <<DS0.0>>03228000
   LOGICAL PROCEDURE CREATEPROC'ERR(ERROR,ERRNUM);             <<01452>>03230000
   VALUE ERROR; INTEGER ERROR,ERRNUM;                          <<01452>>03232000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                       <<01452>>03234000
                                                               <<01452>>03236000
   PROCEDURE CXRFAD EXECUTORHEAD;                              <<DS0.0>>03238000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                      << I.A >>03240000
                                                                        03242000
   PROCEDURE CXSHOWCOM EXECUTORHEAD;                                    03244000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                      << I.A >>03246000
                                                               <<01115>>03248000
PROCEDURE CXFOREIGN EXECUTORHEAD;                              <<01115>>03250000
OPTION EXTERNAL;                                               <<01115>>03252000
                                                               <<01452>>03254000
LOGICAL PROCEDURE JOBSESSIONMAIN; OPTION FORWARD;              <<14.EB>>03256000
                                                               <<04193>>03258000
PROCEDURE STACKMARK( WHICH, DELQ, STAT, RELP, XREG );          <<04193>>03260000
   VALUE WHICH;                                                <<04193>>03262000
   INTEGER WHICH, DELQ, STAT, RELP, XREG;                      <<04193>>03264000
OPTION VARIABLE, UNCALLABLE, PRIVILEGED, FORWARD;              <<04193>>03266000
                                                               <<04193>>03268000
PROCEDURE SYSINTERR( ERRN, BACK );                             <<04193>>03270000
   VALUE   ERRN, BACK;                                         <<04193>>03272000
   INTEGER ERRN, BACK;                                         <<04193>>03274000
OPTION UNCALLABLE, PRIVILEGED, FORWARD;                        <<04193>>03276000
                                                               <<04193>>03278000
                                                               <<14.EB>>03280000
$PAGE   "MISC. COMMAND EXECUTORS -- JOB, HELLO,BYE ETC."                03282000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>03284000
                                                                        03286000
      PROCEDURE CXJOB EXECUTORHEAD;                                     03288000
      OPTION PRIVILEGED, UNCALLABLE;                                    03290000
      BEGIN                                                             03292000
      COMMENT                                                           03294000
      CXJOB IS THE EXECUTOR FOR JOB,EOJ,HELLO,BYE&DATA                  03296000
      COMMAND FORMAT                                                    03298000
      JOB                                                               03300000
      EOJ                                                               03302000
      DATA                                                              03304000
      BYE                                                               03306000
      HELLO                                                             03308000
      ;                                                                 03310000
      ENTRY CXEOJ,CXHELLO,CXBYE,CXDATA;                                 03312000
CXHELLO: << HELLO COMMAND >>                                   <<02329>>03314000
CXDATA:  << DATA COMMAND >>                                    <<02329>>03316000
       CIERR(ERRNUM := BADLOGONSTRING);                        <<02329>>03318000
       RETURN;                                                 <<02329>>03320000
CXEOJ:  << END OF JOB >>                                       <<02329>>03322000
CXBYE:  << END CXJOB  >>                                       <<02329>>03324000
      TERMINATE;                                                        03326000
      END;<<CXJOB>>                                                     03328000
      PROCEDURE CXEOD EXECUTORHEAD;                                     03330000
      OPTION PRIVILEGED, UNCALLABLE;                                    03332000
      BEGIN                                                             03334000
      COMMENT                                                           03336000
      CXEOD IS THE EXECUTOR FOR THE EOD COMMAND                         03338000
      COMMAND FORMAT                                                    03340000
      EOD                                                               03342000
      ;                                                                 03344000
      CIERR(-IGNORED);  <<UNIMPORTANT TO CI>>                  <<U.RAO>>03346000
      END;<<EOD>>                                                       03348000
      PROCEDURE CXPTAPE EXECUTORHEAD;                                   03350000
      OPTION PRIVILEGED, UNCALLABLE;                                    03352000
      BEGIN                                                             03354000
      COMMENT                                                           03356000
      CXPTAPE IS THE EXECUTOR FOR THE PTAPE COMMAND                     03358000
      COMMAND FORMAT                                                    03360000
      PTAPE FILENAME                                                    03362000
      ;                                                                 03364000
      DOUBLE ARRAY PARM(0:1)=Q;                                <<U.RAO>>03366000
      BYTE POINTER BADPARM=PARM+2;                             <<U.RAO>>03368000
   DOUBLE DL := COMMASEMICR;                                   <<U.RAO>>03370000
      BYTE POINTER FNAME = PARM;                                        03372000
      BYTE LEN = PARM + 1;                                              03374000
      INTEGER NUMPARMS, FN1, FN2;                                       03376000
                                                                        03378000
      MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARM);                    <<U.RAO>>03380000
      IF NUMPARMS > 1 THEN  <<TOO MANY PARAMETERS>>            <<U.RAO>>03382000
         BEGIN                                                 <<U.RAO>>03384000
         PARMNUM := 2;                                         <<U.RAO>>03386000
         CIERR(ERRNUM := PTAPE2MP,BADPARM);                    <<U.RAO>>03388000
         RETURN;                                               <<U.RAO>>03390000
         END;                                                  <<U.RAO>>03392000
      IF NUMPARMS = 0 THEN  <<REQUIRES 1 PARM>>                <<U.RAO>>03394000
         BEGIN                                                 <<U.RAO>>03396000
         PARMNUM := 1;                                         <<U.RAO>>03398000
         CIERR(ERRNUM := PTAPENOFILE, PARMSP);                 <<U.RAO>>03400000
         RETURN;                                               <<U.RAO>>03402000
         END;                                                  <<U.RAO>>03404000
      IF CIBADFILENAME(ERRNUM,PARM) THEN                       <<U.RAO>>03406000
         BEGIN                                                 <<U.RAO>>03408000
         PARMNUM := 1;                                         <<U.RAO>>03410000
         RETURN                                                <<U.RAO>>03412000
         END;                                                  <<U.RAO>>03414000
      FN1 := FOPEN(,%44);<<OPEN $STDIN,ASCII>>                          03416000
      IF CARRY THEN  <<OPEN FAILED FOR SOME REASON>>           <<U.RAO>>03418000
         BEGIN                                                 <<U.RAO>>03420000
         CIERR(ERRNUM := PTAPETERMFILE);                       <<U.RAO>>03422000
         RETURN                                                <<U.RAO>>03424000
         END;                                                  <<U.RAO>>03426000
      FN2:=FOPEN(FNAME,%2107,%101);<<DISCFILE,OLD,ASCII,VAR,NO FILE EQ>>03428000
      IF CARRY THEN<<FOPEN OK?>>                                        03430000
         BEGIN<<NO>>                                                    03432000
         FCLOSE(FN1,0,0);<<CLOSE $STDIN>>                               03434000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>03436000
         FNAME(LEN) := 0;                                      <<U.RAO>>03438000
         CIERR(ERRNUM := PTAPEOPENFAILED,,0,@FNAME);           <<U.RAO>>03440000
         RETURN;                                               <<U.RAO>>03442000
         END;                                                           03444000
      PTAPE(FN1,FN2);<<READ PAPER TAPE IN>>                             03446000
      IF < THEN    <<CCL FROM PTAPE => ERROR ON $STDIN>>       <<U.RAO>>03448000
         BEGIN                                                 <<U.RAO>>03450000
         FERROR'(FN1,PARMNUM);                                 <<U.RAO>>03452000
         CIERR(ERRNUM := PTAPEFSERR,,%10000,PARMNUM);          <<U.RAO>>03454000
         FCLOSE(FN2,0,0);                                      <<U.RAO>>03456000
         RETURN;                                               <<U.RAO>>03458000
         END;                                                  <<U.RAO>>03460000
      IF > THEN  <<CCG FROM PTAPE => ERROR ON TARGET FILE>>    <<U.RAO>>03462000
         BEGIN                                                 <<U.RAO>>03464000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>03466000
         CIERR(ERRNUM := PTAPETOFSERR,,%10000,PARMNUM);        <<U.RAO>>03468000
         FCLOSE(FN1,0,0);                                      <<U.RAO>>03470000
         RETURN                                                <<U.RAO>>03472000
         END;                                                  <<U.RAO>>03474000
      FCLOSE(FN1,0,0);                                         <<U.RAO>>03476000
      FCLOSE(FN2,0,0);                                         <<U.RAO>>03478000
      IF CARRY THEN                                            <<U.RAO>>03480000
         BEGIN                                                 <<U.RAO>>03482000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>03484000
         CIERR(ERRNUM := PTAPECLOSEERR,,%10000,PARMNUM);       <<U.RAO>>03486000
         END;                                                  <<U.RAO>>03488000
END;   <<CXPTAPE>>                                             <<U.RAO>>03490000
PROCEDURE FORMUSERID(USERID);                                  <<U.RAO>>03492000
BYTE ARRAY USERID;                                             <<U.RAO>>03494000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>03496000
<<THIS PROCEDURE FORMS A USER ID FOR THE CALLER'S USER>>       <<U.RAO>>03498000
<<OF THE FORM J/S NNN USER.ACCOUNT,LOGON GROUP>>               <<U.RAO>>03500000
BEGIN                                                          <<U.RAO>>03502000
INTEGER ARRAY JITDATA(0:22);  <<HOLDS COPY OF DATA IN JIT>>    <<U.RAO>>03504000
BYTE ARRAY UNAME(*)=JITDATA(19);                               <<U.RAO>>03506000
BYTE ARRAY LGNAME(*) = JITDATA(15);  <<LOGON GROUP NAME IN JIT><<U.RAO>>03508000
BYTE ARRAY ANAME(*)=JITDATA(7);                                <<U.RAO>>03510000
BYTE ARRAY USERSNUM(0:5);  <<J/S NNN>>                         <<U.RAO>>03512000
DEFINE JOBFIELD = (0:2)#;                                      <<U.RAO>>03514000
EQUATE SESSIONTYPE = 1;  <<BIT PATTERN IN JOB NUMBER WORD>>    << I.A >>03516000
                                                               <<U.RAO>>03518000
TOS := @JITDATA;                                               <<U.RAO>>03520000
SETJIT;   <<WE ARE COPYING THE DATA FROM THE JIT>>             <<U.RAO>>03522000
TOS := 9;  <<START AT JOB TYPE/NUMBER FIELD>>                  <<U.RAO>>03524000
TOS := 23;  <<END AFTER USER'S NAME>>                          <<U.RAO>>03526000
ASSEMBLE(MFDS);                                                <<U.RAO>>03528000
<<NOW CONVERT JOB TYPE/NUMBER TO STRING>>                      <<U.RAO>>03530000
USERSNUM(2) := " ";                                            <<U.RAO>>03532000
MOVE USERSNUM(3) := USERSNUM(2),(3);                           <<00749>>03534000
IF JITDATA.JOBFIELD = SESSIONTYPE THEN                         <<U.RAO>>03536000
   USERSNUM := "S"                                             <<U.RAO>>03538000
ELSE                                                           <<U.RAO>>03540000
   USERSNUM := "J";                                            <<U.RAO>>03542000
ASCII(JITDATA.(2:14),10,USERSNUM(1));  <<SESSION NUMBER>>      <<U.RAO>>03544000
FORMNAME(3,USERID,USERSNUM,UNAME,ANAME,LGNAME);                <<U.RAO>>03546000
END;                                                           <<U.RAO>>03548000
PROCEDURE CXSHOWME EXECUTORHEAD;                               <<U.RAO>>03550000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>03552000
BEGIN                                                          <<U.RAO>>03554000
BYTE ARRAY USERID(0:24);  <<WILL HOLD J/S NN, USERNAME>>       <<U.RAO>>03556000
INTEGER ARRAY PARTNO(0:4);  <<FOR GENMSG REASONS>>             <<U.RAO>>03558000
BYTE ARRAY BPARTNO(*)=PARTNO;  <<DITTO>>                       <<U.RAO>>03560000
INTEGER CURRENTDATE;  <<THIS INSTANT IN TIME>>                 <<U.RAO>>03562000
DOUBLE CURRENTTIME;  <<THIS INSTANT IN TIME>>                  <<U.RAO>>03564000
BYTE ARRAY DATEBUF(0:27);  <<HOLDS FORMATTED DATE>>            <<U.RAO>>03566000
INTEGER ARRAY LOGON(0:2)=Q;  <<LOGON DATE & TIME>>             <<U.RAO>>03568000
INTEGER LOGONDATE = LOGON;                                     <<U.RAO>>03570000
DOUBLE LOGONTIME = LOGON+1;                                    <<U.RAO>>03572000
DOUBLE CPUTIME;  <<TOTAL CPU TIME UP TO THIS INSTANT>>         <<U.RAO>>03574000
DOUBLE CONNECTTIME;  <<TOTAL CONNECT TIME UP TO NOW>>          <<U.RAO>>03576000
INTEGER STDINLDEV;  <<LDEV FOR $STDIN>>                        <<U.RAO>>03578000
INTEGER STDLISTLDEV;  <<LDEV FOR $STDLIST>>                    <<U.RAO>>03580000
INTEGER CURRENTTIME0=CURRENTTIME;                              <<U.RAO>>03582000
INTEGER CURRENTTIME1=CURRENTTIME+1;                            <<U.RAO>>03584000
INTEGER LOGONTIMEADR;    <<ADDRESS IN JMAT OF TIME STAMP>>     <<U.RAO>>03586000
INTEGER SHOWMEMSG;  <<CPU ID MESSAGE NUMBER>>                  <<01403>>03588000
INTEGER JITDST;                                                <<U.RAO>>03590000
DEFINE                                                         <<U.RAO>>03592000
   YEAR1 = LOGONDATE.(0:7)#,                                   <<U.RAO>>03594000
   YEAR2 = CURRENTDATE.(0:7)#,                                 <<U.RAO>>03596000
   DAY1  = LOGONDATE.(7:9)#,                                   <<U.RAO>>03598000
   DAY2  = CURRENTDATE.(7:9)#,                                 <<U.RAO>>03600000
   HOUR1 = LOGON(1).(0:8)#,                                    <<U.RAO>>03602000
   HOUR2 = CURRENTTIME0.(0:8)#,                                <<U.RAO>>03604000
   MIN1  = LOGON(1).(8:8)#,                                    <<U.RAO>>03606000
   MIN2  = CURRENTTIME0.(8:8)#,                                <<U.RAO>>03608000
   SEC1  = LOGON(2).(0:8)#,                                    <<U.RAO>>03610000
   SEC2  = CURRENTTIME1.(0:8)#;                                <<U.RAO>>03612000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>03614000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>03616000
SCAN PARMSP WHILE %6440,1;  <<LOOK FOR ANY PARMS>>             <<U.RAO>>03618000
IF NOCARRY THEN                                                <<U.RAO>>03620000
   CIERR(ERRNUM := -WARNXPARMSIGNORED, BPS0);                  <<04787>>03622000
DEL;                                                           <<U.RAO>>03624000
<<FIRST LINE IS USER ID AND BREAK STATUS>>                     <<U.RAO>>03626000
FORMUSERID(USERID);                                            <<U.RAO>>03628000
SETXPXFIXED;                                                   <<U.RAO>>03630000
IF DBARRAY(XREG+PXFWBREAK) THEN                                <<U.RAO>>03632000
   GENMSG(CIGENERALMSGSET, SHOWME1BRK, 0, @USERID)             <<U.RAO>>03634000
ELSE  <<NOT IN BREAK>>                                         <<U.RAO>>03636000
   IF JOBSESSIONMAIN                                           <<04738>>03638000
      THEN GENMSG(CIGENERALMSGSET, SHOWME1NOBRK, 0, @USERID)   <<04738>>03640000
      ELSE GENMSG(CIGENERALMSGSET, SHOWMEINPROG, 0, @USERID);  <<04738>>03642000
IF REQUESTSERVICE THEN RETURN;                                 <<U.RAO>>03644000
                                                               <<U.RAO>>03646000
<<NEXT LINE IS SYSTEM ID>>                                     <<U.RAO>>03648000
PARTNO := 0;                                                   <<U.RAO>>03650000
MOVE PARTNO(1) := PARTNO,(4);                                  <<U.RAO>>03652000
BPARTNO := ABSOLUTE(SYSVERSION);  <<WHOLE PROBLEM HERE IS THAT <<U.RAO>>03654000
PARTNO(1) := ABSOLUTE(SYSUPDATE);  <<THE MPE PART NUMBER IS IN <<U.RAO>>03656000
PARTNO(3) := ABSOLUTE(SYSFIX);    <<ASCII IN SYSGLOB.  WE MUST <<U.RAO>>03658000
  <<TAG THESE ASCII STRINGS WITH 0 FOR GENMSG.  THUS THE ARRAY.<<U.RAO>>03660000
CASE THISCPU OF                                                <<01403>>03662000
   BEGIN                                                       <<01403>>03664000
      SHOWMEMSG:=SHOWME6;  <<SERIES 1>>                        <<01403>>03666000
      SHOWMEMSG:=SHOWME6;  <<SERIES 2>>                        <<01403>>03668000
      SHOWMEMSG:=SHOWME33; <<SERIES 33>>                       <<01403>>03670000
      SHOWMEMSG:=SHOWME6;  <<SERIES 3>>                        <<01403>>03672000
      SHOWMEMSG:=SHOWME33; <<ICF/44>>                          <<01403>>03674000
      SHOWMEMSG:=SHOWME55; <<ICF/55>>                          <<01403>>03676000
   END;                                                        <<01403>>03678000
GENMSG (CIGENERALMSGSET, SHOWMEMSG, 0,                         <<01403>>03680000
   @BPARTNO, @BPARTNO(2), @BPARTNO(6));                        <<U.RAO>>03682000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>03684000
                                                               <<U.RAO>>03686000
<<NEXT LINE IS CURRENT DATE & TIME>>                           <<U.RAO>>03688000
CURRENTDATE := CALENDAR;                                       <<U.RAO>>03690000
CURRENTTIME := CLOCK;                                          <<U.RAO>>03692000
FMTDATE(CURRENTDATE, CURRENTTIME, DATEBUF);                    <<U.RAO>>03694000
DATEBUF(27) := 0;                                              <<U.RAO>>03696000
GENMSG(CIGENERALMSGSET, SHOWME2, 0, @DATEBUF);                 <<U.RAO>>03698000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>03700000
                                                               <<U.RAO>>03702000
<<NOW PUT OUT LOGON TIME AND DATE>>                            <<U.RAO>>03704000
SETXPXGLOB+PXGWJMATX;                                          <<U.RAO>>03706000
LOGONTIMEADR := DBARRAY(X).(0:8)*JMATLEN+JMATTIMESTAMP;        <<U.RAO>>03708000
MOVEFROMDSEG(@LOGON, JMATDST, LOGONTIMEADR, 3);                <<U.RAO>>03710000
FMTDATE(LOGONDATE,LOGONTIME,DATEBUF);                          <<U.RAO>>03712000
DATEBUF(27):=0;                                                <<02335>>03714000
GENMSG(CIGENERALMSGSET, SHOWME3, 0, @DATEBUF);                 <<U.RAO>>03716000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>03718000
                                                               <<U.RAO>>03720000
<<NEXT DO CPU AND CONNECT TIME>>                               <<U.RAO>>03722000
<< For non-programmatic calls, CPU time is the CI's time   >>  <<04738>>03724000
<< plus the local process' time.  For programmatic calls,  >>  <<04738>>03726000
<< CPU time is simply the process' time.                   >>  <<04738>>03728000
SETJIT;  <<CPU TIME ACCUMULATOR IS IN JIT>>                    <<U.RAO>>03730000
JITDST := TOS;                                                 <<U.RAO>>03732000
TOS := @CPUTIME;                                               <<U.RAO>>03734000
MOVEFROMDSEG( *, JITDST, JITCPUTIME, 2);                       <<U.RAO>>03736000
SETXPXFIXED + PXFCPUTIME;  <<GO FOR LOCAL PROCESS TIME>>       <<U.RAO>>03738000
TOS := DBARRAY(X);                                             <<U.RAO>>03740000
TOS := DBARRAY(X := X+1);                                      <<U.RAO>>03742000
IF JOBSESSIONMAIN                                              <<04738>>03744000
   THEN CPUTIME := TOS + CPUTIME + 999D                        <<04738>>03746000
   ELSE CPUTIME := TOS + 999D;                                 <<04738>>03748000
IF OVERFLOW THEN                                               <<U.RAO>>03750000
   CPUTIME := 2147483D  <<MAX CPU SECONDS>>                    <<U.RAO>>03752000
ELSE                                                           <<U.RAO>>03754000
   CPUTIME := CPUTIME/1000D;  <<MILLISEC TO SECONDS>>          <<U.RAO>>03756000
<<NOW COMPUTE CONNECT TIME>>                                   <<U.RAO>>03758000
<<ALGORITHM FOR COMPUTING MINUTES BETWEEN TWO TIME STAMPS:>>   <<U.RAO>>03760000
<< (M2-M1)                                                >>   <<U.RAO>>03762000
<< + 60*((H2-H1)                                          >>   <<U.RAO>>03764000
<< + 24*((D2-D1)+((Y2-1)/4*4-Y1+4)/4    (LEAP YEAR)       >>   <<U.RAO>>03766000
<< + 365*(Y2-Y1)))                                        >>   <<U.RAO>>03768000
<<                                                        >>   <<U.RAO>>03770000
TOS := ((YEAR2 - 1)&ASR(2)&ASL(2)-YEAR1+4)&ASR(2);             <<U.RAO>>03772000
TOS := 45; ASSEMBLE(MPYL);                                     <<U.RAO>>03774000
TOS := YEAR2-YEAR1;                                            <<U.RAO>>03776000
TOS := 16425;  ASSEMBLE(MPYL, DADD);                           <<U.RAO>>03778000
TOS := TOS&DASL(5);                                            <<U.RAO>>03780000
TOS := (DAY2-DAY1)*24+(HOUR2-HOUR1);                           <<U.RAO>>03782000
TOS := 60; ASSEMBLE(MPYL, DADD);                               <<U.RAO>>03784000
TOS := TOS+DOUBLE(MIN2-MIN1);                                  <<U.RAO>>03786000
IF SEC2 > SEC1 THEN TOS := TOS+1D;                             <<U.RAO>>03788000
CONNECTTIME := TOS;                                            <<U.RAO>>03790000
GENMSG( CIGENERALMSGSET,                                       <<04738>>03792000
        IF JOBSESSIONMAIN THEN SHOWME4 ELSE SHOWMEPROGCPU,     <<04738>>03794000
   %22000, @CPUTIME, @CONNECTTIME);                            <<U.RAO>>03796000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>03798000
                                                               <<U.RAO>>03800000
<<FINALLY DO $STDIN, $STDLIST>>                                <<U.RAO>>03802000
SETXPXGLOB+PXGWJOBIN;  <<POINT TO PLACE IN PXGLOB OF LDEVS>>   <<U.RAO>>03804000
STDINLDEV := DBARRAY(X).(8:8);                                 <<U.RAO>>03806000
STDLISTLDEV := DBARRAY(X := X+1).(8:8);                        <<U.RAO>>03808000
GENMSG(CIGENERALMSGSET, SHOWME5,                               <<U.RAO>>03810000
   %11000, STDINLDEV, STDLISTLDEV);                            <<U.RAO>>03812000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>03814000
TOS := ABSOLUTE(WELCOMEDST);                                   <<U.RAO>>03816000
IF > THEN  <<WELCOME MESSAGE EXISTS>>                          <<U.RAO>>03818000
   WELCOMEMES(*,0); <<SECOND PARM IS FUNNY TERMINAL>>          <<U.RAO>>03820000
END;                                                           <<U.RAO>>03822000
PROCEDURE CXSPEED EXECUTORHEAD;                                <<U.RAO>>03824000
      OPTION PRIVILEGED, UNCALLABLE;                                    03826000
      BEGIN                                                             03828000
      COMMENT                                                           03830000
      CXSPEED IS THE EXECUTOR FOR THE SPEED COMMAND                     03832000
      COMMAND FORMAT                                                    03834000
      SPEED [INSPEED],OUTSPEED OR SPEED INSPEED                         03836000
  *** NOTE: IN AND OUT SPEEDS MUST BE EQUAL ON A SERIES 33 *** <<0306>> 03838000
      ;                                                                 03840000
      DOUBLE ARRAY PARMS(0:2);                                 <<U.RAO>>03842000
      LOGICAL DL := %26015;                                             03844000
      INTEGER NUMPARMS,INSPD,OTSPD,INLDEV,OUTLDEV,LEN1,LEN2;            03846000
      INTEGER OLDINSPD;                                        <<0306>> 03848000
      LOGICAL POSTSERIES3;  <<TRUE IF RUNNING ON SERIES 33 OR  <<01403>>03850000
                            <<ICF/44 OR ICF/55>>               <<01403>>03852000
      BYTE POINTER NUMB1,NUMB2;                                         03854000
      ARRAY WOBUF (0:14),LPARM(*)=PARMS;                                03856000
      BYTE ARRAY OBUF (*) = WOBUF,BPARM(*)=PARMS;                       03858000
      ARRAY MSG(*)=PB:="CHANGE SPEED AND INPUT ""MPE"": ";              03860000
                                                                        03862000
      INTEGER SUBROUTINE CHANGEOUTSPD;                                  03864000
        <<                                                              03866000
           THIS SUBROUTINE CHANGES THE OUT SPEED TO THE VALUE SPECIFIED 03868000
          IN OTSPD AND SETS THE OLD SPEED IN OTSPD.IT RETURNS THE LAST  03870000
           3 BITS OF THE STATUS RETURNED FROM ATTACHIO.                 03872000
        >>                                                              03874000
        BEGIN                                                           03876000
          ASSEMBLE(DELB,DZRO);  << DELETE RETURN & ATTACHIO RETURN >>   03878000
          TOS := OUTLDEV;                                               03880000
          TOS := ATTACHIO(*,0,0,0,7,0,OTSPD,0,1);                       03882000
          OTSPD := TOS;  << SAVE OLD SPEED >>                           03884000
          TOS := TOS.(13:3);   << MASK TO GENERAL STATUS RETURN >>      03886000
          ASSEMBLE( XCH     );  << RETURN ADDRESS TO TOS >>             03888000
        END;   << CHANGE OUT SPEED >>                                   03890000
                                                                        03892000
                                                                        03894000
      SUBROUTINE RESTORESPEED(NP);                                      03896000
         VALUE NP; INTEGER NP;                                          03898000
      <<                                                                03900000
         THIS SUBROUTINE RESTORES THE INPUT AND OUTPUT SPEEDS TO THE    03902000
         VALUES SAVED IN INSPD AND OTSPD.                               03904000
      >>                                                                03906000
        BEGIN                                                           03908000
          IF LEN1<>0 THEN                                      <<0306>> 03910000
             ATTACHIO(INLDEV,0,0,0,6,0,OLDINSPD,0,1);          <<0306>> 03912000
          IF NP=2 THEN CHANGEOUTSPD;                                    03914000
        END;   << RESTORE SPEED >>                                      03916000
                                                                        03918000
                                                                        03920000
      POSTSERIES3 := THISCPU=2 LOR THISCPU=4 LOR THISCPU=5;    <<01403>>03922000
      MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                   <<U.RAO>>03924000
      IF NUMPARMS > 2 THEN  <<ONLY ALLOW INPUT & OUTPUT SPEEDS><<U.RAO>>03926000
         BEGIN                                                 <<U.RAO>>03928000
         PARMNUM :=3;                                          <<U.RAO>>03930000
         TOS := ERRNUM := SPEED2MP;                            <<U.RAO>>03932000
         TOS := LPARM(4);                                      <<U.RAO>>03934000
         CIERR(*,*);                                           <<U.RAO>>03936000
         RETURN                                                <<U.RAO>>03938000
         END;                                                  <<U.RAO>>03940000
      LEN1 := BPARM(2);<<SET UP POINTERS TO QUANITIES RETURNED >>       03942000
      LEN2 := BPARM(6);<<BY MYCOMMAND>>                                 03944000
      @NUMB1 := LPARM;                                                  03946000
      @NUMB2 := LPARM(2);                                               03948000
      IF (NUMPARMS=0) OR (LEN1=0) AND (LEN2=0) THEN  <<NO PARMS<<U.RAO>>03950000
         BEGIN                                                 <<U.RAO>>03952000
         PARMNUM := 1;                                         <<U.RAO>>03954000
         CIERR(ERRNUM := SPEEDNOTENUF,PARMSP);                 <<U.RAO>>03956000
         RETURN                                                <<U.RAO>>03958000
         END;                                                  <<U.RAO>>03960000
      SETXPXGLOB + PXGWJOBIN;<<SET X TO PCBX GLOBAL JOB LOCATION>>      03962000
                                                                        03964000
      INLDEV := DBARRAY(X) . (8:8);<<GET JOB INPUT LDN>>                03966000
      OUTLDEV := DBARRAY(X:=X+1) . (8:8);<<GET JOB OUTPUT LDN>>         03968000
                                                                        03970000
      IF LEN1<>0 THEN   << CHECK NEW IN SPEED >>                        03972000
        BEGIN                                                           03974000
          INSPD := BINARY(NUMB1,LEN1);                                  03976000
          IF <> THEN  <<BINARY FAILED>>                        <<U.RAO>>03978000
             BEGIN                                             <<U.RAO>>03980000
             PARMNUM := 1;                                     <<U.RAO>>03982000
             CIERR(ERRNUM := ERRINSPEED,NUMB1);                <<U.RAO>>03984000
             RETURN                                            <<U.RAO>>03986000
             END;                                              <<U.RAO>>03988000
          TOS := ATTACHIO(INLDEV,0,0,0,6,0,INSPD,0,1);                  03990000
          OLDINSPD := TOS;  << SAVE OLD IN SPEED >>            <<0306>> 03992000
          IF TOS.(13:3) <> 1 THEN  <<UNACCEPTABLE SPEED>>      <<U.RAO>>03994000
             BEGIN                                             <<U.RAO>>03996000
             PARMNUM := 1;                                     <<U.RAO>>03998000
             NUMB1(LEN1) := 0;                                 <<U.RAO>>04000000
             CIERR(ERRNUM := ERRINSPEED,NUMB1,0,@NUMB1);       <<U.RAO>>04002000
             RETURN;                                           <<U.RAO>>04004000
             END;                                              <<U.RAO>>04006000
        END;                                                            04008000
                                                                        04010000
      IF NUMPARMS=2 THEN  << CHECK OUT SPEED >>                         04012000
        BEGIN                                                           04014000
          OTSPD := BINARY(NUMB2,LEN2);                                  04016000
          IF <> THEN                                                    04018000
            BEGIN                                                       04020000
              RESTORESPEED(0);   << RESTORE IN SPEED ONLY >>            04022000
              PARMNUM := 2;                                    <<U.RAO>>04024000
             CIERR(ERRNUM := ERROUTSPEED,NUMB2);               <<U.RAO>>04026000
              RETURN                                           <<U.RAO>>04028000
            END;                                                        04030000
                                                               <<0306>> 04032000
          IF POSTSERIES3 THEN                                  <<01403>>04034000
             IF LEN1 = 0 THEN  << INPUT SPEED NOT SPECIFIED >> <<0306>> 04036000
                BEGIN                                          <<0306>> 04038000
                CIERR(ERRNUM := -SPEEDINEQUALOUT);             <<04787>>04040000
                TOS := ATTACHIO(INLDEV,0,0,0,6,0,OTSPD,0,1);   <<0306>> 04042000
                OLDINSPD := TOS;                               <<0306>> 04044000
                IF TOS.(13:3) <> 1 THEN                        <<0306>> 04046000
                   BEGIN                                       <<0306>> 04048000
                   CIERR(ERRNUM:=ERRINSPEED);                  <<0306>> 04050000
                   RETURN;                                     <<0306>> 04052000
                   END;                                        <<0306>> 04054000
                END                                            <<0306>> 04056000
             ELSE                                              <<0306>> 04058000
                BEGIN    << BOTH SPECIFIED. CHECK IF EQUAL >>  <<0306>> 04060000
                IF INSPD <> OTSPD THEN                         <<0306>> 04062000
                   BEGIN                                       <<0306>> 04064000
                   RESTORESPEED(0);  <<RESTORE IN SPEED>>      <<0306>> 04066000
                   PARMNUM := 2;                               <<0306>> 04068000
                   CIERR(ERRNUM:=SPEEDNOTEQUAL);               <<0306>> 04070000
                   RETURN;                                     <<0306>> 04072000
                   END;                                        <<0306>> 04074000
                END;                                           <<0306>> 04076000
                                                                        04078000
          IF CHANGEOUTSPD<>1 THEN   << BAD SPEED >>                     04080000
            BEGIN                                                       04082000
              RESTORESPEED(0);   << RESTORE IN SPEED ONLY >>            04084000
              PARMNUM := 2;                                    <<U.RAO>>04086000
              NUMB2(LEN2) := 0;                                <<U.RAO>>04088000
              CIERR(ERRNUM := ERROUTSPEED,NUMB2,0,@NUMB2);     <<U.RAO>>04090000
              RETURN                                           <<U.RAO>>04092000
            END;                                                        04094000
                                                                        04096000
          CHANGEOUTSPD;   << RESTORE OUT SPEED FOR PRINTING >>          04098000
        END                                                    <<0306>> 04100000
      ELSE      << OUTPUT SPEED NOT SPECIFIED >>               <<0306>> 04102000
        IF POSTSERIES3 THEN                                    <<01403>>04104000
           BEGIN                                               <<0306>> 04106000
           CIERR(ERRNUM := -SPEEDINEQUALOUT);                  <<04787>>04108000
           OTSPD := INSPD;                                     <<0306>> 04110000
           IF CHANGEOUTSPD <> 1 THEN                           <<0306>> 04112000
              BEGIN                                            <<0306>> 04114000
              RESTORESPEED(0);                                 <<0306>> 04116000
              CIERR(ERRNUM:=ERROUTSPEED);                      <<0306>> 04118000
              RETURN;                                          <<0306>> 04120000
              END;                                             <<0306>> 04122000
           CHANGEOUTSPD;  << RESTORE OUT SPEED FOR PRINTING >> <<0306>> 04124000
           END;                                                <<0306>> 04126000
                                                                        04128000
      MOVE WOBUF:=MSG,(15);                                             04130000
      PRINT(WOBUF,15,0);                                                04132000
                                                                        04134000
      IF NUMPARMS=2 OR POSTSERIES3 THEN CHANGEOUTSPD;          <<01403>>04136000
                                                                        04138000
                                                                        04140000
      TOS:=READ(WOBUF,-3);                                              04142000
      IF<> THEN TOS:=TOS+5;                                             04144000
      MOVE OBUF:=OBUF WHILE AS;                                         04146000
      IF(TOS<>3) OR(OBUF<>"MPE") THEN                                   04148000
         BEGIN                                                          04150000
         RESTORESPEED(IF POSTSERIES3 THEN 2 ELSE NUMPARMS);    <<01403>>04152000
         NEXTLINE;                                                      04154000
         CIERR(ERRNUM := -NOTVER);                             <<04787>>04156000
         END;                                                           04158000
                                                                        04160000
      NEXTLINE;                                                         04162000
      END;          <<CXSPEED>>                                         04164000
                                                               <<04738>>04166000
$CONTROL SEGMENT=CIMISC                                        <<U.RAO>>04168000
      PROCEDURE CXMOUNT EXECUTORHEAD;                          <<RH.PV>>04170000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>04172000
      BEGIN                                                    <<RH.PV>>04174000
      COMMENT                                                  <<RH.PV>>04176000
      CXMOUNT IS THE EXECUTOR FOR USER MOUNT AND DISMOUNT      <<RH.PV>>04178000
      REQUESTS;                                                <<RH.PV>>04180000
      ENTRY CXDISMOUNT;                                        <<RH.PV>>04182000
      INTEGER LEN,DELIM,NUMPARMS;                              <<RH.PV>>04184000
      INTEGER GEN:=-1,NPARM:=-1,REQTYPE:=0,ERRTYPE=REQTYPE,    <<RH.PV>>04186000
              MOUNTYPE:=0;                                     <<RH.PV>>04188000
      LOGICAL KEYWD:=FALSE,KEYPARM:=FALSE;                     <<RH.PV>>04190000
      LOGICAL PARMSPEC :=FALSE;                                <<RH.PV>>04192000
      LOGICAL BIND := FALSE;                                   <<RV.PV>>04194000
      DEFINE                                                   <<RH.PV>>04196000
         GENSPEC    = PARMSPEC.(15:1)#;                        <<RH.PV>>04198000
      INTEGER POINTER PARMVAL;                                 <<RH.PV>>04200000
      BYTE ARRAY DL(0:3);                                      <<RH.PV>>04202000
      BYTE ARRAY PDL(*)=PB:=".;=",%15;                         <<RH.PV>>04204000
      DOUBLE ARRAY PARMS(0:5);                                 <<RH.PV>>04206000
      INTEGER ARRAY IPARM(*) = PARMS;                          <<RH.PV>>04208000
      ARRAY VSET(0:14);                                        <<RH.PV>>04210000
      BYTE ARRAY                                               <<RH.PV>>04212000
         VSETB(*)   = VSET,                                    <<RH.PV>>04214000
         VSNAME(*)  = VSET,                                    <<RH.PV>>04216000
         VSGROUP(*) = VSET(5),                                 <<RH.PV>>04218000
         VSACCNT(*) = VSET(10);                                <<RH.PV>>04220000
      BYTE ARRAY STRING'(*) = PB :=                            <<RH.PV>>04222000
         "VSET     ",                                          <<RH.PV>>04224000
         "GROUP    ",                                          <<RH.PV>>04226000
         "ACCOUNT  ",                                          <<RH.PV>>04228000
         "MOUNT    ",                                          <<RH.PV>>04230000
         "DISMOUNT ";                                          <<RH.PV>>04232000
      BYTE ARRAY STRING(0:17);                                 <<RH.PV>>04234000
      BYTE POINTER NAME;                                       <<RH.PV>>04236000
      LOGICAL POINTER PXPNTR;                                  <<RH.PV>>04238000
      EQUATE NOSTRING = -1;                                    <<RH.PV>>04240000
      EQUATE NOHVSET  = 28;  << PVERR 28 >>                    <<RH.PV>>04242000
      EQUATE DUPBIND  = 42;  << PVERR 42 >>                    <<RV.PV>>04244000
      EQUATE INVNAME  = 43;  << PVERR 43 >>                    <<RV.PV>>04246000
      EQUATE  <<DELIMETERS>>                                   <<RH.PV>>04248000
         SEMICOLON = 1,                                        <<RH.PV>>04250000
         EQUALSIGN = 2;                                        << I.A >>04252000
                                                               <<RH.PV>>04254000
                                                               <<RH.PV>>04256000
      SUBROUTINE CXEXIT(ERRN,EADDR,STRINGX);                   <<RH.PV>>04258000
      VALUE ERRN,EADDR,STRINGX;                                <<RH.PV>>04260000
      INTEGER ERRN,STRINGX;                                    <<RH.PV>>04262000
      BYTE POINTER EADDR;                                      <<RH.PV>>04264000
      BEGIN                                                    <<RH.PV>>04266000
         IF ERRN <> 0 THEN                                     <<RH.PV>>04268000
            BEGIN                                              <<RH.PV>>04270000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>04272000
            IF STRINGX = NOSTRING THEN                         <<RH.PV>>04274000
               CIERR(ERRNUM,EADDR)                             <<RH.PV>>04276000
            ELSE                                               <<RH.PV>>04278000
               BEGIN                                           <<RH.PV>>04280000
               MOVE STRING:=STRING'(STRINGX*9),(9);            <<RH.PV>>04282000
               MOVE STRING:=STRING WHILE AN,1;                 <<RH.PV>>04284000
               MOVE * :=%0;  <<GENMSG STOP>>                   <<RH.PV>>04286000
               IF (@NAME:=@EADDR) = 0 THEN  <<NO CARAT>>       <<RH.PV>>04288000
                  CIERR(ERRNUM,,0,@STRING)                     <<RH.PV>>04290000
               ELSE                                            <<RH.PV>>04292000
                  CIERR(ERRNUM,NAME,0,@STRING);                <<RH.PV>>04294000
               END;                                            <<RH.PV>>04296000
            END;                                               <<RH.PV>>04298000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>04300000
      END;<<CXEXIT>>                                           <<RH.PV>>04302000
                                                               <<RH.PV>>04304000
                                                               <<RH.PV>>04306000
      GO TO PROCESS;                                           <<RH.PV>>04308000
CXDISMOUNT:                                                    <<RH.PV>>04310000
      MOUNTYPE:=1;                                             <<RH.PV>>04312000
PROCESS:                                                       <<RH.PV>>04314000
      MOVE DL:=PDL,(4);  <<DELIMITER ARRAY>>                   <<RH.PV>>04316000
      MOVE VSNAME:="*       ";  <<ASSUME HOME VOLUME SET>>     <<RH.PV>>04318000
      VSETB(8):=VSETB(18):=VSETB(28):=" ";  <<TERM CHARS>>     <<RH.PV>>04320000
      MYCOMMAND(PARMSP,DL,6,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>04322000
      IF <> THEN                                               <<RH.PV>>04324000
         BEGIN                                                 <<RH.PV>>04326000
         CIERR(ERRNUM := 242,IPARM(12),%10000,6);              <<04787>>04328000
         RETURN;                                               <<01.RO>>04330000
         END;                                                  <<RH.PV>>04332000
      <<GET DEFAULT GROUP/ACCOUNT SPECIFIERS>>                 <<RH.PV>>04334000
      PUSH(DL);                                                <<RH.PV>>04336000
      @PXPNTR:=TOS-PS0(-1);                                    <<RH.PV>>04338000
      TOS:=@VSET(5);  <<ADDRESS OF VSGROUP>>                   <<RH.PV>>04340000
      TOS:=PXPNTR(PXGWJIT).(6:10);                             <<RH.PV>>04342000
      TOS:=24;   <<WORD LOC OF LOGON GROUP>>                   <<RH.PV>>04344000
      TOS:= 4;   <<TRANSFER COUNT - WORDS>>                    <<RH.PV>>04346000
      ASSEMBLE(MFDS 0);                                        <<RH.PV>>04348000
      S3:=@VSET(10);  <<ADDRESS OF VSACCNT>>                   <<RH.PV>>04350000
      S1:=16;    <<WORD LOC OF ACCOUNT>>                       <<RH.PV>>04352000
      S0:= 4;    <<TRANSFER COUNT - WORDS>>                    <<RH.PV>>04354000
      ASSEMBLE(MFDS 4);                                        <<RH.PV>>04356000
      <<ANALYZE COMMAND - OVERWRITE DEFAULTS IF NECESSARY>>    <<RH.PV>>04358000
      WHILE NUMPARMS <> 0 DO  <<RUN THROUGH PARM LIST>>        <<RH.PV>>04360000
         BEGIN                                                 <<RH.PV>>04362000
         NPARM:=NPARM+1;                                       <<RH.PV>>04364000
         NUMPARMS:=NUMPARMS-1;                                 <<RH.PV>>04366000
         TOS:=PARMS(NPARM);                                    <<RH.PV>>04368000
         ASSEMBLE(XCH);                                        <<RH.PV>>04370000
         @NAME:=TOS;                                           <<RH.PV>>04372000
         DELIM:=LS0.(11:5);                                    <<RH.PV>>04374000
         IF KEYWD THEN  <<ENCOUNTERED A ";">>                  <<RH.PV>>04376000
            BEGIN                                              <<RH.PV>>04378000
            LEN:=TOS.(0:8);                                    <<RH.PV>>04380000
            IF KEYPARM THEN                                    <<RH.PV>>04382000
               BEGIN                                           <<RH.PV>>04384000
               IF LEN = 0 THEN CXEXIT(865,NAME,NOSTRING);      <<RH.PV>>04386000
               KEYWD:=FALSE;                                   <<RH.PV>>04388000
               KEYPARM:=FALSE;                                 <<RH.PV>>04390000
               PARMVAL:=BINARY(NAME,LEN);                      <<RH.PV>>04392000
               IF <> THEN CXEXIT(866,NAME,NOSTRING);           <<RH.PV>>04394000
               IF GENSPEC THEN CIERR(ERRNUM := -320,NAME);     <<04787>>04396000
               GENSPEC:=TRUE;                                  <<RH.PV>>04398000
               END ELSE                                        <<RH.PV>>04400000
            IF LEN = 0 THEN CXEXIT(864,NAME,NOSTRING) ELSE     <<RH.PV>>04402000
            IF NAME = "GEN" THEN  <<GENERATION INDEX>>         <<RH.PV>>04404000
               BEGIN                                           <<RH.PV>>04406000
               IF LEN <> 3 THEN CXEXIT(860,NAME,NOSTRING);     <<RH.PV>>04408000
               IF LOGICAL(MOUNTYPE) THEN                       <<RH.PV>>04410000
                  CXEXIT(867,NAME,NOSTRING);                   <<RH.PV>>04412000
               IF DELIM <> EQUALSIGN THEN                      <<RH.PV>>04414000
                  CXEXIT(312,NAME(LEN+1),NOSTRING);            <<RH.PV>>04416000
               KEYPARM:=TRUE;                                  <<RH.PV>>04418000
               @PARMVAL:=@GEN;                                 <<RH.PV>>04420000
               END ELSE                                        <<RH.PV>>04422000
            CXEXIT(860,NAME,NOSTRING);                         <<RH.PV>>04424000
            IF DELIM=SEMICOLON THEN KEYWD:=TRUE;               <<RH.PV>>04426000
            END                                                <<RH.PV>>04428000
         ELSE                                                  <<RH.PV>>04430000
            BEGIN   <<MUST BE PART OF VOLUME SET NAME>>        <<RH.PV>>04432000
            IF (LS0.(0:8) = 0) AND NUMPARMS = 0 THEN           <<RH.PV>>04434000
               CXEXIT(-306,NAME(-1),NOSTRING);                 <<RH.PV>>04436000
            IF NPARM > 2 THEN CXEXIT(854,NAME,0);              <<RH.PV>>04438000
            IF DELIM = EQUALSIGN THEN                          <<RH.PV>>04440000
               CXEXIT(305,NAME(1),NOSTRING);                   <<RH.PV>>04442000
            IF LS0.(10:1) THEN  <<SPECIAL CHARACTER IN NAME>>  <<RH.PV>>04444000
               IF NOT (BIND := NPARM=0 LAND NAME="*") THEN     <<RV.PV>>04446000
                  CXEXIT(850,NAME,NPARM);                      <<RH.PV>>04448000
            IF LS0.( 9:1) THEN  <<NUMERIC CHARACTER IN NAME>>  <<RH.PV>>04450000
               IF NAME<>ALPHA THEN CXEXIT(851,NAME,NOSTRING);  <<RH.PV>>04452000
            IF (LEN:=TOS.(0:8)) > 8 THEN                       <<RH.PV>>04454000
               CXEXIT(852,NAME,NPARM);                         <<RH.PV>>04456000
            IF LEN = 0 THEN  <<NULL PARAMETER>>                <<RH.PV>>04458000
            IF NPARM > 0 THEN CXEXIT(853,NAME,NPARM) ELSE ELSE <<RH.PV>>04460000
               BEGIN  <<VALID PART OF VS SPECIFIER ENTERED>>   <<RH.PV>>04462000
               REQTYPE := (NOT BIND).(15:1);                   <<RV.PV>>04464000
               MOVE VSETB(NPARM*10):=NAME,(LEN);               <<RH.PV>>04466000
               IF (8-LEN) > 0 THEN <<BLANK REMAINDER OF NAME>> <<RH.PV>>04468000
                  BEGIN                                        <<RH.PV>>04470000
                  MOVE VSETB((NPARM*10)+LEN):=" ",2;           <<RH.PV>>04472000
                  ASSEMBLE(DUP,DECA);                          <<RH.PV>>04474000
                  MOVE * := *,(7-LEN);                         <<RH.PV>>04476000
                  END;                                         <<RH.PV>>04478000
               END;                                            <<RH.PV>>04480000
            END;                                               <<RH.PV>>04482000
            IF DELIM = SEMICOLON THEN KEYWD:=TRUE;             <<RH.PV>>04484000
         END;                                                  <<RH.PV>>04486000
      CASE *MOUNTYPE OF                                        <<RH.PV>>04488000
         BEGIN                                                 <<RH.PV>>04490000
         MOUNT(VSNAME,VSGROUP,VSACCNT,REQTYPE,GEN);            <<RH.PV>>04492000
         DISMOUNT(VSNAME,VSGROUP,VSACCNT,REQTYPE);             <<RH.PV>>04494000
         END;                                                  <<RH.PV>>04496000
      IF <> THEN  <<AN ERROR OF SOME SORT OCCURED>>            <<RH.PV>>04498000
         BEGIN                                                 <<RH.PV>>04500000
         IF ERRTYPE = NOHVSET OR ERRTYPE = DUPBIND OR          <<RV.PV>>04502000
            ERRTYPE = INVNAME THEN                             <<RV.PV>>04504000
            BEGIN                                              <<RH.PV>>04506000
            MOVE STRING:=VSGROUP WHILE AN,1;                   <<RH.PV>>04508000
            MOVE * :=".",2;                                    <<RH.PV>>04510000
            MOVE * :=VSACCNT WHILE AN,1;                       <<RH.PV>>04512000
            MOVE * :=%0;                                       <<RH.PV>>04514000
            GENMSG(PVERRMSGSET,ERRTYPE,0,@STRING);             <<RH.PV>>04516000
            END                                                <<RH.PV>>04518000
         ELSE                                                  <<RH.PV>>04520000
            GENMSG(PVERRMSGSET,ERRTYPE);                       <<RH.PV>>04522000
         CXEXIT(868,ARRDB0,(MOUNTYPE+3));                      <<03.KM>>04524000
         END;                                                  <<RH.PV>>04526000
      END;<<CXMOUNT/CXDISMOUNT>>                               <<RH.PV>>04528000
                                                               <<RH.PV>>04530000
      PROCEDURE CXVSUSER EXECUTORHEAD;                         <<RH.PV>>04532000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>04534000
      BEGIN                                                    <<RH.PV>>04536000
      COMMENT CXVSUSER IS THE EXECUTOR FOR DISPLAYING USERS OF <<RH.PV>>04538000
      MOUNTED VOLUME SETS;                                     <<RH.PV>>04540000
                                                               <<RH.PV>>04542000
      INTEGER NPARM:=-1;                                       <<RH.PV>>04544000
      INTEGER LEN,DELIM,NUMPARMS,ERRTYPE;                      <<RH.PV>>04546000
      LOGICAL DL:=%27015;  <<PERIOD, CARRIAGE RETURN>>         <<RH.PV>>04548000
      DOUBLE ARRAY PARMS(0:3);                                 <<RH.PV>>04550000
      INTEGER ARRAY IPARM(*) = PARMS;                          <<RH.PV>>04552000
      ARRAY VSET(0:11);                                        <<RH.PV>>04554000
      BYTE ARRAY                                               <<RH.PV>>04556000
         VSETB(*)   = VSET,                                    <<RH.PV>>04558000
         VSNAME(*)  = VSET,                                    <<RH.PV>>04560000
         VSGROUP(*) = VSET(4),                                 <<RH.PV>>04562000
         VSACCNT(*) = VSET(8);                                 <<RH.PV>>04564000
      BYTE ARRAY STRING'(*) = PB :=                            <<RH.PV>>04566000
         "VSET     ",                                          <<RH.PV>>04568000
         "GROUP    ",                                          <<RH.PV>>04570000
         "ACCOUNT  ";                                          <<RH.PV>>04572000
      BYTE ARRAY STRING(0:17);                                 <<RH.PV>>04574000
      BYTE POINTER NAME;                                       <<RH.PV>>04576000
      LOGICAL POINTER PXPNTR;                                  <<RH.PV>>04578000
      EQUATE NOSTRING = -1;                                    <<RH.PV>>04580000
      EQUATE NOHVSET  = 28;                                    <<RH.PV>>04582000
                                                               <<RH.PV>>04584000
                                                               <<RH.PV>>04586000
      SUBROUTINE CXEXIT(ERRN,EADDR,STRINGX);                   <<RH.PV>>04588000
      VALUE ERRN,EADDR,STRINGX;                                <<RH.PV>>04590000
      INTEGER ERRN,STRINGX;                                    <<RH.PV>>04592000
      BYTE POINTER EADDR;                                      <<RH.PV>>04594000
      BEGIN                                                    <<RH.PV>>04596000
         IF ERRN <> 0 THEN                                     <<RH.PV>>04598000
            BEGIN                                              <<RH.PV>>04600000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>04602000
            IF STRINGX = NOSTRING THEN                         <<RH.PV>>04604000
               CIERR(ERRNUM,EADDR)                             <<RH.PV>>04606000
            ELSE                                               <<RH.PV>>04608000
               BEGIN                                           <<RH.PV>>04610000
               MOVE STRING:=STRING'(STRINGX*9),(9);            <<RH.PV>>04612000
               MOVE STRING:=STRING WHILE AN,1;                 <<RH.PV>>04614000
               MOVE * :=%0;  <<GENMSG STOP>>                   <<RH.PV>>04616000
               IF (@NAME:=@EADDR) = 0 THEN  <<NO CARAT>>       <<RH.PV>>04618000
                  CIERR(ERRNUM,,0,@STRING)                     <<RH.PV>>04620000
               ELSE                                            <<RH.PV>>04622000
                  CIERR(ERRNUM,NAME,0,@STRING);                <<RH.PV>>04624000
               END;                                            <<RH.PV>>04626000
            END;                                               <<RH.PV>>04628000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>04630000
      END;<<CXEXIT>>                                           <<RH.PV>>04632000
                                                               <<RH.PV>>04634000
                                                               <<RH.PV>>04636000
      MOVE VSNAME:="*       ";  <<ASSUME HOME VOLUME SET>>     <<RH.PV>>04638000
      MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>04640000
      IF <> THEN                                               <<RH.PV>>04642000
         BEGIN                                                 <<RH.PV>>04644000
         CIERR(ERRNUM := 242,IPARM(6),%10000,3);               <<04787>>04646000
         RETURN;                                               <<01.RO>>04648000
         END;                                                  <<RH.PV>>04650000
      <<GET DEFAULT GROUP/ACCOUNT SPECIFIERS>>                 <<RH.PV>>04652000
      PUSH(DL);                                                <<RH.PV>>04654000
      @PXPNTR:=TOS-PS0(-1);                                    <<RH.PV>>04656000
      TOS:=@VSET(4);  <<ADDRESS OF VSGROUP>>                   <<RH.PV>>04658000
      TOS:=PXPNTR(PXGWJIT).(6:10);                             <<RH.PV>>04660000
      TOS:=24;   <<WORD LOC OF LOGON GROUP>>                   <<RH.PV>>04662000
      TOS:= 4;   <<TRANSFER COUNT - WORDS>>                    <<RH.PV>>04664000
      ASSEMBLE(MFDS 0);                                        <<RH.PV>>04666000
      S3:=@VSET(8);  <<ADDRESS OF VSACCNT>>                    <<RH.PV>>04668000
      S1:=16;    <<WORD LOC OF ACCOUNT>>                       <<RH.PV>>04670000
      S0:= 4;    <<TRANSFER COUNT - WORDS>>                    <<RH.PV>>04672000
      ASSEMBLE(MFDS 4);                                        <<RH.PV>>04674000
      <<ANALYZE COMMAND - OVERWRITE DEFAULTS IF NECESSARY>>    <<RH.PV>>04676000
      WHILE (NPARM:=NPARM+1) < NUMPARMS DO                     <<RH.PV>>04678000
         BEGIN                                                 <<RH.PV>>04680000
         TOS:=PARMS(NPARM);                                    <<RH.PV>>04682000
         ASSEMBLE(XCH);                                        <<RH.PV>>04684000
         @NAME:=TOS;                                           <<RH.PV>>04686000
         DELIM:=LS0.(11:5);                                    <<RH.PV>>04688000
         IF (LS0.(0:8) = 0) AND NUMPARMS = 0 THEN              <<RH.PV>>04690000
            CXEXIT(-306,NAME(-1),NOSTRING);                    <<RH.PV>>04692000
         IF NPARM > 2 THEN CXEXIT(854,NAME,0);                 <<RH.PV>>04694000
         IF LS0.(10:1) THEN  <<SPECIAL CHARACTER IN NAME>>     <<RH.PV>>04696000
            IF NOT(NPARM=0 LAND NAME="*") THEN                 <<RH.PV>>04698000
               CXEXIT(850,NAME,NPARM);                         <<RH.PV>>04700000
         IF LS0.( 9:1) THEN  <<NUMERIC CHARACTER IN NAME>>     <<RH.PV>>04702000
            IF NAME<>ALPHA THEN CXEXIT(851,NAME,NOSTRING);     <<RH.PV>>04704000
         IF (LEN:=TOS.(0:8)) > 8 THEN                          <<RH.PV>>04706000
            CXEXIT(852,NAME,NPARM);                            <<RH.PV>>04708000
         IF LEN = 0 THEN  <<NULL PARAMETER>>                   <<RH.PV>>04710000
         IF NPARM > 0 THEN CXEXIT(853,NAME,NPARM) ELSE ELSE    <<RH.PV>>04712000
            BEGIN  <<VALID PART OF VS SPECIFIER ENTERED>>      <<RH.PV>>04714000
            MOVE VSETB(NPARM*8):=NAME,(LEN);                   <<RH.PV>>04716000
            IF (8-LEN) > 0 THEN <<BLANK REMAINDER OF NAME>>    <<RH.PV>>04718000
               BEGIN                                           <<RH.PV>>04720000
               MOVE VSETB((NPARM*8)+LEN):=" ",2;               <<RH.PV>>04722000
               ASSEMBLE(DUP,DECA);                             <<RH.PV>>04724000
               MOVE * := *,(7-LEN);                            <<RH.PV>>04726000
               END;                                            <<RH.PV>>04728000
            END;                                               <<RH.PV>>04730000
         END;                                                  <<RH.PV>>04732000
      ERRTYPE:=VSUSERCOM(0,NUMPARMS,VSNAME);                   <<RH.PV>>04734000
      IF <> THEN  <<AN ERROR OF SOME SORT OCCURED>>            <<RH.PV>>04736000
         BEGIN                                                 <<RH.PV>>04738000
         IF ERRTYPE = NOHVSET  THEN                            <<RH.PV>>04740000
            BEGIN                                              <<RH.PV>>04742000
            MOVE STRING:=VSGROUP WHILE AN,1;                   <<RH.PV>>04744000
            MOVE * :=".",2;                                    <<RH.PV>>04746000
            MOVE * :=VSACCNT WHILE AN,1;                       <<RH.PV>>04748000
            MOVE * :=%0;                                       <<RH.PV>>04750000
            GENMSG(PVERRMSGSET,ERRTYPE,0,@STRING);             <<RH.PV>>04752000
            END                                                <<RH.PV>>04754000
         ELSE                                                  <<RH.PV>>04756000
            GENMSG(PVERRMSGSET,ERRTYPE);                       <<RH.PV>>04758000
         END;                                                  <<RH.PV>>04760000
      END;<<CXVSUSER>>                                         <<RH.PV>>04762000
                                                               <<RH.PV>>04764000
      PROCEDURE CXDSTAT EXECUTORHEAD;                          <<RH.PV>>04766000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>04768000
      BEGIN                                                    <<RH.PV>>04770000
      COMMENT CXDSTAT IS THE EXECUTOR FOR DISPLAYING THE STATUS<<RH.PV>>04772000
      OF DISC DEVICES ON THE SYSTEM;                           <<RH.PV>>04774000
                                                               <<RH.PV>>04776000
      INTEGER LDEV:=0;  <<ASSUME PV DEVICES ONLY>>             <<RH.PV>>04778000
      INTEGER LEN,NUMPARMS,ERRTYPE;                            << I.A >>04780000
      LOGICAL DL:=%15;  <<PERIOD, CARRIAGE RETURN>>            <<RH.PV>>04782000
      DOUBLE ARRAY PARMS(0:1);                                 <<RH.PV>>04784000
      INTEGER ARRAY IPARM(*) = PARMS;                          <<RH.PV>>04786000
      BYTE POINTER PARM;                                       <<RH.PV>>04788000
                                                               <<RH.PV>>04790000
                                                               <<RH.PV>>04792000
      SUBROUTINE CXEXIT(ERRN,EADDR);                           <<RH.PV>>04794000
      VALUE ERRN; INTEGER ERRN;                                <<RH.PV>>04796000
      BYTE ARRAY EADDR;                                        <<RH.PV>>04798000
      BEGIN                                                    <<RH.PV>>04800000
         IF ERRN <> 0 THEN                                     <<RH.PV>>04802000
            BEGIN                                              <<RH.PV>>04804000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>04806000
            CIERR(ERRNUM,EADDR);                               <<RH.PV>>04808000
            END;                                               <<RH.PV>>04810000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>04812000
      END;<<CXEXIT>>                                           <<RH.PV>>04814000
                                                               <<RH.PV>>04816000
                                                               <<RH.PV>>04818000
      MYCOMMAND(PARMSP,DL,1,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>04820000
      IF <> THEN                                               <<RH.PV>>04822000
         BEGIN                                                 <<RH.PV>>04824000
         CIERR(ERRNUM := 242,IPARM(2),%10000,1);               <<04787>>04826000
         RETURN;                                               <<01.RO>>04828000
         END;                                                  <<RH.PV>>04830000
      IF NUMPARMS <> 0 THEN  <<PARM ENTERED>>                  <<RH.PV>>04832000
         BEGIN                                                 <<RH.PV>>04834000
         TOS:=PARMS;                                           <<RH.PV>>04836000
         ASSEMBLE(XCH);                                        <<RH.PV>>04838000
         @PARM:=TOS; <<BYTE ADDRESS OF PARAMETER STRING>>      <<RH.PV>>04840000
         IF (LEN:=LS0.(0:8)) > 3 THEN                          <<RH.PV>>04842000
            CXEXIT(860,PARM);                                  <<RH.PV>>04844000
         IF PARM = "ALL" THEN LDEV:=-1 ELSE                    <<RH.PV>>04846000
         IF (TOS.(8:3) = %2) THEN  <<NUMERIC ONLY>>            <<RH.PV>>04848000
            BEGIN                                              <<RH.PV>>04850000
            LDEV:=BINARY(PARM,LEN);                            <<RH.PV>>04852000
            IF <> OR LDEV <= 0 THEN                            <<RH.PV>>04854000
               CXEXIT(866,PARM);                               <<RH.PV>>04856000
            END                                                <<RH.PV>>04858000
         ELSE                                                  <<RH.PV>>04860000
            CXEXIT(860,PARM);                                  <<RH.PV>>04862000
         END;                                                  <<RH.PV>>04864000
      ERRTYPE:=DSTATCOM(0,LDEV);                               <<RH.PV>>04866000
      IF <> THEN GENMSG(PVERRMSGSET,ERRTYPE,%10000,LDEV);      <<RH.PV>>04868000
      END<<CXDSTAT>>;                                          <<RH.PV>>04870000
                                                               <<RH.PV>>04872000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>04874000
      PROCEDURE CXCONTINUE EXECUTORHEAD;                                04876000
      OPTION PRIVILEGED,UNCALLABLE;                                     04878000
      BEGIN                                                             04880000
      COMMENT                                                           04882000
      CXCONTINUE IS THE EXECUTOR FOR THE CONTINUE,ABORT AND             04884000
      RESUME COMMANDS                                                   04886000
      COMMAND FORMAT                                                    04888000
      ABORT                                                             04890000
      CONTINUE                                                          04892000
      RESUME                                                            04894000
      ;                                                                 04896000
      ENTRY CXABORT,CXRESUME;                                  <<DS.06>>04898000
      INTEGER NUMPARMS;                                                 04900000
      DOUBLE  PARMS;                                           <<DS.06>>04902000
      LOGICAL CONTINUE:=0,ABORT:=0;                                     04904000
      LOGICAL READFLAG := FALSE;                               <<DS0.0>>04906000
      LOGICAL RMOTBRK:=FALSE;                                  <<DS.06>>04908000
      INTEGER IABORT  = ABORT;                                 <<DS.06>>04910000
      INTEGER IRDFLAG = READFLAG;                              <<DS.06>>04912000
                                                                        04914000
      CONTINUE:=CONTINUE+1;<<SET CONTINUE FLAG>>                        04916000
CXABORT:                                                                04918000
      IABORT:=IABORT+1;                                        <<DS.06>>04920000
      IRDFLAG:=IRDFLAG-1;                                      <<DS.06>>04922000
CXRESUME:                                                               04924000
      MYCOMMAND(PARMSP,,0,NUMPARMS,PARMS);<<CHECK COMMAND>>             04926000
      IF <> THEN                                               <<01308>>04928000
      BEGIN                                                    <<01308>>04930000
         IF ABORT AND NOT CONTINUE THEN                        <<01652>>04932000
         BEGIN                                                 <<01308>>04934000
            CIERR( ERRNUM := NOABORTPARMS, PARMSP );           <<01308>>04936000
            RETURN;                                            <<01308>>04938000
         END                                                   <<01308>>04940000
         ELSE                                                  <<01308>>04942000
            CIERR( ERRNUM := -WARNXPARMSIGNORED, PARMSP );     <<04787>>04944000
      END;                                                     <<01308>>04946000
      SETXPXFIXED;<<SET X TO PCBX FIXED>>                               04948000
      IF CONTINUE THEN                                                  04950000
         BEGIN<<CONTINUE>>                                              04952000
         CIS'CONTSTATE := 1;  << FLAG CONTINUE JUST READ >>    << I.A >>04954000
         RETURN;                                                        04956000
         END;                                                           04958000
      TOS:=PXFWBREAK+X;  <<SET TO BREAK>>                      <<DS.06>>04960000
      TOS:=0;                                                  <<DS.06>>04962000
      TOS:=IABORT+1;                                           <<DS.06>>04964000
      TOS:=PCBNUM;                                             <<DS.06>>04966000
      TOS:=ABSOLUTE(%1360);                                    <<DS.06>>04968000
      IF <> THEN ASSEMBLE(PCAL 0) ELSE ASSEMBLE(DDEL,DEL);     <<DS.06>>04970000
      RMOTBRK:=TOS;                                            <<DS.06>>04972000
      X:=TOS;                                                  <<DS.06>>04974000
      IF DBARRAY(X)=0 THEN<<CHECK IF IN BREAK>>                         04976000
         BEGIN<<RESUME & ABORT ALLOWED ONLY IN BREAK>>                  04978000
         IF NOT RMOTBRK THEN CIERR(ERRNUM := -ONLYINBREAK);    <<04787>>04980000
         RETURN;                                                        04982000
         END;                                                           04984000
      DBARRAY(X):=0;<<RESET BREAK>>                                     04986000
                                                               <<00835>>04988000
      << CHECK IF EXITING BREAK MODE WHILE 'IF' NESTED >>      <<00835>>04990000
      IF CIS'IFNESTING <>0 THEN CIERR(ERRNUM:=-IFS'NEQ'ENDIFS);<<04787>>04992000
                                                               <<00835>>04994000
      FUNBREAK(READFLAG);                                               04996000
      IF ABORT THEN ABORTPROG;                                          04998000
      CIS'UDCEXITBREAK := TRUE;                                << I.A >>05000000
END;  <<CXCONTINUE/CXRESUME/CXABORT>>                          <<U.RAO>>05002000
$TITLE "REDO COMMAND"                                          <<08.RO>>05004000
PROCEDURE CXREDO EXECUTORHEAD;                                 <<U.RAO>>05006000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>05008000
BEGIN  <<EXECUTOR FOR THE REDO COMMAND>>                       <<U.RAO>>05010000
<<BASIC SCHEME FOR REDO COMMAND IS AS FOLLOWS.                 <<U.RAO>>05012000
<<THE CI COMMAND BUFFER IS ACTUALLY DOUBLE BUFFERED.  AFTER    <<U.RAO>>05014000
<<EACH COMMAND IS EXECUTED, IT IS COPIED TO THE BUFFER         <<U.RAO>>05016000
<<LASTCOMIMAGE.  WHEN REDO IS INVOKED IT REACHES BACK TO THIS  <<U.RAO>>05018000
<<COPY FOR THE LAST COMMAND BEFORE REDO.                       <<U.RAO>>05020000
<<REDO ITSELF HAS A THIRD OPERATIONAL BUFFER, CALLED           <<U.RAO>>05022000
<<LOCALCOMIMAGE.  ALL OPERATIONS, EXCEPT REDO, ARE PERFORMED IN<<U.RAO>>05024000
<<THIS BUFFER, SO THAT WE CAN RECOVER FROM ERRORS AND DO THE   <<U.RAO>>05026000
<<UNDO FUNCTION.                                               <<U.RAO>>05028000
<<THE BASIC SCHEME IS VERY STRAIGHTFORWARD.  IT CONSISTS OF    <<U.RAO>>05030000
<<LOOPING, READING AND EXECUTING THE USER'S REQUESTS FOR       <<U.RAO>>05032000
<<EDITING FUNCTIONS, UNTIL THE USER DECIDES TO STOP.  EACH OF  <<U.RAO>>05034000
<<THE FUNCTIONS IS DESCRIBED IN ITS SUBROUTINE.  COMMUNICATION <<U.RAO>>05036000
<<BACK TO THE CI IS THROUGH THE "ALREADY READ" FLAG AT         <<U.RAO>>05038000
<<PXFIXED(32).  THIS COMMAND IS BREAKABLE, WITH BREAK BEING    <<U.RAO>>05040000
<<DEFINED AS "FORGET IT".  AN EDIT REQUEST LINE WITH JUST      <<U.RAO>>05042000
<<BLANKS IN IT IS IGNORED.  A REQUEST READ OF 0 SAYS "I'M      <<U.RAO>>05044000
<<FINISHED, EXECUTE IT."                                       <<U.RAO>>05046000
ARRAY LOCALCOMIMAGE(0:CIS'WCOMBUFLEN); << LOCAL WORK SPACE >>  << I.A >>05048000
BYTE ARRAY BLOCALCOMIMAGE(*) = LOCALCOMIMAGE;                  <<U.RAO>>05050000
ARRAY USERREQBUF(0:CIS'WCOMBUFLEN);  << FOR USER REQUESTS >>   << I.A >>05052000
BYTE ARRAY BUSERREQBUF(*) = USERREQBUF;                        <<U.RAO>>05054000
INTEGER LOCALCOMLEN;  <<LENGTH OF COMMAND IN LOCALCOMIMAGE>>   <<U.RAO>>05056000
INTEGER COMLEN;  <<LENGTH OF COMMAND IN WCOMIMAGE (IN DB SPACE)<<U.RAO>>05058000
INTEGER LASTCOMLEN;  <<LENGTH OF COMMAND IN LASTCOMIMAGE>>     <<U.RAO>>05060000
INTEGER USERREQLEN;  <<LENGTH OF IMAGE IN USERREQBUF>>         <<U.RAO>>05062000
INTEGER DATAOFFSET;  <<DISTANCE TO DATA IN USERREQBUF>>        <<U.RAO>>05064000
INTEGER DATALEN;  <<LENGTH OF OPERATIVE FIELD IN USERREQBUF>>  <<U.RAO>>05066000
INTEGER UNDOCOUNT := 0;  <<# UNDO REQUESTS SEEN>>              <<U.RAO>>05068000
LOGICAL LOOPING := TRUE;  <<CONTROL FLAG ON WHILE LOOP>>       <<U.RAO>>05070000
LOGICAL DL := %6400;  <<FOR MYCOMMAND SEARCH FOR PARMS>>       <<U.RAO>>05072000
                                                               <<U.RAO>>05074000
<<                 *********************                   >>  <<U.RAO>>05076000
<<                 *      DOUNDO       *                   >>  <<U.RAO>>05078000
<<                 *********************                   >>  <<U.RAO>>05080000
                                                               <<U.RAO>>05082000
SUBROUTINE DOUNDO(UPTR);                                       <<U.RAO>>05084000
BYTE ARRAY UPTR;  << POINTS TO "U" IN USERREQBUF.  UNUSED.>>   <<U.RAO>>05086000
BEGIN                                                          <<U.RAO>>05088000
<<UNDO CAN DO TWO LEVELS: UNDO THE LAST COMMAND, AND, IF >>    <<U.RAO>>05090000
<<REQUESTED AGAIN, UNDO ALL THE WAY BACK TO THE ORIGINAL.>>    <<U.RAO>>05092000
<<THE ORIGINAL IS STASHED IN LASTCOMIMAGE AND IS NEVER   >>    <<U.RAO>>05094000
<<TOUCHED BY REDO.                                       >>    <<U.RAO>>05096000
<<NOTE THAT UNDOCOUNT IS CLEARED WHENEVER ANY OF THE     >>    <<U.RAO>>05098000
<<OTHER FUNCTIONS IS EXECUTED.                           >>    <<U.RAO>>05100000
IF UNDOCOUNT>0 THEN   <<SECOND OR LATER UNDO>>                 <<U.RAO>>05102000
   BEGIN                                                       <<U.RAO>>05104000
   COMLEN := LASTCOMLEN;                                       <<U.RAO>>05106000
   MOVE CIS'WCOMIMAGE := CIS'LASTCOMIMAGE, (LASTCOMLEN/2+1);   << I.A >>05108000
   END;                                                        <<U.RAO>>05110000
MOVE LOCALCOMIMAGE := CIS'WCOMIMAGE, (COMLEN/2+1);             << I.A >>05112000
LOCALCOMLEN := COMLEN;                                         <<U.RAO>>05114000
UNDOCOUNT := UNDOCOUNT+1;                                      <<U.RAO>>05116000
END;  <<SUBROUTINE DOUNDO>>                                    <<U.RAO>>05118000
                                                               <<U.RAO>>05120000
<<                 *********************                   >>  <<U.RAO>>05122000
<<                 *     DOREPLACE     *                   >>  <<U.RAO>>05124000
<<                 *********************                   >>  <<U.RAO>>05126000
                                                               <<U.RAO>>05128000
SUBROUTINE DOREPLACE(RPTR);                                    <<U.RAO>>05130000
BYTE ARRAY RPTR;  <<POINTS TO "R" IN USERREQBUF>>              <<U.RAO>>05132000
BEGIN                                                          <<U.RAO>>05134000
<<STRATEGY FOR REPLACE FUNCTION:                         >>    <<U.RAO>>05136000
<<SIMPLY DO MOVE TO REPLACE OLD DATA WITH NEW DATA.      >>    <<U.RAO>>05138000
<<ONLY COMPLICATION IS IF START OF MOVE IS BEYOND END OF >>    <<U.RAO>>05140000
<<CURRENT COMMAND, MUST BLANK FILL CURRENTLY UNUSED SPACE>>    <<U.RAO>>05142000
<<NOTE THAT THE REPLACE FUNCTION IS THE DEFAULT CASE, IF >>    <<U.RAO>>05144000
<<THE FUNCTION CODE IS NOT U,R,I,D,u,r,i,d.  IN THIS CASE>>    <<U.RAO>>05146000
<<IT IS ASSUMED THAT NO FUNCTION CODE WAS SUPPLIED.      >>    <<U.RAO>>05148000
                                                               <<U.RAO>>05150000
<<ADJUST POINTER FOR "R">>                                     <<U.RAO>>05152000
DATAOFFSET := @RPTR-@BUSERREQBUF;  <<START ADDR OF REPLACE>>   <<U.RAO>>05154000
IF RPTR ="R" OR RPTR ="r" THEN                                 <<U.RAO>>05156000
   BEGIN  <<SKIP OVER "R" FOR ACTUAL DATA>>                    <<U.RAO>>05158000
   @RPTR := @RPTR+1;                                           <<U.RAO>>05160000
   USERREQLEN := USERREQLEN-1;                                 <<U.RAO>>05162000
   END;                                                        <<U.RAO>>05164000
IF USERREQLEN > CIS'MAXCOMLEN THEN                             << I.A >>05166000
   CIERR(ERRNUM := REDOITOOLONG,,%10000,      << OVERFLOW >>   <<04787>>05168000
           CIS'MAXCOMLEN)                                      <<04787>>05170000
ELSE                                                           <<01455>>05172000
BEGIN                                                          <<01455>>05174000
IF DATAOFFSET>LOCALCOMLEN THEN                                 <<U.RAO>>05176000
   BEGIN  <<BLANK FILL SPACE BETWEEN END OF COMMAND AND DATA>> <<U.RAO>>05178000
   BLOCALCOMIMAGE(LOCALCOMLEN) := " ";                         <<U.RAO>>05180000
   MOVE BLOCALCOMIMAGE(LOCALCOMLEN+1) :=                       <<U.RAO>>05182000
       BLOCALCOMIMAGE(LOCALCOMLEN), (DATAOFFSET-1-LOCALCOMLEN);<<U.RAO>>05184000
   END;                                                        <<U.RAO>>05186000
<<NOW DO REPLACE>>                                             <<U.RAO>>05188000
MOVE BLOCALCOMIMAGE(DATAOFFSET) := RPTR,                       <<U.RAO>>05190000
      (USERREQLEN-DATAOFFSET);                                 <<U.RAO>>05192000
IF LOCALCOMLEN < USERREQLEN THEN                               <<U.RAO>>05194000
   BEGIN  <<ADJUST END OF COMMAND LINE>>                       <<U.RAO>>05196000
   LOCALCOMLEN := USERREQLEN;                                  <<U.RAO>>05198000
   BLOCALCOMIMAGE(LOCALCOMLEN) := %15;                         <<U.RAO>>05200000
   END;                                                        <<U.RAO>>05202000
END;                                                           <<01455>>05204000
END;  <<SUBROUTINE DOREPLACE>>                                 <<U.RAO>>05206000
                                                               <<U.RAO>>05208000
<<                 *********************                   >>  <<U.RAO>>05210000
<<                 *     DOINSERT      *                   >>  <<U.RAO>>05212000
<<                 *********************                   >>  <<U.RAO>>05214000
                                                               <<U.RAO>>05216000
SUBROUTINE DOINSERT(IPTR);                                     <<U.RAO>>05218000
BYTE ARRAY IPTR;  <<BYTE POINTER TO "I" IN USERREQBUF>>        <<U.RAO>>05220000
BEGIN                                                          <<U.RAO>>05222000
<<STRATEGY FOR INSERT:                               >>        <<U.RAO>>05224000
<<    CASE 1:  ENTIRE INSERT IS BEYOND CURRENT END OF>>        <<U.RAO>>05226000
<<       LINE.  DO REPLACE INSTEAD.                  >>        <<U.RAO>>05228000
<<    CASE 2:  INSERT IS WITHIN CURRENT END OF LINE. >>        <<U.RAO>>05230000
<<       MUST CHECK TO SEE THAT NEW LINE LENGTH IS   >>        <<U.RAO>>05232000
<<       GOING TO FIT OUR BUFFERS.  IF IT DOES, WE   >>        <<U.RAO>>05234000
<<       THEN OPEN A HOLE IN LOCALCOMIMAGE THE SIZE  >>        <<U.RAO>>05236000
<<       OF THE INSERT, THEN DO THE INSERT.          >>        <<U.RAO>>05238000
DATAOFFSET := @IPTR-@BUSERREQBUF;  <<DISTANCE TO INPUT DATA>>  <<U.RAO>>05240000
IF DATAOFFSET >= LOCALCOMLEN THEN                              <<U.RAO>>05242000
   BEGIN  <<ADDING BEYOND CURRENT END OF LINE>>                <<U.RAO>>05244000
   IPTR := "R";  <<SIMULATE REPLACE INSTEAD.>>                 <<U.RAO>>05246000
   DOREPLACE(IPTR)                                             <<U.RAO>>05248000
   END                                                         <<U.RAO>>05250000
ELSE  <<INSERT WITHIN CURRENT END OF LINE.>>                   <<U.RAO>>05252000
   BEGIN                                                       <<U.RAO>>05254000
   DATALEN := USERREQLEN-DATAOFFSET-1;  <<AMOUNT TO INSERT>>   <<U.RAO>>05256000
   IF LOCALCOMLEN + DATALEN > CIS'MAXCOMLEN THEN               << I.A >>05258000
      CIERR(ERRNUM := REDOITOOLONG,,%10000,      << OVERFLOW >><<04787>>05260000
           CIS'MAXCOMLEN)                                      <<04787>>05262000
   ELSE                                                        <<U.RAO>>05264000
      BEGIN  <<NEW LINE WILL FIT BUFFER, DO INSERT>>           <<U.RAO>>05266000
      <<FIRST ADJUST OLD LINE TO OPEN HOLE FOR INSERT>>        <<U.RAO>>05268000
      MOVE BLOCALCOMIMAGE(LOCALCOMLEN+DATALEN) <<END OF NEW CMD<<U.RAO>>05270000
           := BLOCALCOMIMAGE(LOCALCOMLEN),  <<END OF OLD CMD>> <<U.RAO>>05272000
              (DATAOFFSET-LOCALCOMLEN-1);  <<GETS CR AS WELL>> <<U.RAO>>05274000
      <<OLD LINE IS NOW ADJUSTED IN LOCALCOMIMAGE.  INSERT DATA<<U.RAO>>05276000
      MOVE BLOCALCOMIMAGE(DATAOFFSET) := IPTR(1),(DATALEN);    <<U.RAO>>05278000
      LOCALCOMLEN := LOCALCOMLEN+DATALEN;                      <<U.RAO>>05280000
      END;                                                     <<U.RAO>>05282000
   END;                                                        <<U.RAO>>05284000
END;   <<SUBROUTINE DOINSERT>>                                 <<U.RAO>>05286000
                                                               <<U.RAO>>05288000
<<                 *********************                   >>  <<U.RAO>>05290000
<<                 *     DODELETE      *                   >>  <<U.RAO>>05292000
<<                 *********************                   >>  <<U.RAO>>05294000
                                                               <<U.RAO>>05296000
SUBROUTINE DODELETE(DPTR);                                     <<U.RAO>>05298000
BYTE ARRAY DPTR;  <<POINTER TO "D" IN USERREQBUF>>             <<U.RAO>>05300000
BEGIN                                                          <<U.RAO>>05302000
<<DELETE IS THE MOST COMPLICATED OF THE EDIT FUNCTIONS.      >><<U.RAO>>05304000
<<POSSIBLE INPUTS ARE:                                       >><<U.RAO>>05306000
<<   "D", "D..D","D    D","D   ","DI...","D  DI","DDDI",D..XX>><<U.RAO>>05308000
<<THE STRATEGY IS: FIRST DEAL WITH THE DELETION PART. COMPUTE>><<U.RAO>>05310000
<<THE NUMBER OF DELETIONS TO DO AND THE LOCATION AT WHICH TO >><<U.RAO>>05312000
<<DO THEM.  THEN DO THE DELETIONS.  FINALLY, IF NECESSARY,   >><<U.RAO>>05314000
<<DEAL WITH THE INSERTION QUESTION OR THE GARBAGE BEYOND THE >><<U.RAO>>05316000
<<LAST DELETION.                                             >><<U.RAO>>05318000
DATAOFFSET := @DPTR-@BUSERREQBUF;                              <<U.RAO>>05320000
<<COUNT THE NUMBER TO DELETE.  THIS IS A COMPLICATED FUNCTION>><<U.RAO>>05322000
<<DUE TO THE NUMBER OF DIFFERENT WAYS OF SPECIFYING THIS.    >><<U.RAO>>05324000
DATALEN := 1;  <<SINCE WE KNOW WE HAVE AT LEAST ONE DELETION>> <<U.RAO>>05326000
@DPTR := @DPTR+1;  <<SKIP THE FIRST "D">>                      <<U.RAO>>05328000
IF DPTR = "D" OR DPTR = "d" THEN  <<CONTIGUOUS D'S>>           <<U.RAO>>05330000
   DO   <<COUNT OF CONTIGUOUS D'S>>                            <<U.RAO>>05332000
      BEGIN                                                    <<U.RAO>>05334000
      DATALEN := DATALEN+1;                                    <<U.RAO>>05336000
      @DPTR := @DPTR+1;  <<SKIP THIS D>>                       <<U.RAO>>05338000
      END                                                      <<U.RAO>>05340000
   UNTIL DPTR <> "D" AND DPTR <> "d"                           <<U.RAO>>05342000
ELSE  <<COULD BE "D  D" OR "D  " OR "D(CR)">>                  <<U.RAO>>05344000
   BEGIN                                                       <<U.RAO>>05346000
   SCAN DPTR WHILE %6440,1;  <<FIND NEXT NON-BLANK>>           <<U.RAO>>05348000
   S2 := TOS;  <<SAVE ITS ADDRESS IN DPTR>>                 <<U.RAO>>   05350000
   IF NOCARRY THEN   <<NOT CR, COULD BE "D">>                  <<U.RAO>>05352000
      IF DPTR = "D" OR DPTR = "d" THEN  <<FOUND D'S SEPARATED>><<U.RAO>>05354000
         BEGIN  <<BY BLANKS, COUNT THE SPACES BETWEEN.>>       <<U.RAO>>05356000
         DATALEN := @DPTR-@BUSERREQBUF-DATAOFFSET+1;           <<U.RAO>>05358000
         @DPTR := @DPTR+1;  <<SKIP TRAILING D>>                <<U.RAO>>05360000
         END;                                                  <<U.RAO>>05362000
   END;                                                        <<U.RAO>>05364000
<<DPTR = ADDR OF a) (CR), b) "I", c) NEXT CHAR BEYOND "D">>    <<U.RAO>>05366000
<<HAVE COMPLETED FIRST STEP, COUNTING THE NUMBER OF DELETIONS.><<U.RAO>>05368000
<<ALSO HAVE DISTANCE TO START OF DELETIONS IN DATAOFFSET.>>    <<U.RAO>>05370000
<<NEXT STEP IS TO PERFORM DELETION.>>                          <<U.RAO>>05372000
<<THREE CASES:                                           >>    <<U.RAO>>05374000
<< 1)  DELETION IS COMPLETELY BEYOND CURRENT END OF LINE.>>    <<U.RAO>>05376000
<<     ACTION IS DO NOTHING.                             >>    <<U.RAO>>05378000
<< 2)  DELETION CROSSES END OF CURRENT LINE.             >>    <<U.RAO>>05380000
<<     ACTION IS MOVE TRAILING CR, ADJUST LINE LENGTH.   >>    <<U.RAO>>05382000
<< 3)  DELETION IS COMPLETELY WITHIN CURRENT LINE.       >>    <<U.RAO>>05384000
<<     ACTION IS DO MOVE WITHIN LINE, DESTROYING DELETED >>    <<U.RAO>>05386000
<<     DATA.                                             >>    <<U.RAO>>05388000
IF DATAOFFSET < LOCALCOMLEN THEN  <<DELETE STARTS WITHIN LINE>><<U.RAO>>05390000
   BEGIN                                                       <<U.RAO>>05392000
   IF DATAOFFSET+DATALEN > LOCALCOMLEN THEN                    <<U.RAO>>05394000
      BEGIN  <<DELETE CROSSES END OF LINE.>>                   <<U.RAO>>05396000
      BLOCALCOMIMAGE(DATAOFFSET) := %15;                       <<U.RAO>>05398000
      LOCALCOMLEN := DATAOFFSET;                               <<U.RAO>>05400000
      END                                                      <<U.RAO>>05402000
   ELSE  <<DELETE ENTIRELY WITHIN CURRENT LINE>>               <<U.RAO>>05404000
      BEGIN                                                    <<U.RAO>>05406000
      MOVE BLOCALCOMIMAGE(DATAOFFSET) <<START ADDRESS OF DELETE<<U.RAO>>05408000
         := BLOCALCOMIMAGE(DATAOFFSET+DATALEN)  <<END ADDRESS>><<U.RAO>>05410000
            ,(LOCALCOMLEN-DATAOFFSET-DATALEN+1);<<TO END OF BUF<<U.RAO>>05412000
      LOCALCOMLEN := LOCALCOMLEN-DATALEN;                      <<U.RAO>>05414000
      END;                                                     <<U.RAO>>05416000
   END;  <<OF DELETION PHASE>>                                 <<U.RAO>>05418000
<<NOW HAVE FINISHED DOING DELETION OPERATION.  NOW JUST >>     <<U.RAO>>05420000
<<DEAL WITH ANY TRAILING GARBAGE OR INSERTION REQUEST.>>       <<U.RAO>>05422000
<<REMEMBER THAT DPTR POINTS TO THE PLACE WHERE WE LEFT>>       <<U.RAO>>05424000
<<OFF OUR SCAN.  A SIDE POINT: EVEN IF GARBAGE IS OUT THERE,>> <<U.RAO>>05426000
<<WE WILL STILL DO THE DELETION, SO WHAT IS IN LASTCOMIMAGE>>  <<U.RAO>>05428000
<<ON THE NEXT TIME THROUGH THE LOOP WILL REFLECT THE DELETE.>> <<U.RAO>>05430000
<<THIS IS PROBABLY A FEATURE.>>                                <<U.RAO>>05432000
SCAN DPTR WHILE %6440,1;  <<SKIP BLANKS TO NEXT NON-BLANK>>    <<U.RAO>>05434000
S2 := TOS;   <<SAVE ITS ADDRESS IN DPTR>>                   <<U.RAO>>   05436000
IF NOCARRY THEN   <<SOMETHING THERE.>>                         <<U.RAO>>05438000
   IF DPTR="I" OR DPTR="i" THEN                                <<U.RAO>>05440000
      BEGIN   <<DO INSERTION TRICK>>                           <<U.RAO>>05442000
      @DPTR := @DPTR-DATALEN;  <<AS IF DELETE WASN'T THERE>>   <<U.RAO>>05444000
      USERREQLEN := USERREQLEN-DATALEN;                        <<U.RAO>>05446000
      MOVE DPTR := DPTR(DATALEN)                               <<U.RAO>>05448000
            ,(USERREQLEN-DATAOFFSET+1);                        <<U.RAO>>05450000
      DOINSERT(DPTR);                                          <<U.RAO>>05452000
      END                                                      <<U.RAO>>05454000
   ELSE  <<GARBAGE THERE>>                                     <<U.RAO>>05456000
      CIERR(ERRNUM := REDODELGARBAGE);                         <<04787>>05458000
END;   <<SUBROUTINE DODELETE>>                                 <<U.RAO>>05460000
<<**********  MAIN BODY  *************>>                       <<U.RAO>>05462000
<<STEP 1 - CHECK FOR (ILLEGAL) PARAMETERS>>                    <<U.RAO>>05464000
MYCOMMAND(PARMSP, DL, 0);                                      <<U.RAO>>05466000
IF <> THEN                                                     <<U.RAO>>05468000
   CIERR(ERRNUM := -WARNXPARMSIGNORED, PARMSP);                <<04787>>05470000
<<STEP 2 - SET UP BUFFERS AND BUFFER LENGTHS>>                 <<U.RAO>>05472000
SCAN CIS'BLASTCOMIMAGE UNTIL %6415, 1;                         << I.A >>05474000
COMLEN := TOS - @CIS'BLASTCOMIMAGE;                            << I.A >>05476000
IF COMLEN > CIS'BCOMBUFLEN THEN  << ERROR:  NO <CR>  >>        << I.A >>05478000
   BEGIN                                                       <<01455>>05480000
   COMLEN := CIS'MAXCOMLEN;                                    << I.A >>05482000
   CIS'BLASTCOMIMAGE( CIS'MAXCOMLEN ) := %15;                  << I.A >>05484000
   END;                                                        <<01455>>05486000
LOCALCOMLEN := LASTCOMLEN := COMLEN;                           <<00526>>05488000
MOVE CIS'WCOMIMAGE := CIS'LASTCOMIMAGE, (COMLEN/2+1);          << I.A >>05490000
MOVE LOCALCOMIMAGE := CIS'LASTCOMIMAGE, (COMLEN/2+1);          << I.A >>05492000
<<NOW LOOP WHILE DOING USER EDIT REQUESTS>>                    <<U.RAO>>05494000
WHILE LOOPING AND NOT REQUESTSERVICE DO                        <<U.RAO>>05496000
   BEGIN                                                       <<U.RAO>>05498000
   <<READ USER REQUEST>>                                       <<U.RAO>>05500000
   PRINT(LOCALCOMIMAGE, -LOCALCOMLEN, 0);                      <<U.RAO>>05502000
   USERREQLEN := READ(USERREQBUF, -CIS'BCOMBUFLEN );           << I.A >>05504000
   IF <> THEN << EOF OR IO ERROR ON  $STDIN >>                 <<00832>>05506000
      BEGIN   << ABORT REDO >>                                 <<00832>>05508000
      CIS'PENDINGCOMLEN := 0;  << SO CI WILL TRY READ >>       << I.A >>05510000
      IF < THEN CIERR(ERRNUM := ERRSTDINIO);                   <<04787>>05512000
      RETURN;                                                  <<00832>>05514000
      END;                                                     <<00832>>05516000
   BUSERREQBUF(USERREQLEN) := %15;  <<ADD TRAILING CR>>        <<U.RAO>>05518000
   IF REQUESTSERVICE THEN <<HIT BREAK DURING READ, BAIL OUT>>  <<U.RAO>>05520000
      LOOPING := FALSE                                         <<U.RAO>>05522000
   ELSE IF USERREQLEN = 0 THEN  <<FINISHED EDITING,>>          <<U.RAO>>05524000
      BEGIN  <<SET CI "COMMAND ALREADY READ" FLAG, EXIT>>      <<U.RAO>>05526000
      MOVE CIS'WCOMIMAGE := LOCALCOMIMAGE, (LOCALCOMLEN/2+1);  << I.A >>05528000
      CIS'PENDINGCOMLEN := LOCALCOMLEN; << GETIMAGE FLAG >>    << I.A >>05530000
      CIS'LINELENSTACK(1) := 0;  << KILL ERR CARET ROUTINE >>  << I.A >>05532000
      CIS'LINELENSTACK := LOCALCOMLEN;                         << I.A >>05534000
      LOOPING := FALSE;                                        <<U.RAO>>05536000
      END                                                      <<U.RAO>>05538000
   ELSE   <<REAL EDIT REQUEST (PROBABLY)>>                     <<U.RAO>>05540000
      BEGIN                                                    <<U.RAO>>05542000
      SCAN BUSERREQBUF WHILE %6440,1;  <<SCAN UNTIL NON-BLANK>><<U.RAO>>05544000
      IF CARRY THEN   <<FOUND BLANKS, CR  => NO REQUEST>>      <<U.RAO>>05546000
         DEL  <<POP POINTER, LOOP FOR ANOTHER TRY>>            <<U.RAO>>05548000
      ELSE                                                     <<U.RAO>>05550000
         BEGIN  <<CHOOSE ROUTINE BASED ON CHARACTER FOUND>>    <<U.RAO>>05552000
         XREG := BPS0;  <<STASH CHARACTER IN XREG>>            <<U.RAO>>05554000
         IF XREG = "U" OR XREG = "u" THEN                      <<U.RAO>>05556000
            DOUNDO(*)                                          <<U.RAO>>05558000
         ELSE                                                  <<U.RAO>>05560000
            BEGIN   <<NON-UNDO FUNCTION, SAVE RESULTS OF LAST E<<U.RAO>>05562000
            MOVE CIS'WCOMIMAGE                                 << I.A >>05564000
               := LOCALCOMIMAGE, (LOCALCOMLEN/2+1);            << I.A >>05566000
            COMLEN := LOCALCOMLEN;                             <<U.RAO>>05568000
            UNDOCOUNT := 0;                                    <<U.RAO>>05570000
            IF XREG = "D" OR XREG = "d" THEN                   <<U.RAO>>05572000
               DODELETE(*)                                     <<U.RAO>>05574000
            ELSE IF XREG = "I" OR XREG = "i" THEN              <<U.RAO>>05576000
               DOINSERT(*)                                     <<U.RAO>>05578000
            ELSE                                               <<U.RAO>>05580000
               DOREPLACE(*);                                   <<U.RAO>>05582000
            END;                                               <<U.RAO>>05584000
         END;                                                  <<U.RAO>>05586000
      END;                                                     <<U.RAO>>05588000
   END;                                                        <<U.RAO>>05590000
END;   <<PROCEDURE CXREDO>>                                    <<U.RAO>>05592000
$TITLE "MISCELLANEOUS COMMANDS, SECOND BLOCK"                  <<08.RO>>05594000
      PROCEDURE CXSHOWTIME EXECUTORHEAD;                                05596000
      OPTION PRIVILEGED, UNCALLABLE;                                    05598000
      BEGIN                                                             05600000
      COMMENT                                                           05602000
      CXSHOWTIME IS THE EXECUTOR FOR THE SHOWTIME COMMAND               05604000
      COMMAND FORMAT                                                    05606000
      SHOWTIME                                                          05608000
      ;                                                                 05610000
      INTEGER NUMPARMS;                                                 05612000
      DOUBLE PARMS;                                                     05614000
      ARRAY WOBUF (0:13);                                               05616000
      BYTE ARRAY OBUF (*) = WOBUF;                                      05618000
                                                                        05620000
      MYCOMMAND(PARMSP,,0,NUMPARMS,PARMS);<<CHECK COMMAND>>             05622000
      IF <> THEN CIERR(ERRNUM := -WARNXPARMSIGNORED,PARMSP);   <<04787>>05624000
      DATE'LINE(OBUF);<<GET DATE AND TIME>>                             05626000
      PRINT (WOBUF, -27, 0);<<PRINT IT>>                                05628000
      END;  <<CXSHOWTIME>>                                              05630000
      PROCEDURE CXFREERIN EXECUTORHEAD;                                 05632000
      OPTION PRIVILEGED,UNCALLABLE;                                     05634000
      BEGIN                                                             05636000
      COMMENT                                                           05638000
      CXFREERIN IS THE EXECUTOR FOR FREERIN & GETRIN                    05640000
      COMMAND FORMAT                                                    05642000
      GETRIN RINPASSWORD                                                05644000
      FREERIN RIN#                                                      05646000
      ;                                                                 05648000
      ENTRY CXGETRIN;                                                   05650000
      LOGICAL DL:=%6400,GETRIN:=0;                                      05652000
      INTEGER NUMPARMS,RIN,LEN;                                         05654000
      DOUBLE UNAME1,UNAME2,ANAME1,ANAME2;                      <<U.RAO>>05656000
      DOUBLE ARRAY PARM(0:1)=Q;                                <<U.RAO>>05658000
      BYTE POINTER BADPARM=PARM+2;                             <<U.RAO>>05660000
      BYTE LENG=PARM+1;                                                 05662000
      LOGICAL PARM'DATA = PARM + 1;                            <<02367>>05664000
      BYTE POINTER PASS=PARM;                                           05666000
      POINTER UNAME:=@UNAME1;                                           05668000
      ARRAY WOBUF(0:4),LPWORD(0:3);                                     05670000
      BYTE ARRAY PWORD(*)=LPWORD,OBUF(*)=WOBUF;                         05672000
      DEFINE SPECIAL' = (10:1)#;                               <<02367>>05674000
                                                                        05676000
      GO TO PROCESS;<<CXFREERIN ENTRY>>                                 05678000
CXGETRIN:                                                               05680000
      GETRIN:=GETRIN+1;<<GET RIN>>                                      05682000
PROCESS:                                                                05684000
      MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARM);                    <<U.RAO>>05686000
      IF NUMPARMS <> 1 THEN                                    <<U.RAO>>05688000
         BEGIN  <<EXACTLY ONE PARM IS REQUIRED>>               <<U.RAO>>05690000
         PARMNUM := (IF < THEN 1 ELSE 2);                      <<U.RAO>>05692000
         TOS := ERRNUM :=  (IF GETRIN THEN GETRINNOPASS        <<U.RAO>>05694000
                                      ELSE FREERINNORIN);      <<U.RAO>>05696000
         TOS := (IF PARMNUM=1 THEN @PARMSP ELSE @BADPARM);     <<U.RAO>>05698000
         CIERR(*,*);                                           <<U.RAO>>05700000
         RETURN                                                <<U.RAO>>05702000
         END;                                                  <<U.RAO>>05704000
      ASSEMBLE (ADDS 16);<<MAKE ROOM FOR JIT ENTRY>>                    05706000
      TOS:=@S15;<<TRANSFER ADDRESS>>                                    05708000
      SETJIT;<<GET JIT DST>>                                            05710000
      TOS:=16;<<SET INDEX INTO JIT>>                                    05712000
      TOS:=16;<<LENGTH>>                                                05714000
      ASSEMBLE(MFDS 4);<<MOVE IN DATA>>                                 05716000
      ANAME1:=DS15;<<GET ACCOUNT NAME>>                                 05718000
      ANAME2:=DS13;                                                     05720000
      UNAME1:=DS3;<<GET USER NAME>>                                     05722000
      UNAME2:=DS1;                                                      05724000
      IF GETRIN THEN                                                    05726000
         BEGIN                                                          05728000
         IF LENG > 8 THEN                                      <<02367>>05730000
            BEGIN                                              <<02367>>05732000
               CIERR(ERRNUM := RINPASS2LONG,PASS);             <<02367>>05734000
               RETURN                                          <<02367>>05736000
            END;                                               <<02367>>05738000
         IF PARM'DATA.SPECIAL' THEN                            <<02367>>05740000
            BEGIN                                              <<02367>>05742000
               CIERR(ERRNUM := RINPASSSPECHAR,PASS);           <<02367>>05744000
               RETURN                                          <<02367>>05746000
            END;                                               <<02367>>05748000
         IF PASS <> ALPHA THEN                                 <<02367>>05750000
            BEGIN                                              <<02367>>05752000
               CIERR(ERRNUM := RINPASSTALPHA,PASS);            <<02367>>05754000
               RETURN                                          <<02367>>05756000
            END;                                               <<02367>>05758000
         MOVE PWORD := "        "; <<BLANK OUT STRING>>                 05760000
         MOVE PWORD := PASS,(LENG);<<FORM STRING>>                      05762000
         RIN:=ALLORIN (2,UNAME,LPWORD);<<GET RIN>>                      05764000
         IF RIN=0 THEN   <<RIN TABLE EVIDENTLY FULL>>          <<U.RAO>>05766000
            BEGIN                                              <<U.RAO>>05768000
            CIERR(ERRNUM := RINTABFULL);                       <<U.RAO>>05770000
            RETURN                                             <<U.RAO>>05772000
            END;                                               <<U.RAO>>05774000
         MOVE OBUF:="RIN: ";<<FORM OUTPUT STRING>>                      05776000
         LEN:=ASCII(RIN,10,OBUF(5))+5;<<COMPLETE STRING>>               05778000
         PRINT(WOBUF,-LEN,0);                                           05780000
         END                                                            05782000
      ELSE                                                              05784000
         BEGIN<<FREE RIN>>                                              05786000
         TOS:=0;<<PUT CELL ON FOR RETURN>>                              05788000
         TOS:=@PASS;<<BYTE POINTER TO RIN #>>                           05790000
         RIN:=BINARY(*,LENG);<<CONVERT RIN>>                            05792000
         IF <> OR RIN<=0 THEN  <<BAD CONVERT ON RIN NUMBER>>   <<U.RAO>>05794000
            BEGIN                                              <<U.RAO>>05796000
            ERRNUM := RININVINT;  <<BAD NUMBER AS RIN NUMBER>> <<U.RAO>>05798000
            PARMNUM := 1;                                      <<U.RAO>>05800000
            PASS(LENG) := 0;                                   <<U.RAO>>05802000
            CIERR(ERRNUM,PASS,LENG,@PASS);                     <<U.RAO>>05804000
            END                                                <<U.RAO>>05806000
         ELSE                                                  <<U.RAO>>05808000
            BEGIN                                              <<U.RAO>>05810000
            DEALLORIN(RIN,UNAME);  <<ATTEMPT TO DEALLOCATE>>   <<U.RAO>>05812000
            IF < THEN CIERR(ERRNUM := RINNOTAL)                <<04787>>05814000
            ELSE IF > THEN CIERR(ERRNUM := RININUSE);          <<04787>>05816000
            END;                                               <<U.RAO>>05818000
         END;                                                           05820000
      END;<<CXGETRIN/CXFREERIN>>                                        05822000
PROCEDURE CXTELLOP EXECUTORHEAD;                               <<U.RAO>>05824000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>05826000
BEGIN                                                          <<U.RAO>>05828000
COMMENT                                                        <<U.RAO>>05830000
CXTELLOP IS THE EXECUTOR FOR THE TELLOP COMMAND                <<U.RAO>>05832000
COMMAND FORMAT                                                 <<U.RAO>>05834000
TELLOP [MESSAGE]                                               <<U.RAO>>05836000
;                                                              <<U.RAO>>05838000
                                                               <<U.RAO>>05840000
ARRAY NAME(0:15);                                              <<U.RAO>>05842000
BYTE ARRAY ANAME(*) = NAME;                                    <<U.RAO>>05844000
BYTE ARRAY UNAME(*) = NAME(12);                                <<U.RAO>>05846000
BYTE ARRAY DUMMY(*) = NAME; << DUMMY ARGUMENTS >>              <<U.RAO>>05848000
BYTE ARRAY USERID(0:17);                                       <<U.RAO>>05850000
BYTE POINTER MSGSTART;  <<START OF MESSAGE>>                   <<U.RAO>>05852000
BYTE POINTER MSGEND;    <<END OF MESSAGE>>                     <<U.RAO>>05854000
INTEGER MSGLEN;   <<LENGTH OF MESSAGE TO BE SENT.>>            <<U.RAO>>05856000
EQUATE CONSOLE = 0;   <<FILE NUMBER FOR GENMSG>>               <<U.RAO>>05858000
EQUATE JITHAN = 16;  <<OFFSET IN JIT OF ACCOUNT NAME ENTRY>>   <<U.RAO>>05860000
                                                               <<U.RAO>>05862000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>05864000
                                                               <<U.RAO>>05866000
SCAN PARMSP WHILE %6440,1;  <<SCAN FOR START OF MESSAGE>>      <<U.RAO>>05868000
@MSGSTART := TOS;                                              <<U.RAO>>05870000
SCAN MSGSTART UNTIL %6415,1;  <<SCAN FOR END OF MESSAGE>>      <<U.RAO>>05872000
@MSGEND := TOS;                                                <<U.RAO>>05874000
MSGLEN := @MSGEND-@MSGSTART+1;                                 <<U.RAO>>05876000
CLEAN'MESSAGE(MSGSTART, MSGLEN-1);                             <<U.RAO>>05878000
MSGEND := 0;  <<TERMINATOR FOR GENMSG>>                        <<U.RAO>>05880000
TOS := @NAME;                                                  <<U.RAO>>05882000
SETJIT;                                                        <<U.RAO>>05884000
MOVEFROMDSEG(*, *, JITHAN, 16);                                <<U.RAO>>05886000
FORMNAME(4, USERID, UNAME, ANAME, DUMMY, DUMMY);               <<U.RAO>>05888000
   <<FORMAT USER ID - "S/J nnn , USER.ACCT">>                  <<U.RAO>>05890000
GENMSG(CIGENERALMSGSET, TELLFROM, 0, @USERID, @MSGSTART,,,,    <<U.RAO>>05892000
   CONSOLE);                                                   <<U.RAO>>05894000
IF <> THEN CIERR(ERRNUM := TELLOPMSGPROBLEM);                  <<U.RAO>>05896000
MSGEND := %15;  <<RESTORE CR TERMINATOR>>                      <<U.RAO>>05898000
END;      <<CXTELLOP>>                                         <<U.RAO>>05900000
PROCEDURE CXTELL EXECUTORHEAD;                                 <<U.RAO>>05902000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>05904000
<<CXTELL IS THE EXECUTOR FOR THE TELL COMMAND>>                <<U.RAO>>05906000
<<THERE ARE THREE BASIC STEPS TO THE ALGORITHM:>>              <<U.RAO>>05908000
<<    1)  PARSE THE JOBID                      >>              <<U.RAO>>05910000
<<    2)  PREPARE THE MESSAGE FOR SENDING      >>              <<U.RAO>>05912000
<<    3)  SEND THE MESSAGE                     >>              <<U.RAO>>05914000
<<                                             >>              <<U.RAO>>05916000
BEGIN                                                          <<U.RAO>>05918000
ENTRY CXWARN;                                                  <<00552>>05920000
INTEGER ARRAY RESULT(0:16);  <<RETURN VARIABLE FROM PARSEJOBID><<U.RAO>>05922000
BYTE ARRAY BRESULT(*) = RESULT;                                <<U.RAO>>05924000
INTEGER ARRAY JMATRETURN(0:2);  <<RETURN FROM SCANJMAT>>       <<U.RAO>>05926000
INTEGER ARRAY JITDATA(0:22);  <<INFO RELATED TO THIS USER>>    <<U.RAO>>05928000
BYTE ARRAY UNAME(*) = JITDATA(19);   <<THIS USER'S NAME>>      <<U.RAO>>05930000
BYTE ARRAY ANAME(*) = JITDATA(7);    <<THIS USER'S ACCOUNT>>   <<U.RAO>>05932000
BYTE ARRAY DUMMY(*) = ANAME;                                   <<U.RAO>>05934000
BYTE ARRAY USERID(0:24);  <<HOLDS THIS USER'S NAME>>           <<U.RAO>>05936000
BYTE ARRAY USERSNUM(0:5);  <<S/J NNN>>                         <<U.RAO>>05938000
BYTE ARRAY RECIPID(0:24);  <<HOLDS OTHER USER'S NAME>>         <<U.RAO>>05940000
BYTE ARRAY RECIPSNUM(0:5);                                     <<U.RAO>>05942000
BYTE POINTER MSGADR;  <<ADDRESS OF MESSAGE TO BE SENT>>        <<U.RAO>>05944000
INTEGER MSGLEN;  <<LENGTH OF MESSAGE TO BE SENT>>              <<U.RAO>>05946000
LOGICAL FOUNDENTRY;  <<SCAN WAS SUCCESSFUL>>                   <<U.RAO>>05948000
INTEGER NEXTJMATINDEX := 1;  <<FOR SCAN THROUGH JMAT>>         <<U.RAO>>05950000
LOGICAL MSGMOVED := FALSE;  <<HAD TO ADJUST MSG TO WORD BDY>>  <<U.RAO>>05952000
LOGICAL TELLTOJOB := FALSE;  <<FOR TRYING TO TELL TO A JOB>>   <<04208>>05954000
LOGICAL WARNFLG;        <<TRUE=>DO WARN, NOT TELL>>            <<00552>>05956000
LOGICAL SENDER'IS'TARGET     << DOES SENDER QUALIFY? >>        <<01652>>05958000
           := FALSE;                                           <<01652>>05960000
BYTE SAVEDBYTE;  <<BYTE DESTROYED BY ADJUSTMENT OF MSG>>       <<U.RAO>>05962000
INTEGER ARRAY ERRTRANS(0:1) = PB :=                            <<U.RAO>>05964000
 0,TELLJOBINVALID,TELLINVSNUM,TELLXPCTJORS,TELLXPCTJSORAT,     <<04208>>05966000
TELLJXPCTJUSTAT,TELLJNAME2LONG,TELLJXPCTALPHA,USERNAMEMISSING, <<U.RAO>>05968000
USERNAMETOOLONG,USEREXPECTALPHA,TELLXPCTPERIOD,                <<U.RAO>>05970000
ACCTNAMEMISSING,ACCTEXPECTNAMENOTAT,ACCTNAMETOOLONG,           <<U.RAO>>05972000
ACCTEXPECTALPHA,TELLJOBIDMISSING;                              <<U.RAO>>05974000
DEFINE JOBFIELD = (0:2)#;  <<JOB TYPE FIELD>>                  <<U.RAO>>05976000
EQUATE SESSIONTYPE = 1,                                        <<U.RAO>>05978000
       JOBTYPE = 2;                                            <<U.RAO>>05980000
DEFINE JMATTYPE = (0:6)#;   <<JMAT ENTRY TYPE FIELD>>          <<U.RAO>>05982000
EQUATE RUNNINGJOB = 2;  <<JMAT TYPE>>                          <<U.RAO>>05984000
DEFINE QUIETBIT = (8:1)#;  <<JMAT BIT => NOT ACCEPTING MSGS>>  <<U.RAO>>05986000
                                                               <<00552>>05988000
WARNFLG:=FALSE;         <<NOT WARN>>                           <<00552>>05990000
GO TO CXTELLMAIN;                                              <<00552>>05992000
                                                               <<00552>>05994000
CXWARN:                                                        <<00552>>05996000
WARNFLG:=TRUE;          <<SET WARN FLAG>>                      <<00552>>05998000
                                                               <<00552>>06000000
CXTELLMAIN:                                                    <<00552>>06002000
<<    MAIN BODY     >>                                         <<U.RAO>>06004000
<<STEP 1 - PARSE THE JOBID>>                                   <<U.RAO>>06006000
IF NOT PARSEJOBID(PARMSP, RESULT) THEN  <<SYNTAX ERROR>>       <<U.RAO>>06008000
   BEGIN                                                       <<U.RAO>>06010000
   TOS := ERRNUM := ERRTRANS(RESULT(15));  <<GET CI ERR NO.>>  <<U.RAO>>06012000
   TOS := RESULT(14);  <<ADDRESS OF ERROR>>                    <<U.RAO>>06014000
   CIERR(*,*);                                                 <<U.RAO>>06016000
   PARMNUM := RESULT(16);                                      <<U.RAO>>06018000
   END                                                         <<U.RAO>>06020000
ELSE                                                           <<U.RAO>>06022000
   BEGIN  <<JOB NAME PARSED OK>>                               <<U.RAO>>06024000
   <<STEP 2 IS TO PREPARE THE MESSAGE FOR SENDING>>            <<U.RAO>>06026000
   <<STEP 2 PART 1 - GET SENDER'S INFO FROM JIT>>              <<U.RAO>>06028000
   TOS := @JITDATA;                                            <<U.RAO>>06030000
   SETJIT;                                                     <<U.RAO>>06032000
   TOS := 9; <<START AT JOB TYPE/NUMBER FIELD>>                <<U.RAO>>06034000
   TOS := 23;  <<END AFTER USER'S NAME>>                       <<U.RAO>>06036000
   ASSEMBLE(MFDS);                                             <<U.RAO>>06038000
   <<PART 2 - CONVERT JOB TYPE/NUMBER TO STRING>>              <<U.RAO>>06040000
   USERSNUM(2) := " ";                                         <<U.RAO>>06042000
   MOVE USERSNUM(3) := USERSNUM(2),(5);                        <<U.RAO>>06044000
   IF JITDATA.JOBFIELD = SESSIONTYPE THEN                      <<U.RAO>>06046000
      USERSNUM := "S"                                          <<U.RAO>>06048000
   ELSE                                                        <<U.RAO>>06050000
      USERSNUM := "J";                                         <<U.RAO>>06052000
   ASCII(JITDATA.(2:14), 10, USERSNUM(1));                     <<U.RAO>>06054000
   <<PART 3 - FORMAT USER NAME>>                               <<U.RAO>>06056000
   FORMNAME(5,USERID,USERSNUM,UNAME,ANAME,DUMMY);              <<U.RAO>>06058000
   <<PART 4 - ADJUST MESSAGE TO WORD BOUNDARY>>                <<U.RAO>>06060000
   IF RESULT(15) <> ";" THEN  <<ALLOW ";" EVEN THOUGH OBSOLETE><<U.RAO>>06062000
      RESULT(14) := RESULT(14)-1;  <<ACTUAL START OF MESSAGE>> <<U.RAO>>06064000
   @MSGADR := RESULT(14);                                      <<U.RAO>>06066000
   <<GET MESSAGE LENGTH>>                                      <<U.RAO>>06068000
   SCAN MSGADR UNTIL %6400, 1;   <<FIND END OF MESSAGE>>       <<U.RAO>>06070000
   MSGLEN := TOS-@MSGADR;                                      <<U.RAO>>06072000
   MSGADR(MSGLEN) := 0;  <<TERMINATOR FOR GENMSG>>             <<U.RAO>>06074000
   <<PART 5 - PURGE MESSAGE OF BAD CHARACTER SEQUENCES>>       <<U.RAO>>06076000
   CLEAN'MESSAGE(MSGADR, MSGLEN);                              <<U.RAO>>06078000
   <<THE MESSAGE IS NOW READY TO GO.>>                         <<U.RAO>>06080000
   <<STEP 3 - SENDING THE MESSAGE.  THERE ARE 3 PROBLEMS HERE.><<U.RAO>>06082000
   <<IF THERE ARE NO JOBS MATCHING THE DESCRIPTION, THE SENDER><<U.RAO>>06084000
   <<MUST BE TOLD;  IF ANY JOB SELECTED IS RUNNING QUIET, THE>><<U.RAO>>06086000
   <<SENDER MUST BE TOLD;  FINALLY, THE MESSAGE MUST BE SENT>> <<U.RAO>>06088000
                                                               <<01652>>06090000
   DO   << SCAN FOR THE FIRST ACCEPTABLE ENTRY. >>             <<01652>>06092000
   BEGIN                                                       <<01652>>06094000
                                                               <<01652>>06096000
      FOUNDENTRY := SCANJMAT( NEXTJMATINDEX, RESULT,           <<01652>>06098000
                              JMATRETURN             );        <<01652>>06100000
                                                               <<01652>>06102000
   << THE SENDER IS NOT A QUALIFED TARGET.  IF THE SENDER >>   <<01652>>06104000
   << IS SELECTED, SKIP OVER IT.                          >>   <<01652>>06106000
      IF RESULT = JITDATA THEN                                 <<01652>>06108000
      BEGIN                                                    <<01652>>06110000
         SENDER'IS'TARGET := TRUE;                             <<01652>>06112000
         FOUNDENTRY := SCANJMAT( NEXTJMATINDEX, RESULT,        <<01652>>06114000
                                 JMATRETURN             );     <<01652>>06116000
      END;                                                     <<01652>>06118000
                                                               <<01652>>06120000
   END                                                         <<01652>>06122000
   UNTIL  NOT FOUNDENTRY                                       <<01652>>06124000
          OR  (JMATRETURN.JMATTYPE = RUNNINGJOB);              <<01652>>06126000
                                                               <<01652>>06128000
   IF NOT FOUNDENTRY THEN   <<NO SUCH JOBS FITTING JOBID FOUND><<U.RAO>>06130000
      IF SENDER'IS'TARGET                                      <<01652>>06132000
         THEN CIERR( ERRNUM := -TELLSENDONLYTARGET, PARMSP )   <<04787>>06134000
         ELSE CIERR( ERRNUM := -TELLNOSUCHJOBS,     PARMSP )   <<04787>>06136000
   ELSE   <<HAVE AT LEAST ONE WINNER>>                         <<U.RAO>>06138000
      DO   <<LOOP THROUGH JMAT, SENDING MESSAGES>>             <<U.RAO>>06140000
         IF (JMATRETURN.JMATTYPE = RUNNINGJOB)                 <<U.RAO>>06142000
               AND (RESULT<>JITDATA) <<NOT SENDER>> THEN       <<U.RAO>>06144000
         IF LOGICAL(JMATRETURN.QUIETBIT) AND NOT WARNFLG THEN  <<00552>>06146000
               BEGIN   <<TELL SENDER>>                         <<U.RAO>>06148000
               <<FORMAT JOBID OF TARGET>>                      <<U.RAO>>06150000
               RECIPSNUM(2) := " ";                            <<U.RAO>>06152000
               MOVE RECIPSNUM(3) := RECIPSNUM(2),(3);          <<U.RAO>>06154000
               IF RESULT.JOBFIELD = SESSIONTYPE THEN           <<U.RAO>>06156000
                  RECIPSNUM := "S"                             <<U.RAO>>06158000
               ELSE                                            <<U.RAO>>06160000
                  RECIPSNUM := "J";                            <<U.RAO>>06162000
               ASCII(RESULT.(2:14), 10, RECIPSNUM(1));         <<U.RAO>>06164000
               FORMNAME(5,RECIPID,RECIPSNUM,BRESULT(2),BRESULT(10),     06166000
                  DUMMY);                                      <<U.RAO>>06168000
               GENMSG(CIGENERALMSGSET, TELLNOTACCEPT, 0, @RECIPID);     06170000
               END                                             <<U.RAO>>06172000
            ELSE   <<ACCEPTING MESSAGES, SEND MESSAGE>>        <<U.RAO>>06174000
         IF RESULT.JOBFIELD = JOBTYPE THEN << TELL TO JOB>>    <<04208>>06176000
            TELLTOJOB := TRUE                                  <<04208>>06178000
         ELSE                                                  <<04208>>06180000
         IF WARNFLG THEN GENMSG(1,OPWARN,0,@MSGADR,,,,,        <<00552>>06182000
               JMATRETURN(1),,,,JMATRETURN(2)&LSL(12)+2)       <<01317>>06184000
                                                               <<00552>>06186000
         ELSE <<OP.01>>                                        <<00552>>06188000
               GENMSG(CIGENERALMSGSET, TELLFROM, 0, @USERID, @MSGADR,   06190000
                  ,,,JMATRETURN(1),,,,JMATRETURN(2)&LSL(12)+1) <<U.RAO>>06192000
         UNTIL NOT SCANJMAT(NEXTJMATINDEX, RESULT, JMATRETURN);<<U.RAO>>06194000
   <<MESSAGES ALL SENT.  NOW CLEAN UP AND RETURN>>             <<U.RAO>>06196000
    IF TELLTOJOB THEN                                          <<04208>>06198000
       CIERR(ERRNUM := -TELLJOBINVALID,PARMSP);                <<04787>>06200000
   IF MSGMOVED THEN   <<SHIFT RIGHT 1 BYTE>>                   <<U.RAO>>06202000
      BEGIN                                                    <<U.RAO>>06204000
      MOVE MSGADR(MSGLEN) := MSGADR(MSGLEN-1), (-MSGLEN);      <<U.RAO>>06206000
      MSGADR := SAVEDBYTE;                                     <<U.RAO>>06208000
      @MSGADR := @MSGADR+1;                                    <<U.RAO>>06210000
      END;                                                     <<U.RAO>>06212000
   MSGADR(MSGLEN) := %15;  <<RESTORE OVER TRAILING 0>>         <<U.RAO>>06214000
   END;                                                        <<U.RAO>>06216000
END;  <<PROCEDURE CXTELL>>                                     <<U.RAO>>06218000
PROCEDURE CXHELP EXECUTORHEAD;                                 <<01.EB>>06220000
   OPTION UNCALLABLE;                                          <<01.EB>>06222000
BEGIN                                                          <<01.EB>>06224000
                                                               <<01.EB>>06226000
EQUATE                                                         <<01.EB>>06228000
   BREAKHIT  = 41,                                             <<01.EB>>06230000
   FATALERR  = 50,                                             <<01.EB>>06232000
   HELPSPACE         = 3650,  << HELPROC NEEDS AS OF FIX. >>   <<01895>>06234000
   CATERR            = 51,                                     <<06.EB>>06236000
   USERLABELERR      = 54;                                     <<06.EB>>06238000
                                                               <<01.EB>>06240000
BYTE ARRAY BUFF(0:13);                                         <<01.EB>>06242000
INTEGER                                                        <<01895>>06244000
   OLD'RELZ,   << Z BEFORE ZSIZE CALL. >>                      <<01895>>06246000
   HELPCATFN;                                                  <<01895>>06248000
                                                               <<01.EB>>06250000
PROCEDURE HELPROC(CATFN,LISTFN,COMIMAGE,COMBASE,ERRNO,         <<01.EB>>06252000
      INTACTIVE);                                              <<01.EB>>06254000
   VALUE CATFN,LISTFN,INTACTIVE;                               <<01.EB>>06256000
   INTEGER CATFN,LISTFN,ERRNO;                                 <<01.EB>>06258000
   BYTE ARRAY COMIMAGE,COMBASE;                                <<01.EB>>06260000
   LOGICAL INTACTIVE;                                          <<01.EB>>06262000
   OPTION EXTERNAL;                                            <<01.EB>>06264000
                                                               <<01.EB>>06266000
<< NEED TO MAKE SURE THAT THERE IS ENOUGH STACK SPACE >>       <<01895>>06268000
<< FOR PROGRAMMATIC CALLS TO HELP.                    >>       <<01895>>06270000
                                                               <<01895>>06272000
PUSH(Z);                                                       <<01895>>06274000
OLD'RELZ := TOS;                                               <<01895>>06276000
                                                               <<01895>>06278000
TOS := 0;  << GET SPACE FOR ZSIZE RETURN VALUE. >>             <<01895>>06280000
PUSH(S);                                                       <<01895>>06282000
TOS := TOS + HELPSPACE;                                        <<01895>>06284000
ZSIZE(*);                                                      <<01895>>06286000
IF <> THEN                                                     <<01895>>06288000
   BEGIN                                                       <<01895>>06290000
   ZSIZE(OLD'RELZ);                                            <<01895>>06292000
   CIERR( ERRNUM := NOSTACKSPACE );                            <<01895>>06294000
   RETURN;                                                     <<01895>>06296000
   END;                                                        <<01895>>06298000
                                                               <<01895>>06300000
MOVE BUFF := "CICAT.PUB.SYS ";                                 <<14.EB>>06302000
HELPCATFN := FOPEN(BUFF,1,%300);                               <<14.EB>>06304000
IF <> THEN                                                     <<14.EB>>06306000
BEGIN                                                          <<14.EB>>06308000
   FERROR'(HELPCATFN,PARMNUM);                                 <<14.EB>>06310000
   CIERR( ERRNUM := OPENCATFAIL );                             <<01895>>06312000
   ZSIZE(OLD'RELZ);  << GET Z BACK DOWN. >>                    <<01895>>06314000
   RETURN;                                                     <<14.EB>>06316000
END;                                                           <<14.EB>>06318000
HELPROC( HELPCATFN, 2, PARMSP, CIS'BCOMIMAGE,                  << I.A >>06320000
         ERRNUM, JOBSESSIONMAIN               );               << I.A >>06322000
IF ERRNUM >= FATALERR THEN                                     <<06.EB>>06324000
BEGIN                                                          <<01.EB>>06326000
   IF ERRNUM = CATERR OR ERRNUM = USERLABELERR THEN            <<06.EB>>06328000
      FERROR'(HELPCATFN,PARMNUM);                              <<06.EB>>06330000
   CIERR(ERRNUM := ERRNUM +HELPOFFSET);                        <<01.EB>>06332000
END                                                            <<01.EB>>06334000
ELSE                                                           <<01.EB>>06336000
BEGIN                                                          <<01.EB>>06338000
   IF ERRNUM = BREAKHIT THEN GENMSG(CIERRMSGSET,               <<01.EB>>06340000
      HELPTERMINATED);                                         <<01.EB>>06342000
   ERRNUM := 0; << EVERYTHING PEACHY >>                        <<01.EB>>06344000
END;                                                           <<01.EB>>06346000
                                                               <<01.EB>>06348000
FCLOSE(HELPCATFN, 0, 0);                                       <<U.RAO>>06350000
                                                               <<01895>>06352000
ZSIZE(OLD'RELZ);     << RETURN Z TO PREVIOUS VALUE >>          <<01895>>06354000
                                                               <<01895>>06356000
END; << CXHELP >>                                              <<01.EB>>06358000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>06360000
      PROCEDURE CXDEBUG EXECUTORHEAD;                                   06362000
      OPTION PRIVILEGED,UNCALLABLE;                                     06364000
      BEGIN                                                             06366000
      COMMENT                                                           06368000
      CXDEBUG IS THE EXECUTOR FOR THE DEBUG COMMAND                     06370000
      COMMAND FORMAT                                                    06372000
      DEBUG                                                             06374000
;                                                              <<U.RAO>>06376000
SCAN PARMSP WHILE %6440;                                       <<U.RAO>>06378000
IF NOCARRY THEN CIERR(ERRNUM := -WARNXPARMSIGNORED, PARMSP);   <<04787>>06380000
DEBUG;                                                         <<U.RAO>>06382000
END;   <<CXDEBUG>>                                             <<U.RAO>>06384000
$PAGE "IF, ELSE, ENDIF AND JCW RELATED PROCEDURES"             <<08.RO>>06386000
<< There are really just two issues to be dealt with>>         <<08.RO>>06388000
<< in the IF command jungle of procedures.  The bulk >>        <<08.RO>>06390000
<< of the code is for parsing the JCW expression in   >>       <<08.RO>>06392000
<< the IF command header.  That problem is handled in >>       <<08.RO>>06394000
<< a more or less standard interpreter manner, with   >>       <<08.RO>>06396000
<< recursive descent parsers which return subexpression>>      <<08.RO>>06398000
<< values to the caller.  Eventually CXIF gets a      >>       <<08.RO>>06400000
<< TRUE/FALSE/ERROR return as the value of the        >>       <<08.RO>>06402000
<< expression.  The second issue to be dealt with is  >>       <<08.RO>>06404000
<< the actual functional operation of the commands.   >>       <<08.RO>>06406000
<< There are three global CI variables used for keeping>>      <<08.RO>>06408000
<< track of the current if levels.  IFNESTING is a    >>       <<08.RO>>06410000
<< count of the IF levels.  It is incremented by CXIF >>       <<08.RO>>06412000
<< and decremented by CXENDIF.  IFSKIP is a flag      >>       <<08.RO>>06414000
<< indicating whether we are currently in the false   >>       <<08.RO>>06416000
<< block of an IF expression, in which case the       >>       <<08.RO>>06418000
<< CI commands are ignored.  NOTE that there are some >>       <<08.RO>>06420000
<< problems in this area.  These problems will be     >>       <<08.RO>>06422000
<< described below.  Management of IFSKIP is very     >>       <<08.RO>>06424000
<< tricky, due to handling nesting levels.  See the   >>       <<08.RO>>06426000
<< code for details.  Finally, the global variable    >>       <<08.RO>>06428000
<< ELSESEEN is used for avoiding mishandling          >>       <<08.RO>>06430000
<< redundantly specified ELSE's.                      >>       <<08.RO>>06432000
<< There are two significant, perhaps incompletely    >>       <<08.RO>>06434000
<< resolved problems with the IF construct.  It has   >>       <<08.RO>>06436000
<< been suggested, and I concur, that the IF level on >>       <<08.RO>>06438000
<< exit from a UDC should be the same as the level on >>       <<08.RO>>06440000
<< entry to that same UDC.  A mechanism will have to  >>       <<08.RO>>06442000
<< be invented to solve this problem.  This probably  >>       <<08.RO>>06444000
<< just requires that the current values be saved on  >>       <<08.RO>>06446000
<< entry to a UDC and restored on exit.  The second   >>       <<08.RO>>06448000
<< problem is to make sure that all commands which    >>       <<08.RO>>06450000
<< MUST be recognized, regardless of whether we are   >>       <<08.RO>>06452000
<< flushing or not, are seen by the appropriate       >>       <<08.RO>>06454000
<< executor.  There are currently four such commands, >>       <<08.RO>>06456000
<< IF, ELSE, ENDIF and RFA.  Job terminating commands >>       <<08.RO>>06458000
<< such as BYE, JOB, HELLO etc. are also automatically>>       <<08.RO>>06460000
<< seen by the I/O system.  There is a bit in the     >>       <<08.RO>>06462000
<< access entry in COMSEARCH which controls whether a >>       <<08.RO>>06464000
<< command is recognized while flushing.              >>       <<08.RO>>06466000
<<                                                    >>       <<08.RO>>06468000
$CONTROL SEGMENT=CIMISC                                        <<U.RAO>>06470000
PROCEDURE GETNEXTIFOP(OP, OPARR);                              <<U.RAO>>06472000
BYTE ARRAY OP, OPARR;                                          <<U.RAO>>06474000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>06476000
BEGIN                                                          <<U.RAO>>06478000
BYTE ARRAY LOCOP(0:4);                                         <<U.RAO>>06480000
MOVE OPARR := "     ";                                         <<U.RAO>>06482000
LOCOP(4) := " ";                                               <<U.RAO>>06484000
MOVE LOCOP := OP, (4);                                         <<U.RAO>>06486000
MOVE OPARR := LOCOP WHILE ANS;                                 <<U.RAO>>06488000
END;   <<PROCEDURE GETNEXTIFOP>>                               <<U.RAO>>06490000
PROCEDURE JCWPRIMARY(PARMPTR,JCWVALUE,ERRNUM,ERRADR,PARMNUM);  <<U.RAO>>06492000
BYTE ARRAY PARMPTR;                                            <<U.RAO>>06494000
LOGICAL JCWVALUE;                                              <<U.RAO>>06496000
INTEGER ERRNUM, ERRADR, PARMNUM;                               <<U.RAO>>06498000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>06500000
BEGIN                                                          <<U.RAO>>06502000
<<THIS PROCEDURE DETERMINES IF A GIVEN TOKEN IS A JCW PRIMARY. <<U.RAO>>06504000
<<A JCW PRIMARY IS EITHER A NUMBER (POSSIBLY OCTAL), A JCW     <<U.RAO>>06506000
<<EQUATE (SEE TRANSJCWEQUATE), OR AN EXISTING JCW NAME.        <<U.RAO>>06508000
<<PARMPTR POINTS AT THE FIRST BYTE OF THE TOKEN ON ENTRY.      <<U.RAO>>06510000
<<JCWVALUE WILL BE RETURNED THE VALUE OF THE PRIMARY, IF NO    <<U.RAO>>06512000
<<   ERRORS WERE DETECTED.  IT HAS NO INPUT SIGNIFICANCE.      <<U.RAO>>06514000
<<ERRNUM IS RETURNED AN ERROR CODE (SEE TRANSJCWEQUATE).       <<U.RAO>>06516000
<<   IT IS ASSUMED TO BE 0 ON ENTRY.  THE POSSIBLE ERRORS ARE  <<U.RAO>>06518000
<<   DETAILED BELOW.                                           <<U.RAO>>06520000
<<ERRADR IS RETURNED EITHER THE BYTE ADDRESS AT WHICH AN ERROR <<U.RAO>>06522000
<<   WAS DETECTED OR THE ADDRESS OF THE NEXT NON-BLANK BEYOND  <<U.RAO>>06524000
<<   THE CURRENT PRIMARY.                                      <<U.RAO>>06526000
<<PARMNUM IS THE ORDINAL OF THE CURRENT PARM.  IT IS ASSUMED   <<U.RAO>>06528000
<<   TO BE THE PREVIOUS TOKEN UPON ENTRY AND WILL BE UPDATED.  <<U.RAO>>06530000
<<THE CONDITION CODE IS UNCHANGED.                             <<U.RAO>>06532000
<<THE ALGORITHM IS NOT PARTICULARLY INTERESTING OR TRICKY.     <<U.RAO>>06534000
INTEGER PARMLEN;  <<LENGTH OF THE TOKEN BEING PROCESSED.>>     <<U.RAO>>06536000
INTEGER TRANSERR;  <<RETURNED ERROR CODE FROM TRANSJCWEQUATE.>><<U.RAO>>06538000
INTEGER TRANSERRPTR;  <<RETURNED ERROR/END AROM TRANSJCWEQUATE.<<U.RAO>>06540000
DOUBLE TEMPJCWVALUE := 0D;  <<HOLDS CONVERTED RESULT>>         <<02.RO>>06542000
LOGICAL REALJCWVALUE = TEMPJCWVALUE+1; <<SIGNIFICANT PART>>    <<02.RO>>06544000
EQUATE                                                         <<U.RAO>>06546000
   NOJCWERR       = 0,  <<NO ERRORS ENCOUNTERED.>>             <<U.RAO>>06548000
   NOPRIMARY      = 1,  <<NOTHING FOUND AT ALL.>>              <<U.RAO>>06550000
   NUM2LARGE      = 2,  <<NUM EXCEEDS 65535.>>                 <<U.RAO>>06552000
   INVOCTDGT      = 3,  <<8 OR 9 IN OCTAL NUMBER.>>            <<U.RAO>>06554000
   INVJCWEQNUM    = 2,  <<INVALID NUMBER WITH THIS EQUATE TYPE><<U.RAO>>06556000
   <<5,6,7 USED>>                                              <<U.RAO>>06558000
   JCWNAME2LONG   = 8,  <<NAME > 255 CHARACTERS LONG.>>        <<U.RAO>>06560000
   JCWNAMENOALPHA = 9,  <<NAME DOES NOT START WITH ALPHA.>>    <<U.RAO>>06562000
   NOSUCHJCW      = 10, <<NO SUCH JCW IN JCW TABLE.>>          <<U.RAO>>06564000
   INVJCWTYPE     = 1;  <<TYPE PART OF JCW NOT RECOGNIZED.>>   <<U.RAO>>06566000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>06568000
SCAN PARMPTR WHILE %6440,1;  <<SKIP LEADING BLANKS>>           <<U.RAO>>06570000
@PARMPTR := ERRADR := TOS;                                     <<U.RAO>>06572000
IF CARRY THEN   <<HIT CARRIAGE RETURN, NO PARM SUPPLIED>>      <<U.RAO>>06574000
   ERRNUM := NOPRIMARY                                         <<U.RAO>>06576000
ELSE                                                           <<U.RAO>>06578000
   BEGIN                                                       <<U.RAO>>06580000
   IF (PARMPTR=NUMERIC) OR (PARMPTR="%") THEN                  <<U.RAO>>06582000
      BEGIN   <<GUESS THAT IT IS A NUMBER>>                    <<U.RAO>>06584000
      IF PARMPTR = "%" THEN   <<OCTAL VALUE>>                  <<U.RAO>>06586000
         PARMLEN := 1                                          <<U.RAO>>06588000
      ELSE                                                     <<U.RAO>>06590000
         PARMLEN := 0;                                         <<U.RAO>>06592000
      MOVE PARMPTR(PARMLEN) := PARMPTR(PARMLEN) WHILE N,1;     <<U.RAO>>06594000
      PARMLEN := TOS-@PARMPTR;  <<TOKEN LEN>>                  <<U.RAO>>06596000
      TEMPJCWVALUE := DBINARY(PARMPTR, PARMLEN);               <<02.RO>>06598000
      IF < THEN   <<INVALID NUMBER>>                           <<02.RO>>06600000
         ERRNUM := INVOCTDGT                                   <<02.RO>>06602000
      ELSE IF > OR TEMPJCWVALUE > 65535D THEN                  <<02.RO>>06604000
         ERRNUM := NUM2LARGE                                   <<02.RO>>06606000
      ELSE  <<VALID NUMBER>>                                   <<02.RO>>06608000
         @PARMPTR := @PARMPTR+PARMLEN;  <<GOOD, MOVE PAST TOKEN<<02.RO>>06610000
      JCWVALUE := REALJCWVALUE;   <<RETURN SIGNIFICANT WORD>>  <<02.RO>>06612000
      END                                                      <<U.RAO>>06614000
   ELSE  <<IS ALPHA, 2 POSSIBILITIES>>                         <<U.RAO>>06616000
      BEGIN                                                    <<U.RAO>>06618000
      TRANSJCWEQUATE(PARMPTR, JCWVALUE, TRANSERR, TRANSERRPTR);<<U.RAO>>06620000
      IF (TRANSERR <> INVJCWTYPE)AND(TRANSERR <> NOJCWERR) THEN<<U.RAO>>06622000
         BEGIN  <<BAD JCW EQUATE>>                             <<U.RAO>>06624000
         ERRNUM := INVJCWEQNUM+TRANSERR;                       <<U.RAO>>06626000
         ERRADR := TRANSERRPTR;                                <<U.RAO>>06628000
         END                                                   <<U.RAO>>06630000
      ELSE IF TRANSERR = NOJCWERR THEN   <<IS VALID JCW EQUATE><<U.RAO>>06632000
         @PARMPTR := TRANSERRPTR  <<JUST UPDATE END POINTER>>  <<U.RAO>>06634000
      ELSE  <<WAS NOT A JCW EQUATE EITHER.>>                   <<U.RAO>>06636000
         BEGIN  <<LAST CHANCE IS ANOTHER JCW>>                 <<U.RAO>>06638000
         FINDJCW(PARMPTR, JCWVALUE, TRANSERR);                 <<U.RAO>>06640000
         CASE *TRANSERR OF                                     <<U.RAO>>06642000
            BEGIN                                              <<U.RAO>>06644000
               BEGIN  <<NO ERROR, UPDATE POINTER.>>            <<U.RAO>>06646000
               MOVE PARMPTR := PARMPTR WHILE AN,1;             <<U.RAO>>06648000
               @PARMPTR := TOS;                                <<U.RAO>>06650000
               END;                                            <<U.RAO>>06652000
                                                               <<U.RAO>>06654000
               ERRNUM := JCWNAME2LONG;                         <<U.RAO>>06656000
                                                               <<U.RAO>>06658000
               ERRNUM := JCWNAMENOALPHA;                       <<U.RAO>>06660000
                                                               <<U.RAO>>06662000
               ERRNUM := NOSUCHJCW;                            <<U.RAO>>06664000
            END;                                               <<U.RAO>>06666000
         END;   <<OTHER JCW CASE>>                             <<U.RAO>>06668000
      END;  <<ALPHA CASE>>                                     <<U.RAO>>06670000
   END;  <<PARM EXISTS CASE>>                                  <<U.RAO>>06672000
IF ERRNUM = NOJCWERR THEN                                      <<U.RAO>>06674000
   BEGIN  <<LAST JOB IS TO SKIP BLANKS TO NEXT TOKEN>>         <<U.RAO>>06676000
   SCAN PARMPTR WHILE %6440,1;                                 <<U.RAO>>06678000
   ERRADR := TOS;                                              <<U.RAO>>06680000
   END;                                                        <<U.RAO>>06682000
END;   <<JCWPRIMARY>>                                          <<U.RAO>>06684000
PROCEDURE CPRIMARY(PRIMARY,PRIMARYVALUE,ERRNUM,ENDADR,PARMNUM);<<U.RAO>>06686000
BYTE ARRAY PRIMARY;                                            <<U.RAO>>06688000
LOGICAL PRIMARYVALUE;                                          <<U.RAO>>06690000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>06692000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>06694000
BEGIN                                                          <<U.RAO>>06696000
<<This procedure determines if a particular part of the        <<U.RAO>>06698000
<<conditional expression is a conditional primary.  In BNF terms U.RAO>>06700000
<<it is looking for <cprimary>::=<jcwprimary><relop><jcwprimary>.U.RAO>>06702000
<<PRIMARY is a byte pointer to the suspected conditional primary.U.RAO>>06704000
<<PRIMARYVALUE will be returned the value of the conditional   <<U.RAO>>06706000
<<   primary.                                                  <<U.RAO>>06708000
<<ERRNUM will be the (already sent) CI error number, if any.   <<U.RAO>>06710000
<<ENDADR is the address of the error or of the next token,     <<U.RAO>>06712000
<<   if no errors were encountered.                            <<U.RAO>>06714000
<<PARMNUM is the ordinal of the current parameter.             <<U.RAO>>06716000
<<The condition code is unaffected.                            <<U.RAO>>06718000
EQUATE CR=%15;                                                 <<U.RAO>>06720000
INTEGER TRANSERR:=0; <<INTERNAL ERROR CODE RETURNED BY JCWPRIMA<<U.RAO>>06722000
INTEGER TRANSERRADR;  <<ADDRESS OF END/ERROR FROM JCWPRIMARY>> <<U.RAO>>06724000
INTEGER RELOPLEN;   <<LENGTH OF THE RELATIONAL OPERATOR.>>     <<U.RAO>>06726000
BYTE ARRAY RELOPDICTP(0:1) = PB :=                             <<U.RAO>>06728000
   3,1,"<",                                                    <<U.RAO>>06730000
   3,1,"=",                                                    <<U.RAO>>06732000
   3,1,">",                                                    <<U.RAO>>06734000
   4,2,"<=",                                                   <<U.RAO>>06736000
   4,2,">=",                                                   <<U.RAO>>06738000
   4,2,"<>",                                                   <<U.RAO>>06740000
   0;                                                          <<U.RAO>>06742000
EQUATE RELOPDICTLEN=3+3+3+4+4+4+1;                             <<U.RAO>>06744000
BYTE ARRAY RELOPDICT(0:RELOPDICTLEN-1);                        <<U.RAO>>06746000
INTEGER RELOPINDEX; <<WHICH RELATIONAL OPERATOR WAS FOUND>>    <<U.RAO>>06748000
   << 1 <, 2 =, 3 >, 4 <=, 5 >=, 6 <>  >>                      <<U.RAO>>06750000
LOGICAL PRIMARY2VALUE;<<TEMPORARY FOR SECOND JCW PRIMARY VALUE><<U.RAO>>06752000
<<***  START OF BODY  ***>>                                    <<U.RAO>>06754000
JCWPRIMARY(PRIMARY,PRIMARYVALUE,TRANSERR,TRANSERRADR,PARMNUM); <<U.RAO>>06756000
@PRIMARY := TRANSERRADR;                                       <<U.RAO>>06758000
CASE *TRANSERR OF                                              <<U.RAO>>06760000
   BEGIN                                                       <<U.RAO>>06762000
      IF PRIMARY = CR THEN  <<REST OF RELATIONAL MISSING>>     <<U.RAO>>06764000
         ERRNUM := IFXPCTRELATION;                             <<U.RAO>>06766000
      ERRNUM := IFXPCTRELOP;                                   <<U.RAO>>06768000
      ERRNUM := SETJCWNUM2LARGE;                               <<U.RAO>>06770000
      ERRNUM := SETJCWINVOCTDGT;                               <<U.RAO>>06772000
      ERRNUM := SETJCWOKVAL2BIG;                               <<U.RAO>>06774000
      ERRNUM := SETJCWWARNVAL;                                 <<U.RAO>>06776000
      ERRNUM := SETJCWFATALVAL;                                <<U.RAO>>06778000
      ERRNUM := SETJCWSYSTEMVAL;                               <<U.RAO>>06780000
      ERRNUM := SETJCWNAME2LONG;                               <<U.RAO>>06782000
      ERRNUM := SETJCWNAMENOALP;                               <<U.RAO>>06784000
      ERRNUM := IFNOSUCHJCW;                                   <<U.RAO>>06786000
   END;                                                        <<U.RAO>>06788000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>06790000
   CIERR(ERRNUM, PRIMARY)                                      <<U.RAO>>06792000
ELSE                                                           <<U.RAO>>06794000
   BEGIN  <<HAVE FIRST ELEMENT, GO FOR RELATIONAL OP>>         <<U.RAO>>06796000
   IF "<" <= INTEGER(PRIMARY(1)) <= ">" THEN                   <<U.RAO>>06798000
      RELOPLEN := 2                                            <<U.RAO>>06800000
   ELSE                                                        <<U.RAO>>06802000
      RELOPLEN := 1;                                           <<U.RAO>>06804000
   MOVE RELOPDICT := RELOPDICTP, (RELOPDICTLEN);               <<U.RAO>>06806000
   RELOPINDEX := SEARCH(PRIMARY, RELOPLEN, RELOPDICT);         <<U.RAO>>06808000
   IF (RELOPINDEX=0) OR (PRIMARY(RELOPLEN)<>" ") AND           <<U.RAO>>06810000
         (PRIMARY(RELOPLEN)<>"%") AND                          <<U.RAO>>06812000
         (PRIMARY(RELOPLEN)<>CR) AND                           <<U.RAO>>06814000
         (PRIMARY(RELOPLEN)=SPECIAL) THEN  <<BAD RELOP>>       <<U.RAO>>06816000
      CIERR(ERRNUM := IFXPCTRELOP, PRIMARY)                    <<U.RAO>>06818000
   ELSE                                                        <<U.RAO>>06820000
      BEGIN  <<HAVE FIRST PRIMARY AND RELOP>>                  <<U.RAO>>06822000
      @PRIMARY := @PRIMARY+RELOPLEN;                           <<U.RAO>>06824000
      JCWPRIMARY(PRIMARY, PRIMARY2VALUE, TRANSERR, TRANSERRADR,<<U.RAO>>06826000
         PARMNUM);  <<CHECK SECOND PRIMARY>>                   <<U.RAO>>06828000
      @PRIMARY := TRANSERRADR;                                 <<U.RAO>>06830000
      CASE *TRANSERR OF                                        <<U.RAO>>06832000
         BEGIN                                                 <<U.RAO>>06834000
            BEGIN  <<NO ERROR, DO RETURN STUFF>>               <<U.RAO>>06836000
            ENDADR := @PRIMARY;                                <<U.RAO>>06838000
            CASE *RELOPINDEX-1 OF  <<COMPUTE RETURN VALUE>>    <<U.RAO>>06840000
               BEGIN                                           <<U.RAO>>06842000
               PRIMARYVALUE := PRIMARYVALUE < PRIMARY2VALUE;   <<U.RAO>>06844000
               PRIMARYVALUE := PRIMARYVALUE = PRIMARY2VALUE;   <<U.RAO>>06846000
               PRIMARYVALUE := PRIMARYVALUE > PRIMARY2VALUE;   <<U.RAO>>06848000
               PRIMARYVALUE := PRIMARYVALUE <= PRIMARY2VALUE;  <<U.RAO>>06850000
               PRIMARYVALUE := PRIMARYVALUE >= PRIMARY2VALUE;  <<U.RAO>>06852000
               PRIMARYVALUE := PRIMARYVALUE <> PRIMARY2VALUE;  <<U.RAO>>06854000
               END;                                            <<U.RAO>>06856000
            END;  <<SUCCESS CASE>>                             <<U.RAO>>06858000
            ERRNUM := IFXPCTJCWVAL;                            <<U.RAO>>06860000
            ERRNUM := SETJCWNUM2LARGE;                         <<U.RAO>>06862000
            ERRNUM := SETJCWINVOCTDGT;                         <<U.RAO>>06864000
            ERRNUM := SETJCWOKVAL2BIG;                         <<U.RAO>>06866000
            ERRNUM := SETJCWWARNVAL;                           <<U.RAO>>06868000
            ERRNUM := SETJCWFATALVAL;                          <<U.RAO>>06870000
            ERRNUM := SETJCWSYSTEMVAL;                         <<U.RAO>>06872000
            ERRNUM := SETJCWNAME2LONG;                         <<U.RAO>>06874000
            ERRNUM := SETJCWNAMENOALP;                         <<U.RAO>>06876000
            ERRNUM := IFNOSUCHJCW;                             <<U.RAO>>06878000
         END;                                                  <<U.RAO>>06880000
      IF ERRNUM <> 0 THEN  <<SEND ERROR MESSAGE>>              <<U.RAO>>06882000
         CIERR(ERRNUM, PRIMARY);                               <<U.RAO>>06884000
      END;                                                     <<U.RAO>>06886000
   END;                                                        <<U.RAO>>06888000
END;   <<PROCEDURE CPRIMARY>>                                  <<U.RAO>>06890000
PROCEDURE CFACTOR(FACTOR,FACTORVALUE,ERRNUM,ENDADR,PARMNUM);   <<U.RAO>>06892000
BYTE ARRAY FACTOR;                                             <<U.RAO>>06894000
LOGICAL FACTORVALUE;                                           <<U.RAO>>06896000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>06898000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>06900000
BEGIN                                                          <<U.RAO>>06902000
<<This procedure determines if the tokens following FACTOR >>  <<U.RAO>>06904000
<<constitute a conditional factor in the terms of the      >>  <<U.RAO>>06906000
<<IF command.  In BNF terms it is looking for              >>  <<U.RAO>>06908000
<< <cfactor> ::= (<cexpression>) | <cprimary>              >>  <<U.RAO>>06910000
<<FACTOR is a byte pointer to the suspected factor.        >>  <<U.RAO>>06912000
<<FACTORVALUE will be returned the value of the factor.    >>  <<U.RAO>>06914000
<<ERRNUM, ENDADR, PARMNUM are defined as usual for this set>>  <<U.RAO>>06916000
<<   of procedures.                                        >>  <<U.RAO>>06918000
                                                               <<U.RAO>>06920000
IF FACTOR = "(" THEN                                           <<U.RAO>>06922000
   BEGIN  <<ASSUME EXPRESSION FOLLOWS.>>                       <<U.RAO>>06924000
   SCAN FACTOR(1) WHILE %6440,1;  <<SKIP BLANKS TO FIRST TOKEN><<U.RAO>>06926000
   @FACTOR := TOS;                                             <<U.RAO>>06928000
   CONDEXP(FACTOR, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);      <<U.RAO>>06930000
   IF ERRNUM = 0 THEN   <<NO ERRORS IN EXPRESSION>>            <<U.RAO>>06932000
      BEGIN  <<CHECK END OF EXPRESSION, RETURN>>               <<U.RAO>>06934000
      @FACTOR := ENDADR;                                       <<U.RAO>>06936000
      IF FACTOR <> ")" THEN   <<MISSING TRAILING PAREN>>       <<U.RAO>>06938000
         CIERR(ERRNUM := IFXPCTCLOSPAREN, FACTOR)              <<U.RAO>>06940000
      ELSE  <<EVERYTHING IS FINE.>>                            <<U.RAO>>06942000
         BEGIN  <<CLEANUP, EXIT>>                              <<U.RAO>>06944000
         SCAN FACTOR(1) WHILE %6440,1;                         <<U.RAO>>06946000
         ENDADR := TOS;  <<SKIP TO NEXT TOKEN>>                <<U.RAO>>06948000
         END                                                   <<U.RAO>>06950000
      END                                                      <<U.RAO>>06952000
   END                                                         <<U.RAO>>06954000
ELSE   <<MUST BE CONDITIONAL PRIMARY>>                         <<U.RAO>>06956000
   CPRIMARY(FACTOR, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>06958000
END;   <<CFACTOR>>                                             <<U.RAO>>06960000
PROCEDURE CTERM(TERM, TERMVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>06962000
BYTE ARRAY TERM;                                               <<U.RAO>>06964000
LOGICAL TERMVALUE;                                             <<U.RAO>>06966000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>06968000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>06970000
BEGIN                                                          <<U.RAO>>06972000
<<This procedure checks for a conditional term.  In BNF it is>><<U.RAO>>06974000
<<   looking for                                             >><<U.RAO>>06976000
<<      <cterm> ::= <cterm> { AND <cterm> }                  >><<U.RAO>>06978000
<<                                                           >><<U.RAO>>06980000
<<TERM is a byte pointer to the start of the <term>.         >><<U.RAO>>06982000
<<TERMVALUE will be returned the value of the <term>.        >><<U.RAO>>06984000
<<ERRNUM, ENDADR, PARMNUM are as usual under these procedures>><<U.RAO>>06986000
                                                               <<U.RAO>>06988000
BYTE ARRAY ANDARRAY(0:4);  <<LOCAL FOR "AND" OPERATOR IN PARSE.<<U.RAO>>06990000
LOGICAL FACTORVALUE;   <<TEMPORARY FOR RETURN FROM CFACTOR>>   <<U.RAO>>06992000
CFACTOR(TERM, TERMVALUE, ERRNUM, ENDADR, PARMNUM);             <<U.RAO>>06994000
@TERM := ENDADR;                                               <<U.RAO>>06996000
GETNEXTIFOP(TERM, ANDARRAY);  <<EXTRACT NEXT TOKEN FOR CHECK>> <<U.RAO>>06998000
WHILE (ERRNUM=0) AND (ANDARRAY="AND ") DO                      <<U.RAO>>07000000
   BEGIN  <<LOOP THROUGH "AND <factor>"'s    >>                <<U.RAO>>07002000
   SCAN TERM(3) WHILE %6440,1;  <<SKIP TO START OF FACTOR>>    <<U.RAO>>07004000
   @TERM := TOS;                                               <<U.RAO>>07006000
   CFACTOR(TERM, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);        <<U.RAO>>07008000
   @TERM := ENDADR;                                            <<U.RAO>>07010000
   TERMVALUE := TERMVALUE LAND FACTORVALUE;                    <<U.RAO>>07012000
   GETNEXTIFOP(TERM, ANDARRAY);  <<PREP FOR NEXT LOOP>>        <<U.RAO>>07014000
   END;                                                        <<U.RAO>>07016000
END;  <<PROCEDURE CTERM>>                                      <<U.RAO>>07018000
PROCEDURE CONDEXP(EXP, EXPVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>07020000
BYTE ARRAY EXP;                                                <<U.RAO>>07022000
LOGICAL EXPVALUE;                                              <<U.RAO>>07024000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>07026000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>07028000
BEGIN                                                          <<U.RAO>>07030000
<<This procedure checks for a conditional expression.        >><<U.RAO>>07032000
<<The BNF is   <cexpression> ::= <cterm> { OR <cterm> }      >><<U.RAO>>07034000
<<The parameters are analogous to those under CTERM.         >><<U.RAO>>07036000
                                                               <<U.RAO>>07038000
BYTE ARRAY ORARRAY(0:4);  <<HOLDS "OR" OPERATOR FOR LOOP TEST>><<U.RAO>>07040000
LOGICAL TERMVALUE;   <<TEMP FOR SECOND CALL TO CTERM>>         <<U.RAO>>07042000
                                                               <<U.RAO>>07044000
CTERM(EXP, EXPVALUE, ERRNUM, ENDADR, PARMNUM);                 <<U.RAO>>07046000
@EXP := ENDADR;                                                <<U.RAO>>07048000
GETNEXTIFOP(EXP, ORARRAY);                                     <<U.RAO>>07050000
WHILE (ERRNUM=0) AND (ORARRAY="OR ") DO                        <<U.RAO>>07052000
   BEGIN   <<LOOP THROUGH "OR <term>"'s >>                     <<U.RAO>>07054000
   SCAN EXP(2) WHILE %6440,1;                                  <<U.RAO>>07056000
   @EXP := TOS;                                                <<U.RAO>>07058000
   CTERM(EXP, TERMVALUE, ERRNUM, ENDADR, PARMNUM);             <<U.RAO>>07060000
   @EXP := ENDADR;                                             <<U.RAO>>07062000
   EXPVALUE := EXPVALUE LOR TERMVALUE;                         <<U.RAO>>07064000
   GETNEXTIFOP(EXP, ORARRAY);                                  <<U.RAO>>07066000
   END;                                                        <<U.RAO>>07068000
END;   <<PROCEDURE CONDEXP>>                                   <<U.RAO>>07070000
PROCEDURE CXIF EXECUTORHEAD;                                   <<U.RAO>>07072000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>07074000
BEGIN                                                          <<U.RAO>>07076000
LOGICAL EXPVALUE;  <<RETURNED VALUE OF CONDITIONAL EXPRESSION>><<U.RAO>>07078000
INTEGER EXPEND;   <<HOLDS ADDRESS OF END OF EXPRESSION>>       <<U.RAO>>07080000
BYTE ARRAY THENLOC(0:5);                                       <<04710>>07082000
IF CIS'IFNESTING >= 15 THEN  << HAS OR WILL OVERFLOW >>        << I.A >>07084000
   begin                                                       <<U.RAO>>07086000
   CIS'IFNESTING := CIS'IFNESTING + 1;                         << I.A >>07088000
   cierr(errnum := ifnestingtoogreat);                         <<U.RAO>>07090000
   end                                                         <<U.RAO>>07092000
ELSE IF CIS'IFSKIP THEN << FLUSH "IF", BUT ACCOUNT >>          << I.A >>07094000
   begin   <<for it since it will have matching endif>>        <<U.RAO>>07096000
   CIS'IFNESTING := CIS'IFNESTING + 1;                         << I.A >>07098000
   CIS'IFSKIP := CIS'IFSKIP & LSL(1) LOR 1;  << FLAG FLUSH >>  << I.A >>07100000
   CIS'ELSESEEN := CIS'ELSESEEN & LSL(1);  << NEW ELSE LEVEL >><< I.A >>07102000
   end                                                         <<U.RAO>>07104000
else  <<no strange problems, just do it>>                      <<U.RAO>>07106000
   begin                                                       <<U.RAO>>07108000
   parmnum := 0;                                               <<U.RAO>>07110000
   SCAN PARMSP WHILE %6440,1;                                  <<U.RAO>>07112000
   @PARMSP := TOS;                                             <<U.RAO>>07114000
   IF CARRY THEN                                               <<U.RAO>>07116000
      BEGIN   <<NO PARAMETERS>>                                <<U.RAO>>07118000
      CIERR(ERRNUM := IFNOPARMS, PARMSP);                      <<U.RAO>>07120000
      RETURN;                                                  <<U.RAO>>07122000
      END;                                                     <<U.RAO>>07124000
   CONDEXP(PARMSP, EXPVALUE, ERRNUM, EXPEND, PARMNUM);         <<U.RAO>>07126000
   @PARMSP := EXPEND;                                          <<U.RAO>>07128000
   IF ERRNUM = 0 THEN   <<HAVE VALID EXPRESSION, WE THINK>>    <<U.RAO>>07130000
      BEGIN                                                    <<U.RAO>>07132000
      PARMNUM := PARMNUM+1;  <<TO TAKE INTO ACCOUNT THE THEN>> <<U.RAO>>07134000
      MOVE PARMSP := PARMSP WHILE AN,1;                        <<U.RAO>>07136000
      IF TOS-@PARMSP <> 4 THEN   <<NEXT TOKEN <> "THEN">>      <<U.RAO>>07138000
         CIERR(ERRNUM := IFNOTHEN, PARMSP)                     <<U.RAO>>07140000
      ELSE                                                     <<U.RAO>>07142000
         BEGIN   <<CHECK FOR ACTUAL THEN>>                     <<U.RAO>>07144000
         MOVE THENLOC := PARMSP WHILE ANS;                     <<U.RAO>>07146000
         IF THENLOC <> "THEN" THEN  <<NEXT TOKEN <> "THEN">>   <<U.RAO>>07148000
            CIERR(ERRNUM := IFNOTHEN, PARMSP)                  <<U.RAO>>07150000
         ELSE   <<HAVE THEN, LOOK FOR EXTRANEOUS GARBAGE>>     <<U.RAO>>07152000
            BEGIN                                              <<U.RAO>>07154000
            SCAN PARMSP(4) WHILE %6440,1;                      <<U.RAO>>07156000
            @PARMSP := TOS;                                    <<U.RAO>>07158000
            IF NOCARRY THEN   <<IS EXTRANEOUS GARBAGE>>        <<U.RAO>>07160000
               CIERR(ERRNUM := IFEXTRANEOUS, PARMSP)           <<U.RAO>>07162000
            ELSE  <<IT ALL LOOKS GOOD FROM HERE>>              <<U.RAO>>07164000
               BEGIN                                           <<U.RAO>>07166000
               PARMNUM := 0;                                   <<U.RAO>>07168000
               CIS'IFNESTING := CIS'IFNESTING + 1;             << I.A >>07170000
               CIS'ELSESEEN := CIS'ELSESEEN & LSL(1);          << I.A >>07172000
               IF EXPVALUE THEN   <<DO IF BLOCK>>              <<U.RAO>>07174000
                  BEGIN                                        <<00849>>07176000
                  CIS'IFSKIP := 0;  << 0 -> NOT FLUSHING >>    << I.A >>07178000
                  IF CIS'UDCNESTLEVEL = 0                      << I.A >>07180000
                     OR CIS'UDCLISTOPT      THEN               << I.A >>07182000
                     GENMSG(CIGENERALMSGSET,CONDITION'TRUE);   <<00849>>07184000
                  END                                          <<00849>>07186000
               ELSE   <<DO ELSE BLOCK, FLUSH IF BLOCK>>        <<U.RAO>>07188000
                  BEGIN                                        <<00849>>07190000
                     CIS'IFSKIP := 1; << 1 -> FLUSH >>         << I.A >>07192000
                  IF CIS'UDCNESTLEVEL = 0                      << I.A >>07194000
                     OR CIS'UDCLISTOPT      THEN               << I.A >>07196000
                     GENMSG(CIGENERALMSGSET,CONDITION'FALSE);  <<00849>>07198000
                  END;                                         <<00849>>07200000
               END   <<SUCCESS BLOCK>>                         <<U.RAO>>07202000
            END  <<FOUND THEN BLOCK>>                          <<U.RAO>>07204000
         END  <<CHECK FOR ACTUAL THEN BLOCK>>                  <<U.RAO>>07206000
      END  <<HAVE VALID EXPRESSION BLOCK>>                     <<U.RAO>>07208000
   END;   <<PROCEDURE CXIF>>                                   <<U.RAO>>07210000
end;                                                           <<U.RAO>>07212000
PROCEDURE CXELSE EXECUTORHEAD;                                 <<U.RAO>>07214000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>07216000
BEGIN                                                          <<U.RAO>>07218000
PARMNUM := 0;                                                  <<U.RAO>>07220000
SCAN PARMSP WHILE %6440,1;  <<SKIP ANY LEADING BLANKS>>        <<U.RAO>>07222000
@PARMSP := TOS;                                                <<U.RAO>>07224000
IF NOCARRY THEN   <<FOUND SOME EXTRANEOUS PARMS>>              <<U.RAO>>07226000
   CIERR(ERRNUM := -ELSE2MP, PARMSP);                          <<U.RAO>>07228000
IF CIS'IFNESTING <= 0 THEN                                     << I.A >>07230000
   CIERR(ERRNUM := ELSEUNPAIRED)                               <<U.RAO>>07232000
ELSE IF CIS'IFNESTING <= 15 THEN  << >15 IF'S ARE IGNORED. >>  << I.A >>07234000
   begin                                                       <<U.RAO>>07236000
   IF CIS'ELSESEEN THEN << ALREADY HAVE ELSE FOR THIS LEVEL >> << I.A >>07238000
      cierr(errnum := else2manyelses)                          <<U.RAO>>07240000
   else                                                        <<U.RAO>>07242000
      begin  <<have valid if-else paIR>>                       <<U.RAO>>07244000
      CIS'ELSESEEN := CIS'ELSESEEN LOR 1; << THIS LEVEL >>     << I.A >>07246000
      <<next step is to toggle flush bit.  tricky bit is, if>> <<U.RAO>>07248000
      <<this whole "if" level is being flushed due to a flush ><<U.RAO>>07250000
      <<at a lower level, we don't want to start executing now.<<U.RAO>>07252000
      <<so must check to see if we are being flushed from a>>  <<U.RAO>>07254000
      <<lower level.  this is done by counting the number of>> <<U.RAO>>07256000
      <<flushing levels as recorded by ifskip.>>               <<U.RAO>>07258000
      IF CIS'IFSKIP <= 1 THEN  << AT MOST 1 FLUSHING LEVEL >>  << I.A >>07260000
         begin   <<toggle bit.  if flushing (1) then want>>    <<U.RAO>>07262000
         <<not flushing (0) or vice versa.>>                   <<U.RAO>>07264000
         <<INDICATE WHETHER SUBSEQUENT COMMANDS WILL BE>>      <<00849>>07266000
         <<IGNORED OR EXECUTED                         >>      <<00849>>07268000
         IF CIS'UDCNESTLEVEL = 0                               << I.A >>07270000
            OR CIS'UDCLISTOPT       THEN                       << I.A >>07272000
            GENMSG( CIGENERALMSGSET, (IF CIS'IFSKIP=1 THEN     << I.A >>07274000
                   RESUME'EXEC ELSE IGNORE'COMM));             <<00849>>07276000
         TOS := CIS'IFSKIP;                                    << I.A >>07278000
         aSsemble(tcbc 15);                                    <<U.RAO>>07280000
         CIS'IFSKIP := TOS;                                    << I.A >>07282000
         end;                                                  <<U.RAO>>07284000
      end;                                                     <<U.RAO>>07286000
   END;                                                        <<U.RAO>>07288000
END;   <<PROCEDURE CXELSE>>                                    <<U.RAO>>07290000
PROCEDURE CXENDIF EXECUTORHEAD;                                <<U.RAO>>07292000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>07294000
BEGIN                                                          <<U.RAO>>07296000
PARMNUM := 0;                                                  <<U.RAO>>07298000
SCAN PARMSP WHILE %6440,1;                                     <<U.RAO>>07300000
@PARMSP := TOS;  <<SKIP ANY LEADING BLANKS>>                   <<U.RAO>>07302000
IF NOCARRY THEN  <<EXTRANEOUS DATA FOUND>>                     <<U.RAO>>07304000
   CIERR(ERRNUM := -ENDIF2MP, PARMSP);                         <<U.RAO>>07306000
IF CIS'IFNESTING <= 0 THEN                                     << I.A >>07308000
   CIERR(ERRNUM := -ENDIFUNPAIRED)                             <<U.RAO>>07310000
ELSE IF CIS'IFNESTING > 15 THEN  << HANDLING IGNORED OVFL >>   << I.A >>07312000
   CIS'IFNESTING := CIS'IFNESTING - 1                          << I.A >>07314000
ELSE  <<ITS OK, DELETE THIS NESTING LEVEL>>                    <<U.RAO>>07316000
   BEGIN                                                       <<U.RAO>>07318000
   CIS'IFNESTING := CIS'IFNESTING - 1;                         << I.A >>07320000
   <<IF ENDING AN 'IFSKIP' THEN INFORM USER>>                  <<00849>>07322000
   <<THAT EXECTION OF COMMANDS WILL RESUME >>                  <<00849>>07324000
   IF CIS'IFSKIP = 1   AND                                     << I.A >>07326000
      ( CIS'UDCNESTLEVEL=0 OR CIS'UDCLISTOPT  ) THEN           << I.A >>07328000
      GENMSG(CIGENERALMSGSET,RESUME'EXEC);                     <<00849>>07330000
   CIS'IFSKIP := CIS'IFSKIP & LSR(1);                          << I.A >>07332000
   CIS'ELSESEEN := CIS'ELSESEEN & LSR(1);                      << I.A >>07334000
   END;                                                        <<U.RAO>>07336000
END;                                                           <<U.RAO>>07338000
PROCEDURE TRANSJCWEQUATE(EQ, JCW, ERRNUM, ERRPTR);             <<U.RAO>>07340000
BYTE ARRAY EQ;                                                 <<U.RAO>>07342000
INTEGER JCW, ERRNUM, ERRPTR;                                   <<U.RAO>>07344000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>07346000
<<THIS PROCEDURE TRANSLATES JCW EQUATES INTO AN INTEGER.       <<U.RAO>>07348000
<<EQ IS A BYTE ARRAY HOLDING THE PUTATIVE JCW EQUATE.          <<U.RAO>>07350000
<<JCW WILL BE RETURNED THE EQUIVALENT INTEGER VALUE OF THE EQUA<<U.RAO>>07352000
<<ERRNUM INDICATES WHAT, IF ANY, ERRORS WERE DETECTED.         <<U.RAO>>07354000
<<   0 => NO ERRORS.                                           <<U.RAO>>07356000
<<   1 => INVALID TYPE PART (I.E., NOT OK, WARN, FATAL, OR SYST<<U.RAO>>07358000
<<   2 => NUMBER PART OF OK > 65535                            <<U.RAO>>07360000
<<   3 => NUMBER PART OF WARN > 49151                          <<U.RAO>>07362000
<<   4 => NUMBER PART OF FATAL > 32767                         <<U.RAO>>07364000
<<   5 => NUMBER PART OF SYSTEM > 16383                        <<U.RAO>>07366000
<<ERRPTR WILL BE RETURNED A BYTE ADDRESS.  IF NO ERROR WAS DETE<<U.RAO>>07368000
<<   IT WILL BE THE ADDRESS OF THE NEXT BYTE BEYOND THE NAME.  <<U.RAO>>07370000
<<   ERROR WAS DETECTED, IT WILL POINT TO THE ITEM PROBABLY AT <<U.RAO>>07372000
BEGIN                                                          <<U.RAO>>07374000
BYTE ARRAY TYPE(0:1) = PB :=                                   <<U.RAO>>07376000
   4,2,"OK",                                                   <<U.RAO>>07378000
   6,4,"WARN",                                                 <<U.RAO>>07380000
   7,5,"FATAL",                                                <<U.RAO>>07382000
   8,6,"SYSTEM",                                               <<U.RAO>>07384000
   0;                                                          <<U.RAO>>07386000
EQUATE TYPEARRAYLEN = 4+6+7+8+1;                               <<U.RAO>>07388000
BYTE ARRAY LOCALTYPE(0:TYPEARRAYLEN-1);  <<HOLDS DB REL ARRAY T<<U.RAO>>07390000
INTEGER TYPELEN;  <<LENGTH OF TYPE PART OF EQUATE FOR SEARCH IN<<U.RAO>>07392000
EQUATE MAXTYPELEN = 6;   <<"SYSTEM">>                          <<U.RAO>>07394000
BYTE ARRAY LOCALEQ(0:MAXTYPELEN-1); <<HOLDS LOCAL COPY OF TYPE <<U.RAO>>07396000
INTEGER EQTYPE;  <<RESULT FROM SEARCH OF TYPE ARRAY>>          <<U.RAO>>07398000
INTEGER NUMLEN;  <<LENGTH OF NUMERIC PART OF EQUATE>>          <<U.RAO>>07400000
DOUBLE DNUMVAL;  <<HOLDS VALUE OF NUMERIC PART OF EQUATE>>     <<U.RAO>>07402000
EQUATE NOERROR = 0,                                            <<U.RAO>>07404000
       INVALIDTYPE = 1,                                        <<U.RAO>>07406000
       INVALIDNUM = 2;                                         << I.A >>07408000
ERRPTR := @EQ;                                                 <<U.RAO>>07410000
<<FIRST STEP IS TO EXTRACT TYPE FIELD>>                        <<U.RAO>>07412000
MOVE LOCALTYPE := TYPE,(TYPEARRAYLEN);                         <<U.RAO>>07414000
MOVE EQ := EQ WHILE A,1;  <<TO GET TOKEN LENGTH>>              <<U.RAO>>07416000
TYPELEN := TOS-@EQ;                                            <<U.RAO>>07418000
IF TYPELEN > MAXTYPELEN THEN                                   <<U.RAO>>07420000
   ERRNUM := INVALIDTYPE                                       <<U.RAO>>07422000
ELSE                                                           <<U.RAO>>07424000
   BEGIN                                                       <<U.RAO>>07426000
   MOVE LOCALEQ := EQ WHILE AS;  <<GET SHIFTED LOCAL COPY>>    <<U.RAO>>07428000
   EQTYPE := SEARCH(LOCALEQ, TYPELEN, LOCALTYPE) -1;           <<U.RAO>>07430000
   IF < THEN                                                   <<U.RAO>>07432000
      ERRNUM := INVALIDTYPE                                    <<U.RAO>>07434000
   ELSE                                                        <<U.RAO>>07436000
      BEGIN  <<HAVE VALID TYPE, NOW CHECK NUMERIC PART>>       <<U.RAO>>07438000
      ERRPTR := @EQ + TYPELEN;                                 <<U.RAO>>07440000
      MOVE EQ(TYPELEN) := EQ(TYPELEN) WHILE N,1;               <<U.RAO>>07442000
      NUMLEN := TOS-@EQ(TYPELEN);                              <<U.RAO>>07444000
      DNUMVAL := DBINARY(EQ(TYPELEN), NUMLEN);                 <<U.RAO>>07446000
      IF <> OR (DNUMVAL>%177777D) THEN                         <<U.RAO>>07448000
         ERRNUM := INVALIDNUM+EQTYPE                           <<U.RAO>>07450000
      ELSE                                                     <<U.RAO>>07452000
         BEGIN  <<DO RANGE CHECKS>>                            <<U.RAO>>07454000
         <<WHOLE TRICK HERE IS, MUST FIT IN 16 BITS.>>         <<U.RAO>>07456000
         <<CALCULATE RESULT VALUE, CHECK < %177777D >>         <<U.RAO>>07458000
         TOS := 0;                                             <<U.RAO>>07460000
         TOS := EQTYPE&CSR(2);  <<SET UP TYPE INDUCED MASK>>   <<U.RAO>>07462000
         TOS := TOS+DNUMVAL;  <<MASK + NUMERIC PART>>          <<U.RAO>>07464000
         IF DS1 > %177777D THEN                                <<U.RAO>>07466000
            ERRNUM := INVALIDNUM+EQTYPE                        <<U.RAO>>07468000
         ELSE  <<EVERYTHING FINE, RETURN VALUES>>              <<U.RAO>>07470000
            BEGIN                                              <<U.RAO>>07472000
            ERRNUM := NOERROR;                                 <<U.RAO>>07474000
            ERRPTR := @EQ+TYPELEN+NUMLEN;                      <<U.RAO>>07476000
            JCW := TOS;  <<RESULT VALUE WAS ON TOS, REMEMBER>> <<U.RAO>>07478000
            END;                                               <<U.RAO>>07480000
         END;                                                  <<U.RAO>>07482000
      END;                                                     <<U.RAO>>07484000
   END;                                                        <<U.RAO>>07486000
END;   <<TRANSJCWEQUATE>>                                      <<U.RAO>>07488000
PROCEDURE CXSETJCW EXECUTORHEAD;                               <<U.RAO>>07490000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>07492000
<<THE SYNTAX OF THE SETJCW COMMAND IS                          <<U.RAO>>07494000
<<                                                  {<number>} <<U.RAO>>07496000
<<   SETJCW  <jcwname><non-alphanumeric except cr,%>{<equate>} <<U.RAO>>07498000
<<                                                  {<existing <<U.RAO>>07500000
<<                                                             <<U.RAO>>07502000
BEGIN                                                          <<U.RAO>>07504000
BYTE POINTER PARMPTR;  <<LOCAL POINTER INTO PARAMETER STRING>> <<U.RAO>>07506000
EQUATE CR=%15;  <<CARRIAGE RETURN>>                            <<U.RAO>>07508000
INTEGER NAMELEN;  <<HOLDS JCW NAME LENGTH>>                    <<U.RAO>>07510000
                                                               <<04708>>07512000
LOGICAL INTERACTIVE;  << TRUE IF IN A SESSION. >>              <<01893>>07514000
INTEGER TRANSERR:=0;<<ERROR RETURNS FROM EXTERNAL PROCEDURES>> <<U.RAO>>07516000
INTEGER TRANSERRPTR:=0; <<ERROR ADDRESS FROM TRANSJCWEQUATE>>  <<U.RAO>>07518000
                                                               <<04708>>07520000
DOUBLE DOUBLE'NEWVALUE:=0D;         << LOGICAL ARITHEMETIC >>  <<04708>>07522000
LOGICAL NEWVALUE=DOUBLE'NEWVALUE+1; << SIGNIFICANT PART    >>  <<04708>>07524000
DOUBLE TEMPJCWVALUE;                << LOGICAL ARITHMETIC  >>  <<04708>>07526000
LOGICAL REALJCWVALUE=TEMPJCWVALUE+1;<< SIGNIFICANT PART    >>  <<04708>>07528000
LOGICAL ADD;                        << OPERATION TYPE      >>  <<04708>>07530000
DOUBLE SECOND'VALUE:=0D;            << LOGICAL ARITHMETIC  >>  <<04708>>07532000
LOGICAL SECOND=SECOND'VALUE+1;      << SIGNIFICANT PART    >>  <<04708>>07534000
EQUATE PLUS="+";                                               <<04708>>07536000
EQUATE MINUS="-";                                              <<04708>>07538000
                                                               <<04708>>07540000
<<BASIC SCHEME: 1) FIND NAME, 2) FIND DELIMITER, 3) GET VALUE>><<U.RAO>>07542000
ERRNUM := 0;                                                   <<U.RAO>>07544000
PARMNUM := 1;                                                  <<U.RAO>>07546000
WHILE PARMSP=" " DO @PARMSP := @PARMSP+1;                      <<U.RAO>>07548000
MOVE PARMSP := PARMSP WHILE ANS,1; <<RESULT IS ADDR OF DELIM>> <<U.RAO>>07550000
@PARMPTR := TOS;                                               <<U.RAO>>07552000
IF (@PARMPTR = @PARMSP) AND PARMPTR <> "@" THEN                <<04.RO>>07554000
   CIERR(ERRNUM := SETJCWNONAME, PARMSP)                       <<U.RAO>>07556000
ELSE                                                           <<U.RAO>>07558000
   BEGIN  <<NAME IS NON-NULL.  GET VALUE>>                     <<U.RAO>>07560000
   NAMELEN := @PARMPTR - @PARMSP;                              <<U.RAO>>07562000
   IF NAMELEN = 0 THEN   <<WAS "@", SKIP OVER>>                <<04.RO>>07564000
      @PARMPTR := @PARMPTR+1;                                  <<04.RO>>07566000
   WHILE (PARMPTR = SPECIAL) AND (PARMPTR <> CR) AND           <<04708>>07568000
        (PARMPTR<>"%") AND (PARMPTR<>MINUS) DO                 <<04708>>07570000
      @PARMPTR := @PARMPTR+1;                                  <<U.RAO>>07572000
   IF PARMPTR = MINUS THEN                                     <<04708>>07574000
      ERRNUM := SETJCWNUM2LARGE                                <<04708>>07576000
   ELSE                                                        <<04708>>07578000
   BEGIN                                                       <<04708>>07580000
   JCWPRIMARY(PARMPTR, NEWVALUE, TRANSERR, TRANSERRPTR,        <<U.RAO>>07582000
      PARMNUM);                                                <<U.RAO>>07584000
   @PARMPTR := TRANSERRPTR;                                    <<U.RAO>>07586000
   CASE *TRANSERR OF                                           <<U.RAO>>07588000
      BEGIN                                                    <<U.RAO>>07590000
      IF (PARMPTR<>CR) AND                                     <<04708>>07592000
         (PARMPTR<>PLUS) AND (PARMPTR<>MINUS) THEN             <<04708>>07594000
            ERRNUM := SETJCW2MP;                               <<04708>>07596000
         ERRNUM := SETJCWNOVALUE;                              <<U.RAO>>07598000
         ERRNUM := SETJCWNUM2LARGE;                            <<U.RAO>>07600000
         ERRNUM := SETJCWINVOCTDGT;                            <<U.RAO>>07602000
         ERRNUM := SETJCWOKVAL2BIG;                            <<U.RAO>>07604000
         ERRNUM := SETJCWWARNVAL;                              <<U.RAO>>07606000
         ERRNUM := SETJCWFATALVAL;                             <<U.RAO>>07608000
         ERRNUM := SETJCWSYSTEMVAL;                            <<U.RAO>>07610000
         ERRNUM := SETJCWNAME2LONG;                            <<U.RAO>>07612000
         ERRNUM := SETJCWNAMENOALP;                            <<U.RAO>>07614000
         ERRNUM := SETJCWNOSUCHJCW;                            <<U.RAO>>07616000
      END;                                                     <<U.RAO>>07618000
   END;                                                        <<04708>>07620000
   IF ERRNUM <> 0 THEN                                         <<U.RAO>>07622000
      CIERR(ERRNUM, PARMPTR)                                   <<U.RAO>>07624000
   ELSE   <<HAVE VALID JCW VALUE IN "NEWVALUE".  EXECUTE!>>    <<U.RAO>>07626000
      BEGIN                                                    <<U.RAO>>07628000
                                                               <<04708>>07630000
<<  NOW CHECK IF ANY ARITHMETIC OPERATIONS NEED TO BE >>       <<04708>>07632000
<<  PERFORMED ON THE PARAMETERS.                      >>       <<04708>>07634000
                                                               <<04708>>07636000
      IF (PARMPTR=PLUS) OR (PARMPTR=MINUS) THEN                <<04708>>07638000
       BEGIN                                                   <<04708>>07640000
                                                               <<04708>>07642000
<<  DETERMINE OPERATION TYPE                          >>       <<04708>>07644000
                                                               <<04708>>07646000
         IF (PARMPTR=PLUS) THEN                                <<04708>>07648000
            ADD:=TRUE                                          <<04708>>07650000
         ELSE ADD:=FALSE;                                      <<04708>>07652000
         @PARMPTR:=@PARMPTR+1;                                 <<04708>>07654000
                                                               <<04708>>07656000
<<  GET A VALUE FOR THE SECOND JCW VALUE              >>       <<04708>>07658000
                                                               <<04708>>07660000
         JCWPRIMARY(PARMPTR,SECOND,TRANSERR,TRANSERRPTR,       <<04708>>07662000
            PARMNUM);                                          <<04708>>07664000
         @PARMPTR:=TRANSERRPTR;                                <<04708>>07666000
         CASE *TRANSERR OF                                     <<04708>>07668000
            BEGIN                                              <<04708>>07670000
               IF (PARMPTR<>CR) THEN                           <<04708>>07672000
                  ERRNUM := SETJCW2MP;                         <<04708>>07674000
               ERRNUM := SETJCWNOVALUE;                        <<04708>>07676000
               ERRNUM := SETJCWNUM2LARGE;                      <<04708>>07678000
               ERRNUM := SETJCWINVOCTDGT;                      <<04708>>07680000
               ERRNUM := SETJCWOKVAL2BIG;                      <<04708>>07682000
               ERRNUM := SETJCWWARNVAL;                        <<04708>>07684000
               ERRNUM := SETJCWFATALVAL;                       <<04708>>07686000
               ERRNUM := SETJCWSYSTEMVAL;                      <<04708>>07688000
               ERRNUM := SETJCWNAME2LONG;                      <<04708>>07690000
               ERRNUM := SETJCWNAMENOALP;                      <<04708>>07692000
               ERRNUM := SETJCWNOSUCHJCW;                      <<04708>>07694000
            END;                                               <<04708>>07696000
         IF ERRNUM <> 0 THEN                                   <<04708>>07698000
            BEGIN                                              <<04708>>07700000
              CIERR(ERRNUM,PARMPTR);                           <<04708>>07702000
              RETURN;                                          <<04708>>07704000
            END;                                               <<04708>>07706000
                                                               <<04708>>07708000
<<  NO ERRORS YET--NOW PERFORM THE ARITHMETIC         >>       <<04708>>07710000
                                                               <<04708>>07712000
         IF NOT ADD THEN                                       <<04708>>07714000
            SECOND'VALUE := -SECOND'VALUE;                     <<04708>>07716000
         TEMPJCWVALUE := DOUBLE'NEWVALUE + SECOND'VALUE;       <<04708>>07718000
                                                               <<04708>>07720000
<<  NOW CHECK IF THE RESULT IS TOO LARGE              >>       <<04708>>07722000
                                                               <<04708>>07724000
         IF (TEMPJCWVALUE > 65535D) OR (TEMPJCWVALUE < 0D) THEN<<04708>>07726000
            BEGIN                                              <<04708>>07728000
              ERRNUM := SETJCWNUM2LARGE;                       <<04708>>07730000
              @PARMPTR := @PARMPTR-2;                          <<04708>>07732000
              CIERR(ERRNUM, PARMPTR);                          <<04708>>07734000
              RETURN;                                          <<04708>>07736000
            END                                                <<04708>>07738000
         ELSE                                                  <<04708>>07740000
            NEWVALUE := REALJCWVALUE;                          <<04708>>07742000
       END;                                                    <<04708>>07744000
      PUTJCW(PARMSP, NEWVALUE, TRANSERR);  <<SEND NEW VALUE>>  <<U.RAO>>07746000
      CASE *TRANSERR OF                                        <<U.RAO>>07748000
         BEGIN                                                 <<U.RAO>>07750000
            <<NO ERRORS, SEE IF IT WAS "JCW">>                 <<U.RAO>>07752000
            IF NEWVALUE.(0:1) <<BIT 0 SET>> THEN               <<04.RO>>07754000
               IF (NAMELEN=3) AND PARMSP="JCW"                 <<04.RO>>07756000
                  OR PARMSP="@" THEN                           <<04.RO>>07758000
               BEGIN                                           <<01893>>07760000
               << IF :SETJCW IS EXECUTED PROGRAMMATICALLY, >>  <<01893>>07762000
               << DON'T BOTHER WITH ANY ERROR MESSAGES.    >>  <<01893>>07764000
                  IF JOBSESSIONMAIN THEN                       <<01893>>07766000
                  BEGIN                                        <<01893>>07768000
                  << WARNING ABOUT POSSIBLE FLUSHING OF UDC. >><<01893>>07770000
                     IF CIS'UDC4.CIS'NESTLEVEL <> 0 THEN       << I.A >>07772000
                        CIERR( ERRNUM := -SETJCWFATINUDC );    <<04787>>07774000
                                                               <<01893>>07776000
                  << WARNING ABOUT POSSIBLE JOB FLUSHING. >>   <<01893>>07778000
                     INTERACTIVETEST;                          <<01893>>07780000
                     INTERACTIVE := TOS;                       <<01893>>07782000
                     IF NOT INTERACTIVE THEN                   <<01893>>07784000
                        CIERR( ERRNUM := -SETJCWFATINJOB );    <<04787>>07786000
                                                               <<01893>>07788000
                  END;                                         <<01893>>07790000
                                                               <<01893>>07792000
               << KILL JOB IF APPROPRIATE.           >>        <<01893>>07794000
                                                               <<01893>>07796000
                   CIERR;                                      <<01893>>07798000
                END;                                           <<01893>>07800000
            CIERR(ERRNUM := SETJCWNAME2LONG, PARMSP);          <<01893>>07802000
            CIERR(ERRNUM := SETJCWNAMENOALP, PARMSP);          <<U.RAO>>07804000
            CIERR(ERRNUM := JCWTABOVERFLOW, PARMSP);           <<U.RAO>>07806000
            CIERR(ERRNUM := SETJCWNAMERESV,PARMSP);            <<04688>>07808000
         END;                                                  <<U.RAO>>07810000
      END;                                                     <<U.RAO>>07812000
   END;                                                        <<U.RAO>>07814000
END;   <<PROCEDURE CXSETJCW>>                                  <<U.RAO>>07816000
PROCEDURE CXSHOWJCW EXECUTORHEAD;                              <<U.RAO>>07818000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>07820000
<<SYNTAX     SHOWJCW [<jcwname>]    >>                         <<U.RAO>>07822000
BEGIN                                                          <<U.RAO>>07824000
INTEGER NAMELEN;   <<LENGTH OF JCW NAME>>                      <<U.RAO>>07826000
INTEGER JDTDST;   <<HOLDS DST NUMBER OF JDT>>                  <<U.RAO>>07828000
EQUATE JJCWADR = 5;                                            <<U.RAO>>07830000
DOUBLE JCWTABLIMITS;                                           <<U.RAO>>07832000
INTEGER NEXTJCWADR = JCWTABLIMITS;  <<LOWER BOUND OF JCW TABLE><<U.RAO>>07834000
INTEGER JCWTABEND = JCWTABLIMITS+1; <<UPPER BOUND OF JCW TABLE><<U.RAO>>07836000
INTEGER ARRAY CANDIDATEW(0:128);                               <<U.RAO>>07838000
BYTE ARRAY CANDIDATE(*) = CANDIDATEW;                          <<U.RAO>>07840000
INTEGER ERROR;  <<FOR CALL TO FINDJCW>>                        <<U.RAO>>07842000
INTEGER JCWGROUP;  <<NEED TO ACCOUNT FOR OK, WARN, ETC.>>      <<U.RAO>>07844000
INTEGER JCWVALUE;                 <<ACTUAL JCWVALUE PART>>     <<U.RAO>>07846000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>07848000
                                                               <<U.RAO>>07850000
<<FIRST CHECK FOR PARM>>                                       <<U.RAO>>07852000
SCAN PARMSP WHILE %6440,1;  <<SKIP ANY LEADING BLANKS>>        <<U.RAO>>07854000
@PARMSP := TOS;                                                <<U.RAO>>07856000
IF NOCARRY THEN   <<SOMETHING ELSE BEFORE CR>>                 <<U.RAO>>07858000
   BEGIN                                                       <<U.RAO>>07860000
   PARMNUM := 1;                                               <<U.RAO>>07862000
   MOVE PARMSP := PARMSP WHILE AN,1;  <<TO GET NAME LENGTH>>   <<U.RAO>>07864000
   NAMELEN := TOS-@PARMSP;                                     <<U.RAO>>07866000
   IF NAMELEN > 255 THEN                                       <<U.RAO>>07868000
      CIERR(ERRNUM := SETJCWNAME2LONG, PARMSP)                 <<U.RAO>>07870000
   ELSE  <<NAME IS LEGAL LENGTH>>                              <<U.RAO>>07872000
      BEGIN   <<TRY TO GET IT>>                                <<U.RAO>>07874000
      MOVE CANDIDATE := PARMSP WHILE ANS,0;                    <<U.RAO>>07876000
      SCAN * WHILE %6440,1;  <<LOOK FOR EXTRANEOUS DATA>>      <<U.RAO>>07878000
      IF NOCARRY THEN   <<IS SOME EXTRANEOUS PARM, WARN>>      <<U.RAO>>07880000
         BEGIN                                                 <<U.RAO>>07882000
         TOS := ERRNUM := -SHOWJCW2MP;                         <<U.RAO>>07884000
         ASSEMBLE(XCH);                                        <<U.RAO>>07886000
         CIERR(*,*);                                           <<U.RAO>>07888000
         END;                                                  <<U.RAO>>07890000
      CANDIDATE(NAMELEN) := 0;  <<END OF NAME STOPPER>>        <<U.RAO>>07892000
      FINDJCW(CANDIDATE, JCWVALUE, ERROR);                     <<U.RAO>>07894000
      JCWGROUP := JCWVALUE.(0:2);  <<EXTRACT TYPE FIELD>>      <<U.RAO>>07896000
      JCWVALUE := JCWVALUE.(2:14);  <<MODIFIER FIELD>>         <<U.RAO>>07898000
      CASE *ERROR OF                                           <<U.RAO>>07900000
         BEGIN                                                 <<U.RAO>>07902000
            GENMSG(CIGENERALMSGSET, SHOWJCWMSG+JCWGROUP,       <<U.RAO>>07904000
                     %01000, @CANDIDATE, JCWVALUE);            <<U.RAO>>07906000
            ;  <<NAME > 255 CHAR CAN'T HAPPEN>>                <<U.RAO>>07908000
            CIERR(ERRNUM := SETJCWNAMENOALP, PARMSP);          <<U.RAO>>07910000
            CIERR(ERRNUM := SHOWJCWNOSCHJCW, PARMSP);          <<U.RAO>>07912000
         END;                                                  <<U.RAO>>07914000
      END;                                                     <<U.RAO>>07916000
   END                                                         <<U.RAO>>07918000
ELSE   <<NO PARAMETERS, LIST ALL JCWS>>                        <<U.RAO>>07920000
   BEGIN                                                       <<U.RAO>>07922000
   <<FIRST GET BOUNDS ON TABLE>>                               <<U.RAO>>07924000
   SETXPXGLOB+PXGWJDT;                                         <<U.RAO>>07926000
   JDTDST := ARRDB0(XREG).(6:10);                              <<KS.01>>07928000
   MOVEFROMDSEG(@JCWTABLIMITS, JDTDST, JJCWADR, 2);            <<U.RAO>>07930000
   <<NOW LOOP THROUGH JCW TABLE, PRINTING ENTRIES>>            <<U.RAO>>07932000
   WHILE NEXTJCWADR < JCWTABEND DO                             <<U.RAO>>07934000
      BEGIN                                                    <<U.RAO>>07936000
      <<FIRST GET NEXT ENTRY IN FROM TABLE.>>                  <<U.RAO>>07938000
      TOS := @CANDIDATEW;                                      <<U.RAO>>07940000
      TOS := JDTDST;                                           <<U.RAO>>07942000
      TOS := NEXTJCWADR;                                       <<U.RAO>>07944000
      <<LENGTH TO READ IS MIN OF 129 OR THE SPACE LEFT IN TABLE<<U.RAO>>07946000
      IF JCWTABEND-NEXTJCWADR > 129 THEN                       <<U.RAO>>07948000
         TOS := 129                                            <<U.RAO>>07950000
      ELSE  <<TABLE HAS LESS THAN 129 WORDS LEFT IN IT>>       <<U.RAO>>07952000
         TOS := JCWTABEND-NEXTJCWADR;                          <<U.RAO>>07954000
      ASSEMBLE(MFDS);  <<GET ITEM IN>>                         <<U.RAO>>07956000
      <<NOW HAVE NEXT CANDIDATE IN LOCAL ARRAY, PREP FOR MESSAG<<U.RAO>>07958000
      JCWVALUE := CANDIDATEW(CANDIDATE&LSR(1)+1);              <<U.RAO>>07960000
      JCWGROUP := JCWVALUE.(0:2);  <<GET TYPE FIELD>>          <<U.RAO>>07962000
      JCWVALUE := JCWVALUE.(2:14);  <<ISOLATE MODIFIER PART>>           07964000
      CANDIDATE(CANDIDATE+1) := 0;  <<STOPPER FOR GENMSG>>     <<U.RAO>>07966000
      <<FINALLY PRINT MESSAGE>>                                <<U.RAO>>07968000
      GENMSG(CIGENERALMSGSET, SHOWJCWMSG+JCWGROUP,             <<U.RAO>>07970000
             %01000, @CANDIDATE(1), JCWVALUE);                 <<U.RAO>>07972000
      NEXTJCWADR := NEXTJCWADR+INTEGER(CANDIDATE)&LSR(1)+2;    <<U.RAO>>07974000
      IF REQUESTSERVICE THEN NEXTJCWADR := JCWTABEND;          <<U.RAO>>07976000
      END;                                                     <<U.RAO>>07978000
   END;                                                        <<U.RAO>>07980000
END;   <<PROCEDURE SHOWJCW>>                                   <<U.RAO>>07982000
$PAGE "MISCELLANEOUS COMMANDS, THIRD BLOCK"                    <<08.RO>>07984000
PROCEDURE CXCOMMENT EXECUTORHEAD;                              <<U.RAO>>07986000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>07988000
      BEGIN                                                             07990000
      <<NOP PROCEDURE...COMMENT ALREADY LISTED BY GETIMAGE>>            07992000
      END;                                                              07994000
$PAGE       "ERROR HANLDERS AND MISC ROUTINES"                          07996000
$CONTROL   SEGMENT  = CIERR                                             07998000
LOGICAL PROCEDURE JOBSESSIONMAIN;                              <<U.RAO>>08000000
   OPTION UNCALLABLE;                                          <<U.RAO>>08002000
COMMENT                                                        <<U.RAO>>08004000
   RETURNS TRUE IF CURRENT PROCESS IS J/S MAIN                 <<U.RAO>>08006000
;                                                              <<U.RAO>>08008000
IF PCB09.PCBPTYPE = PCBJSMAIN THEN JOBSESSIONMAIN:=TRUE;       <<U.RAO>>08010000
LOGICAL PROCEDURE CIBADFILENAME(ERRNUM,PARM);                  <<U.RAO>>08012000
VALUE PARM;                                                    <<U.RAO>>08014000
DOUBLE PARM;                                                   <<U.RAO>>08016000
INTEGER ERRNUM;                                                <<U.RAO>>08018000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>08020000
BEGIN                                                          <<U.RAO>>08022000
   <<THIS PROCEDURE IS AN INTERFACE ROUTINE BETWEEN>>          <<U.RAO>>08024000
   <<CHECKFILENAME' AND THOSE ROUTINES WHICH WANT A FILE NAME ><<U.RAO>>08026000
   <<CHECKED AND ANY SYNTACTIC ERRORS REPORTED.  IT ONLY >>    <<U.RAO>>08028000
   <<RETURNS TRUE IF AN ERROR WAS DETECTED AND ONLY RETURNS>>  <<U.RAO>>08030000
   <<FALSE IF THE FILE NAME WAS NOT BAD.  >>                   <<U.RAO>>08032000
   <<ERRNUM IS A POINTER TO THE PARAMETER ERRNUM KNOWN THROUGOU<<U.RAO>>08034000
   <<THE CI.  PARM IS A DOUBLE DESCRIBING THE FILE NAME IN>>   <<U.RAO>>08036000
   <<THE FORMAT RETURNED BY MYCOMMAND.  IN PARTICULAR, THE FIRS<<U.RAO>>08038000
   <<WORD IS THE BYTE ADDRESS OF THE NAME AND THE FIRST BYTE>> <<U.RAO>>08040000
   <<OF THE SECOND WORD IS THE LENGTH OF THE NAME>>            <<U.RAO>>08042000
                                                               <<U.RAO>>08044000
LOGICAL DUMMY;                                                 <<U.RAO>>08046000
BYTE POINTER ERRPTR;                                           <<U.RAO>>08048000
LOGICAL LERRPTR = ERRPTR;                                      <<U.RAO>>08050000
                                                               <<U.RAO>>08052000
TOS := CHECKFILENAME'(PARM&LSR(8), DUMMY, DUMMY, LERRPTR);     <<U.RAO>>08054000
IF < THEN                                                      <<U.RAO>>08056000
   BEGIN                                                       <<U.RAO>>08058000
   ERRNUM := S0;                                               <<U.RAO>>08060000
   CIERR(*,ERRPTR);                                            <<U.RAO>>08062000
   CIBADFILENAME := TRUE;                                      <<U.RAO>>08064000
   END                                                         <<U.RAO>>08066000
ELSE                                                           <<U.RAO>>08068000
   CIBADFILENAME := FALSE;                                     <<U.RAO>>08070000
END;  <<CIBADFILENAME>>                                        <<U.RAO>>08072000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>08074000
VALUE PDEF; DOUBLE PDEF;                                       <<U.RAO>>08076000
LOGICAL GPTR,APTR,ERRPTR;                                      <<U.RAO>>08078000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>08080000
BEGIN                                                          <<U.RAO>>08082000
COMMENT                                                                 08084000
  THIS PROCEDURE DOES A COMPLETE VALIDATION OF THE FORM OF AN           08086000
ACTUAL FILE DESIGNATOR, INCLUDING SPECIAL FILES.                        08088000
                                                                        08090000
PARAMETERS:                                                             08092000
  PDEF - THE FIRST WORD IS A BYTE POINTER TO THE START OF THE           08094000
         ACTUAL FILE DESIGNATOR AND THE SECOND WORD IS A COUNT          08096000
         OF THE NUMBER OF CHARACTERS IN THE NAME,                       08098000
         INCLUDING SPECIAL CHARACTERS IF ANY.  IT IS A DOUBLE           08100000
         BECAUSE THAT IS THE MOST CONVENIENT FORM FOR ROUTINES WHICH    08102000
         HAVE THEIR PARAMETERS PARSED BY MYCOMMAND.                     08104000
  GPTR - IF A REASONABLY VALID GROUP NAME IS PARSED, A BYTE POINTER     08106000
         TO THE START OF THAT NAME IS PASSED THROUGH THIS LOGICAL       08108000
         BY REFERENCE.  IF NO VALID GROUP NAME IS FOUND, THIS IS        08110000
         UNCHANGED.                                                     08112000
  APTR - AN ACCOUNT POINTER SIMILAR TO THE GPTR.                        08114000
  ERRPTR - A MEANS BY WHICH THIS PROCEDURE MAY RETURN A POINTER TO      08116000
           ANY ERROR FOUND IN THE BODY OF THE NAME.                     08118000
  CHECKFILENAME' - SEE CONDITION CODE FOR INTERPRETATION.               08120000
  CONDITION CODE:                                                       08122000
     CCE => FOUND NORMAL ACTUAL FILE DESIGNATOR, NO ERRORS, RETURNS     08124000
            A 0.                                                        08126000
     CCL => FOUND ERROR.  CHECKFILENAME' IS THE CIERROR NUMBER.         08128000
     CCG => NO ERRORS. FOUND BACKREFERENCED FILE NAME OR SYSTEM         08130000
            DEFINED FILE NAME.  IF CHECKFILENAME' = 0, THEN IS          08132000
            BACKREFERENCED FILE NAME. IF <> 0 THEN IS INDEX OF          08134000
            SYSTEM DEFINED FILE NAME, AS DEFINED IN THE DEFAULT         08136000
            DESIGNATOR FIELD OF THE FOPTION WORD IN FOPEN.              08138000
                                                                        08140000
ALGORITHM - THE SCHEME IS TO SIMPLY CRUNCH THROUGH, LOOKING AT EACH     08142000
         PART AS WE COME TO IT.                                         08144000
                                                               <<04849>>08146000
                                                               <<04849>>08148000
The entry point, "CHK'DESCRIBE'FNAME", was added to show       <<04849>>08150000
which options where present in the file name.  If an error     <<04849>>08152000
is found, CCL is returned as before.  If a regular file        <<04849>>08154000
or a system file was correctly specified, then the top         <<04849>>08156000
eight bits indicate what was specified--for CCE (file name     <<04849>>08158000
specified), the top three bits have the meanings listed        <<04849>>08160000
below.  For CCG (back-referenced file name), the top three     <<04849>>08162000
bits have the same meaning.  For CCG (system file name),       <<04849>>08164000
the lower eight bits indicate which system file was            <<04849>>08166000
specifed, and the upper eight bits will be zero.               <<04849>>08168000
                                                               <<04849>>08170000
     CHK'DESCRIBE'FNAME.(0:1) - lockword present,              <<04849>>08172000
     CHK'DESCRIBE'FNAME.(1:1) - group name present, and        <<04849>>08174000
     CHK'DESCRIBE'FNAME.(2:1) - account name present.          <<04849>>08176000
                                                               <<04849>>08178000
;                                                                       08180000
                                                               <<U.RAO>>08182000
INTEGER RESULTSPACE=CHECKFILENAME';                            <<U.RAO>>08184000
BYTE POINTER PARMPTR = PDEF;  <<POINTER TO CURRENT LOCATION IN NAME>>   08186000
INTEGER LENGTH = PDEF+1;                                       <<U.RAO>>08188000
BYTE ARRAY PSYSDEFLIST(0:1)=PB :=                              <<U.RAO>>08190000
  10, 8, "$STDLIST",                                           <<U.RAO>>08192000
  10, 8, "$NEWPASS",                                           <<U.RAO>>08194000
  10, 8, "$OLDPASS",                                           <<U.RAO>>08196000
   8, 6, "$STDIN",                                             <<U.RAO>>08198000
   9, 7, "$STDINX",                                            <<U.RAO>>08200000
   7, 5, "$NULL",                                              <<U.RAO>>08202000
   0;                                                          <<U.RAO>>08204000
EQUATE PSYSDEFLISTL = 55;                                      <<U.RAO>>08206000
BYTE ARRAY SYSDEFLIST(0:PSYSDEFLISTL-1);                       <<U.RAO>>08208000
LOGICAL LOCKWORD := FALSE;                                     <<U.RAO>>08210000
INTEGER TEMPLEN;                                               <<U.RAO>>08212000
                                                               <<U.RAO>>08214000
EQUATE EXPECTALPHA = 1,                                        <<U.RAO>>08216000
       NAMEMISSING = 2,                                        <<U.RAO>>08218000
       NAMETOOLONG = 3;                                        <<U.RAO>>08220000
                                                               <<04849>>08222000
<< Declarations used by the entry point, CHK'DESCRIBE'FNAME. >><<04849>>08224000
   ENTRY                                                       <<04849>>08226000
      CHK'DESCRIBE'FNAME;                                      <<04849>>08228000
                                                               <<04849>>08230000
   LOGICAL                                                     <<04849>>08232000
      DESCRIBEIT         := FALSE;                             <<04844>>08234000
                                                               <<04844>>08236000
   INTEGER                                                     <<04844>>08238000
      RETURNVAL          := 0;                                 <<04844>>08240000
                                                               <<04849>>08242000
   DEFINE                                                      <<04849>>08244000
      GOTLOCK         = RETURNVAL.(0:1) #,                     <<04849>>08246000
      GOTGROUP        = RETURNVAL.(1:1) #,                     <<04849>>08248000
      GOTACCT         = RETURNVAL.(2:1) #;                     <<04849>>08250000
                                                               <<04849>>08252000
                                                               <<04849>>08254000
                                                               <<U.RAO>>08256000
LOGICAL SUBROUTINE CHECKNAME(DELTA);                           <<U.RAO>>08258000
<<GENERAL PURPOSE NAME CHECKER>>                               <<U.RAO>>08260000
VALUE DELTA;INTEGER DELTA;                                     <<U.RAO>>08262000
                                                               <<U.RAO>>08264000
BEGIN                                                          <<U.RAO>>08266000
CHECKNAME := FALSE;                                            <<U.RAO>>08268000
@PARMPTR := @PARMPTR+1;  <<ELIMINATE DELIMITER>>               <<U.RAO>>08270000
ERRPTR := ERRPTR+1;                                            <<U.RAO>>08272000
LENGTH := LENGTH-1;                                            <<U.RAO>>08274000
IF = THEN                                                      <<U.RAO>>08276000
   BEGIN                                                       <<U.RAO>>08278000
   CC := CCL;  <<SET ERROR INDICATION>>                        <<U.RAO>>08280000
   CHECKFILENAME' := NAMEMISSING+DELTA                         <<U.RAO>>08282000
   END                                                         <<U.RAO>>08284000
ELSE IF PARMPTR <> ALPHA THEN                                  <<U.RAO>>08286000
   BEGIN                                                       <<U.RAO>>08288000
   CC := CCL;  <<SET ERROR INDICATION>>                        <<U.RAO>>08290000
   CHECKFILENAME' := EXPECTALPHA+DELTA                         <<U.RAO>>08292000
   END                                                         <<U.RAO>>08294000
ELSE                                                           <<U.RAO>>08296000
   BEGIN                                                       <<U.RAO>>08298000
   MOVE PARMPTR := PARMPTR WHILE ANS, 0;                       <<U.RAO>>08300000
   TEMPLEN := TOS-@PARMPTR;                                    <<U.RAO>>08302000
   IF = THEN                                                   <<U.RAO>>08304000
      BEGIN                                                    <<U.RAO>>08306000
      DEL;                                                     <<U.RAO>>08308000
      CHECKFILENAME' := NAMEMISSING+DELTA;                     <<U.RAO>>08310000
      CC := CCL;  <<SET ERROR INDICATION>>                     <<U.RAO>>08312000
      END                                                      <<U.RAO>>08314000
   ELSE IF TEMPLEN > 8 THEN                                    <<U.RAO>>08316000
      BEGIN                                                    <<U.RAO>>08318000
      DEL;                                                     <<U.RAO>>08320000
      CHECKFILENAME' := NAMETOOLONG+DELTA;                     <<U.RAO>>08322000
      CC := CCL;  <<SET ERROR INDICATION>>                     <<U.RAO>>08324000
      END                                                      <<U.RAO>>08326000
   ELSE  <<NAME OK>>                                           <<U.RAO>>08328000
      BEGIN                                                    <<U.RAO>>08330000
      @PARMPTR := S0;                                          <<U.RAO>>08332000
      ERRPTR := TOS;  <<FIXUP FOR NEXT ROUND>>                 <<U.RAO>>08334000
      CHECKNAME := TRUE;                                       <<U.RAO>>08336000
      END;                                                     <<U.RAO>>08338000
   END;                                                        <<U.RAO>>08340000
END;  <<SUBROUTINE CHECKNAME>>                                 <<U.RAO>>08342000
<< Start of Main Code.                                       >><<04849>>08344000
                                                               <<04849>>08346000
GOTO PARSEIT;                                                  <<04849>>08348000
                                                               <<04849>>08350000
CHK'DESCRIBE'FNAME:                                            <<04849>>08352000
   DESCRIBEIT := TRUE;                                         <<04849>>08354000
                                                               <<04849>>08356000
                                                               <<04849>>08358000
PARSEIT:                                                       <<04849>>08360000
                                                               <<04849>>08362000
ERRPTR := @PARMPTR;                                            <<U.RAO>>08364000
CHECKFILENAME' := 0;                                           <<U.RAO>>08366000
CC := CCE;  <<ASSUME NORMAL FILE NAME>>                        <<U.RAO>>08368000
IF LENGTH = 0 THEN                                             <<U.RAO>>08370000
   BEGIN                                                       <<U.RAO>>08372000
   CC := CCL;                                                  <<U.RAO>>08374000
   CHECKFILENAME' := FILENAMEMISSING                           <<U.RAO>>08376000
   END                                                         <<U.RAO>>08378000
ELSE IF PARMPTR = "$" THEN  <<SYSTEM DEFINED FILE>>            <<U.RAO>>08380000
   BEGIN                                                       <<U.RAO>>08382000
   CC := CCG;  <<SET SYSTEM DEFINED FILE>>                     <<U.RAO>>08384000
   MOVE SYSDEFLIST := PSYSDEFLIST,(PSYSDEFLISTL);              <<U.RAO>>08386000
   CHECKFILENAME' :=  SEARCH(PARMPTR,LENGTH,SYSDEFLIST);       <<U.RAO>>08388000
   IF RESULTSPACE = 0 THEN                                     <<U.RAO>>08390000
      BEGIN                                                    <<U.RAO>>08392000
      CC := CCL;  <<SEARCH FAILED>>                            <<U.RAO>>08394000
      CHECKFILENAME' := UNKNOWNSYSDEF;                         <<U.RAO>>08396000
      END;                                                     <<U.RAO>>08398000
   END                                                         <<U.RAO>>08400000
ELSE                                                           <<U.RAO>>08402000
   BEGIN                                                       <<U.RAO>>08404000
   IF PARMPTR <> "*" THEN  <<NOT BACK REFERENCED FILE>>        <<U.RAO>>08406000
      BEGIN  <<MUST FAKE DELIMITER>>                           <<U.RAO>>08408000
      @PARMPTR := @PARMPTR-1;                                  <<U.RAO>>08410000
      ERRPTR := ERRPTR-1;                                      <<U.RAO>>08412000
      LENGTH := LENGTH+1;                                      <<U.RAO>>08414000
      END                                                      <<U.RAO>>08416000
   ELSE                                                        <<U.RAO>>08418000
      CC := CCG;                                               <<U.RAO>>08420000
   << FIRST CHORE IS TO CHECK FILE NAME>>                      <<U.RAO>>08422000
   IF NOT CHECKNAME(FFNAMEBASE) THEN RETURN;                   <<U.RAO>>08424000
   LENGTH := LENGTH-TEMPLEN;                                   <<U.RAO>>08426000
   IF = THEN GOTO OUTL;  << Entire name okay. >>               <<04849>>08428000
   IF PARMPTR = "/" THEN  <<LOCKWORD?>>                        <<U.RAO>>08430000
      BEGIN                                                    <<U.RAO>>08432000
      IF NOT CHECKNAME(FLWORDBASE) THEN RETURN;  <<BAD LOCKWORD<<U.RAO>>08434000
      GOTLOCK := 1;                                            <<04849>>08436000
      LOCKWORD := TRUE;                                        <<04849>>08438000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>08440000
      IF = THEN GOTO OUTL;                                     <<04849>>08442000
      END;                                                     <<U.RAO>>08446000
   <<CHECK GROUP NAME>>                                        <<U.RAO>>08448000
   IF PARMPTR = "." THEN  <<GROUP NAME>>                       <<U.RAO>>08450000
      BEGIN                                                    <<U.RAO>>08452000
      GPTR := @PARMPTR+1;                                      <<U.RAO>>08454000
      IF NOT CHECKNAME(FGNAMEBASE) THEN RETURN;                <<U.RAO>>08456000
      GOTGROUP := 1;                                           <<04849>>08458000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>08460000
      IF = THEN GOTO OUTL;                                     <<04849>>08462000
      END                                                      <<U.RAO>>08464000
   ELSE  <<SOME OTHER SPECIAL CHARACTER>>                      <<U.RAO>>08466000
      BEGIN                                                    <<U.RAO>>08468000
      CC := CCL;                                               <<U.RAO>>08470000
      IF LOCKWORD THEN CHECKFILENAME' := EXPECTPERIOD          <<U.RAO>>08472000
      ELSE CHECKFILENAME' := XPCTPERIODSLASH;                  <<U.RAO>>08474000
      RETURN                                                   <<U.RAO>>08476000
      END;                                                     <<U.RAO>>08478000
   IF PARMPTR = "." THEN  <<POSSIBLE ACCOUNT NAME>>            <<U.RAO>>08480000
      BEGIN                                                    <<U.RAO>>08482000
      APTR := @PARMPTR+1;                                      <<U.RAO>>08484000
      IF NOT CHECKNAME(FANAMEBASE) THEN RETURN;                <<U.RAO>>08486000
      GOTACCT := 1;                                            <<04849>>08488000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>08490000
      IF = THEN GOTO OUTL;                                     <<04849>>08492000
      END                                                      <<U.RAO>>08494000
   ELSE  <<SOME OTHER SPECIAL CHARACTER>>                      <<U.RAO>>08496000
      BEGIN                                                    <<U.RAO>>08498000
      CC := CCL;                                               <<U.RAO>>08500000
      CHECKFILENAME' := EXPECTPERIOD;                          <<U.RAO>>08502000
      RETURN                                                   <<U.RAO>>08504000
      END;                                                     <<U.RAO>>08506000
   CHECKFILENAME' := EXTRANEOUSADESG;                          <<U.RAO>>08508000
   CC := CCL;  <<FAILED IF WE GOT TO HERE>>                    <<U.RAO>>08510000
   END;                                                        <<U.RAO>>08512000
                                                               <<04849>>08514000
OUTL:                                                          <<04849>>08516000
                                                               <<04849>>08518000
   IF DESCRIBEIT LAND (CC<>CCL)                                <<04844>>08520000
      THEN RESULTSPACE.(0:8) := RETURNVAL.(0:8);               <<04844>>08522000
   RETURN;                                                     <<04849>>08524000
                                                               <<04849>>08526000
END;  <<CHECKFILENAME'>>                                       <<U.RAO>>08528000
<< Returns values from specified stack marker. >>              <<04193>>08530000
                                                               <<04193>>08532000
PROCEDURE STACKMARK( WHICH, DELQ, STAT, RELP, XREG );          <<04193>>08534000
   VALUE   WHICH;                                              <<04193>>08536000
   INTEGER WHICH, DELQ, STAT, RELP, XREG;                      <<04193>>08538000
   OPTION VARIABLE, UNCALLABLE, PRIVILEGED;                    <<04193>>08540000
BEGIN                                                          <<04193>>08542000
                                                               <<04193>>08544000
<<*********************************************************>>  <<04193>>08546000
<<                                                         >>  <<04193>>08548000
<< This procedure traces back the caller's stack to the    >>  <<04193>>08550000
<< stack marker specified by WHICH--note that the call to  >>  <<04193>>08552000
<< this procedure is not counted; thus, if a procedure     >>  <<04193>>08554000
<< wants the previous stack marker, it should call this    >>  <<04193>>08556000
<< procedure with a value of 1 for WHICH.  This procedure  >>  <<04193>>08558000
<< will return the values stored in the specified marker.  >>  <<04193>>08560000
<<                                                         >>  <<04193>>08562000
<<    Since it is easy to get confused about how many      >>  <<04193>>08564000
<< stack markers back are traveled, please examine the     >>  <<04193>>08566000
<< following example.  Suppose CXLISTF calls CIERR and     >>  <<04193>>08568000
<< CIERR then calls PRINTCARET; further suppose that       >>  <<04193>>08570000
<< PRINTCARET wishes the STATUS and RELATIVE-P that        >>  <<04193>>08572000
<< indicates that CIERR was called by CXLISTF (i.e. the    >>  <<04193>>08574000
<< STATUS and RELATIVE-P should point into the system      >>  <<04193>>08576000
<< segment that contains CXLISTF).  While in PRINTCARET,   >>  <<04193>>08578000
<< the stack would look like this:                         >>  <<04193>>08580000
<<                                                         >>  <<04193>>08582000
<<    |                     |                              >>  <<04193>>08584000
<<    |  CXLISTF work area  |                              >>  <<04193>>08586000
<<    |                     |                              >>  <<04193>>08588000
<<    |---------------------|                              >>  <<04193>>08590000
<<    |                     |  Stack marker for CXLISTF.   >>  <<04193>>08592000
<<    |---------------------|                              >>  <<04193>>08594000
<<    |  CIERR work area    |                              >>  <<04193>>08596000
<<    |---------------------|                              >>  <<04193>>08598000
<<    |                     |  Stack marker for CIERR.     >>  <<04193>>08600000
<<    |---------------------|                              >>  <<04193>>08602000
<<    |  PRINTCARET work    |  <--Q+1                      >>  <<04193>>08604000
<<    |       area          |                              >>  <<04193>>08606000
<<    |                     |                              >>  <<04193>>08608000
<<                                                         >>  <<04193>>08610000
<< While in PRINTCARET, a call to STACK'MARK( 0, ...);     >>  <<04193>>08612000
<< would return values from the stack marker for CIERR.    >>  <<04193>>08614000
<< Therefore, in this example, PRINTCARET will need a call >>  <<04193>>08616000
<< of the form STACK'MARK( 1, ... ); in order to determine >>  <<04193>>08618000
<< that it was CXLISTF that called CIERR.                  >>  <<04193>>08620000
<<                                                         >>  <<04193>>08622000
<<    If the above example seems wrong and you feel that   >>  <<04193>>08624000
<< we should travel back 2 markers to get the desired      >>  <<04193>>08626000
<< information, please pretend that we are doing zero      >>  <<04193>>08628000
<< origin indexing.                                        >>  <<04193>>08630000
<<                                                         >>  <<04193>>08632000
<<                                                         >>  <<04193>>08634000
<< Parameters:                                             >>  <<04193>>08636000
<<    WHICH:  (required) specified how many stack markers  >>  <<04193>>08638000
<<            back from the caller to travel.              >>  <<04193>>08640000
<<    DELQ:   (optional) if there, gets the delta-Q value  >>  <<04193>>08642000
<<            of the specified marker.                     >>  <<04193>>08644000
<<    STAT:   (optional) if there, gets the status word    >>  <<04193>>08646000
<<            of the specified marker.                     >>  <<04193>>08648000
<<    RELP:   (optional) if there, gets the relative P     >>  <<04193>>08650000
<<            value of the specified marker.               >>  <<04193>>08652000
<<    XREG:   (optional) if there, gets the X register     >>  <<04193>>08654000
<<            value of the specified marker.               >>  <<04193>>08656000
<<                                                         >>  <<04193>>08658000
<< Condition code:  This procedure returns CCE if it was   >>  <<04193>>08660000
<<    able to access the specified marker.  It returns CCL >>  <<04193>>08662000
<<    if WHICH is less than -1 or if the procedure goes    >>  <<04193>>08664000
<<    past the stack's initial-Q value in the search for   >>  <<04193>>08666000
<<    the specified marker.                                >>  <<04193>>08668000
<<                                                         >>  <<04193>>08670000
<<*********************************************************>>  <<04193>>08672000
                                                               <<04193>>08674000
LOGICAL  PMASK  = Q-4;   << Parameter mask for variable    >>  <<04193>>08676000
                         <<    procedure option.           >>  <<04193>>08678000
DEFINE                                                         <<04193>>08680000
   WANTS'XREG  = PMASK.(15:1)#,   << These defines deter-  >>  <<04193>>08682000
   WANTS'RELP  = PMASK.(14:1)#,   << mine which parameters >>  <<04193>>08684000
   WANTS'STAT  = PMASK.(13:1)#,   << were present in the   >>  <<04193>>08686000
   WANTS'DELQ  = PMASK.(12:1)#,   << procedure call.       >>  <<04193>>08688000
   WHICH'MISSING  = ( NOT PMASK.(11:1) )#;                     <<04193>>08690000
                                                               <<04193>>08692000
INTEGER POINTER QINDEX;  << For referencing the markers.   >>  <<04193>>08694000
                                                               <<04193>>08696000
INTEGER I := -1;         << Counts stack markers.          >>  <<04193>>08698000
                                                               <<04193>>08700000
INTEGER INITQ;           << This stack's initial Q value.  >>  <<04193>>08702000
                                                               <<04193>>08704000
INTEGER IX = X;          << The index register is used in  >>  <<04193>>08706000
                         << the global defines needed to   >>  <<04193>>08708000
                         << determine this stack's INITQ.  >>  <<04193>>08710000
                                                               <<04193>>08712000
DEFINE                                                         <<04193>>08714000
   GET'INITQ = SETXPXFIXED;   << Initializes INITQ.        >>  <<04193>>08716000
               INITQ := DBARRAY( IX+PXFWQINIT ) #;             <<04193>>08718000
                                                               <<04193>>08720000
<< Start of STACKMARK's code.                              >>  <<04193>>08722000
                                                               <<04193>>08724000
<< Initialize.  Assume successful completion.              >>  <<04193>>08726000
   CC := CCE;                                                  <<04193>>08728000
   GET'INITQ;                                                  <<04193>>08730000
                                                               <<04193>>08732000
<< Check on WHICH.  If not present or out of bounds, then  >>  <<04193>>08734000
<<    produce an error return.                             >>  <<04193>>08736000
   IF WHICH'MISSING  OR  WHICH < -1 THEN                       <<04193>>08738000
   BEGIN                                                       <<04193>>08740000
      CC := CCL;                                               <<04193>>08742000
      RETURN;                                                  <<04193>>08744000
   END;                                                        <<04193>>08746000
                                                               <<04193>>08748000
<< Starting from STACK'MARKER's Q, trace back WHICH+1      >>  <<04193>>08750000
<<    stack markers if possible.  Recall that WHICH is     >>  <<04193>>08752000
<<    relative to this procedure's caller, thus WHICH+1.   >>  <<04193>>08754000
<<    This is performed because I is initialized to -1.    >>  <<04193>>08756000
   @QINDEX := @DELTAQ;           << STACK'MARKER's marker. >>  <<04193>>08758000
   WHILE @QINDEX <> INITQ  AND  I < WHICH DO                   <<04193>>08760000
   BEGIN                                                       <<04193>>08762000
      @QINDEX := @QINDEX - QINDEX;                             <<04193>>08764000
      I := I + 1;                                              <<04193>>08766000
   END;                                                        <<04193>>08768000
                                                               <<04193>>08770000
<< Check for falling off the stack.                        >>  <<04193>>08772000
   IF @QINDEX = INITQ                                          <<04193>>08774000
      THEN CC := CCL         << Fell off the stack.        >>  <<04193>>08776000
   ELSE                                                        <<04193>>08778000
   BEGIN                                                       <<04193>>08780000
                                                               <<04193>>08782000
   << Found the right stack.  Return the requested values. >>  <<04193>>08784000
      IF WANTS'DELQ  THEN DELQ := QINDEX;                      <<04193>>08786000
      IF WANTS'STAT  THEN STAT := QINDEX(-1);                  <<04193>>08788000
      IF WANTS'RELP  THEN RELP := QINDEX(-2);                  <<04193>>08790000
      IF WANTS'XREG  THEN XREG := QINDEX(-3);                  <<04193>>08792000
                                                               <<04193>>08794000
   END;                                                        <<04193>>08796000
                                                               <<04193>>08798000
END;  << STACKMARK >>                                          <<04193>>08800000
                                                               <<04193>>08802000
                                                               <<04193>>08804000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<U.RAO>>08806000
VALUE FNUM;                                                    <<U.RAO>>08808000
INTEGER FNUM,PARMNUM;                                          <<U.RAO>>08810000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>08812000
<<GENERATES FILESYS ERROR MESSAGE, RETURNS FCHECK #>>          <<U.RAO>>08814000
BEGIN                                                          <<U.RAO>>08816000
FCHECK(FNUM,PARMNUM);                                          <<U.RAO>>08818000
IF NOT (0<=FNUM<=2) THEN                                       <<U.RAO>>08820000
   FCLOSE(FNUM, -1, 0);                                        <<U.RAO>>08822000
IF JOBSESSIONMAIN THEN GENMSG(FSERRORMSGSET, PARMNUM);         <<02.RO>>08824000
END;  <<FERROR'>>                                              <<U.RAO>>08826000
PROCEDURE CXNOTYET EXECUTORHEAD;                                        08828000
   OPTION PRIVILEGED, UNCALLABLE;                                       08830000
   CIERR(ERRNUM:=NOTYETIMPLEMENTED);                                    08832000
$PAGE "SYSTEM INTERNAL ERROR HANDLER"                          <<04193>>08834000
<< Handles generation of System Internal Error messages. >>    <<04193>>08836000
                                                               <<04193>>08838000
PROCEDURE SYSINTERR( ERRN, BACK );                             <<04193>>08840000
   VALUE   ERRN, BACK;                                         <<04193>>08842000
   INTEGER ERRN, BACK;                                         <<04193>>08844000
   OPTION UNCALLABLE, PRIVILEGED;                              <<04193>>08846000
BEGIN                                                          <<04193>>08848000
                                                               <<04193>>08850000
<<*********************************************************>>  <<04193>>08852000
<<                                                         >>  <<04193>>08854000
<< This procedure handles the printing of system internal  >>  <<04193>>08856000
<< errors.  These are error messages for those circum-     >>  <<04193>>08858000
<< stances where a recovery is possible, but we wish to    >>  <<04193>>08860000
<< report the error, anyhow.                               >>  <<04193>>08862000
<<                                                         >>  <<04193>>08864000
<< Parameters:                                             >>  <<04193>>08866000
<<    ERRN:  The message number in the system internal     >>  <<04193>>08868000
<<           error message set.                            >>  <<04193>>08870000
<<    BACK:  If BACK >= -1, then the RELATIVE-P and the    >>  <<04193>>08872000
<<           STATUS value of the indicated stack marker    >>  <<04193>>08874000
<<           are printed.  See the header comment for      >>  <<04193>>08876000
<<           the procedure STACK'MARKER for further        >>  <<04193>>08878000
<<           information on the meaning of this parameter. >>  <<04193>>08880000
<<           Note, however, that this value is relative to >>  <<04193>>08882000
<<           SYSINTERR's caller, thus BACK is incremented  >>  <<04193>>08884000
<<           by one when STACK'MARKER is called.           >>  <<04193>>08886000
<<                                                         >>  <<04193>>08888000
<< Future Enhancements:                                    >>  <<04193>>08890000
<<    In the future, this procedure will be modified to    >>  <<04193>>08892000
<<    also log the occurences of system internal errors.   >>  <<04193>>08894000
<<                                                         >>  <<04193>>08896000
<<*********************************************************>>  <<04193>>08898000
                                                               <<04193>>08900000
INTEGER                                                        <<04193>>08902000
   CALLERSTAT,     << Status register of CIERR caller.>>       <<04193>>08904000
   CALLERSP;       << P offset of CIERR caller.       >>       <<04193>>08906000
                                                               <<04193>>08908000
BYTE ARRAY                                                     <<04193>>08910000
   OUTBUFF(0:21);  << For error msg in bounds viol.   >>       <<04193>>08912000
                                                               <<04193>>08914000
                                                               <<04193>>08916000
                                                               <<04193>>08918000
<< Print the initial error message.                        >>  <<04193>>08920000
   GENMSG( INTRNLERRSET, ERRN, , ,,,,, -2 );                   <<04193>>08922000
                                                               <<04193>>08924000
<< If BACK was specified, print the STATUS and RELATIVE-P  >>  <<04193>>08926000
<<    values of the stack marker indicated.                >>  <<04193>>08928000
   IF BACK >= -1 THEN                                          <<04193>>08930000
   BEGIN                                                       <<04193>>08932000
      STACKMARK( BACK+1, , CALLERSTAT, CALLERSP );             <<04193>>08934000
      IF = THEN     << Was able to find the appropriate >>     <<04193>>08936000
      BEGIN         <<    stack marker.                 >>     <<04193>>08938000
         OUTBUFF := 0;   MOVE OUTBUFF(1) := OUTBUFF, (21);     <<04193>>08940000
         OUTBUFF := "%";                                       <<04193>>08942000
         ASCII( CALLERSTAT, 8, OUTBUFF(1) );                   <<04193>>08944000
         OUTBUFF(11) := "%";                                   <<04193>>08946000
         ASCII( CALLERSP, 8, OUTBUFF(12) );                    <<04193>>08948000
         GENMSG( INTRNLERRSET, STATUS'AND'P, 0,                <<04193>>08950000
                 @OUTBUFF, @OUTBUFF(11), ,,, -2 );             <<04193>>08952000
      END;                                                     <<04193>>08954000
   END;                                                        <<04193>>08956000
                                                               <<04193>>08958000
<< Request that the user send in information so that we    >>  <<04193>>08960000
<<    later examine the cause of the internal error.       >>  <<04193>>08962000
                                                               <<04193>>08964000
   GENMSG( INTRNLERRSET, COPYSCREEN, 0, ,,,,, -2 );            <<04193>>08966000
   RETURN;                                                     <<04193>>08968000
                                                               <<04193>>08970000
END;  << SYSINTERR >>                                          <<04193>>08972000
                                                               <<04193>>08974000
                                                               <<04193>>08976000
PROCEDURE PRINTCARET(ERRADR);                                  <<01032>>08978000
BYTE ARRAY ERRADR;                                             <<01032>>08980000
OPTION INTERNAL;                                               <<01032>>08982000
                                                               <<01032>>08984000
BEGIN                                                          <<01032>>08986000
COMMENT                                                        <<01032>>08988000
    THE FOLLOWING ROUTINE PRINTS A CARET UNDER THE ITEM        <<01032>>08990000
    IN ERROR. IF THE COMMAND EXTENDED OVER SEVERAL LINES THEN  <<01032>>08992000
    THE OFFENDING LINE IS PRINTED WITH THE CARET UNDER THE     <<01032>>08994000
    GUILTY CHARACTER, AND A LINE NUMBER RELATIVE TO THE FIRST  <<01032>>08996000
    LINE OF THE COMMAND IS PRINTED OUT.                        <<01032>>08998000
                                                               <<01032>>09000000
    ERRADR - A BYTE POINTER TO THE OFFENDING CHARACTER.        <<01032>>09002000
    BCOMIMAGE - DB RELATIVE ARRAY CONTAINING THE ENTIRE        <<01032>>09004000
                COMMAND TO BE PASSED TO THE CI.                <<01032>>09006000
    LINELENSTACK - A GLOBAL ARRAY CONTAINING THE LENGTHS IN    <<01032>>09008000
                   BYTES OF ORGINAL AND ANY CONSCUTIVE CONTI-  <<01032>>09010000
                   NUATION LINES. THIS ARRAY IS TERMINATED BY  <<01032>>09012000
                   A BINARY ZERO.                              <<01032>>09014000
                                                               <<01032>>09016000
    OPERATION : IF THERE ARE NO CONTINUATION LINES THEN ADJUST <<01032>>09018000
               THE OFFSET WITHIN THE OUTPUT BUFFER AND PRINT   <<01032>>09020000
               IT OUT. OTHERWISE CALCULATE THE OFFSET AND THE  <<01032>>09022000
               LINE NUMBER WHERE THE ERROR OCCURED FORMAT THE  <<01032>>09024000
               LINE NUMBER AND PUT IT TOGETHER WITH THE CONTENT<<01032>>09026000
               OF THE LINE INTO THE OUTPUT BUFFER. IF THE OFFEN<<01032>>09028000
               DING LINE IS THE LAST ONE,DO NOT ECHO IT.       <<01032>>09030000
                                                                        09032000
    ;                                                          <<01032>>09034000
DEFINE LINE'LENGTH = CIS'LINELENSTACK( LINELENSPTR ) #;        << I.A >>09036000
INTEGER OFFSET,LINELENSPTR:=-1,                                <<01032>>09038000
        BYTE'COUNT:=0,LEN:=-1;                                 <<01032>>09040000
ARRAY WBUF(0:CIS'WCOMBUFLEN-1);                                << I.A >>09042000
BYTE ARRAY BBUF(*)=WBUF;                                       <<01032>>09044000
BYTE POINTER BPTR;                                             <<01032>>09046000
                                                               <<01032>>09048000
<< Calculate the caret position and bounds-check. >>           <<04193>>09050000
OFFSET := @ERRADR - @CIS'BCOMIMAGE + 1;                        << I.A >>09052000
IF NOT ( 0 <= OFFSET <= CIS'BCOMBUFLEN ) THEN                  << I.A >>09054000
BEGIN    << Offset not in bounds--CIERR calling error. >>      <<04193>>09056000
                                                               <<04193>>09058000
   SYSINTERR( PRINTCARETERR, 1 );                              <<04193>>09060000
   RETURN;                                                     <<04193>>09062000
                                                               <<04193>>09064000
END;                                                           <<04193>>09066000
                                                               <<04193>>09068000
IF CIS'LINELENSTACK( LINELENSPTR+1 ) <> 0 THEN                 << I.A >>09070000
    BEGIN                                                      <<01032>>09072000
        DO BEGIN                                               <<01032>>09074000
            LINELENSPTR := LINELENSPTR + 1;                    <<01032>>09076000
            BYTE'COUNT := BYTE'COUNT + LINE'LENGTH;            <<01032>>09078000
        END UNTIL BYTE'COUNT >= OFFSET OR LINE'LENGTH = 0;     <<01517>>09080000
        IF LINE'LENGTH <> 0 THEN                               <<01032>>09082000
            BEGIN                                              <<01032>>09084000
               @BPTR := @CIS'BCOMIMAGE(BYTE'COUNT-LINE'LENGTH);<< I.A >>09086000
                BBUF := "(";                                   <<01032>>09088000
                LEN := ASCII(LINELENSPTR,10,BBUF(1));          <<01032>>09090000
                BBUF(LEN + 1) := ")";                          <<01032>>09092000
                MOVE BBUF(LEN+2) := BPTR,(LINE'LENGTH);        <<01032>>09094000
                PRINT(WBUF,-LINE'LENGTH-LEN-2,0);              <<01032>>09096000
                OFFSET := OFFSET - CIS'NUMBLANKS;              << I.A >>09098000
            END;                                               <<01032>>09100000
        OFFSET := OFFSET-(BYTE'COUNT-LINE'LENGTH)+LEN+1;       <<01032>>09102000
    END;                                                       <<01032>>09104000
BBUF := " ";                                                   <<01032>>09106000
MOVE BBUF(1) := BBUF, ( CIS'BCOMBUFLEN-1 );                    << I.A >>09108000
OFFSET := OFFSET + CIS'NUMBLANKS;                              << I.A >>09110000
<<                  >>                                         <<01032>>09112000
BBUF(OFFSET) := "^";                                           <<01032>>09114000
PRINT(WBUF,-OFFSET-1,0);                                       <<01032>>09116000
                                                               <<01032>>09118000
END; << PROCEDURE PRINTCARET >>                                <<01032>>09120000
PROCEDURE CIERR(ERRNUM,ERRADR,PARMMASK,PARM);                  <<U.RAO>>09122000
VALUE ERRNUM,PARMMASK,PARM;                                    <<U.RAO>>09124000
INTEGER ERRNUM,PARMMASK,PARM;                                  <<U.RAO>>09126000
BYTE ARRAY ERRADR;                                             <<U.RAO>>09128000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                         <<U.RAO>>09130000
BEGIN                                                          <<U.RAO>>09132000
COMMENT                                                        <<U.RAO>>09134000
                                                               <<U.RAO>>09136000
  CAUSES ERROR MESSAGE TO BE PRINTED, HANDLES DETAILS RELATED  <<U.RAO>>09138000
    TO THE CONSEQUENCES OF MAKING AN ERROR.                    <<U.RAO>>09140000
                                                               <<U.RAO>>09142000
  ERRNUM - CIERROR NUMBER.   REQUIRED PARAMETER.   IF NEGATIVE,<<U.RAO>>09144000
    SIMPLY PRINT THE INDICATED MESSAGE AND RETURN.             <<U.RAO>>09146000
  ERRADR - BYTE ADDRESS WHERE PROBLEM DETECTED.  PASSED TO     <<U.RAO>>09148000
    PRINTCARET.  IF MISSING, DO NOT PRINT CARET.               <<U.RAO>>09150000
  PARMMASK -                                                   <<03.KM>>09152000
    %0000N => PARM IS BYTE ADDR.  IF N<=1, @PARM CONTAINS ONLY <<03.KM>>09154000
              ONE STRING.  IF N=2, @PARM CONTAINS TWO STRINGS. <<03.KM>>09156000
              STRINGS ARE TERMINATED BY NULL (0).              <<03.KM>>09158000
    %10000 => PARM IS INTEGER BY VALUE.                        <<U.RAO>>09160000
    %20000 => PARM IS DOUBLE INTEGER BY REFERENCE.             <<U.RAO>>09162000
    %30000 - %70000  ARE SPARES.                               <<U.RAO>>09164000
       (NOTE: BITS 4-15 ARE RESERVED)                          <<U.RAO>>09166000
    IF PARMMASK IS MISSING, NO PARAMETER WAS PASSED.           <<U.RAO>>09168000
  PARM - ACTUAL PARAMETER AS DESCRIBED UNDER PARMMASK.         <<U.RAO>>09170000
*************************************************************  <<06.RO>>09172000
WARNING:  In JOBs, CIERR attempts to abort the user, if he has <<06.RO>>09174000
not invoked the CONTINUE command and it is not just a warning. <<06.RO>>09176000
In such cases, CIERR does not ever return to the caller.  If   <<06.RO>>09178000
you have cleanup work which must be done before termination,   <<06.RO>>09180000
such as releasing SIRs, it must be done before calling CIERR.  <<06.RO>>09182000
*************************************************************  <<06.RO>>09184000
  ;                                                            <<U.RAO>>09186000
                                                               <<U.RAO>>09188000
DEFINE PFLAG=     VARMASK.(14:1) #,                            <<03.KM>>09190000
       NONSTRING= PARMMASK.(1:3)<>0 #,                         <<03.KM>>09192000
       ONESTRING= PARMMASK.(13:3)<=1 #;                        <<03.KM>>09194000
INTEGER PARM2;                                                 <<03.KM>>09196000
INTEGER COMLEN;                                                <<00617>>09198000
LOGICAL VARMASK=Q-4;  <<OPTION VARIABLE MASK WORD>>            <<U.RAO>>09200000
LOGICAL JUSTPRINT := FALSE;                                    <<U.RAO>>09202000
LOGICAL MODE;   <<RETURNED BY WHO INTRINSIC>>                  <<U.RAO>>09204000
BYTE ARRAY JCWNAME(0:7);  <<WILL HOLD JCW NAME "CIERROR">>     <<U.RAO>>09206000
                                                               <<U.RAO>>09208000
IF NOT JOBSESSIONMAIN THEN RETURN; <<PROGRAMMATIC CALL>>       <<U.RAO>>09210000
IF VARMASK.(12:1) AND ERRNUM<0 THEN <<JUST PRINT MSG>>         <<U.RAO>>09212000
   BEGIN                                                       <<U.RAO>>09214000
   ERRNUM := -ERRNUM;                                          <<U.RAO>>09216000
   JUSTPRINT := TRUE;                                          <<U.RAO>>09218000
   END;                                                        <<U.RAO>>09220000
                                                               <<U.RAO>>09222000
<<NOW CLEAN UP TERMINAL STATE>>                                <<U.RAO>>09224000
WHO(MODE);  <<GET DATA ON WHETHER JOB OR SESSION>>             <<U.RAO>>09226000
SETXPXGLOB+PXGWJOBLIST;  <<POINT TO LIST DEVICE>>              <<U.RAO>>09228000
IF MODE <<INTERACTIVE>> AND MODE.(12:2) <<SESSION>> THEN <<BREA<<U.RAO>>09230000
   <<ASSUME COULD BE IN BREAK, RESET BREAK BITS, CLEAR FLUSH FL<<U.RAO>>09232000
  ATTACHIO(DBARRAY(X).(8:8),0,0,0,25,0,%320,0,1);              <<U.RAO>>09234000
  <<CLEAR BREAK/IO FLUSH FLAGS, ENABLE WRITE>>                 <<U.RAO>>09236000
SETSERVICE(0);  <<ENABLE BREAK>>                               <<U.RAO>>09238000
                                                               <<U.RAO>>09240000
<< IF UDC AND NOT OPTION LIST AND NOT OPTION NOHELP THEN >>    <<00617>>09242000
<< PRINT THE LINE IN WHICH THE ERROR OCCURED.            >>    <<00617>>09244000
IF CIS'UDCNESTLEVEL <> 0 AND NOT CIS'UDCLISTOPT                << I.A >>09246000
       AND NOT CIS'UDCNOHELPOPT                                << I.A >>09248000
       AND NOT CIS'UDCNOPRINT                                  << I.A >>09250000
                       AND (ERRNUM <> STORE'FAILED)            <<04695>>09252000
                       AND (ERRNUM <> PGMABORT) THEN           <<00733>>09254000
   BEGIN                                                       <<00617>>09256000
   SCAN CIS'BCOMIMAGE UNTIL %6400, 1;                          << I.A >>09258000
   COMLEN := TOS - @CIS'BCOMIMAGE;                             << I.A >>09260000
   PRINT( CIS'WCOMIMAGE, -COMLEN, 0 );                         << I.A >>09262000
   CIS'NUMBLANKS := 0;                                         << I.A >>09264000
   END;                                                        <<00617>>09266000
<<NOW ON WITH THE MESSAGE>>                                    <<U.RAO>>09268000
IF VARMASK.(12:1) THEN   <<MESSAGE NUMBER PRESENT>>            <<U.RAO>>09270000
   BEGIN   <<PUT OUT MESSAGE>>                                 <<U.RAO>>09272000
   MOVE JCWNAME := "CIERROR ";                                 <<U.RAO>>09274000
   TOS := 0;                                                   <<U.RAO>>09276000
   PUTJCW(JCWNAME, ERRNUM, S0);                                <<U.RAO>>09278000
   DEL;                                                        <<U.RAO>>09280000
IF VARMASK.(13:1)   AND                                        << I.A >>09282000
   ( CIS'UDCNESTLEVEL=0 OR NOT CIS'UDCNOHELPOPT )              << I.A >>09284000
      THEN PRINTCARET(ERRADR);                                 <<00538>>09286000
   IF NOT PFLAG THEN GENMSG( CIERRMSGSET, ERRNUM )             << I.A >>09288000
   ELSE IF NONSTRING OR ONESTRING THEN                         <<03.KM>>09290000
      BEGIN                                                    <<03.KM>>09292000
      GENMSG( CIERRMSGSET, ERRNUM, PARMMASK, PARM );           << I.A >>09294000
      END                                                      <<03.KM>>09296000
   ELSE                                                        <<03.KM>>09298000
      BEGIN                                                    <<03.KM>>09300000
      TOS:=PARM;                                               <<03.KM>>09302000
      SCAN * UNTIL 0,1;                                        <<03.KM>>09304000
      PARM2:=TOS+LOGICAL(1);                                   <<03.KM>>09306000
      GENMSG( CIERRMSGSET, ERRNUM, 0, PARM, PARM2 );           << I.A >>09308000
      END;                                                     <<03.KM>>09310000
   END;  <<OF MESSAGE GENERATION STEP>>                        <<U.RAO>>09312000
                                                               <<U.RAO>>09314000
<<FINALLY WE MUST DISPOSE OF THE JOB/SESSION>>                 <<U.RAO>>09316000
IF JUSTPRINT THEN RETURN;                                      <<U.RAO>>09318000
IF CIS'CONTSTATE <> 0 THEN << CONTINUE IN EFFECT, IGNORE ERR >><< I.A >>09320000
   RETURN;                                                     <<08.RO>>09322000
IF CIS'UDCNESTLEVEL <> 0 THEN << PROCESSING A UDC >>           << I.A >>09324000
   BEGIN                                                       <<08.RO>>09326000
   CIS'UDCFATALCIERR := TRUE;  << UDC DAMAGED. >>              << I.A >>09328000
   IF CIS'CONTINUSTATESTK <> 0D THEN << PREV. LEVEL CONTINUE >><< I.A >>09330000
      RETURN;  <<DON'T KILL JOB>>                              <<08.RO>>09332000
   END;                                                        <<08.RO>>09334000
IF MODE.(12:2) = 1 THEN   <<SESSION, DON'T TERMINATE>>         <<08.RO>>09336000
   RETURN;  <<NOTE THAT IF IN UDC, THERE IS NO PENDING >>      <<08.RO>>09338000
            <<CONTINUE, SO WE FLUSH BACK TO REGULAR CI LEVEL>> <<08.RO>>09340000
                                                               <<U.RAO>>09342000
<<FROM HERE ON OUT, THE JOB IS DOWN THE TUBES>>                <<U.RAO>>09344000
GENMSG(CIGENERALMSGSET,JOBFLUSHED);                            <<U.RAO>>09346000
SETXPXFIXED+PXFWQINIT;                                         <<U.RAO>>09348000
TOS := DBARRAY(X)-4;  <<DB REL PTR TO QINIT-4>>                <<U.RAO>>09350000
PS0 := 4;  <<FLAG FOR PROCEDURE CLEANUPJOB>>                   <<U.RAO>>09352000
SETXPXFIXED+PXFWBREAK;                                         <<U.RAO>>09354000
IF DBARRAY(X) THEN FUNBREAK(TRUE);                             <<U.RAO>>09356000
SETJCW(%100000); <<SET ABORT BIT>>                             <<00243>>09358000
TERMINATE;                                                     <<U.RAO>>09360000
END;                                                           <<U.RAO>>09362000
PROCEDURE CYDIRERR'(DIRECRETURN,OKMASK,ERRNUM);                <<U.RAO>>09364000
VALUE DIRECRETURN,OKMASK;                                      <<U.RAO>>09366000
DOUBLE DIRECRETURN;                                            <<U.RAO>>09368000
INTEGER ERRNUM;                                                <<U.RAO>>09370000
LOGICAL OKMASK;                                                <<U.RAO>>09372000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>09374000
<<CONVERTS DIRECRETURN TO CIERROR, RETURNS IT TO>>             <<U.RAO>>09376000
<<ERRNUM, CALLS CIERR>>                                        <<U.RAO>>09378000
BEGIN                                                          <<U.RAO>>09380000
INTEGER DERR1 = DIRECRETURN,                                   <<U.RAO>>09382000
        DERR0 = DIRECRETURN+1;                                 <<U.RAO>>09384000
X := DERR0;                                                    <<U.RAO>>09386000
TOS := OKMASK;                                                 <<U.RAO>>09388000
ASSEMBLE(TBC 0,X);                                             <<U.RAO>>09390000
IF = THEN  SUDDENDEATH(506);  <<DIRECTORY PROBLEM>>            <<U.RAO>>09392000
CASE *(X) OF                                                   <<U.RAO>>09394000
   BEGIN                                                       <<U.RAO>>09396000
   TOS := DIRIOERR;                                            <<U.RAO>>09398000
   TOS := DIRDUPLNAME;                                         <<U.RAO>>09400000
   CASE *(DERR1) OF <<NON EXISTENT ...>>                       <<U.RAO>>09402000
      BEGIN                                                    <<U.RAO>>09404000
      TOS := DIRNOSUCHFILE;                                    <<U.RAO>>09406000
      TOS := DIRNOSUCHGROUP;                                   <<U.RAO>>09408000
      TOS := DIRNOSUCHACCT;                                    <<U.RAO>>09410000
      TOS := DIRNOSUCHUSER;                                    <<U.RAO>>09412000
      TOS := DIRNOSUCHVSD;                                     <<U.RAO>>09414000
      TOS := DIRNOSUCHVSL;                                     <<U.RAO>>09416000
      END;                                                     <<U.RAO>>09418000
   IF DERR1 = 1 THEN TOS := DIRNOSAVEGROUP                     <<U.RAO>>09420000
                ELSE TOS := DIRNOSAVEACCT;                     <<U.RAO>>09422000
   TOS := DIROVERFLOW;                                         <<U.RAO>>09424000
   TOS := DIROVERFLOW;                                         <<U.RAO>>09426000
   TOS := DIROVERFLOW;                                         <<U.RAO>>09428000
   TOS := DIRINUSE;                                            <<U.RAO>>09430000
   IF DERR1 = 1 THEN TOS := DIRGRPFSPACE                       <<U.RAO>>09432000
                ELSE TOS := DIRACCTFSPACE;                     <<U.RAO>>09434000
   END;  <<CASE ON MASTER ERROR TYPE>>                         <<U.RAO>>09436000
ERRNUM := TOS;                                                 <<U.RAO>>09438000
CIERR(ERRNUM);                                                 <<U.RAO>>09440000
END;                                                           <<U.RAO>>09442000
PROCEDURE LOADERROR(ERRNUM);                                   <<U.RAO>>09444000
VALUE ERRNUM;                                                  <<U.RAO>>09446000
INTEGER ERRNUM;                                                <<U.RAO>>09448000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>09450000
<<THIS PROCEDURE PRINTS OUT THE LOADER ERROR MESSAGE AND,>>    <<U.RAO>>09452000
<<OPTIONALLY, THE FILE SYSTEM ERROR MESSAGE ASSOCIATED>>       <<U.RAO>>09454000
BEGIN                                                          <<U.RAO>>09456000
INTEGER FSERRNUM;  <<FILE SYSTEM ERROR NUMBER>>                <<U.RAO>>09458000
IF NOT JOBSESSIONMAIN THEN RETURN;  <<AVOID MESSAGES>>         <<U.RAO>>09460000
IF 50 <= ERRNUM <= 64 THEN    <<FILE ERROR RELATED>>           <<U.RAO>>09462000
   BEGIN                                                       <<U.RAO>>09464000
   FSERRNUM := ERRORGET(1).(8:8);                              <<U.RAO>>09466000
   IF FSERRNUM <> 0 THEN                                       <<U.RAO>>09468000
      GENMSG(FSERRORMSGSET,FSERRNUM);                          <<07.RO>>09470000
   END;                                                        <<U.RAO>>09472000
GENMSG(LOADERRMSGSET,ERRNUM);                                  <<U.RAO>>09474000
END;                                                           <<U.RAO>>09476000
LOGICAL PROCEDURE CREATEERROR;                                 <<U.RAO>>09478000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>09480000
<<IF CREATE ERROR, RETURN TRUE                     >>          <<U.RAO>>09482000
<<ELSE IS LOAD ERROR (DURING CREATE), RETURN FALSE>>           <<U.RAO>>09484000
<<IN ANY CASE, PRINT THE APPROPRIATE ERROR MESSAGE>>           <<U.RAO>>09486000
BEGIN                                                          <<U.RAO>>09488000
INTEGER ERRNUM, FSERRNUM;                                      <<U.RAO>>09490000
IF NOT JOBSESSIONMAIN THEN RETURN;  <<AVOID MESSAGES>>         <<U.RAO>>09492000
CREATEERROR := TRUE;                                           <<U.RAO>>09494000
ERRNUM := ERRORGET (1);                                        <<01244>>09496000
IF ERRNUM = 30 THEN      <<LOAD ERROR ACTUALLY>>               <<U.RAO>>09498000
   BEGIN                                                       <<U.RAO>>09500000
   CREATEERROR := FALSE;                                       <<01244>>09502000
   ERRNUM := ERRORGET (2);                                     <<01426>>09504000
   IF 50 <= ERRNUM <= 64 THEN  <<FURTHER COMPLICATED BY >>     <<U.RAO>>09506000
      BEGIN   <<FILE SYSTEM DETECTED ERROR>>                   <<U.RAO>>09508000
      FSERRNUM := ERRORGET (3).(8:8);                          <<01426>>09510000
      IF FSERRNUM <> 0 THEN                                    <<U.RAO>>09512000
         GENMSG(FSERRORMSGSET,FSERRNUM)                        <<U.RAO>>09514000
      ELSE                                                     <<U.RAO>>09516000
         GENMSG(CIGENERALMSGSET, ENDOFFILEMSG);                <<U.RAO>>09518000
      END;                                                     <<U.RAO>>09520000
   GENMSG(LOADERRMSGSET,ERRNUM);                               <<U.RAO>>09522000
   END                                                         <<U.RAO>>09524000
ELSE                                                           <<U.RAO>>09526000
   GENMSG(CREATEERRMSGSET,ERRNUM);                             <<U.RAO>>09528000
END;   <<CREATEERROR>>                                         <<01452>>09530000
                                                               <<01452>>09532000
PROCEDURE HARD'LOADERR(ERRNUM);                                <<01452>>09534000
   INTEGER ERRNUM;                                             <<01452>>09536000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01452>>09538000
                                                               <<01452>>09540000
COMMENT                                                        <<01452>>09542000
   This procedure can be called to print the LOADER/FILE       <<01452>>09544000
SYSTEM error messages when the error returned from             <<01452>>09546000
CREATEPROCESS is 16.  ERRNUM is set to the LOADER error number.<<01452>>09548000
;                                                              <<01452>>09550000
                                                               <<01452>>09552000
BEGIN                                                          <<01452>>09554000
   INTEGER FSERR;                                              <<01452>>09556000
                                                               <<01452>>09558000
   ERRNUM := ERRORGET(2);  << LOAD ERR >>                      <<01452>>09560000
   IF 50 <= ERRNUM <= 64 THEN                                  <<01452>>09562000
      BEGIN  << ALSO A FILESYSTEM ERROR >>                     <<01452>>09564000
      FSERR := ERRORGET(3).(8:8);                              <<01452>>09566000
      IF FSERR <> 0 THEN                                       <<01452>>09568000
         GENMSG( FSERRORMSGSET, FSERR )                        <<01452>>09570000
      ELSE                                                     <<01452>>09572000
         GENMSG( CIGENERALMSGSET, ENDOFFILEMSG );              <<01452>>09574000
      END;                                                     <<01452>>09576000
   GENMSG( LOADERRMSGSET, ERRNUM );                            <<01452>>09578000
                                                               <<01452>>09580000
END;  << OF HARD'LOADERR >>                                    <<01452>>09582000
                                                               <<01452>>09584000
                                                               <<01452>>09586000
LOGICAL PROCEDURE CREATEPROC'ERR(ERROR,ERRNUM);                <<01452>>09588000
   VALUE ERROR; INTEGER ERROR,ERRNUM;                          <<01452>>09590000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01452>>09592000
                                                               <<01452>>09594000
COMMENT                                                        <<01452>>09596000
   This procedure breaks down the error code returned by       <<01452>>09598000
CREATEPROCESS (which is passed in ERROR) into CIERROR messages.<<01452>>09600000
                                                               <<01452>>09602000
   If ERROR = 16, then a hard loader error has occured.  If    <<01452>>09604000
this is the case, another procedure is called which prints     <<01452>>09606000
the appropriate LOADER/FILE SYSTEM error messages.             <<01452>>09608000
                                                               <<01452>>09610000
   The logical value returned by this procedure tells the      <<01452>>09612000
calling procedure whether a hard loader error has occured.  If <<01452>>09614000
ERROR = 16, then the procedure returns FALSE.  In all other    <<01452>>09616000
cases, the procedure returns TRUE.  ERRNUM is set to the       <<01452>>09618000
appropriate CIERROR number.                                    <<01452>>09620000
;                                                              <<01452>>09622000
                                                               <<01452>>09624000
BEGIN                                                          <<01452>>09626000
   LOGICAL RESULT = CREATEPROC'ERR;                            <<01452>>09628000
                                                               <<01452>>09630000
   RESULT := TRUE;                                             <<01452>>09632000
                                                               <<01452>>09634000
   CASE ERROR OF                                               <<01452>>09636000
      BEGIN                                                    <<01452>>09638000
                                                               <<01452>>09640000
      << 0 = NO ERROR >>                                       <<01452>>09642000
      ;                                                        <<01452>>09644000
                                                               <<01452>>09646000
      << 1 = NO PH CAPABILITY -- SHOULDN'T HAPPEN >>           <<01452>>09648000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>09650000
                                                               <<01452>>09652000
      << 2 = ERROR PARAMETER OMITTED -- SHOULDN'T HAPPEN >>    <<01452>>09654000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>09656000
                                                               <<01452>>09658000
      << 3 = PIN/PROGRAM NAME BAD -- SHOULDN'T HAPPEN >>       <<01452>>09660000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>09662000
                                                               <<01452>>09664000
      << 4 = OUT OF PCB'S >>                                   <<01452>>09666000
      CIERR( ERRNUM := OUTOFPCBS );                            <<01452>>09668000
                                                               <<01452>>09670000
      << 5 = INVALID OPTION -- SHOULDN'T HAPPEN >>             <<01452>>09672000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>09674000
                                                               <<01452>>09676000
      << 6 = UNKNOWN PROGRAM FILE -- CALLER SHOULD HANDLE >>   <<01452>>09678000
      ;                                                        <<01452>>09680000
                                                               <<01452>>09682000
      << 7 = FILE IS NOT A VALID PROGRAM FILE >>               <<01452>>09684000
      CIERR( ERRNUM := INVALIDPROG );                          <<01452>>09686000
                                                               <<01452>>09688000
      << 8 = NO SUCH ENTRY POINT >>                            <<01452>>09690000
      CIERR( ERRNUM := BADENTRYPT );                           <<01452>>09692000
                                                               <<01452>>09694000
   << Errors 9 - 14 are actually warnings and are      >>      <<01452>>09696000
   << returned as negative numbers by CREATEPROCESS.   >>      <<01452>>09698000
   << The caller should ensure that error is positive. >>      <<01452>>09700000
                                                               <<01452>>09702000
      << 9 = PROGRAM FILE STACK SIZE USED >>                   <<01452>>09704000
      CIERR(ERRNUM := -DFLTSTACK);                             <<04787>>09706000
                                                               <<01452>>09708000
      << 10 = PROGRAM FILE DL SIZE USED >>                     <<01452>>09710000
      CIERR(ERRNUM := -DFLTDL);                                <<04787>>09712000
                                                               <<01452>>09714000
      << 11 = PROGRAM FILE MAXDATA USED >>                     <<01452>>09716000
      CIERR(ERRNUM := -DFLTMAXD);                              <<04787>>09718000
                                                               <<01452>>09720000
      << 12 = DLSIZE ROUNDED UP 128 WORDS >>                   <<01452>>09722000
      CIERR(ERRNUM := -DLRNDED);                               <<04787>>09724000
                                                               <<01452>>09726000
      << 13 = CONFIGURATION MAXDATA USED >>                    <<01452>>09728000
      CIERR(ERRNUM := -CONFMAXD);                              <<04787>>09730000
                                                               <<01452>>09732000
      << 14 = MAXDATA ROUNDED UP TO REQUIRED SPACE >>          <<01452>>09734000
      CIERR(ERRNUM := -STKRNDEDUP);                            <<04787>>09736000
                                                               <<01452>>09738000
   << End of warning sublist. >>                               <<01452>>09740000
                                                               <<01452>>09742000
      << 15 = STACK SPACE TOO BIG >>                           <<01452>>09744000
      CIERR( ERRNUM := STACKTOOBIG );                          <<01452>>09746000
                                                               <<01452>>09748000
      << 16 = HARD LOADER ERROR.  In this case, ERRNUM is   >> <<01452>>09750000
      << set to the LOADER error number.  Therefore, it is  >> <<01452>>09752000
      << expected that the calling procedure will call      >> <<01452>>09754000
      << CIERR to print a more general loading error        >> <<01452>>09756000
      << message and to set ERRNUM to this error number.    >> <<01452>>09758000
      BEGIN                                                    <<01452>>09760000
         RESULT := FALSE;  << HARD LOADER ERROR >>             <<01452>>09762000
         HARD'LOADERR(ERRNUM);                                 <<01452>>09764000
      END;                                                     <<01452>>09766000
                                                               <<01452>>09768000
      << 17 = BAD PRIORITY SPECIFIED -- SHOULDN'T HAPPEN >>    <<01452>>09770000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>09772000
                                                               <<01452>>09774000
      << 18 = COULDN'T OPEN $STDIN FOR PROGRAM >>              <<01452>>09776000
      CIERR( ERRNUM := BADSTDIN );                             <<01452>>09778000
                                                               <<01452>>09780000
      << 19 = COULDN'T OPEN $STDLIST FOR PROGRAM >>            <<01452>>09782000
      CIERR( ERRNUM := BADSTDLIST );                           <<01452>>09784000
                                                               <<01452>>09786000
      << 20 = INVALID STRING -- SHOULDN'T HAPPEN >>            <<01452>>09788000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>09790000
                                                               <<01452>>09792000
      END; << OF CASE STATEMENT >>                             <<01452>>09794000
                                                               <<01452>>09796000
END;  << OF CREATEPROC'ERR >>                                  <<01452>>09798000
      LOGICAL PROCEDURE REQUESTSERVICE;                        <<01452>>09800000
      OPTION PRIVILEGED;                                       <<01.EB>>09802000
      BEGIN                                                             09804000
      TOS:=ABSOLUTE(ABSOLUTE(4)+9).(10:1);<<GET HARD KILL BIT>>         09806000
      TOS:=ABSOLUTE(X).(11:1);<<GET SOFT KILL BIT>>                     09808000
       IF ABSOLUTE(X).(6:2)=1 THEN                                      09810000
         BEGIN  <<IN MAIN>>                                             09812000
         PUSH(DL,DB,SBANK);                                             09814000
         ASSEMBLE(CAB,DEL;   <<DELETE CURRENT DB BANK>>                 09816000
                  CAB,CAB;   <<ARRANGE SBANK,REL DL,DB AT TOP>>         09818000
                  ADD;       <<CALCULATE ABSOLUTE DL>>                  09820000
                  DDUP,DECA; <<DUP SBANK AND DL>>                       09822000
                  LSEA;DELB; <<LOAD DL-@PCBX>>                          09824000
                  DELB,SUB); <<CALCULATE  ABS PCBX>>                    09826000
         TOS := TOS + PXGWJOBIN;                                        09828000
         ASSEMBLE(LSEA;DELB;DELB);                                      09830000
         TOS := TOS LAND %377;<<LDEV # OF $STDIN>>                      09832000
         TOS := TOS&LSL(1)+1; <<INDEX INTO  LPDT>>                      09834000
         TOS := LPDT(TOS).(10:1); <<BREAK BIT>>                         09836000
         END                                                            09838000
       ELSE TOS := 0; <<NOT IN MAIN,DON'T CHECK BREAK>>                 09840000
      REQUESTSERVICE:=TOS LOR TOS LOR TOS;                              09842000
      END;<<REQUESTSERVICE>>                                            09844000
      PROCEDURE SETSERVICE(DISP);                                       09846000
      VALUE DISP;                                                       09848000
      LOGICAL DISP;                                                     09850000
      OPTION PRIVILEGED,UNCALLABLE;                                     09852000
      BEGIN                                                             09854000
         PUSH(DL,DB,SBANK);                                             09856000
         ASSEMBLE(CAB,DEL;    <<DELETE CURRENT DB BANK>>                09858000
                  CAB,CAB;    <<ARRANGE SBANK,REL DL,DB AT S0>>         09860000
                  ADD;        <<CALCULATE ABSOLUTE DL>>                 09862000
                  DDUP,DECA;  <<DUP SBANK AND DL>>                      09864000
                  LSEA;DELB;  <<LOAD DL-@PCBX>>                         09866000
                  DELB,SUB);  <<CALCULATE ABS PCBX>>                    09868000
         TOS := TOS + PXGWJOBIN;                                        09870000
         ASSEMBLE(LSEA;DELB;DELB);                                      09872000
         TOS := TOS LAND %377; <<LDEV # OF $STDIN>>                     09874000
         TOS := TOS&LSL(1)+1;  <<INDEX INTO LPDT>>                      09876000
         DISABLE;                                                       09878000
         TOS := LPDT(TOS); <<GET FLAGS WORD>>                           09880000
         TOS.(10:1) := DISP;                                            09882000
         LPDT(X) := TOS;                                                09884000
         ENABLE;                                                        09886000
      END;<<SETSERVICE>>                                                09888000
PROCEDURE WELCOMEMES (WDST, FUNNYTERMINAL);                   <<A00.04>>09890000
   VALUE WDST,FUNNYTERMINAL;                                  <<A00.04>>09892000
   INTEGER WDST;  <<WELCOME MESSAGE DATA SEGMENT>>            <<A00.04>>09894000
   LOGICAL FUNNYTERMINAL; <<IF TRUE, INDICATES APL TERMINAL>> <<A00.04>>09896000
   OPTION PRIVILEGED, UNCALLABLE;                             <<A00.04>>09898000
<<PRINTS CURRENT WELCOME MESSAGE, OBTAINED FROM <WDST> -                09900000
   STOPS AT END, OR BREAK.  IF APL TERMINAL, TRANSLATES                 09902000
   CHARACTER SETS>>                                           <<A00.04>>09904000
BEGIN                                                         <<A00.04>>09906000
<< WELCOME MSG DATA SEG STRUCTURE >>                          <<A00.04>>09908000
   INTEGER USECOUNT        = DB+0;  <<0:1 => CURRENT>>        <<A00.04>>09910000
   ARRAY FIRSTLINE (*)     = DB+3;  <<1'ST RECORD>>           <<A00.04>>09912000
<< DB+1 IS THE LENGTH OF THE DATA SEGMENT             >>      <<A00.04>>09914000
<< DB+2.(0:8) IS THE CHARACTER "#"                    >>      <<A00.04>>09916000
<< DB+2.(8:8) IS THE LENGTH OF THE FIRST LINE         >>      <<A00.04>>09918000
<< EACH SUBSEQUENT LINE HAS THE FOLLOWING STRUCTURE:  >>      <<A00.04>>09920000
<<   THEY START ON A WORD BOUNDARY, THE BYTE PRECEEDING>>     <<A00.04>>09922000
<<   IS THE LINE LENGTH IN BYTES, WHICH IS ALWAYS ODD.>>      <<A00.04>>09924000
<<   IF NECESSARY, THE LINE IS PADDED WITH A BLANK.   >>      <<A00.04>>09926000
<< LOCALS >>                                                  <<A00.04>>09928000
   INTEGER POINTER LINEP; <<KEEPS CURRENT POINTER IN DSEG>>   <<A00.04>>09930000
   DEFINE LINELEN =LINEP(-1).(8:8)#; <<LINE LENGTH>>          <<A00.04>>09932000
   INTEGER ARRAY LOCCOPY(0:127); <<LOCAL ARRAY FOR APL TRANS>><<A00.04>>09934000
   INTEGER LINELENAPL;  <<WHEN FUNNYTERMINAL, IS LINE LENGTH>><<A00.04>>09936000
   LOGICAL CRIT'STATE,  << OLD CRITICAL STATE >>               <<02318>>09938000
           OLDSIR;      << OLD SIR STATE      >>               <<02318>>09940000
                                                               <<02318>>09942000
   EQUATE WELCOMESIR = %27;  << WELCOME DST SIR >>             <<02318>>09944000
                                                              <<A00.04>>09946000
<<  >>                                                        <<A00.04>>09948000
   @LINEP := @FIRSTLINE;  <<SETUP LINEP>>                     <<A00.04>>09950000
   EXCHANGEDB(WDST);                                          <<A00.04>>09952000
   << MUST PROTECT THE USECOUNT WORD OF THE WELCOME DATA   >>  <<02318>>09954000
   << SEGMENT SO THAT 1) TWO PROCESSES CANNOT ACCESS THAT  >>  <<02318>>09956000
   << WORD CONCURRENTLY, AND 2) ONCE THE COUNT HAS BEEN    >>  <<02318>>09958000
   << INCREMENTED, THE PROCESS CANNOT BE ABORTED UNTIL THE >>  <<02318>>09960000
   << COUNT HAS BEEN DECREMENTED.  DON'T WANT TO HOLD SIR  >>  <<02318>>09962000
   << WHILE WELCOME MESSAGE PRINTING SO OTHERS CAN LOGON.  >>  <<02318>>09964000
   OLDSIR := GETSIR(WELCOMESIR);                               <<02318>>09966000
   USECOUNT := USECOUNT+1; <<BUMP USER COUNT>>                <<A00.04>>09968000
   CRIT'STATE := SETCRITICAL;  << NO ABORT 'TIL DEC. COUNT >>  <<02318>>09970000
   RELSIR(WELCOMESIR,OLDSIR);                                  <<02318>>09972000
   IF FUNNYTERMINAL THEN  <<BEGIN - APL TRANSLATION REQ'D>>   <<A00.04>>09974000
      BEGIN                                                   <<A00.04>>09976000
      TOS := LINELEN;  <<GET LENGTH OF FIRST LINE>>           <<A00.04>>09978000
      EXCHANGEDB(0);  <<SET BACK TO STACK>>                   <<A00.04>>09980000
      LINELENAPL := TOS;  <<SAVE LENGTH OF FIRST LINE>>       <<A00.04>>09982000
      <<NOW SET UP FOR MOVE FROM DATA SEG>>                   <<A00.04>>09984000
      TOS := @LOCCOPY;                                        <<A00.04>>09986000
      TOS := WDST;                                            <<A00.04>>09988000
      TOS := @LINEP;                                          <<A00.04>>09990000
      FUNNYTERMINAL := FUNNYTERMINAL.(13:2);<<EXTRACT TERMTYPE>>        09992000
      WHILE (LINELENAPL<>255) <<NOT END>>                     <<A00.04>>09994000
            AND (NOT(REQUESTSERVICE)) DO  <<NO BREAK>>        <<A00.04>>09996000
         BEGIN                                                <<A00.04>>09998000
            S2 := @LOCCOPY;                                   <<A00.04>>10000000
            TOS := (LINELENAPL+1)&ASR(1);  <<LENGTH OF MOVE>> <<A00.04>>10002000
            ASSEMBLE(MFDS 1);  <<ONLY POP DEAD COUNT>>        <<A00.04>>10004000
            APLTRANSLATEOUT(LOCCOPY,LINELENAPL,FUNNYTERMINAL);<<A00.04>>10006000
            FWRITE(2,LOCCOPY,-LINELENAPL,0);                  <<A00.04>>10008000
            IF <> THEN  <<FWRITE FAILED FOR SOME REASON>>     <<A00.04>>10010000
               LINELENAPL := 255  <<SET EXIT FLAG>>           <<A00.04>>10012000
            ELSE  <<EVERYTHING OK, GO TO TOP>>                <<A00.04>>10014000
               LINELENAPL := LOCCOPY(LINELENAPL&ASR(1)).(8:8);<<A00.04>>10016000
         END;                                                 <<A00.04>>10018000
         EXCHANGEDB(WDST);                                    <<A00.04>>10020000
      END                                                     <<A00.04>>10022000
   ELSE  <<REGULAR TERMINAL>>                                 <<A00.04>>10024000
      BEGIN                                                   <<A00.04>>10026000
      WHILE (LINELEN<>255)  <<NOT END>>                       <<A00.04>>10028000
            AND (NOT(REQUESTSERVICE)) DO  <<NO BREAK>>        <<A00.04>>10030000
         BEGIN  <<EMIT LINE AND ADVANCE POINTER>>             <<A00.04>>10032000
         FWRITE(2,LINEP,-LINELEN,0);                          <<A00.04>>10034000
         IF <> THEN GOTO LEAVE;                               <<A00.04>>10036000
         @LINEP := @LINEP+((LINELEN+1)&ASR(1));               <<A00.04>>10038000
         END;                                                 <<A00.04>>10040000
      END;                                                    <<A00.04>>10042000
LEAVE:                                                        <<A00.04>>10044000
   OLDSIR := GETSIR(WELCOMESIR);                               <<02318>>10046000
   USECOUNT := USECOUNT-1;  <<ONE LESS USER>>                 <<A00.04>>10048000
   RELSIR(WELCOMESIR,OLDSIR);                                  <<02318>>10050000
   RESETCRITICAL(CRIT'STATE);  << CAN NOW ABORT >>             <<02318>>10052000
   EXCHANGEDB(0);                                             <<A00.04>>10054000
   END;    <<WELCOMMES>>                                      <<A00.04>>10056000
$PAGE       "COMSEARCH - COMMAND DICTIONARY"                   <<08.RO>>10058000
$CONTROL SEGMENT= CIINIT                                                10060000
                                                                        10062000
LOGICAL PROCEDURE COMSEARCH (COMMAND, COMLEN, CAP, ACCESS,     <<U.RAO>>10064000
   EXECPLABEL, CAPERR);                                        <<U.RAO>>10066000
   VALUE COMLEN;                                               <<U.RAO>>10068000
   BYTE ARRAY COMMAND;                                         <<U.RAO>>10070000
   INTEGER COMLEN;                                             <<U.RAO>>10072000
   DOUBLE CAP;                                                 <<U.RAO>>10074000
   INTEGER EXECPLABEL;                                         <<U.RAO>>10076000
   DOUBLE ACCESS;                                              <<U.RAO>>10078000
   INTEGER CAPERR;                                             <<U.RAO>>10080000
   OPTION PRIVILEGED, UNCALLABLE;                              <<U.RAO>>10082000
                                                               <<U.RAO>>10084000
COMMENT:                                                       <<U.RAO>>10086000
   FINDS A COMMAND.                                            <<U.RAO>>10088000
   INPUT PARAMETERS:                                           <<U.RAO>>10090000
      <COMMAND> IS BYTE ARRAY CONTAINING COMMAND NAME.         <<U.RAO>>10092000
      <COMLEN> IS LENGTH OF NAME.                              <<U.RAO>>10094000
   RETURNS:                                                    <<U.RAO>>10096000
<CAP> - Capability mask required to use command.  format is    <<U.RAO>>10098000
   identical to that used in the Directory routines.           <<U.RAO>>10100000
      user attributes & file attributes required               <<U.RAO>>10102000
      0  sm                                                    <<U.RAO>>10104000
      1  am                                                    <<U.RAO>>10106000
      2  al                                                    <<U.RAO>>10108000
      3  gl                                                    <<U.RAO>>10110000
      4  di                                                    <<U.RAO>>10112000
      5  op                                                    <<U.RAO>>10114000
      6  cv                                                    <<U.RAO>>10116000
      7  uv                                                    <<U.RAO>>10118000
      8  LG     (USER LOGGING)                                 <<U.RAO>>10120000
      9  not used                                              <<U.RAO>>10122000
      10  not used                                             <<U.RAO>>10124000
      11  not used                                             <<U.RAO>>10126000
      12  not used                                             <<U.RAO>>10128000
      13  cs                                                   <<U.RAO>>10130000
      14  ND                                                   <<U.RAO>>10132000
      15  SF                                                   <<U.RAO>>10134000
      command access restrictions / resource capabilities      <<U.RAO>>10136000
      0  NOT USED                                              <<U.RAO>>10138000
      1  NOT USED                                              <<U.RAO>>10140000
      2  NOT USED                                              <<U.RAO>>10142000
      3  NOT USED                                              <<U.RAO>>10144000
      4  not USED                                              <<U.RAO>>10146000
      5  not USED                                              <<U.RAO>>10148000
      6  NOT USED                                              <<U.RAO>>10150000
      7  ba                                                    <<U.RAO>>10152000
      8  ia                                                    <<U.RAO>>10154000
      9  pm                                                    <<U.RAO>>10156000
      10  NOT USED                                             <<U.RAO>>10158000
      11  not used                                             <<U.RAO>>10160000
      12  mr                                                   <<U.RAO>>10162000
      13  NOT USED                                             <<U.RAO>>10164000
      14  ds                                                   <<U.RAO>>10166000
      15  ph                                                   <<U.RAO>>10168000
<COMSEARCH>  FALSE IMPLIES COMMAND NOT IN DIRECTORY            <<U.RAO>>10170000
<ACCESS> - LIMITATIONS ON USE OF INDIVIDUAL COMMAND.           <<U.RAO>>10172000
     FIRST WORD DEFINED AS FOLLOWS:                            <<00552>>10174000
        10:6 = OPERATOR COMMAND MASK INDEX                     <<00552>>10176000
         10:2 IS THE WORD INDEX                                <<00552>>10178000
         12:4 IS THE BIT INDEX                                 <<00552>>10180000
      SECOND WORD DEFINED AS FOLLOWS:                          <<U.RAO>>10182000
         15:1 = 1  NOT PERMITTED DURING BREAK,                 <<U.RAO>>10184000
         14:1 = 1  NOT PERMITTED PROGRAMMATICALLY,             <<U.RAO>>10186000
         12:2 = 0  NO CAP CHECK REQUIRED.  OTHERWISE:          <<U.RAO>>10188000
              = 1  AND CHECK  (ALL BITS REQUIRED),             <<U.RAO>>10190000
              = 2  OR CHECK (ANY ONE REQUIRED).                <<U.RAO>>10192000
         11:1 = 1  NOT PERMITTED DURING BATCH JOB,             <<U.RAO>>10194000
         10:1 = 1  NOT PERMITTED DURING SESSION.               <<U.RAO>>10196000
         9:1 = 1  ABORTABLE COMMAND                            <<U.RAO>>10198000
         8:1 = 0  NOT PERMITTED WITH APL CHARACTER SET         <<U.RAO>>10200000
         7:1 = 1  execute even if flushing for if command      <<U.RAO>>10202000
         6:1 = 1 NOT PERMITTED IN USER DEFINED COMMAND.        <<U.RAO>>10204000
         5:1 = 1 COMMAND CANNOT BE REDONE WITH REDO.           <<08.RO>>10206000
        4:1 = 1 COMMAND IS AN OPERATOR ONLY COMMAND (USER MUST <<00552>>10208000
                BEEN 'ALLOW'ED ACCESS.                         <<00552>>10210000
         3:1 = 1 COMMAND PERMITTED DURING SPECIAL BREAK                 10212000
<EXECPLABEL> - PLABEL FOR EXECUTOR.                            <<U.RAO>>10214000
<CAPERR> - THE CI ERROR NUMBER TO BE USED IF THE SUBROUTINE    <<U.RAO>>10216000
   PERMITACCESS IN COMMANDINTERP DETECTS A CAPABILITY PROBLEM. <<U.RAO>>10218000
   ;                                                           <<U.RAO>>10220000
COMMENT  *************************************************     <<U.RAO>>10222000
   ***  TO ADD A NEW COMMAND TO THE DIRECTORY  ***********     <<U.RAO>>10224000
   *******************************************************     <<U.RAO>>10226000
STEP 1:  DETERMINE THE CAPABILITIES REQUIRED TO USE THIS NEW   <<U.RAO>>10228000
  COMMAND, SUCH AS SM, AM, AL, UV, BA.  THE COMMENT ABOVE WILL <<U.RAO>>10230000
  HELP YOU FORMAT THIS INFORMATION INTO A DOUBLE WORD.         <<U.RAO>>10232000
  INCIDENTALLY, THIS DOUBLE WORD EXACTLY MATCHES THE USER      <<U.RAO>>10234000
  CAPABILITY ENTRY IN THE DIRECTORY IN ITS PLACEMENT OF BITS.  <<U.RAO>>10236000
  IF YOU ADD A NEW CAPABILITY, YOU MUST MAINTAIN THIS          <<U.RAO>>10238000
  CORRESPONDENCE.                                              <<U.RAO>>10240000
STEP 2:  DECIDE WHEN YOU WISH THIS COMMAND TO BE ILLEGAL.  FOR <<U.RAO>>10242000
  EXAMPLE, YOU MAY NOT WISH TO ALLOW ITS USE IN BATCH, OR      <<U.RAO>>10244000
  PROGRAMMATICALLY, OR YOU MAY WISH IT TO BE BREAKABLE.  YOU   <<U.RAO>>10246000
  MAY ALSO DECIDE WHETHER YOU WISH AN "AND" MATCH ON THE       <<U.RAO>>10248000
  CAPABILITIES DOUBLE WORD OR AND "OR" MATCH.  "OR" IMPLIES    <<U.RAO>>10250000
  ANY ONE OF THE CAPABILIES IS SUFFICIENT, "AND" REQUIRES THAT <<U.RAO>>10252000
  THE USER HAVE ALL THE CAPABILITIES.  THE COMMENT ABOVE WILL  <<U.RAO>>10254000
  HELP YOU IN FORMATTING THE ACCESS RESTRICTIONS DOUBLE WORD.  <<U.RAO>>10256000
  NOTE THAT IF YOU ADD ANY NEW ACCESS RESTRICTIONS, THE SUBROUTINE      10258000
  "PERMIT" IN COMMANDINTERP MUST BE CHANGED TO CHECK THE       <<U.RAO>>10260000
  RESTRICTION.                                                 <<U.RAO>>10262000
STEP 3:  FIND THE APPROPRIATE HASH BUCKET FOR YOUR COMMAND.  IF<<U.RAO>>10264000
  YOU WISH, YOU MAY CALCULATE IT OUT BY HAND.  HOWEVER, THE    <<U.RAO>>10266000
  EASIEST WAY IS TO GET ON A STAND-ALONE MACHINE, SET A        <<U.RAO>>10268000
  BREAKPOINT IN THIS ROUTINE AT THE LABEL NEXTDDEL, ENTER      <<U.RAO>>10270000
  YOUR FULL COMMAND, AND EXAMINE THE INDEX REGISTER WHEN YOU   <<U.RAO>>10272000
  HIT THE BREAKPOINT.  THAT REGISTER WILL CONTAIN THE INDEX OF <<U.RAO>>10274000
  THE HASH BUCKET YOU NEED.                                    <<U.RAO>>10276000
STEP 4:  ADD THE COMMAND TO THE COMMAND DIRECTORY.  USING ONE OF        10278000
  THE COMMANDS ALREADY THERE AS A TEMPLATE, FORMAT AND ENTER YOUR       10280000
  COMMAND IN THE TABLE.  IF THE HASH BUCKET IS CURRENTLY EMPTY,<<U.RAO>>10282000
  THE ENTRY FOR THAT BUCKET IN COMMANDDICT WILL BE 0 AND THE   <<U.RAO>>10284000
  LABEL WILL BE ABSENT.  SIMPLY CREATE THE NECESSARY LABEL AND <<U.RAO>>10286000
  ENTER IT IN COMMANDDICT.  NOTE THE LINKING SCHEME WITHIN THE <<U.RAO>>10288000
  BUCKETS.  A LINK OF 0 TERMINATES A BUCKET.  ALSO NOTE THAT THE        10290000
  COMMAND EXECUTOR MUST BE ADDED TO THE SYSTEM AT THE SAME TIME<<U.RAO>>10292000
  THAT THE MODIFIED PROCEDURE COMSEARCH IS ADDED, SO THAT THE  <<U.RAO>>10294000
  LLBL CAN BE EXECUTED.  OTHERWISE THE CI WILL ABORT.          <<U.RAO>>10296000
;                                                              <<U.RAO>>10298000
                                                               <<U.RAO>>10300000
                                                               <<U.RAO>>10302000
BEGIN                                                          <<U.RAO>>10304000
DEFINE W = :CON#, Y=;LLBL#, Z=;CON#;   <<FOR DICTIONARY>>      <<U.RAO>>10306000
DEFINE   <<CAPABILITY EQUATES>>                                <<U.RAO>>10308000
   NOTB = 0,0,0,1,0#,  << Not allowed in break >>              <<01999>>10310000
   NOTPB = 0,0,0,3,0#,              <<NOT PROG, NOT IN BREAK>> <<U.RAO>>10312000
   OP = %2000,0,0,4,CAPREQ'OP'#,  <<OP CAP, "AND" CHECK>>      <<U.RAO>>10314000
   OPNBR = %2000,0,0,7,CAPREQ'OP'#,  <<AND, NOT IN BRK OR PROG><<U.RAO>>10316000
   OPNOTBRK = %2000,0,0,5,CAPREQ'OP'#, <<OP, NOT IN BRK>>      <<U.RAO>>10318000
   MGR = %100000, 0, 0, 4, CAPREQ'SM'#, <<SM, AND CHECK >>     <<U.RAO>>10320000
   OPBR = %2000,0,0,%104,CAPREQ'OP'#,  <<OP, "AND", BREAKABLE>><<U.RAO>>10322000
   AMGR = %40000, 0, 0, 4, CAPREQ'AM'#, <<AM, AND CHECK>>      <<U.RAO>>10324000
   MGRSA = %140000,0,0,%110,CAPREQSMORAM#,<<OR CHECK, BREAKABLE<<U.RAO>>10326000
   CS = 4,0,0,4,CAPREQ'CS'#,  <<CS, AND CHECK>>                <<U.RAO>>10328000
   OPNOTPB = %2000,0,0,6,CAPREQ'OP'#, <<OP, AND CHECK, NOT PROG<<U.RAO>>10330000
   OPSYSPROG = %102000,0,0,%33,CAPREQSMOROP#,<<NOT JOB/PRG,OR>><<01724>>10332000
   UVCAP = %1400, 0, 0, %12,CAPREQUVORCV#,  <<OR CHK, NOT PROG.<<U.RAO>>10334000
   UVCAPBPROG = %1400,0,0,%110,CAPREQUVORCV#, <<UV,CV,PROG>>   <<U.RAO>>10336000
   CVCAP = %1000, 0, 0, 4, CAPREQ'CV'#,  <<CV, AND CHECK>>     <<U.RAO>>10338000
   IFSTATEMENT = 0,0,0,%402,0#,  <<EVEN IN IF STMT, NOT PROG>> <<U.RAO>>10340000
   OPORSMNB = %102000,0,0,%10,CAPREQSMOROP#, <<OR CHECK>>      <<01724>>10342000
   BREAKABLE = 0,0,0, %100, 0#,  <<ANYTHING, IS BREAKABLE>>    <<U.RAO>>10344000
   USERLOGGING = %102200,0,0,%110,CAPREQ'LG'#,                 <<00596>>10346000
   UNRESTRICTED = 0,0,0,0,0#;  <<ANYTHING, NOT BREAKABLE>>     <<U.RAO>>10348000
   EQUATE HASHVAL = 49;                                        <<U.RAO>>10350000
EQUATE NPOP=%4000;      <<OPERATOR ONLY>>                      <<00552>>10352000
EQUATE NPOPNOTB = %4001;  << Operator only, not in break >>    <<01999>>10354000
EQUATE NPOPAB=%4100; <<OPERATOR COMM., NO RESTRIC, ABORTABLE>> <<00552>>10356000
$PAGE                                                          <<00552>>10358000
<<FOLLOWING EQUATES DEFINE THE MASK BIT FOR EACH OP. COMMAND>> <<00552>>10360000
<< THE FIRST "M'DEVICE" COMMANDS DEFINE THE OPERATOR COMMANDS>><<00552>>10362000
<< DEALING WITH DEVICES                                      >><<00552>>10364000
                                                               <<00552>>10366000
EQUATE M'ABORTIO=0,              <<ABORTIO ALLOW MASK BIT>>    <<00552>>10368000
       M'ACCEPT=M'ABORTIO+1,     <<ACCEPT ALLOW MASK BIT>>     <<00552>>10370000
       M'DOWN=M'ACCEPT+1,        <<DOWN ALLOW MASK BIT>>       <<00552>>10372000
       M'GIVE=M'DOWN+1,          <<GIVE ALLOW MASK BIT>>       <<00552>>10374000
       M'HEADOFF=M'GIVE+1,       <<HEADOFF ALLOW MASK BIT>>    <<00552>>10376000
       M'HEADON=M'HEADOFF+1,     <<HEADON ALLOW MASK BIT>>     <<00552>>10378000
       M'REFUSE=M'HEADON+1,      <<REFUSE ALLOW MASK BIT>>     <<00552>>10380000
       M'REPLY=M'REFUSE+1,       <<REPLY ALLOW MASK BIT>>      <<00552>>10382000
       M'STARTSPOOL=M'REPLY+1,   <<STARTSPOOL ALLOW MASK BIT>> <<00552>>10384000
       M'TAKE=M'STARTSPOOL+1,    <<TAKE ALLOW MASK BIT>>       <<00552>>10386000
       M'UP=M'TAKE+1,            <<UP ALLOW MASK BIT>>         <<00552>>10388000
       M'MPLINE=M'UP+1,          <<MPLINE ALLOW MASK BIT>>     <<00552>>10390000
       M'DSCONTROL=M'MPLINE+1,   <<DSCONTROL ALLOW MASK BIT>>  <<00552>>10392000
                                                               <<00552>>10394000
       M'DEVICE=M'DSCONTROL, <<UPPER LIMIT OF DEVICE COMMANDS>><<00552>>10396000
                                                               <<00552>>10398000
       M'ABORTJOB=M'DEVICE+1,    <<ABORTJOB ALLOW MASK BIT>>   <<00552>>10400000
       M'ALLOW=M'ABORTJOB+1,     <<ALLOW ALLOW MASK BIT>>      <<00552>>10402000
       M'ALTSPOOLFILE=M'ALLOW+1, <<ALTFILE ALLOW MASK BIT>>    <<00552>>10404000
       M'ALTJOB=M'ALTSPOOLFILE+1,<<ALTJOB ALLOW MASK BIT>>     <<00552>>10406000
       M'BREAKJOB=M'ALTJOB+1,    <<BREAKJOB ALLOW MASK BIT>>   <<00552>>10408000
       M'DELETESPOOLFILE=M'BREAKJOB+1,<<DELETE ALLOW MASK>>    <<00552>>10410000
       M'DISALLOW=M'DELETESPOOLFILE+1,<<DISALLOW MASK BIT>>    <<00552>>10412000
       M'JOBFENCE=M'DISALLOW+1,  <<JOBFENCE ALLOW MASK BIT>>   <<00552>>10414000
       M'LIMIT=M'JOBFENCE+1,     <<LIMIT ALLOW MASK BIT>>      <<00552>>10416000
       M'STOPSPOOL=M'LIMIT+1,    <<STOPSPOOL ALLOW MASK BIT>>  <<00552>>10418000
       M'SUSPENDSPOOL=M'STOPSPOOL+1,<<SUSPENDSPOOL ALLOW BIT>> <<00552>>10420000
       M'OUTFENCE=M'SUSPENDSPOOL+1, <<OUTFENCE ALLOW MASK BIT>><<00552>>10422000
       M'RECALL=M'OUTFENCE+1,    <<RECALL ALLOW MASK BIT>>     <<00552>>10424000
       M'RESUMEJOB=M'RECALL+1,   <<RESUMEJOB ALLOW MASK BIT>>  <<00552>>10426000
       M'RESUMESPOOL=M'RESUMEJOB+1,<<RESUMESPOOL ALLOW MASK>>  <<00552>>10428000
       M'STREAMS=M'RESUMESPOOL+1,  <<STREAMS ALLOW MASK BIT>>  <<00552>>10430000
       M'CONSOLE=M'STREAMS+1,    <<CONSOLE  ALLOW MASK BIT>>   <<00552>>10432000
       M'WARN=M'CONSOLE+1,       <<WARN ALLOW MASK BIT>>       <<00552>>10434000
       M'WELCOME=M'WARN+1,       <<WELCOME ALLOW MASK BIT>>    <<00552>>10436000
       M'MON=M'WELCOME+1,        <<MON ALLOW MASK BIT>>        <<00552>>10438000
       M'MOFF=M'MON+1,           <<MOFF ALLOW MASK BIT>>       <<00552>>10440000
       M'VMOUNT=M'MOFF+1,        <<VMOUNT ALLOW MASK BIT>>     <<00552>>10442000
       M'LMOUNT=M'VMOUNT+1,      <<LMOUNT ALLOW MASK BIT>>     <<00552>>10444000
       M'LDISMOUNT=M'LMOUNT+1,   <<LDISMOUNT ALLOW MASK BIT>>  <<00552>>10446000
       M'MRJECNTRL=M'LDISMOUNT+1,<<MRJECNTRL ALLOW MASK BIT>> <<OP.01>> 10448000
       M'JOBSCRTY=M'MRJECNTRL+1, <<JOBSECURITY ALLOW MASK BI>> <<00552>>10450000
       M'DOWNLOAD=M'JOBSCRTY+1,  <<DOWNLOAD ALLOW BITMASK BIT>><<00575>>10452000
       M'MIOENABLE=M'DOWNLOAD+1,  <<MIOENABLE ALLOW MASK BIT>> <<00575>>10454000
       M'MIODISABLE=M'MIOENABLE+1,<<MIODISABLE ALLOW MASK BIT>><<00601>>10456000
       M'LOG=M'MIODISABLE+1,  << LOG ALLOW MASK BIT >>         <<01424>>10458000
       M'IMLCONTROL=M'LOG+2; << ALLOW MASK BIT, SORRY >>       << I.A >>10460000
$PAGE                                                          <<00552>>10462000
DEFINE C'ABORTIO=UNRESTRICTED#,                      <<OP.01>> <<00552>>10464000
       C'ACCEPT=UNRESTRICTED#,                       <<OP.01>> <<00552>>10466000
       C'DOWN=UNRESTRICTED#,                         <<OP.01>> <<00552>>10468000
       C'GIVE=UNRESTRICTED#,                         <<OP.01>> <<00552>>10470000
       C'HEADOFF=UNRESTRICTED#,                      <<OP.01>> <<00552>>10472000
       C'HEADON=UNRESTRICTED#,                       <<OP.01>> <<00552>>10474000
       C'REFUSE=UNRESTRICTED#,                       <<OP.01>> <<00552>>10476000
       C'REPLY=0,0,0,%10000,0#,  <<UNRESTRICTED, OK IN SPECIAL <<00594>>10478000
       C'RESUME=0,0,0,%10022,0#,                               <<00594>>10480000
       C'STARTSPOOL=UNRESTRICTED#,                             <<00552>>10482000
       C'TAKE=UNRESTRICTED#,                         <<OP.01>> <<00552>>10484000
       C'UP=UNRESTRICTED#,                           <<OP.01>> <<00552>>10486000
       C'MPLINE=NOTB#,      << Not in break >>                 <<01999>>10488000
       C'DSCONTROL=NOTB#,   << Not in break >>                 <<01999>>10490000
                                                               <<00552>>10492000
       C'ABORTJOB=UNRESTRICTED#,                     <<OP.01>> <<00552>>10494000
       C'ALLOW=0,0,M'ALLOW,NPOPAB,0#,<<         ALLOW>>        <<00552>>10496000
       C'ALTSPOOLFILE=UNRESTRICTED#,                           <<00552>>10498000
       C'ALTSP=C'ALTSPOOLFILE#,                                <<00552>>10500000
       C'ALTJOB=UNRESTRICTED#,                       <<OP.01>> <<00552>>10502000
       C'BREAKJOB=UNRESTRICTED#,                     <<OP.01>> <<00552>>10504000
       C'DELETESPOOLFILE=UNRESTRICTED#,                        <<00552>>10506000
       C'DISALLOW=0,0,M'DISALLOW,NPOPAB,0#,<<         ALLOW>>  <<00552>>10508000
       C'JOBFENCE=0,0,M'JOBFENCE,NPOP,0#,<<           ALLOW>>  <<00552>>10510000
       C'LIMIT=0,0,M'LIMIT,NPOP,0#,<<           ALLOW>>        <<00552>>10512000
       C'STOPSPOOL=UNRESTRICTED#,                              <<00552>>10514000
       C'SUSPENDSPOOL=UNRESTRICTED#,                           <<00552>>10516000
       C'OUTFENCE=UNRESTRICTED#,                                        10518000
       C'RECALL=0,0,0,%10000,0#, <<UNRESTRICTED, OK IN SPECIAL <<00594>>10520000
       C'RESUMEJOB=UNRESTRICTED#,                    <<OP.01>> <<00552>>10522000
       C'RESUMESPOOL=UNRESTRICTED#,                            <<00552>>10524000
       C'RESUMESP=C'RESUMESPOOL#,                              <<00552>>10526000
       C'STREAMS=0,0,M'STREAMS,NPOP,0#,<<           ALLOW>>    <<00552>>10528000
       C'CONSOLE=UNRESTRICTED#,                                <<01043>>10530000
       C'WARN=0,0,M'WARN,NPOP,0#,<<           ALLOW>>          <<00552>>10532000
       C'WELCOME=0,0,M'WELCOME,NPOP,0#,<<           ALLOW>>    <<00552>>10534000
       C'MON=0,0,M'MON,NPOP,0#,<<           ALLOW>>            <<00552>>10536000
       C'MOFF=0,0,M'MOFF,NPOP,0#,<<           ALLOW>>          <<00552>>10538000
       C'VMOUNT=0,0,M'VMOUNT,NPOP,0#,<<           ALLOW>>      <<00552>>10540000
       C'LMOUNT=0,0,M'LMOUNT,NPOP,0#,<<           ALLOW>>      <<00552>>10542000
       C'LDISMOUNT=0,0,M'LDISMOUNT,NPOP,0#,<<          ALLOW>> <<00552>>10544000
       C'MRJECNTRL=0,0,M'MRJECNTRL,NPOPNOTB,0#,                <<01999>>10546000
       C'JOBSCRTY=0,0,M'JOBSCRTY,NPOP,0#,                      <<00552>>10548000
       C'LOG=0,0,M'LOG,NPOP,0#,                                <<00601>>10550000
       C'DOWNLOAD=UNRESTRICTED#,                               <<00575>>10552000
       C'MIOENABLE=0,0,M'MIOENABLE,NPOP,0#,<<    ALLOW>>       <<00575>>10554000
       C'MIODISABLE=0,0,M'MIODISABLE,NPOP,0#,<<  ALLOW>>       <<01424>>10556000
       C'FOREIGN=UNRESTRICTED#,                                <<01115>>10558000
       C'IMLCONTROL=0,0,M'IMLCONTROL,NPOPNOTB,0#,              <<01999>>10560000
       C'SHOWCOM=UNRESTRICTED#;                                << I.A >>10562000
                                                               <<00575>>10564000
$PAGE                              <<OP.01>>                   <<00552>>10566000
   TOS := COMLEN;                                              <<U.RAO>>10568000
   IF > THEN                                                   <<U.RAO>>10570000
      BEGIN   <<GET HASH INDEX>>                               <<U.RAO>>10572000
      << HASH VALUE = HASH KEY MOD HASH BASE (49) >>           <<U.RAO>>10574000
      << KEY IS CONSTRUCTED FROM THE LENGTH OF THE COMMAND>>   <<U.RAO>>10576000
      << AND THE FIRST, MIDDLE AND LAST CHARACTERS OF THE>>    <<U.RAO>>10578000
      << NAME.  THAT IS,                                 >>    <<U.RAO>>10580000
      << BYTE 0 = LENGTH, BYTE 1 = FIRST CHARACTER       >>    <<U.RAO>>10582000
      << BYTE 2 = MIDDLE CHAR (ROUND DOWN), BYTE 3 = LAST>>    <<U.RAO>>10584000
      TOS := @COMMAND;                                         <<U.RAO>>10586000
      ASSEMBLE (STBX);                                         <<U.RAO>>10588000
      TOS := LOGICAL (X) & LSL(8) LOR LOGICAL (COMMAND);       <<U.RAO>>10590000
      TOS := LOGICAL (COMMAND (X:=X-1)) LOR                    <<U.RAO>>10592000
            LOGICAL (COMMAND ((X +1) & ASR(1))) & LSL(8);      <<U.RAO>>10594000
      TOS := HASHVAL;                                          <<U.RAO>>10596000
      ASSEMBLE (LDIV, XAX);                                    <<U.RAO>>10598000
      <<XREG NOW HAS HASH INDEX  (REMAINDER)>>                 <<U.RAO>>10600000
      << S-0, S-1 ARE GARBAGE FROM CALCULATION>>               <<U.RAO>>10602000
                                                               <<U.RAO>>10604000
                                                               <<U.RAO>>10606000
   NEXTDDEL:                                                   <<U.RAO>>10608000
      ASSEMBLE ( DDEL;                                         <<U.RAO>>10610000
                                                               <<U.RAO>>10612000
   NEXT:                                                       <<U.RAO>>10614000
      << S-1 = COMLEN, >>                                      <<U.RAO>>10616000
      << S-0 = @COMMAND,  >>                                   <<U.RAO>>10618000
      << X = COMMANDDICT DISPL OF LAST ENTRY.  >>              <<U.RAO>>10620000
                                                               <<U.RAO>>10622000
         LOAD COMMANDDICT, X;          <<P-REL DISPL OF NEXT COMMAND>>  10624000
         BNE NOTEND;   <<SOMETHING IN BUCKET POINTER, LOOK FURTHER>>    10626000
         EXIT 6;  <<BUCKET POINTER EMPTY, NO SUCH COMMAND>>    <<U.RAO>>10628000
NOTEND:                                                        <<U.RAO>>10630000
            ADAX, DDUP;   <<GET OFFSET TO NEXT CANDIDATE IN DIRECTORY>> 10632000
            LRA COMMANDDICT, X;   <<ADDRESS OF BUCKET ENTRY>>  <<U.RAO>>10634000
            INCA;   <<SKIP OVER HASH LINK>>                    <<U.RAO>>10636000
            LSL 1;   <<GET BYTE ADDRESS OF COMMAND NAME IN DIRECTORY>>  10638000
            CAB;  <<PUT LENGTH OF COMMAND NAME ON TOS>>        <<U.RAO>>10640000
            CMPB PB, 1;  <<SEE IF MATCH WITH DIRECTORY NAME>>  <<U.RAO>>10642000
            BNE NEXTDDEL;   <<NO MATCH, TRY AGAIN>>            <<U.RAO>>10644000
            LRA S-1;   <<SUCCESSFUL MATCH, LOOK TO SEE IF DATA><<U.RAO>>10646000
            LSL 1;   <<IS SUBSET OF ACTUAL ENTRY IN DIRECTORY>><<U.RAO>>10648000
            XCH;  <<DONE BY CHECKING NEXT CHARACTER IN DIRECTORY>>      10650000
            LDI 1;   <<IS ALPHABETIC CHARACTER>>               <<U.RAO>>10652000
            MVB PB, 3;                                         <<U.RAO>>10654000
            LSR 8;                                             <<U.RAO>>10656000
            BTST, DEL;                                         <<U.RAO>>10658000
            BE NEXT;                                           <<U.RAO>>10660000
         << FOUND >>                                           <<U.RAO>>10662000
            DEL, INCA;                                         <<U.RAO>>10664000
               ASR 1;                  <<COM WORD LEN (ROUNDED DOWN)>>  10666000
               INCA, ADAX;                                     <<U.RAO>>10668000
               LOAD COMMANDDICT, X;    << LLBL >>              <<U.RAO>>10670000
               XEQ 0;                  << P-LABEL >>           <<U.RAO>>10672000
               INCX;                                           <<U.RAO>>10674000
               LOAD COMMANDDICT, X;    << CAP(0) >>            <<U.RAO>>10676000
               INCX;                                           <<U.RAO>>10678000
               LOAD COMMANDDICT, X;   << CAP(1) >>             <<U.RAO>>10680000
               INCX;                                           <<U.RAO>>10682000
               LOAD COMMANDDICT, X;  << ACCESS(0) >>           <<U.RAO>>10684000
               INCX;                                           <<U.RAO>>10686000
               LOAD COMMANDDICT, X;  << ACCESS(1) >>           <<U.RAO>>10688000
               INCX;                                           <<U.RAO>>10690000
               LOAD COMMANDDICT, X); << CAPERR >>              <<U.RAO>>10692000
               CAPERR := TOS;  <<CAPABILITY ERROR CODE>>       <<U.RAO>>10694000
               ACCESS := TOS;                                  <<U.RAO>>10696000
               CAP := TOS;                                     <<U.RAO>>10698000
               EXECPLABEL := TOS;  <<EXECUTOR PLABEL>>         <<U.RAO>>10700000
               COMSEARCH := TRUE;  <<FOUND LEGAL COMMAND>>     <<U.RAO>>10702000
      END;                                                     <<U.RAO>>10704000
   RETURN;   <<LOGICAL END OF EXECUTABLE CODE>>                <<U.RAO>>10706000
                                                               <<U.RAO>>10708000
<< BUCKET HEADS >>                                                      10710000
                                                                        10712000
COMMANDDICT:  ASSEMBLE (                                                10714000
      CON                                                               10716000
  BUCKET0 ,BUCKET1 ,0       ,BUCKET3 ,BUCKET4 ,BUCKET5 ,BUCKET6 ,       10718000
  BUCKET7 ,BUCKET8 ,BUCKET9 ,BUCKET10,BUCKET11,BUCKET12,BUCKET13,       10720000
                                                               <<01.EB>>10722000
  BUCKET14,BUCKET15,BUCKET16,BUCKET17,BUCKET18,BUCKET19,BUCKET20,       10724000
  BUCKET21,BUCKET22,BUCKET23,BUCKET24,BUCKET25,BUCKET26,BUCKET27,       10726000
  BUCKET28,BUCKET29,BUCKET30,BUCKET31,BUCKET32,BUCKET33,BUCKET34,       10728000
  BUCKET35,BUCKET36,BUCKET37,BUCKET38,BUCKET39,BUCKET40,0       ,       10730000
  BUCKET42,BUCKET43,BUCKET44,BUCKET45,BUCKET46,BUCKET47,BUCKET48;       10732000
                                                                        10734000
<< DICTIONARY ENTRIES                                          <<U.RAO>>10736000
<< 1. P-RELATIVE HASH LINK,                                    <<U.RAO>>10738000
<< 2. COMMAND NAME,                                            <<U.RAO>>10740000
<< 3. LLBL EXECUTOR,                                           <<U.RAO>>10742000
<< 4. CAPABILITY AND ACCESS DATA.  SEE COMMENT ABOVE FOR FORMAT<<U.RAO>>10744000
<<    THE FIRST TWO WORDS ARE THE CAPABILITIES REQUIRED >>     <<U.RAO>>10746000
<<    (RETURNED IN THE DOUBLE <CAP> DEFINED ABOVE) AND  >>     <<U.RAO>>10748000
<<    THE SECOND TWO WORDS ARE THE ACCESS RESTRICTIONS  >>     <<U.RAO>>10750000
<<    (RETURNED IN THE DOUBLE <ACCESS> DEFINED ABOVE).  >>     <<U.RAO>>10752000
<<    IN GENERAL YOU WILL FIND IT MORE CONVENIENT TO    >>     <<U.RAO>>10754000
<<    CREATE A DEFINE FOR THIS FIELD OF THE DICTIONARY. >>     <<U.RAO>>10756000
<<    THE FIFTH WORD IS THE CI ERROR NUMBER TO BE USED IFF     <<U.RAO>>10758000
<<    SUBROUTINE PERMITACCESS IN THE CI ENCOUNTERS A CAPABILITY<<U.RAO>>10760000
<<    ERROR.                                                   <<U.RAO>>10762000
<< NOTE: COMMANDS WHICH ARE BEGINNING SUBSTRINGS OF OTHER      <<U.RAO>>10764000
<<       COMMANDS IN THE SAME BUCKET, MUST APPEAR BEFORE THOSE <<U.RAO>>10766000
<<       COMMANDS IN THE BUCKET CHAIN.                         <<U.RAO>>10768000
<< <X>,<Y> AND <Z> BELOW ARE DEFINES FOR DELIMITERS.           <<U.RAO>>10770000
                                                                        10772000
<< <LOCATION> :CON <HASHLINK> ,"<COMMAND>" ;LLBL <EXEC>   ;CON <DATA>;>>10774000
<<           14            28             43             58    <<U.RAO>>10776000
                                                               <<U.RAO>>10778000
BUCKET0:                                                       <<U.RAO>>10780000
TUNE         W ALTLOG      ,"TUNE"        Y CXTUNE       Z OPORSMNB;    10782000
ALTLOG       W DEBUG'L     ,"ALTLOG"      Y CXALTLOG     Z USERLOGGING; 10784000
DEBUG'L      W EOD         ,"DEBUG"       Y CXDEBUG      Z 0,%100,0,%26,10786000
                                                           CAPREQ'PM';  10788000
EOD          W STREAM      ,"EOD "        Y CXEOD        Z NOTPB       ;10790000
STREAM       W RJE         ,"STREAM"      Y CXSTREAM     Z BREAKABLE   ;10792000
RJE          W SETDUMP'L   ,"RJE "        Y CXRJE        Z NOTPB       ;10794000
SETDUMP'L    W SYSDUMP     ,"SETDUMP "    Y CXSETDUMP    Z UNRESTRICTED;10796000
SYSDUMP      W 0           ,"SYSDUMP "    Y CXSYSDUMP    Z OPNBR       ;10798000
                                                               <<U.RAO>>10800000
BUCKET1:                                                       <<DS0.0>>10802000
DISASSOCIATE W ABORTJOB ,"DISASSOCIATE" Y CXDISASSOCIATE Z UNRESTRICTED;10804000
ABORTJOB     W REDO        ,"ABORTJOB"    Y CXABORTJOB   Z C'ABORTJOB;  10806000
REDO         W RFA         ,"REDO"        Y CXREDO             <<01455>>10808000
                                          Z 0,0,0,%3102,0;     <<01455>>10810000
RFA          W 0           ,"RFA "        Y CXRFAD      Z 0,0,0,%2400,0;10812000
                                                               <<DS0.0>>10814000
                                                           <<00815>>    10816000
BUCKET3:                                                       <<U.RAO>>10818000
PASCALGO     W DISALLOW    ,"PASCALGO"    Y CXPASCALGO         <<02844>>10820000
                                          Z NOTPB;             <<02844>>10822000
DISALLOW     W SHOWIN      ,"DISALLOW"    Y CXDISALLOW   Z C'DISALLOW;  10824000
<<SPOOL        W SHOWIN      ,"SPOOL"       Y CXSPOOL      Z C'SPOOL;>> 10826000
SHOWIN       W NEWACCT     ,"SHOWIN"      Y CXSHOWIN     Z BREAKABLE   ;10828000
NEWACCT      W CLINE       ,"NEWACCT "    Y CXNEWACCT    Z MGR         ;10830000
CLINE        W 0           ,"CLINE "      Y CXCLINE      Z CS          ;10832000
                                                               <<U.RAO>>10834000
BUCKET4:                                                       <<U.RAO>>10836000
FOREIGN      W REPLY       ,"FOREIGN"     Y CXFOREIGN    Z C'FOREIGN;   10838000
REPLY        W ELSE'       ,"REPLY"       Y CXREPLY      Z C'REPLY;     10840000
ELSE'        W FREERIN     ,"ELSE"        Y CXELSE       Z IFSTATEMENT; 10842000
                                                               <<U.RAO>>10844000
FREERIN      W SHOWLOG     ,"FREERIN "    Y CXFREERIN    Z NOTPB       ;10846000
SHOWLOG      W 0           ,"SHOWLOG "    Y CXSHOWLOG    Z OPBR        ;10848000
                                                               <<U.RAO>>10850000
BUCKET5:                                                       <<U.RAO>>10852000
TELLOP       W 0           ,"TELLOP"      Y CXTELLOP     Z UNRESTRICTED;10854000
                                                               <<U.RAO>>10856000
BUCKET6:                                                       <<U.RAO>>10858000
                                                               <<00506>>10860000
LISTLOG      W EOJ         ,"LISTLOG "    Y CXLISTLOG    Z USERLOGGING; 10862000
EOJ          W BASICGO     ,"EOJ "        Y CXEOJ        Z 0,0,0,%42,0; 10864000
BASICGO      W BASICPREP   ,"BASICGO "    Y CXBASICGO    Z NOTPB       ;10866000
BASICPREP    W PASCAL      ,"BASICPREP"   Y CXBASICPREP        <<02844>>10868000
                                          Z NOTPB;             <<02844>>10870000
PASCAL       W 0           ,"PASCAL"      Y CXPASCAL           <<02844>>10872000
                                          Z NOTPB;             <<02844>>10874000
                                                               <<U.RAO>>10876000
BUCKET7:                                                       <<U.RAO>>10878000
LDISMOUNT    W VMOUNT      ,"LDISMOUNT"   Y CXLDISMOUNT  Z C'LDISMOUNT; 10880000
VMOUNT       W HELP        ,"VMOUNT"      Y CXVMOUNT     Z C'VMOUNT;    10882000
HELP         W 0           ,"HELP"        Y CXHELP       Z BREAKABLE   ;10884000
                                                               <<01.EB>>10886000
BUCKET8:                                                       <<U.RAO>>10888000
ALLOW        W SHOWQ       ,"ALLOW"       Y CXALLOW      Z C'ALLOW;     10890000
SHOWQ        W JOBPRI      ,"SHOWQ"       Y CXSHOWQ      Z OPBR;        10892000
JOBPRI       W 0           ,"JOBPRI"      Y CXJOBPRI     Z OP; <<U.RAO>>10894000
                                                               <<U.RAO>>10896000
BUCKET9:                                                       <<U.RAO>>10898000
PURGE        W PURGEUSER   ,"PURGE "      Y CXPURGE      Z UNRESTRICTED;10900000
PURGEUSER    W 0           ,"PURGEUSER "  Y CXPURGEUSER  Z AMGR        ;10902000
                                                               <<U.RAO>>10904000
BUCKET10:                                                      <<U.RAO>>10906000
IMFMGR       W SHOWCOM     ,"IMFMGR"      Y CX3270MGR          <<02845>>10908000
                                          Z NOTPB;             <<02845>>10910000
SHOWCOM      W A3270MGR    ,"SHOWCOM"     Y CXSHOWCOM    Z C'SHOWCOM;   10912000
A3270MGR     W LISTVS      ,"IMLMGR"      Y CX3270MGR    Z NOTPB       ;10914000
LISTVS       W 0           ,"LISTVS"      Y CXLISTVS     Z UVCAPBPROG  ;10916000
                                                                        10918000
BUCKET11:                                                               10920000
                                                               <<01436>>10922000
MRJECONTROL  W RPGPREP     ,"MRJECONTROL" Y CXMRJECONTROL Z C'MRJECNTRL;10924000
                                                               <<01436>>10926000
RPGPREP      W PURGEACCT   ,"RPGPREP "    Y CXRPGPREP    Z NOTPB       ;10928000
PURGEACCT    W PURGEVSET   ,"PURGEACCT "  Y CXPURGEACCT  Z MGR         ;10930000
PURGEVSET    W FCOPY       ,"PURGEVSET "  Y CXPURGEVSET        <<01453>>10932000
                                          Z CVCAP;             <<01453>>10934000
FCOPY        W 0           ,"FCOPY "      Y CXFCOPY            <<01453>>10936000
                                          Z NOTPB;             <<01453>>10938000
                                                                        10940000
BUCKET12:                                                               10942000
PREPRUN      W QUANTUM'L   ,"PREPRUN "    Y CXPREPRUN    Z NOTPB       ;10944000
QUANTUM'L    W 0           ,"QUANTUM "    Y CXQUANTUM    Z OP          ;10946000
                                                                        10948000
BUCKET13:                                                               10950000
ALLOCATE     W  0           ,"ALLOCATE"    Y CXALLOCATE   Z OPNOTPB    ;10952000
                                                                        10954000
BUCKET14:                                                               10956000
OUTFENCE     W STREAMS     ,"OUTFENCE"    Y CXOUTFENCE   Z C'OUTFENCE;  10958000
STREAMS      W HELLO       ,"STREAMS"     Y CXSTREAMS    Z C'STREAMS;   10960000
HELLO        W LISTACCT    ,"HELLO "      Y CXHELLO     Z 0,%200,0,%133,10962000
                                                           CAPREQ'IA';  10964000
LISTACCT     W 0           ,"LISTACCT"    Y CXLISTACCT   Z MGRSA       ;10966000
                                                                        10968000
BUCKET15:                                                               10970000
FORTGO       W JOB         ,"FORTGO"      Y CXFORTGO     Z NOTPB       ;10972000
JOB          W GETRIN      ,"JOB "        Y CXJOB       Z 0,%400,0,%113,10974000
                                                           CAPREQ'BA';  10976000
GETRIN       W DSTAT       ,"GETRIN"      Y CXGETRIN     Z UNRESTRICTED;10978000
DSTAT        W 0           ,"DSTAT "      Y CXDSTAT      Z UNRESTRICTED;10980000
                                                                        10982000
BUCKET16:                                                               10984000
RESUMESPOOL  W TAKE        ,"RESUMESPOOL" Y CXRESUMESPOOL Z C'RESUMESP; 10986000
TAKE         W SETJCW'L    ,"TAKE"        Y CXTAKE       Z C'TAKE;      10988000
SETJCW'L     W PREP        ,"SETJCW"      Y CXSETJCW     Z UNRESTRICTED;10990000
PREP         W SAVE        ,"PREP"        Y CXPREP       Z NOTPB       ;10992000
SAVE         W 0           ,"SAVE"        Y CXSAVE       Z 1,0,0,4,     10994000
                                                           CAPREQ'SF';  10996000
                                                                        10998000
BUCKET17:                                                               11000000
LOG          W SHOWOUT     ,"LOG"        Y CXLOG         Z C'LOG;       11002000
SHOWOUT      W 0           ,"SHOWOUT "    Y CXSHOWOUT    Z BREAKABLE   ;11004000
                                                                        11006000
BUCKET18:                                                               11008000
PTAPE        W 0           ,"PTAPE "      Y CXPTAPE      Z 0,0,0,%20,0 ;11010000
                                                                        11012000
BUCKET19:                                                               11014000
JOBSECURITY  W SHOWDEV     ,"JOBSECURITY" Y CXJOBSECURITY Z C'JOBSCRTY; 11016000
SHOWDEV      W RPG        ,"SHOWDEV "     Y CXSHOWDEV    Z BREAKABLE   ;11018000
RPG          W 0          ,"RPG "         Y CXRPG        Z NOTPB       ;11020000
                                                                        11022000
BUCKET20:                                                               11024000
SHOWJCW      W ALTUSER     ,"SHOWJCW "    Y CXSHOWJCW    Z BREAKABLE;   11026000
                                                               <<U.RAO>>11028000
ALTUSER      W VINIT       ,"ALTUSER "    Y CXALTUSER    Z AMGR        ;11030000
VINIT        W 0           ,"VINIT "      Y CXVINIT      Z OPSYSPROG   ;11032000
                                                                        11034000
BUCKET21:                                                               11036000
WELCOME      W ASSOCIATE   ,"WELCOME"     Y CXWELCOME    Z C'WELCOME;   11038000
ASSOCIATE    W SECURE      ,"ASSOCIATE"   Y CXASSOCIATE Z UNRESTRICTED; 11040000
SECURE       W 0           ,"SECURE"      Y CXSECURE     Z UNRESTRICTED;11042000
                                                                        11044000
BUCKET22:                                                               11046000
                                                               <<01177>>11048000
DSCONTROL    W LMOUNT      ,"DSCONTROL"   Y CXDSCONTROL  Z C'DSCONTROL; 11050000
                                                               <<01177>>11052000
LMOUNT       W ALTJOB      ,"LMOUNT"      Y CXLMOUNT     Z C'LMOUNT;    11054000
ALTJOB       W FORTRAN     ,"ALTJOB"      Y CXALTJOB     Z C'ALTJOB;    11056000
FORTRAN      W SPLGO       ,"FORTRAN "    Y CXFORTRAN    Z NOTPB       ;11058000
SPLGO        W RESETDUMP'L ,"SPLGO "      Y CXSPLGO      Z NOTPB       ;11060000
RESETDUMP'L  W DSCOPY      ,"RESETDUMP"   Y CXRESETDUMP        <<01452>>11062000
                                          Z UNRESTRICTED;      <<01452>>11064000
DSCOPY       W 0           ,"DSCOPY"      Y CXDSCOPY           <<01452>>11066000
                                          Z NOTPB;             <<01452>>11068000
                                                                        11070000
BUCKET23:                                                               11072000
IMF          W BREAKJOB    ,"IMF "        Y CX3270             <<02845>>11074000
                                          Z NOTPB;             <<02845>>11076000
BREAKJOB     W RENAME      ,"BREAKJOB"    Y CXBREAKJOB   Z C'BREAKJOB;  11078000
RENAME       W 0           ,"RENAME"      Y CXRENAME     Z UNRESTRICTED;11080000
                                                                        11082000
BUCKET24:                                                               11084000
LIMIT        W WARN        ,"LIMIT"       Y CXLIMIT      Z C'LIMIT;     11086000
WARN         W ALTSEC      ,"WARN"        Y CXWARN       Z C'WARN;      11088000
ALTSEC       W 0           ,"ALTSEC"      Y CXALTSEC     Z UNRESTRICTED;11090000
                                                                        11092000
BUCKET25:                                                               11094000
APL          W NEWUSER     ,"APL "        Y CXAPL        Z NOTPB       ;11096000
NEWUSER      W 0           ,"NEWUSER "    Y CXNEWUSER    Z AMGR        ;11098000
                                                                        11100000
BUCKET26:                                                               11102000
MIOENABLE    W RELEASE     ,"MIOENABLE"   Y CXMIOENABLE  Z C'MIOENABLE; 11104000
RELEASE      W SHOWTIME    ,"RELEASE "    Y CXRELEASE    Z BREAKABLE   ;11106000
SHOWTIME     W RESETACCT   ,"SHOWTIME"    Y CXSHOWTIME   Z BREAKABLE   ;11108000
RESETACCT    W 0           ,"RESETACCT "  Y CXRESETACCT  Z MGR         ;11110000
                                                                        11112000
BUCKET27:                                                               11114000
LISTF        W CONTINUE    ,"LISTF "      Y CXLISTF      Z BREAKABLE   ;11116000
CONTINUE     W 0           ,"CONTINUE"    Y CXCONTINUE   Z 0,0,0,%2,0;  11118000
                                                                        11120000
BUCKET28:                                                               11122000
BUILD        W 0           ,"BUILD "      Y CXBUILD      Z UNRESTRICTED;11124000
                                                                        11126000
BUCKET29:                                                               11128000
A3270        W RESUMEJOB   ,"IML "        Y CX3270       Z NOTPB       ;11130000
RESUMEJOB    W SEGMENTER'L ,"RESUMEJOB"   Y CXRESUMEJOB  Z C'RESUMEJOB; 11132000
SEGMENTER'L  W COMMENTL    ,"SEGMENTER"   Y CXSEGMENTER  Z NOTPB;       11134000
COMMENTL     W 0           ,"COMMENT "    Y CXCOMMENT    Z UNRESTRICTED;11136000
                                                                        11138000
BUCKET30:                                                               11140000
ALTSPOOLFILE W STOPSPOOL   ,"ALTSPOOLFILE" Y CXALTSPOOLFILE Z C'ALTSP;  11142000
STOPSPOOL    W RECALL      ,"STOPSPOOL"    Y CXSTOPSPOOL  Z C'STOPSPOOL;11144000
RECALL       W REMOTE      ,"RECALL"      Y CXRECALL     Z C'RECALL;    11146000
REMOTE       W COBOLPREP   ,"REMOTE"      Y CXREMOTED    Z UNRESTRICTED;11148000
COBOLPREP    W 0           ,"COBOLPREP "  Y CXCOBOLPREP  Z NOTPB       ;11150000
                                                                        11152000
BUCKET31:                                                               11154000
CONSOLE      W HEADOFF     ,"CONSOLE"     Y CXCONSOLE    Z C'CONSOLE;   11156000
HEADOFF      W HEADON      ,"HEADOFF"     Y CXHEADOFF    Z C'HEADOFF;   11158000
HEADON       W COBOL       ,"HEADON"      Y CXHEADON     Z C'HEADON;    11160000
COBOL        W 0           ,"COBOL "      Y CXCOBOL      Z NOTPB       ;11162000
                                                                        11164000
BUCKET32:                                                               11166000
RUN          W SETCOM      ,"RUN"         Y CXRUN        Z NOTPB;       11168000
SETCOM       W RESET       ,"SET"         Y CXSET        Z UNRESTRICTED;11170000
RESET        W SPEED       ,"RESET "      Y CXRESET      Z UNRESTRICTED;11172000
SPEED        W VSUSER      ,"SPEED "      Y CXSPEED            <<01724>>11174000
                                          Z 0,0,0,%20,0;       <<01724>>11176000
VSUSER       W 0           ,"VSUSER"      Y CXVSUSER     Z UVCAP       ;11178000
                                                                        11180000
                                                                        11182000
BUCKET33:                                                               11184000
DOWNLOAD     W ABORTIO     ,"DOWNLOAD"    Y CXDOWNLOAD   Z C'DOWNLOAD;  11186000
ABORTIO      W SETMSG      ,"ABORTIO"     Y CXABORTIO    Z C'ABORTIO;   11188000
SETMSG       W DISMOUNTC   ,"SETMSG"      Y CXSETMSG     Z UNRESTRICTED;11190000
DISMOUNTC    W ALTVSET     ,"DISMOUNT"    Y CXDISMOUNT   Z UVCAP       ;11192000
ALTVSET      W 0           ,"ALTVSET"     Y CXALTVSET    Z CVCAP       ;11194000
                                                                        11196000
BUCKET34:                                                               11198000
ACCEPT       W DOWN        ,"ACCEPT"      Y CXACCEPT     Z C'ACCEPT;    11200000
DOWN         W GIVE        ,"DOWN"        Y CXDOWN       Z C'DOWN;      11202000
GIVE         W DSLINE      ,"GIVE"        Y CXGIVE       Z C'GIVE;      11204000
DSLINE       W SPLPREP     ,"DSLINE"      Y CXDSLINED    Z UNRESTRICTED;11206000
SPLPREP      W TELL        ,"SPLPREP "    Y CXSPLPREP    Z NOTPB       ;11208000
TELL         W RESUMELOG   ,"TELL"        Y CXTELL       Z UNRESTRICTED;11210000
RESUMELOG    W DEALLOCATE  ,"RESUMELOG "  Y CXRESUMELOG  Z OPBR        ;11212000
DEALLOCATE   W 0           ,"DEALLOCATE"  Y CXDEALLOCATE Z OPNOTBRK;    11214000
                                                                        11216000
BUCKET35:                                                               11218000
SHOWLOGSTAT W LISTGROUP,"SHOWLOGSTATUS " Y CXSHOWLOGSTATUS Z 0,0,0,%2,0;11220000
                                                               <<00506>>11222000
LISTGROUP    W 0           ,"LISTGROUP "  Y CXLISTGROUP  Z MGRSA       ;11224000
                                                                        11226000
BUCKET36:                                                               11228000
DELETESPOOLFILE W SUSPENDSPOOL,                                <<00552>>11230000
             "DELETESPOOLFILE" Y CXDELETESPOOLFILE Z C'DELETESPOOLFILE; 11232000
SUSPENDSPOOL W IF'         ,                                   <<00552>>11234000
             "SUSPENDSPOOL"    Y CXSUSPENDSPOOL Z C'SUSPENDSPOOL;       11236000
IF'          W LISTUSER    ,"IF"          Y CXIF         Z IFSTATEMENT; 11238000
                                                               <<U.RAO>>11240000
LISTUSER     W 0           ,"LISTUSER"    Y CXLISTUSER   Z MGRSA       ;11242000
                                                                        11244000
BUCKET37:                                                               11246000
FORTPREP     W DATA        ,"FORTPREP"    Y CXFORTPREP   Z NOTPB       ;11248000
DATA         W PURGEGROUP  ,"DATA"        Y CXDATA       Z NOTPB       ;11250000
PURGEGROUP   W MOUNTC      ,"PURGEGROUP"  Y CXPURGEGROUP Z AMGR        ;11252000
MOUNTC       W 0           ,"MOUNT "      Y CXMOUNT      Z UVCAP       ;11254000
                                                                        11256000
BUCKET38:                                                               11258000
STARTSPOOL   W ABORT       ,                                            11260000
              "STARTSPOOL"     Y CXSTARTSPOOL   Z C'STARTSPOOL;         11262000
ABORT        W CRESET      ,"ABORT "      Y CXABORT      Z 0,0,0,%22,0 ;11264000
CRESET       W NEWVSET     ,"CRESET"      Y CXCRESET     Z UNRESTRICTED;11266000
NEWVSET      W 0           ,"NEWVSET"     Y CXNEWVSET    Z CVCAP       ;11268000
                                                                        11270000
BUCKET39:                                                               11272000
SHOWALLOW    W SHOWCATALOG ,"SHOWALLOW"   Y CXSHOWALLOW  Z BREAKABLE   ;11274000
SHOWCATALOG  W BASIC       ,"SHOWCATALOG " Y CXSHOWCATALOG Z 0D,%102D,0;11276000
BASIC        W 0           ,"BASIC "      Y CXBASIC      Z NOTPB       ;11278000
                                                              <<MRJE>>  11280000
BUCKET40:                                                     <<MRJE>>  11282000
MIODISABLE   W UP          ,"MIODISABLE"  Y CXMIODISABLE Z C'MIODISABLE;11284000
UP           W MRJE        ,"UP"          Y CXUP         Z C'UP;        11286000
MRJE         W GETLOG      ,"MRJE"        Y CXMRJE       Z NOTPB    ;   11288000
GETLOG       W 0           ,"GETLOG"      Y CXGETLOG     Z USERLOGGING; 11290000
                                                              <<MRJE>>  11292000
                                                                        11294000
BUCKET42:                                                               11296000
BYE          W RPGGO       ,"BYE "        Y CXBYE        Z 0,0,0,%123,0;11298000
RPGGO        W ALTGROUP    ,"RPGGO "      Y CXRPGGO      Z NOTPB       ;11300000
ALTGROUP     W 0           ,"ALTGROUP"    Y CXALTGROUP   Z AMGR        ;11302000
                                                                        11304000
BUCKET43:                                                               11306000
PASCALPREP   W SHOWME      ,"PASCALPREP"  Y CXPASCALPREP       <<02844>>11308000
                                          Z NOTPB;             <<02844>>11310000
SHOWME       W 0           ,"SHOWME"      Y CXSHOWME     Z BREAKABLE;   11312000
                                                               <<U.RAO>>11314000
BUCKET44:                                                               11316000
SETCATALOG   W EDITOR      ,"SETCATALOG"  Y CXSETCATALOG Z 0,0,0,2,0   ;11318000
EDITOR       W RESTORE     ,"EDITOR"      Y CXEDITOR     Z NOTPB       ;11320000
RESTORE      W ENDIF       ,"RESTORE "    Y CXRESTORE    Z BREAKABLE   ;11322000
ENDIF        W 0           ,"ENDIF "      Y CXENDIF      Z IFSTATEMENT; 11324000
                                                               <<U.RAO>>11326000
                                                                        11328000
BUCKET45:                                                               11330000
                                                               <<01208>>11332000
MPLINE       W STORE       ,"MPLINE"      Y CXMPLINE     Z C'MPLINE;    11334000
                                                               <<01208>>11336000
STORE        W REPORT      ,"STORE "      Y CXSTORENEW         <<04695>>11338000
                                          Z NOTB;              <<04695>>11340000
REPORT       W SWITCHLOG   ,"REPORT"      Y CXREPORT     Z BREAKABLE   ;11342000
SWITCHLOG    W 0           ,"SWITCHLOG "  Y CXSWITCHLOG  Z OPBR        ;11344000
                                                                        11346000
BUCKET46:                                                               11348000
MOFF         W JOBFENCE    ,"MOFF"        Y CXMOFF       Z C'MOFF;      11350000
JOBFENCE     W COBOLGO'L   ,"JOBFENCE"    Y CXJOBFENCE   Z C'JOBFENCE;  11352000
COBOLGO'L    W 0           ,"COBOLGO "    Y CXCOBOLGO    Z NOTPB       ;11354000
                                                                        11356000
BUCKET47:                                                               11358000
IMFCONTROL   W A3270CONTROL,"IMFCONTROL"  Y CX3270CONTROL      <<02845>>11360000
                                          Z C'IMLCONTROL;      <<02845>>11362000
A3270CONTROL W MON         ,"IMLCONTROL" Y CX3270CONTROL Z C'IMLCONTROL;11364000
MON          W REFUSE      ,"MON"         Y CXMON        Z C'MON;       11366000
REFUSE       W SPL         ,"REFUSE"      Y CXREFUSE     Z C'REFUSE;    11368000
SPL          W RESUME      ,"SPL "        Y CXSPL        Z NOTPB       ;11370000
RESUME       W BASICOMP    ,"RESUME"      Y CXRESUME     Z C'RESUME;    11372000
BASICOMP     W NEWGROUP    ,"BASICOMP"    Y CXBASICOMP   Z NOTPB       ;11374000
NEWGROUP     W ALTACCT     ,"NEWGROUP"    Y CXNEWGROUP   Z AMGR        ;11376000
ALTACCT      W 0           ,"ALTACCT "    Y CXALTACCT    Z MGR         ;11378000
                                                                        11380000
BUCKET48:                                                               11382000
RELLOG       W FILE        ,"RELLOG"      Y CXRELLOG     Z USERLOGGING; 11384000
                                                               <<00506>>11386000
FILE         W SHOWJOB     ,"FILE"        Y CXFILE       Z UNRESTRICTED;11388000
SHOWJOB      W 0           ,"SHOWJOB "    Y CXSHOWJOB    Z BREAKABLE   ;11390000
   );                                                          <<U.RAO>>11392000
END    <<COMSEARCH>>;                                          <<U.RAO>>11394000
$PAGE "COMMANDINTERP - MAIN BODY OF CI"                        <<08.RO>>11396000
PROCEDURE COMMANDINTERP(EXPCODE);                              <<02.EB>>11398000
   VALUE EXPCODE;                                              <<02.EB>>11400000
   LOGICAL EXPCODE;                                            <<02.EB>>11402000
   OPTION UNCALLABLE;                                          <<02.EB>>11404000
BEGIN                                                                   11406000
      ENTRY                                                    <<U.RAO>>11408000
          UDCCI,  <<REENTRY POINT FOR UDC'S>>                  <<03.RO>>11410000
          COMMAND',  <<ENTRY FOR COMMAND INTRINSIC>>           <<03.RO>>11412000
          SYSBREAK;  <<ENTRY FOR TERMINAL BREAK FUNCTION>>     <<03.RO>>11414000
                                                               <<01.PV>>11416000
      DOUBLE                                                   <<01.PV>>11418000
          ACCESS,  <<ACCESS RESTRICTIONS FROM COMSEARCH>>      <<U.RAO>>11420000
          CAP;   <<EXEC CAPABILITY FROM COMSEARCH>>            <<03.RO>>11422000
                                                               <<01.PV>>11424000
      LOGICAL                                                  <<01.PV>>11426000
          CAP0 = CAP,                                          <<01.PV>>11428000
          CAP1 = CAP0+1,                                       <<01.PV>>11430000
         ACCESS0=ACCESS,   <<10:6 =OPERATOR COMMAND INDEX>>    <<00552>>11432000
          ACCESS1 = ACCESS+1,  <<ACCESS RESTRICTIONS>>         <<U.RAO>>11434000
          PROGCALL := FALSE,  <<PROGRAMMATICALLY INVOKED>>     <<03.RO>>11436000
         SPECIAL'BREAK:=FALSE, <<ENTERED THRU RIT BREAK FLAG>> <<00594>>11438000
          STAT2 = Q-5,  <<FOR PROGRAMMATIC CALL STATUS RTN>>   <<03.RO>>11440000
          PROMPT := ": ",   <<PROMPT FOR SESSION>>             <<03.RO>>11442000
          CONTFLG := FALSE,  <<EXPECTING CONTINUATION RECORD>> <<03.RO>>11444000
          JOBFLG,  <<PROCESSING "JOB" COMMAND, NO ECHO>>       <<03.RO>>11446000
          EXECPLABEL,  <<PLABEL OF COMMAND EXECUTOR TO CALL>>  <<03.RO>>11448000
          NONABORTABLE; <<COMMAND CAN BE BROKEN WITH BREAK>>   <<03.RO>>11450000
                                                               <<01.PV>>11452000
      ARRAY                                                    <<01.PV>>11454000
          WMESNO(0:15);   <<ANSWER HOLDER FOR ABORT QUESTION>> <<U.RAO>>11456000
                                                               <<01.PV>>11458000
      INTEGER ARRAY ALLOWMASK(0:2); <<HOLDER OF ALLOW MASK>>   <<00552>>11460000
                                 <<OP.01>>                              11462000
      INTEGER                                                  <<01.PV>>11464000
          ERRNUM,  <<ERROR NUMBER RETURNED FROM EXECUTOR>>     <<03.RO>>11466000
          PARMNUM, <<PARAMETER INDEX FROM EXECUTOR>>           <<03.RO>>11468000
          LENGTH,  <<LENGTH OF THE RECORD JUST READ.>>         <<03.RO>>11470000
          COMLEN,  <<LENGTH OF THE CURRENT COMMAND NAME>>      <<03.RO>>11472000
          LEFT,  <<SPACE LEFT IN THE INPUT BUFFER>>            <<03.RO>>11474000
          CAPCHECKERR,  <<CIERR IF CAPABILITY CHECK FAILED>>   <<03.RO>>11476000
          BYTE'INDEX, << INDEX INTO TEMP ARRAY FOR ECHO  >>    <<04212>>11478000
          TEMP'COMLENGTH,<< TEMP COMMAND STRING LENGTHY>>      <<04212>>11480000
          TEMP'BYTE'INDX,<<SAVES BYTE INDX TO LOCKWORD START>> <<04212>>11482000
          LEN'STRING'LEFT,<<LENGTH OF STRING AFTER LOCKWORD>>  <<04212>>11484000
          WHOLELENGTH, <<SAVES WHOLE STRING LENGTH>>           <<04212>>11486000
          TEMP'COUNT,<<FIGURED COUNT OF CHARS COMPACTED>>      <<04212>>11488000
          NCHAR; <<NUMBER OF CHARACTERS READ FOR ABORT REPLY>> <<03.RO>>11490000
                                                               <<01.PV>>11492000
      POINTER                                                  <<01.PV>>11494000
          ERRPARM = Q-9,  <<ERRNUM FROM COMMAND INTRINSIC>>    <<03.RO>>11496000
          PARMPARM = Q-8, <<PARMNUM FROM COMMAND INTRINSIC>>   <<03.RO>>11498000
          JFLAGS,  <<JOB FLAGS FROM PXGLOB>>                   <<03.RO>>11500000
          PXGLOB;  <<DB RELATIVE POINTER TO PXGLOB>>           <<03.RO>>11502000
      INTEGER IOERRCOUNT;  <<COUNT OF READ ERRORS ENCOUNTERED>><<03.RO>>11504000
      EQUATE IOERRLIMIT = 3;  <<BEFORE TERMINATING SESSION>>   <<03.RO>>11506000
      LOGICAL UDCEXECED := FALSE;  <<FLAG BETWEEN CI & UDC>>   <<03.EB>>11508000
INTEGER LINELENSPTR;  <<STACK POINTER INTO LINE LENGTH STACK>> <<U.RAO>>11510000
      BYTE POINTER                                             <<03.RO>>11512000
          COMARRAY = Q-10,  <<COMMAND STRING FROM COMMAND>>    <<03.RO>>11514000
                         <<INTRINSIC.  POINTS TO COMMAND NAME>><<03.RO>>11516000
          PNTR,  <<CURRENT END OF INPUT BUFFER (SEE GETIMAGE)>><<03.RO>>11518000
           TEMP'PNTR,<<POINTS TO START IF ECHO TEMP ARRAY>>    <<04212>>11520000
           B'POINTER, << POINTS TO WHERE SLASH IS FOUND>>      <<04212>>11522000
          PARMSP;  <<START OF COMMAND PARAMETERS>>             <<03.RO>>11524000
      LOGICAL                                                  <<00257>>11526000
          LCOMARRAY = COMARRAY;<<USED TO GET ADDR OF COMARRAY>><<00257>>11528000
      EQUATE                                                   <<00257>>11530000
          CR'CR = %6415;                                       <<00257>>11532000
      BYTE ARRAY MESNO(*) = WMESNO;   <<FOR MESSAGES>>         <<U.RAO>>11534000
       BYTE SAVEECHOBYTE;                                      <<04212>>11536000
       BYTE ARRAY TEMP'COMIMAGE (0:CIS'BCOMBUFLEN);            << I.A >>11538000
DEFINE    <<FOR ACCESS RESTRICTIONS>>                          <<U.RAO>>11540000
   OPCOMMANDWRD=ACCESS0.(10:2)#, <<ALLOW MASK WORD INDEX>>     <<00552>>11542000
   OPCOMMANDINX=ACCESS0.(12:4)#, <<ALLOW MASK BIT INDEX>>      <<00552>>11544000
   ANOTINBREAK = ACCESS1#,  <<NOT ALLOWED IN BREAK>>           <<U.RAO>>11546000
   ANOTINPROG = ACCESS1.(14:1)#, <<NOT ALLOWED PROGRAMMATICALLY<<U.RAO>>11548000
   CAPCHECK = ACCESS1.(12:2)<>0#, <<CAP CHECK REQUIRED>>       <<U.RAO>>11550000
   ANDCAPCHECK = ACCESS1.(12:2)=1#,  <<DO "AND" CHECK>>        <<U.RAO>>11552000
   ORCAPCHECK = ACCESS1.(12:2)=2#,  <<DO "OR" CHECK>>          <<U.RAO>>11554000
   ANOTINJOB = ACCESS1.(11:1)#,  <<NOT ALLOWED IN BATCH>>      <<U.RAO>>11556000
   ANOTINSESSION = ACCESS1.(10:1)#, <<NOT ALLOWED IN SESSION>> <<U.RAO>>11558000
   ACANBREAK = ACCESS1.(9:1)#,  <<CAN BREAK COMMAND LISTING>>  <<U.RAO>>11560000
   ACAN'TWITHAPL = ACCESS1.(8:1)#,  <<CAN'T USE WITH APL>>     <<U.RAO>>11562000
   AEXECEVENINIF = ACCESS1.(7:1)#,  <<DON'T FLUSH IN IF>>      <<U.RAO>>11564000
   ANOTINUDC = ACCESS1.(6:1)#, <<NOT ALLOWED IN USER DEF CMD>> <<08.RO>>11566000
    SPECIALBREAK'COM=ACCESS1.(3:1)#,   <<COMMAND OK IN SPECIAL <<00594>>11568000
   OPCOMMAND=ACCESS1.(4:1)#,    <<USER MUST HAVE BEEN ALLOWED>><<00552>>11570000
   ANOTREDOABLE = ACCESS1.(5:1)#;  <<CAN'T REDO>>              <<08.RO>>11572000
                                                               <<04710>>11574000
DEFINE          << Bit in PCB(0) indicating SIR holding.   >>  <<04710>>11576000
   HASSIR = (3:1) #;                                           <<04710>>11578000
                                                               <<04710>>11580000
EQUATE JOBFLAG = 2,                                            <<U.RAO>>11582000
       SESSIONFLAG = 1;  <<JOB/SESSION FIELD IN JOB NUMBERS>>  <<U.RAO>>11584000
      EQUATE PROMPTL=-1;  <<PROMPT LENGTH IS ONE BYTE>>        <<03.RO>>11586000
      DEFINE CCC=STAT2.(6:2)#,  <<FOR COMMAND INTRINSIC>>      <<03.RO>>11588000
      DUPLF=JFLAGS.(PXGFDUP)#,   <<DUPLICATIVE FLAG>>          <<03.RO>>11590000
      INTERACTF=JFLAGS.(PXGFINTER)#;   <<INTERACTIVE FLAG>>    <<03.RO>>11592000
      DEFINE INSTANTLOGON =  <<FOR ONE COMMAND LOGONS>>        <<03.RO>>11594000
         TOS := 0;                                             <<02.EB>>11596000
         TOS := @S0; << TARGET >>                              <<02.EB>>11598000
         TOS := JMATDST;                                       <<02.EB>>11600000
         TOS := PXGLOB(PXGWJMATX).(0:8) *JMATLEN +24;          <<02.EB>>11602000
         TOS := 1; << 24TH WORD FROM JMAT ENTRY >>             <<02.EB>>11604000
         ASSEMBLE(MFDS 4);                                     <<02.EB>>11606000
         TOS := TOS.(3:2);                                     <<U.RAO>>11608000
         PASSEDCOMMAND := TOS&LSL(1)#;                         <<U.RAO>>11610000
      LOGICAL PASSEDCOMMAND:=0;  <<STATUS WORD FOR PASSED COM><<A00.04>>11612000
      DEFINE FUNNYTERMINAL=PASSEDCOMMAND.(15:1)#,<<APL TERMINAL<A00.04>>11614000
             COMMANDPASSED=PASSEDCOMMAND.(0:1)#, <<ONE SEEN>> <<A00.04>>11616000
             COMMANDEXECED=PASSEDCOMMAND.(1:1)#, <<ONE DONE>> <<A00.04>>11618000
             APLTERMTYPE  =PASSEDCOMMAND.(13:2)#;             <<A00.04>>11620000
DOUBLE OLDSEQNUM := 0D,  <<LAST VALID SEQUENCE NUMBER>>        <<01.RO>>11622000
       NEWSEQNUM;   <<CANDIDATE SEQUENCE NUMBER>>              <<01.RO>>11624000
INTEGER                                                        <<00419>>11626000
   STDLISTLENB,                                                <<00419>>11628000
   STDLISTLENW;                                                <<00419>>11630000
POINTER                                                        <<00419>>11632000
   PRINTPOS;   << USED IN SUBR. ECHO >>                        <<00419>>11634000
LOGICAL                                                        <<00540>>11636000
   OLDCRITICAL,                                                <<04169>>11638000
   DUMMY,                                                      <<01455>>11640000
   LOCKWORD'SLASH := %6457,  <<CARRIAGE RETURN,SLASH>>         <<04212>>11642000
   HARDEOF'THEN'BRK := FALSE; <<HIT BRK AFTER :EOF:>>          <<00540>>11644000
                                                               <<00835>>11646000
<< SAVE AREA FOR UDC AND IF NESTING GLOBALS DURING BREAK >>    <<00835>>11648000
LOGICAL                                                        <<00835>>11650000
   SAVE'UDC3,                                                  <<00835>>11652000
   SAVE'UDC4,                                                  <<00835>>11654000
   SAVE'IFNESTING,                                             <<00835>>11656000
   SAVE'IFSKIP,                                                <<00835>>11658000
   SAVE'ELSESEEN;                                              <<00835>>11660000
DOUBLE                                                         <<00835>>11662000
   SAVE'CONTINUSTATESTK;                                       <<00835>>11664000
                                                               <<00835>>11666000
                                                               <<01.RO>>11668000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<01.RO>>11670000
                                                               <<01.RO>>11672000
                                                                        11674000
<<                 *********************                   >>  <<U.RAO>>11676000
<<                 *   ABORTREFUSED    *                   >>  <<U.RAO>>11678000
<<                 *********************                   >>  <<U.RAO>>11680000
                                                               <<U.RAO>>11682000
LOGICAL SUBROUTINE ABORTREFUSED (COMLEN);                               11684000
   VALUE COMLEN;                                                        11686000
   INTEGER COMLEN;    <<LENGTH OF COMMAND (IN COMIMAGE) 2 B SAVED>>     11688000
                                                                        11690000
<< CALLED WHEN PROGRAM-ABORTING COMMAND DETECTED (INCL EOF).            11692000
   IF NOT IN BREAK MODE, THEN RETURNS FALSE.                            11694000
   IF IN BREAK MODE, THEN                                               11696000
      IF USER CONFIRMS "ABORT?", THEN                                   11698000
         SAVE COMLEN (IN PENDINGCOMLEN),                                11700000
         ABORT PROGRAM, AND                                             11702000
         (PROCEDURE) EXIT TO BREAK CODE (PSEUDO INT ROUTINE).           11704000
      IF USER DECLINES "ABORT?", THEN                                   11706000
         WARNING ("NOT VALID IN BREAK") EMITTED, AND                    11708000
         TRUE RETURNED TO CALLER.    >>                                 11710000
                                                                        11712000
BEGIN                                                                   11714000
   SETXPXFIXED +PXFWBREAK;    << CHECK FOR BREAK >>                     11716000
   IF NOT (DBARRAY (XREG)) THEN                                         11718000
      ABORTREFUSED := FALSE    << NOT EVEN IN BREAK MODE >>             11720000
   ELSE                                                                 11722000
      IF SPECIAL'BREAK THEN <<IGNORE EOF'S IN SPECIAL BREAK>>  <<00594>>11724000
      BEGIN                                                    <<00594>>11726000
         CIERR(ERRNUM:=SPECIALCOM);                            <<00594>>11728000
         ABORTREFUSED:=TRUE;                                   <<00594>>11730000
         FRESETEOF;                                            <<00594>>11732000
         LPDT((PXGLOB(3).(8:8))&ASL(1)+1).(7:3):=0;            <<00594>>11734000
      END                                                      <<00594>>11736000
      ELSE                                                     <<00594>>11738000
ASK:  BEGIN    << BREAK MODE: ASK USER FOR ABORT >>                     11740000
      GENMSG(CIGENERALMSGSET,ABORTQ,,,,,,,,,,,%100000);        <<U.RAO>>11742000
      SETXPXGLOB +PXGWJOBIN;                                            11744000
      TOS := ATTACHIO (DBARRAY (XREG).(8:8), 0, 0,                      11746000
            @WMESNO, 0, -4, 5, 0, 1);                                   11748000
      ASSEMBLE (NEG, XCH);    <<FIX COUNT & CHECK COMPLETION>>          11750000
      ASSEMBLE(DUP); << duplicate attachio status >>           <<02849>>11752000
      IF TOS.(13:3) <> 1 THEN << i/o error >>                  <<02849>>11754000
         BEGIN                                                 <<02849>>11756000
         IF TOS.(9:7) <> %173 THEN << broken read OK. (DS) >>  <<02849>>11758000
            BEGIN                                              <<02849>>11760000
            FUNBREAK(TRUE);                                    <<02849>>11762000
            TERMINATE;                                         <<02849>>11764000
            END;                                               <<02849>>11766000
         END                                                   <<02849>>11768000
      ELSE                                                     <<02849>>11770000
         DEL;                                                  <<02849>>11772000
      NCHAR := TOS;                                                     11774000
      MOVE MESNO := MESNO WHILE AS;    <<UPSHIFT>>                      11776000
      IF (NCHAR = 3) AND (MESNO = "YES") THEN                           11778000
         BEGIN    <<ABORT REQUESTED>>                                   11780000
         SETXPXFIXED +PXFWBREAK;    <<SAVE COMLEN IN PCBX>>             11782000
         DBARRAY(XREG) := 0;   <<CLEAR BREAK FLAG>>            <<U.RAO>>11784000
         CIS'PENDINGCOMLEN := COMLEN;                          << I.A >>11786000
         FUNBREAK(TRUE);                                                11788000
         ABORTPROG;                                                     11790000
         CIS'UDCEXITBREAK := TRUE;                             << I.A >>11792000
         ABORTREFUSED := TRUE;                                 <<03.EB>>11794000
         RETURN;                                               <<03.EB>>11796000
         END;                                                           11798000
      IF (NCHAR <> 2) OR (MESNO <> "NO") THEN                           11800000
         BEGIN    << RESPONSE WAS NEITHER "YES" NOR "NO" >>             11802000
         CIERR(ERRNUM := -BRKINVLDRESP);                       <<04787>>11804000
         <<FIX UP BREAK FLAGS BEFORE TRYING AGAIN>>            <<04.RO>>11806000
         SETXPXGLOB+PXGWJOBIN;                                 <<04.RO>>11808000
         ATTACHIO(DBARRAY(XREG).(8:8),0,0,0,28,0,0,0,1);<<QUIES<<04.RO>>11810000
         SETSERVICE(TRUE);                                     <<04.RO>>11812000
         ATTACHIO(DBARRAY(XREG := XREG+1).(8:8),0,0,0,         <<04.RO>>11814000
               25,0,%320,0,1);   <<CLEAR FLUSH FLAGS>>         <<04.RO>>11816000
         GOTO ASK;    <<AND TRY AGAIN>>                                 11818000
         END;                                                           11820000
      << USER DECLINED "ABORT?" >>                                      11822000
      CIERR(ERRNUM := -NOTINBREAK);                            <<04787>>11824000
      ABORTREFUSED := TRUE;                                             11826000
      END;                                                              11828000
   END;    <<ABORTREFUSED>>                                             11830000
                                                                        11832000
<<                 *********************                   >>  <<U.RAO>>11834000
<<                 *       ECHO        *                   >>  <<U.RAO>>11836000
<<                 *********************                   >>  <<U.RAO>>11838000
                                                               <<U.RAO>>11840000
SUBROUTINE ECHO(LEN);                                                   11842000
VALUE LEN;                                                              11844000
INTEGER LEN;                                                            11846000
<<If STDIN and STDLIST are DUPLICATIVE, don't echo line>>      <<03.RO>>11848000
BEGIN                                                                   11850000
IF NOT(DUPLF) THEN                                                      11852000
   BEGIN                                                       <<00419>>11854000
TEMP'COMLENGTH := WHOLELENGTH :=LEN; <<LENGTH OF CMD STRING>>  <<04212>>11856000
@TEMP'PNTR := @TEMP'COMIMAGE; <<BYTE PTR TO STRING START>>     <<04212>>11858000
TEMP'COMIMAGE :=" "; <<BLANK OUT TEMP BUFFER>>                 <<04212>>11860000
MOVE TEMP'COMIMAGE(1):= TEMP'COMIMAGE,(CIS'BCOMBUFLEN-1);      << I.A >>11862000
MOVE TEMP'COMIMAGE:= PNTR,(LEN+1); <<PUT CMND FROM BCOMIMAGE>> <<04212>>11864000
    << COMMAND MOVED TO TEMPORARY BUFFER >>                    <<04212>>11866000
IF CIS'SEQUENCED AND LEN > 8 THEN                              << I.A >>11868000
     BEGIN                                                     <<04212>>11870000
     LEN := LEN - 8;                                           <<04212>>11872000
     NEWSEQNUM := DBINARY(TEMP'PNTR(LEN),8);<<VALID SEQ #?>>   <<04212>>11874000
     IF = THEN BEGIN <<VALID NUMBER >>                         <<04212>>11876000
            SAVEECHOBYTE:= TEMP'PNTR(LEN);<<SAVE BYTE BEFORE SE<<04212>>11878000
            TEMP'PNTR(LEN) := %15;<< PUT IN CARRIAGE RETURN >> <<04212>>11880000
            END                                                <<04212>>11882000
     ELSE LEN := WHOLELENGTH;<<DON'T PRINTCOMMAND YET,# UNSEQ?><<04212>>11884000
     END;                                                      <<04212>>11886000
TOS := @TEMP'COMIMAGE; <<SET UP FOR SCAN FOR SLASH >>          <<04212>>11888000
                                                               <<04212>>11890000
REPEATSCAN:                                                    <<04212>>11892000
     SCAN * UNTIL LOCKWORD'SLASH,1;                            <<04212>>11894000
     IF CARRY THEN <<NO/NO MORE LOCKWORDS FOUND>>              <<04212>>11896000
         BEGIN                                                 <<04212>>11898000
         DEL;                                                  <<04212>>11900000
         IF (TEMP'COUNT:= WHOLELENGTH -LEN-8) > 0 THEN BEGIN   <<04212>>11902000
             MOVE TEMP'PNTR(LEN) := " ";                       <<04212>>11904000
          MOVE TEMP'PNTR(LEN+1):=TEMP'PNTR(LEN),(TEMP'COUNT-1);<<04212>>11906000
             END;<<BLANKS RESIDUAL AFTER LOCKWORD COMPRESSION D<<04212>>11908000
         GOTO PRINTCOMMAND;                                    <<04212>>11910000
         END                                                   <<04212>>11912000
 <<          SLASH FOUND,  LOCK/PASSWORD FOLLOWS  >>           <<04212>>11914000
     ELSE                                                      <<04212>>11916000
        BEGIN                                                  <<04212>>11918000
        @B'POINTER := TOS;                                     <<04212>>11920000
        BYTE'INDEX:= LOGICAL(@B'POINTER - @TEMP'COMIMAGE) + 1; <<04212>>11922000
        TEMP'BYTE'INDX:= BYTE'INDEX; << SAVE BYTE INDEX>>      <<04212>>11924000
        WHILE TEMP'PNTR(BYTE'INDEX) <> SPECIAL                 <<04212>>11926000
            DO BEGIN                                           <<04212>>11928000
            MOVE TEMP'PNTR(BYTE'INDEX):= " "; <<BLANK LOCKWORD><<04212>>11930000
            BYTE'INDEX:= BYTE'INDEX + 1;                       <<04212>>11932000
            END;                                               <<04212>>11934000
        IF TEMP'PNTR(BYTE'INDEX) = %15 <<GOT CARRIAGE RETURN>> <<04212>>11936000
            << END OF COMMAND STRING   >>                      <<04212>>11938000
            THEN GOTO PRINTCOMMAND                             <<04212>>11940000
        ELSE BEGIN      <<COMPACT STRING >>                    <<04212>>11942000
            LEN'STRING'LEFT := LEN-BYTE'INDEX;                 <<04212>>11944000
            MOVE TEMP'PNTR(TEMP'BYTE'INDX) :=                  <<04212>>11946000
                TEMP'PNTR(BYTE'INDEX),(LEN'STRING'LEFT);       <<04212>>11948000
            LEN := LEN- (BYTE'INDEX-TEMP'BYTE'INDX);           <<04212>>11950000
     <<           NEW STRING LENGTH COMPUTED           >>      <<04212>>11952000
            TOS := @B'POINTER +1; <<POINT AT BYTE AFTER SLASH>><<04212>>11954000
            GOTO REPEATSCAN;                                   <<04212>>11956000
        END;                                                   <<04212>>11958000
     END;                                                      <<04212>>11960000
                                                               <<04212>>11962000
PRINTCOMMAND:                                                  <<04212>>11964000
   IF WHOLELENGTH > LEN THEN                                   <<04212>>11966000
       BEGIN                                                   <<04212>>11968000
       LEN := WHOLELENGTH;                                     <<04212>>11970000
       TEMP'PNTR(WHOLELENGTH-8) := SAVEECHOBYTE; <<REPLACE BYTE<<04212>>11972000
       END;                                                    <<04212>>11974000
   @PRINTPOS := @TEMP'PNTR&LSR(1);<< PNTR=START OF TEMPBUFFER <<04212>>11976000
   IF LEN > STDLISTLENB THEN                                   <<00419>>11978000
      DO BEGIN   << BREAK LINE INTO PRINTABLE PIECES >>        <<00419>>11980000
         PRINT(PRINTPOS,STDLISTLENW,0);                        <<00419>>11982000
         IF > THEN CIERR(ERRNUM := ERRSTDLISTEOF)              <<04787>>11984000
         ELSE IF < THEN CIERR(ERRNUM := ERRSTDLISTIO);         <<04787>>11986000
         LEN := LEN-STDLISTLENB;                               <<00419>>11988000
         @PRINTPOS := @PRINTPOS+STDLISTLENW;                   <<00419>>11990000
         END                                                   <<00419>>11992000
      UNTIL LEN <= STDLISTLENB;                                <<00419>>11994000
   PRINT(PRINTPOS,-LEN,0);                                     <<00419>>11996000
   IF > THEN CIERR(ERRNUM := ERRSTDLISTEOF)                    <<04787>>11998000
   ELSE IF < THEN CIERR(ERRNUM := ERRSTDLISTIO);               <<04787>>12000000
   END;                                                        <<00419>>12002000
END;<<ECHO>>                                                            12004000
                                                               <<00607>>12006000
<<               **************************                >>  <<00607>>12008000
<<               *  CLEAN'TERMINAL'STATE  *                >>  <<00607>>12010000
<<               **************************                >>  <<00607>>12012000
                                                               <<00607>>12014000
SUBROUTINE CLEAN'TERMINAL'STATE (PROMPTUSER);                  <<00607>>12016000
   VALUE PROMPTUSER;                                           <<00607>>12018000
   LOGICAL PROMPTUSER;                                         <<00607>>12020000
BEGIN                                                          <<00607>>12022000
COMMENT:                                                       <<00607>>12024000
   THIS SUBROUTINE DISALLOWS BREAK, CLEARS THE FLUSH           <<00607>>12026000
   FLAG TO ALLOW READ/WRITE TO TERMINAL, AND PRINTS            <<00607>>12028000
   ":" IF PROMPTUSER IS TRUE.;                                 <<00607>>12030000
ATTACHIO(PXGLOB(3).(8:8),0,0,0,28,0,0,0,1);                    <<00607>>12032000
<<QUIESCE I/O TO WAIT UNTIL ALL OTHER I/O IS COMPLETED>>       <<00607>>12034000
<<BEFORE BREAK IS DISALLOWED ON $STDIN                >>       <<00607>>12036000
SETSERVICE(TRUE); <<DON'T ALLOW BREAK>>                        <<00607>>12038000
IF PROMPTUSER THEN                                             <<00607>>12040000
   ATTACHIO(PXGLOB(4).(8:8),0,0,@PROMPT,25,PROMPTL,            <<00607>>12042000
            %320,0,1)  <<WRITE OUT PROMPT>>                    <<00607>>12044000
ELSE  <<NO PROMPT--BUT CLEAR FLUSH>>                           <<00607>>12046000
   ATTACHIO(PXGLOB(4).(8:8),0,0,0,25,0,%320,0,1);              <<00607>>12048000
END;<<CLEAN'TERMINAL'STATE>>                                   <<00607>>12050000
<<                 *********************                   >>  <<U.RAO>>12052000
<<                 *     GETIMAGE      *                   >>  <<U.RAO>>12054000
<<                 *********************                   >>  <<U.RAO>>12056000
                                                               <<U.RAO>>12058000
SUBROUTINE GETIMAGE;                                                    12060000
<<This subroutine is responsible for getting the next command>><<03.RO>>12062000
<<image from the user, except for UDC's and the COMMAND >>     <<03.RO>>12064000
<<intrinsic.  When it returns a completed command image will>> <<03.RO>>12066000
<<be found in the COMIMAGE buffer.  The subroutine is primarily<<03.RO>>12068000
<<a giant loop which reads and processes each record until>>   <<03.RO>>12070000
<<it decides that there are no more continuation records to>>  <<03.RO>>12072000
<<be read.>>                                                   <<03.RO>>12074000
<<The first part of the loop (before label HAVECOMMAND) is>>   <<03.RO>>12076000
<<involved with the I/O aspects of getting the record.>>       <<03.RO>>12078000
<<First, if STDIN is a terminal, it quiesces the terminal,>>   <<03.RO>>12080000
<<clears the BREAK bits, then prompts the user.>>              <<03.RO>>12082000
<<Second it manages a stack called LINELENSTACK.  This stack>> <<03.RO>>12084000
<<holds the processed lengths of each of the lines read.  >>   <<03.RO>>12086000
<<This information is used when CIERR calculates where in >>   <<03.RO>>12088000
<<world to put a caret.  This is an imperfect mechanism since>><<03.RO>>12090000
<<it requires a lot of coordination between the executors and>><<03.RO>>12092000
<<CIERR.  It should be replaced with a better one.  >>         <<03.RO>>12094000
<<Third a READ is issued against STDIN.  This read is followed><<03.RO>>12096000
<<by a lot of code to handle I/O errors and EOF's.  Not very>> <<03.RO>>12098000
<<interesting stuff.  One thing to note, however, is that>>    <<03.RO>>12100000
<<with terminals we usually try to continue.  In some cases>>  <<03.RO>>12102000
<<this will cause the CI to loop until it finally gets aborted><<03.RO>>12104000
<<from elsewhere or for some other reason.>>                   <<03.RO>>12106000
<<The second part of the command (after HAVECOMMAND) we process<<03.RO>>12108000
<<the read record into what will later be passed to the >>     <<03.RO>>12110000
<<command executor.  In particular it deletes leading and>>    <<03.RO>>12112000
<<trailing blanks, handles sequence numbers, checks for the>>  <<03.RO>>12114000
<<leading colon, checks the current length of the command>>    <<03.RO>>12116000
<<for a fit with our buffer and several other fairly obvious>> <<03.RO>>12118000
<<tasks.  Finally the subroutine returns to the outer block>>  <<03.RO>>12120000
<<of the procedure.  One other related thing to be aware of>>  <<03.RO>>12122000
<<is the fact that sometimes the first record of the command>> <<03.RO>>12124000
<<has been pre-read.  In particular this occurs if a user>>    <<03.RO>>12126000
<<program was reading data from STDIN in a job.  In this>>     <<03.RO>>12128000
<<case the CI tries to flush all remaining user data until>>   <<03.RO>>12130000
<<it finds an MPE command (leading colon) to execute.>>        <<03.RO>>12132000
<<The procedure doing the flush (CISUBSYSFINISH) then >>       <<03.RO>>12134000
<<stuffs the MPE command it stopped on into COMIMAGE and >>    <<03.RO>>12136000
<<leaves the length in PENDINGCOMLEN.  Obviously then we>>     <<03.RO>>12138000
<<must branch around the code which does the read the first>>  <<03.RO>>12140000
<<time through.  Hence HAVECOMMAND.  >>                        <<03.RO>>12142000
<<There are also some scattered flags for UDC for handling>>   <<03.RO>>12144000
<<REDO and error message generation on UDC's.>>                <<03.RO>>12146000
BEGIN                                                                   12148000
IOERRCOUNT := 0;  << Gets "IOERRLIMIT" tries this cmd. >>      <<04709>>12150000
NEXTCOM:                                                                12152000
      @PNTR := @CIS'BCOMIMAGE;                                 << I.A >>12154000
      COMMENT:                                                 <<00287>>12156000
         INITIALIZE "SPACE LEFT" TO NUM OF ALLOWED CHAR+1,     <<00287>>12158000
         IN ORDER TO CATCH 'COMMAND TOO LONG';                 <<00287>>12160000
      LEFT := CIS'BCOMBUFLEN - 1;                              << I.A >>12162000
      CIS'UDCIMAGEADJUST := FALSE;                             << I.A >>12164000
      CONTFLG := JOBFLG := FALSE;                              <<03.RO>>12166000
      SETXPXGLOB;                                                       12168000
      @JFLAGS := (@PXGLOB := X) +PXGWFLAGS;                             12170000
   << CHECK FOR ENTIRE COM (BREAK) OR PARTIAL COM (FLUSH) PENDING>>     12172000
      LENGTH := CIS'PENDINGCOMLEN; << READ COMMAND LENGTH >>   << I.A >>12174000
      IF > THEN                                                         12176000
         BEGIN    <<SOMETHING PENDING>>                                 12178000
         CIS'PENDINGCOMLEN := 0;  << CLEAR ALREADY READ FLAG >><< I.A >>12180000
         IF COMMANDPASSED THEN COMMANDEXECED:=TRUE; <<IMAGED>>          12182000
         LINELENSPTR := 0;  << INITIALIZE FOR (CMD) LOGONS >>  <<00240>>12184000
         <<DISABLE BREAK & CLEAR FLUSH FLAG>>                  <<00607>>12186000
         IF INTERACTF THEN CLEAN'TERMINAL'STATE(FALSE);        <<00607>>12188000
         GOTO HAVECOMMAND;                                              12190000
         END;                                                           12192000
      LINELENSPTR := -1;   <<INITIALIZE STACK POINTER>>        <<U.RAO>>12194000
      DO                                                                12196000
         BEGIN                                                          12198000
         IF INTERACTF THEN                                              12200000
           BEGIN                                                        12202000
           <<DISABLE BREAK,CLEAR FLUSH,WRITE PROMPT IF NEC.>>  <<00607>>12204000
           IF LPDT(PXGLOB(3).(8:8)&LSL(1)+1).(7:3)=0 THEN               12206000
              CLEAN'TERMINAL'STATE(TRUE) <<WRITE PROMPT>>      <<00607>>12208000
           ELSE  <<NO PROMPT>>                                 <<00607>>12210000
              CLEAN'TERMINAL'STATE(FALSE);                     <<00607>>12212000
           END;                                                         12214000
           <<PREPARE TO UPDATE LINELENGTH STACK>>              <<U.RAO>>12216000
           LINELENSPTR := LINELENSPTR+1;                       <<U.RAO>>12218000
    IF LINELENSPTR > CIS'MAXCONTLINES THEN                     << I.A >>12220000
    BEGIN                                                      <<01032>>12222000
        CIERR(ERRNUM := COMTOOMANYLINES);                      <<04787>>12224000
        GO TO NEXTCOM;                                         <<01032>>12226000
    END;                                                       <<01032>>12228000
            IF LINELENSPTR <> 0                                << I.A >>12230000
               THEN CIS'UDCIMAGEADJUST                         << I.A >>12232000
                      := TRUE;                                 << I.A >>12234000
            TOS := 0;                                                   12236000
            TOS := @PNTR & ASR(1);     <<STACK < 16K>>                  12238000
            LENGTH := READ (*, -LEFT);                                  12240000
            IF <> THEN                                                  12242000
               BEGIN    << ERROR OR EOF >>                              12244000
            IF < THEN   <<IO ERROR ON STDIN>>                  <<U.RAO>>12246000
               BEGIN                                           <<U.RAO>>12248000
               CIERR(ERRNUM := ERRSTDINIO);                    <<04787>>12250000
               IF (IOERRCOUNT:=IOERRCOUNT+1) > IOERRLIMIT THEN <<03.RO>>12252000
                  BEGIN                                        <<03.RO>>12254000
                  SETSERVICE(FALSE);                           <<03.RO>>12256000
                  TERMINATE;                                   <<03.RO>>12258000
                  END;  <<TOO MANY IO ERRORS ON READ FROM STDIN<<03.RO>>12260000
               GO TO NEXTCOM;                                  <<U.RAO>>12262000
               END;                                            <<U.RAO>>12264000
               << EOF: PHYSICAL OR JOB-DELIMITING COMMAND >>            12266000
                IF HARDEOF'THEN'BRK THEN                       <<00540>>12268000
                   BEGIN                                       <<00540>>12270000
                   COMMENT:                                    <<00540>>12272000
                      HIT BREAK AFTER :EOF:. IGNORE BREAK      <<00540>>12274000
                      AND END SESSION;                         <<00540>>12276000
                   SETXPXFIXED + PXFWBREAK;                    <<00540>>12278000
                   DBARRAY(XREG) := 0;   <<CLEAR BREAK FLAG>>  <<00540>>12280000
                   CIS'PENDINGCOMLEN := 0;                     << I.A >>12282000
                   FUNBREAK(TRUE);                             <<00540>>12284000
                   ABORTPROG;                                  <<00540>>12286000
                   CIS'UDCEXITBREAK := TRUE;                   << I.A >>12288000
                   GO NEXT;                                    <<00540>>12290000
                   END;                                        <<00540>>12292000
               IF NOT (CONTFLG) THEN                                    12294000
                  BEGIN    <<NO PARTIAL COMMAND: "PURE EOF">>           12296000
                  IF ABORTREFUSED (0) THEN                              12298000
                     BEGIN    << ABORT REFUSED IN BREAK >>              12300000
                     IF CIS'UDCEXITBREAK THEN GO NEXT;         << I.A >>12302000
                     FRESETEOF;    <<CLEAR FSYS' EOF STUFF>>            12304000
                     LEFT := PXGLOB (3).(8:8);    <<JIN DEV>>           12306000
                     << CHECK FOR BACKSPACED COMMAND & CLEAR >>         12308000
                     IF NOT (LOGICAL (LPDT (LEFT &ASL(1)+1).(9:1))) THEN12310000
                        ATTACHIO (LEFT,0,0,0,0,0,0,0,1)                 12312000
                     ELSE                                               12314000
                        << JUST CLEAR LPDT EOF INDICATOR >>             12316000
                        LPDT (LEFT &ASL(1) +1).(7:3) := 0;              12318000
                     GOTO NEXTCOM;    <<CONTINUE SESSION>>              12320000
                     END;                                               12322000
                  <<NOT IN BREAK MODE (INCL ALL BATCH)>>                12324000
                  IF PXGLOB(PXGWFLAGS).(PXGFJOBTYPE)=2 AND LPDT(        12326000
                    PXGLOB(3).(8:8)&LSL(1)+1).(7:3)=7 THEN              12328000
                    BEGIN <<EOJ READ IN JOB MODE>>                      12330000
                    MOVE PNTR := ":EOJ";                                12332000
                    PNTR(4) :=%15;                             <<04690>>12334000
                    ECHO(5);                                   <<04690>>12336000
                    END;                                                12338000
                  SETSERVICE(FALSE);<<CLEAR BREAK BIT IN LPDT>>         12340000
                  TERMINATE;    <<EOF TERMINATES DIRECTLY>>             12342000
                  END;                                                  12344000
               LENGTH := 0;    <<EOF AS CONTINUED COMMAND DELIM>>       12346000
               END;                                                     12348000
               IOERRCOUNT := 0;  <<SINCE SUCCESSFUL READ>>     <<03.RO>>12350000
HAVECOMMAND:                                                            12352000
            PNTR(LENGTH) := %15;  <<TERMINATOR>>               <<01.RO>>12354000
            CIS'NUMBLANKS := 0; << no. blanks in last line >>  << I.A >>12356000
            IF NOT (INTERACTF) AND NOT (CONTFLG) THEN          <<01.RO>>12358000
               BEGIN                                           <<01.RO>>12360000
               <<NEXT FIND CMD NAME, SINCE MIGHT BE JOB CMD.>> <<01.RO>>12362000
               <<IF SO, DON'T WANT TO ECHO>>                   <<01.RO>>12364000
               SCAN PNTR(1) WHILE %6440,1;<<SKIP BLANKS TO NAME<<01.RO>>12366000
               ASSEMBLE(DUP);                                  <<01.RO>>12368000
               MOVE BPS0 := BPS0 WHILE AS,1;                   <<01.RO>>12370000
               ASSEMBLE(SUB);  <<NEG OF COMMAND NAME LENGTH>>  <<01.RO>>12372000
               IF TOS = -3 THEN   <<LENGTH IS RIGHT FOR :JOB>> <<01.RO>>12374000
                  IF *="JOB" THEN                              <<01.RO>>12376000
                     JOBFLG := TRUE   <<DON'T ECHO>>           <<01.RO>>12378000
                  ELSE                                         <<01.RO>>12380000
               ELSE DEL;  <<POP POINTER TO COMMAND NAME>>      <<01.RO>>12382000
               END;                                            <<01.RO>>12384000
            IF NOT JOBFLG THEN   <<NOT IN MIDDLE OF JOB CMD>>  <<01.RO>>12386000
               ECHO(LENGTH);                                   <<01.RO>>12388000
            IF CIS'SEQUENCED AND LENGTH > 8 THEN               << I.A >>12390000
               BEGIN  <<HANDLE SEQUENCE NUMBER>>               <<01.RO>>12392000
               LENGTH := LENGTH-8;  <<DELETE SEQUENCE NUMBER>> <<01.RO>>12394000
               NEWSEQNUM := DBINARY(PNTR(LENGTH), 8);          <<01.RO>>12396000
               IF = THEN   <<VALID NUMBER>>                    <<01.RO>>12398000
                  IF NEWSEQNUM >= OLDSEQNUM THEN  <<IN SEQUENCE<<01.RO>>12400000
                     OLDSEQNUM := NEWSEQNUM                    <<01.RO>>12402000
                  ELSE <<OUT OF SEQUENCE>>                     <<01.RO>>12404000
                   CIERR(ERRNUM:=-BADSEQUENCEORDR,PNTR(LENGTH))<<04787>>12406000
               ELSE  <<NON-NUMERIC, CHECK FOR BLANKS>>         <<01.RO>>12408000
                  IF PNTR(LENGTH) <> "        " THEN           <<01.RO>>12410000
                     BEGIN                                     <<01.RO>>12412000
                   CIERR(ERRNUM:=-BADSEQUENCENUM,PNTR(LENGTH));<<04787>>12414000
                     LENGTH := LENGTH+8;                       <<01.RO>>12416000
                     END;                                      <<01.RO>>12418000
               PNTR(LENGTH) := %15;  <<TRAILING CR>>           <<01.RO>>12420000
               END;                                            <<01.RO>>12422000
            IF (LENGTH > 0) AND (PNTR (LENGTH -1) = " ") THEN  <<00581>>12424000
               BEGIN    <<STRIP TRAILING BALNKS>>              <<01.RO>>12426000
               TOS := @PNTR (X);                               <<01.RO>>12428000
               ASSEMBLE (DUP, DECA);                           <<01.RO>>12430000
               TOS := -X;                                      <<01.RO>>12432000
               ASSEMBLE (CMPB 0);                              <<01.RO>>12434000
               LENGTH := -TOS;                                 <<01.RO>>12436000
               DDEL;                                           <<01.RO>>12438000
               PNTR(LENGTH) := %15;  <<TRAILING CR>>           <<00581>>12440000
               END;                                            <<01.RO>>12442000
         IF NOT INTERACTF THEN   <<IS JOB>>                    <<01.RO>>12444000
            BEGIN  <<USER MUST PROVIDE LEADING COLON>>         <<01.RO>>12446000
            IF PNTR <> ":" THEN                                <<01.RO>>12448000
                       <<COLON MISSING, MIGHT BE DATA, NOT CMD><<01.RO>>12450000
               IF CIS'IFSKIP THEN <<NOT PARSING ANYHOW>>       << I.A >>12452000
                  GO TO NEXTCOM   <<IGNORE>>                   <<07.RO>>12454000
               ELSE  <<FATAL ERROR>>                           <<07.RO>>12456000
                  BEGIN                                        <<00255>>12458000
                  CIERR(ERRNUM := NOCOLON, CIS'BCOMIMAGE);     <<04787>>12460000
                  GO TO NEXTCOM; <<IN CASE OF PREV :CONTINUE>> <<00255>>12462000
                  END;                                         <<00255>>12464000
            IF LENGTH=1 AND NOT CONTFLG THEN <<NULL COMMAND>>  <<U.RAO>>12466000
               GO TO NEXTCOM;  <<TRY AGAIN>>                   <<U.RAO>>12468000
            PNTR := " ";  <<WIPE OUT COLON>>                   <<U.RAO>>12470000
            CIS'NUMBLANKS := -1;                               << I.A >>12472000
            END                                                <<U.RAO>>12474000
         ELSE  <<IN SESSION JUST CHECK FOR BLANK COMMAND>>     <<U.RAO>>12476000
            IF (LENGTH=0) AND NOT CONTFLG THEN                 <<U.RAO>>12478000
               GO TO NEXTCOM;  <<ZERO LENGTH READ>>            <<U.RAO>>12480000
         <<NOW DELETE ANY LEADING BLANKS>>                     <<U.RAO>>12482000
         IF PNTR=" " THEN                                      <<U.RAO>>12484000
            BEGIN   <<AT LEAST ONE THERE>>                     <<U.RAO>>12486000
            TOS := @PNTR;                                      <<U.RAO>>12488000
            SCAN PNTR WHILE %6440,1;  <<SCAN UNTIL NOT BLANK>> <<U.RAO>>12490000
            ASSEMBLE(DDUP, SUB);  <<NEG # OF BLANKS TO DELETE>><<U.RAO>>12492000
            CIS'NUMBLANKS := -S0 + CIS'NUMBLANKS;              << I.A >>12494000
            LENGTH := TOS+LENGTH;  <<ACTUAL LENGTH OF COMMAND>><<U.RAO>>12496000
            MOVE * := *, (LENGTH);                             <<U.RAO>>12498000
            PNTR(LENGTH) := %15;  <<MARK END OF COMMAND>>      <<U.RAO>>12500000
            CIS'UDCIMAGEADJUST := TRUE;                        << I.A >>12502000
            END;                                               <<U.RAO>>12504000
         IF LENGTH >= LEFT THEN  << CMMD TOO LONG FOR BUFFER >><< I.A >>12506000
            BEGIN                                              <<U.RAO>>12508000
            CIERR(ERRNUM := COMMAND'GT'BUFFER,                 <<04787>>12510000
                  CIS'BCOMIMAGE( CIS'BCOMBUFLEN-LEFT ), %10000,<< I.A >>12512000
                  CIS'MAXCOMLEN    );                          << I.A >>12514000
            GO TO NEXTCOM;                                     <<U.RAO>>12516000
            END;                                               <<U.RAO>>12518000
         << IGNORE LINE IF: 1) NOT A CONTINUATION LINE AND >>  <<01309>>12520000
         <<                 2) ONLY CHARACTER IS A "&".    >>  <<01309>>12522000
         IF (NOT CONTFLG) AND                                  <<01309>>12524000
            (LENGTH=1) AND (PNTR="&") THEN                     <<01309>>12526000
            GO TO NEXTCOM;                                     <<01309>>12528000
         IF NOT CONTFLG THEN                                   <<U.RAO>>12530000
            BEGIN   <<IDENTIFY COMMAND>>                       <<U.RAO>>12532000
            IF PNTR = ALPHA                                    <<00184>>12534000
              THEN MOVE PNTR := PNTR WHILE AS,0                <<00184>>12536000
              ELSE MOVE PNTR := PNTR WHILE ANS,0;              <<00184>>12538000
            @PARMSP := TOS;                                    <<U.RAO>>12540000
            COMLEN := TOS-@PNTR;                               <<U.RAO>>12542000
            END;                                               <<U.RAO>>12544000
         @PNTR := @PNTR+LENGTH;                                <<U.RAO>>12546000
         IF PNTR(-1)="&" THEN   <<WILL EXPECT CONTINUATION>>   <<U.RAO>>12548000
            BEGIN                                              <<U.RAO>>12550000
            CONTFLG := TRUE;                                   <<U.RAO>>12552000
            PNTR(-1) := " ";  <<WIPE OUT "&">>                 <<U.RAO>>12554000
            END                                                <<U.RAO>>12556000
         ELSE  <<NO CONTINUATION EXPECTED>>                    <<U.RAO>>12558000
            CONTFLG := FALSE;                                  <<U.RAO>>12560000
         IF LOGICAL(@PNTR) THEN  <<ON ODD BYTE BOUNDARY>>      <<U.RAO>>12562000
            BEGIN  <<ADJUST TO WORD BOUNDARY>>                 <<U.RAO>>12564000
            PNTR := " ";                                       <<U.RAO>>12566000
            @PNTR := @PNTR+1;                                  <<U.RAO>>12568000
            LENGTH := LENGTH+1;                                <<U.RAO>>12570000
            END;                                               <<U.RAO>>12572000
      CIS'LINELENSTACK(LINELENSPTR) := LENGTH;                 << I.A >>12574000
         LEFT := LEFT-LENGTH;                                  <<U.RAO>>12576000
         END                                                   <<U.RAO>>12578000
      UNTIL NOT CONTFLG;  <<UNTIL NO MORE CONTINUATIONS>>      <<U.RAO>>12580000
   PNTR := %15;  <<MARK END WITH CR>>                          <<U.RAO>>12582000
   CIS'LINELENSTACK(LINELENSPTR) := 0;  << TERMINATOR >>       << I.A >>12584000
END   <<GETIMAGE>>;                                                     12586000
<<                 *********************                   >>  <<U.RAO>>12588000
<<                 *   PERMITACCESS    *                   >>  <<U.RAO>>12590000
<<                 *********************                   >>  <<U.RAO>>12592000
                                                               <<U.RAO>>12594000
LOGICAL SUBROUTINE PERMITACCESS;                               <<U.RAO>>12596000
BEGIN                                                          <<U.RAO>>12598000
<<THIS SUBROUTINE PROCESSES THE ACCESS MASK PASSED BACK>>      <<U.RAO>>12600000
<<BY COMSEARCH.  TO SEE THE EXPLICIT ASSIGNMENT OF BITS>>      <<U.RAO>>12602000
<<TO RESTRICTIONS AND CAPABILITIES, SEE THE COMMENT TO>>       <<U.RAO>>12604000
<<THAT PROCEDURE.  THIS SUBROUTINE DOES NOTHING OF GREAT>>     <<U.RAO>>12606000
<<DIFFICULTY.  NOTE THAT IT IS ASSUMED THAT THE CALLER>>       <<U.RAO>>12608000
<<WILL COPE WITH ANY DIFFICULTIES ASSOCIATED WITH HANDLING>>   <<U.RAO>>12610000
<<PROGRAMMATIC CALLS, SUCH AS RETURNING ERROR CODES.>>         <<U.RAO>>12612000
IF NOT PROGCALL AND CIS'IFSKIP AND NOT AEXECEVENINIF THEN      << I.A >>12614000
   RETURN;  <<FLUSH, IN NON-EXECUTING BLOCK OF IF COMMAND>>    <<U.RAO>>12616000
IF ACANBREAK THEN <<SET FLAG, SO OUTER BLOCK CAN INITIALIZE>>  <<U.RAO>>12618000
   NONABORTABLE := FALSE  <<ITSELF TO HOLD OFF BREAK>>         <<U.RAO>>12620000
ELSE  <<CAN'T BE BROKEN>>                                      <<U.RAO>>12622000
   NONABORTABLE := TRUE;  <<SORRY FOR THE DOUBLE NEGATIVES>>   <<U.RAO>>12624000
<< THE CHECK FOR NOT REDOABLE HAS BEEN REMOVED FROM >>         <<01455>>12626000
<< PERMITACCESS AND MOVED TO XEQIT.                 >>         <<01455>>12628000
IF ANOTINBREAK THEN  <<CHECK TO SEE IF USER IN BREAK>>         <<U.RAO>>12630000
   BEGIN                                                       <<U.RAO>>12632000
   TOS := 0;  <<RETURN SPACE FOR ABORTREFUSED>>                <<U.RAO>>12634000
   SCAN CIS'BCOMIMAGE UNTIL %6415,1;  << GET WHOLE CMMD LEN >> << I.A >>12636000
   TOS := TOS - @CIS'BCOMIMAGE;  << COMMAND LENGTH >>          << I.A >>12638000
   IF ABORTREFUSED(*) THEN                                     <<U.RAO>>12640000
      BEGIN                                                    <<02366>>12642000
      IF CIS'UDCNESTLEVEL <> 0 THEN                            << I.A >>12644000
         CIS'UDCFATALCIERR  := TRUE;                           << I.A >>12646000
      RETURN;  <<ABORT REFUSED IN BREAK MODE>>                 <<U.RAO>>12648000
      END;                                                     <<02366>>12650000
   END;                                                        <<U.RAO>>12652000
IF PROGCALL AND ANOTINPROG THEN                                <<U.RAO>>12654000
   BEGIN  <<CAN'T BE USED PROGRAMMATICALLY>>                   <<U.RAO>>12656000
   ERRNUM := ERRNOTPROGRAMAT;                                  <<U.RAO>>12658000
   RETURN                                                      <<U.RAO>>12660000
   END;                                                        <<U.RAO>>12662000
IF UDCEXECED AND ANOTINUDC THEN                                <<01455>>12664000
   BEGIN  << NOT ALLOWED IN UDC >>                             <<01455>>12666000
   CIERR( ERRNUM:=NOTINUDC, CIS'BCOMIMAGE );                   << I.A >>12668000
   RETURN                                                      <<01455>>12670000
   END;                                                        <<01455>>12672000
IF ANOTINJOB AND PXGLOB(PXGWFLAGS).(PXGFJOBTYPE) = JOBFLAG THEN<<U.RAO>>12674000
   BEGIN  <<NOT ALLOWED IN JOB>>                               <<U.RAO>>12676000
   CIERR( ERRNUM:=NOTINJOB, CIS'BCOMIMAGE );                   << I.A >>12678000
   RETURN                                                      <<U.RAO>>12680000
   END;                                                        <<U.RAO>>12682000
IF ANOTINSESSION AND PXGLOB(PXGWFLAGS).(PXGFJOBTYPE) =         <<U.RAO>>12684000
      SESSIONFLAG THEN                                         <<U.RAO>>12686000
   BEGIN  <<NOT ALLOWED IN SESSION>>                           <<U.RAO>>12688000
   CIERR( ERRNUM:=NOTINSESSION, CIS'BCOMIMAGE );               << I.A >>12690000
   RETURN                                                      <<U.RAO>>12692000
   END;                                                        <<U.RAO>>12694000
IF FUNNYTERMINAL AND ACAN'TWITHAPL THEN                        <<U.RAO>>12696000
   BEGIN                                                       <<U.RAO>>12698000
   CIERR( ERRNUM:=APLTERM, CIS'BCOMIMAGE(1) );                 << I.A >>12700000
   RETURN                                                      <<U.RAO>>12702000
   END;                                                        <<U.RAO>>12704000
IF CAPCHECK THEN                                               <<U.RAO>>12706000
   BEGIN                                                       <<U.RAO>>12708000
   <<STRATEGY IS TO LOAD USER'S CAP LIST, USE REQUESTED>>      <<U.RAO>>12710000
   <<COMPARISON, SEND USER'S ERROR MESSAGE AS SUPPLIED IN>>    <<U.RAO>>12712000
   <<COMSEARCH.>>                                              <<U.RAO>>12714000
   TOS := CAP0 LAND PXGLOB(PXGWATTRIBUTE);                     <<U.RAO>>12716000
   SETXPXFIXED;                                                <<U.RAO>>12718000
   TOS := CAP1 LAND DBARRAY(X+PXFWRESOURCE);                   <<U.RAO>>12720000
   IF ORCAPCHECK AND TOS=0D OR ANDCAPCHECK AND TOS<>CAP THEN  <<U.RAO>> 12722000
      BEGIN                                                    <<U.RAO>>12724000
      CIERR( ERRNUM:=CAPCHECKERR, CIS'BCOMIMAGE );             << I.A >>12726000
      RETURN                                                   <<U.RAO>>12728000
      END;                                                     <<U.RAO>>12730000
   END;                                                        <<U.RAO>>12732000
IF OPCOMMAND AND NOT MASTEROP THEN                             <<00552>>12734000
BEGIN                                                          <<00552>>12736000
   TOS:=@ALLOWMASK;                                            <<00552>>12738000
   SETJIT;           <<GET USER'S JIT'S DST #>>                <<00552>>12740000
   MOVEFROMDSEG(*,*,JITALLOW,JITALLOW'L);<<GET ALLOW MASK>>    <<00552>>12742000
   IF (ALLOWMASK(OPCOMMANDWRD)&LSL(OPCOMMANDINX))>=0 THEN      <<00552>>12744000
   BEGIN                                                       <<00552>>12746000
      CIERR( ERRNUM:=OPCOMNOTALLOW, CIS'BCOMIMAGE );           << I.A >>12748000
      RETURN;                                                  <<00552>>12750000
   END;                                                        <<00552>>12752000
END;                                                           <<00552>>12754000
   IF SPECIAL'BREAK AND NOT SPECIALBREAK'COM THEN              <<00594>>12756000
   BEGIN                                                       <<00594>>12758000
      CIERR( ERRNUM:=SPECIALCOM, CIS'BCOMIMAGE );              << I.A >>12760000
      RETURN;                                                  <<00594>>12762000
   END; <<COMMAND NOT ALLOWED DURING SPECIAL BREAK>>           <<00594>>12764000
PERMITACCESS := TRUE;                                          <<U.RAO>>12766000
END;  <<SUBROUTINE PERMITACCESS>>                              <<U.RAO>>12768000
                                                                        12770000
<<                 *********************                   >>  <<U.RAO>>12772000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>12774000
<<                 *********************                   >>  <<U.RAO>>12776000
                                                               <<U.RAO>>12778000
                                                               <<03.RO>>12780000
<<The main body of the procedure is really split up into>>     <<03.RO>>12782000
<<two pieces, a part which fires up the job/session and>>      <<03.RO>>12784000
<<a part which iterates, getting commands and sending>>        <<03.RO>>12786000
<<them to the appropriate executor.   Most of the first>>      <<03.RO>>12788000
<<part is done by procedure INITJSMP in NURSERY.>>             <<03.RO>>12790000
<<As a sidelight, it should be noted that this is where the>>  <<03.RO>>12792000
<<WELCOME message is sent to the user.>>                       <<03.RO>>12794000
<<The bulk of the work is done by the second part of the main>><<03.RO>>12796000
<<body.  There are five major sections.  The first four are>>  <<03.RO>>12798000
<<all involved with making sure we get the command image from>><<03.RO>>12800000
<<the right place.  The last one is concerned with trying to>> <<03.RO>>12802000
<<execute the command that was found.  Therefore we will deal>><<03.RO>>12804000
<<with the last section, XEQIT, first.  This block must do >>  <<03.RO>>12806000
<<three things.  First, it calls procedure COMSEARCH to>>      <<03.RO>>12808000
<<decide if this is a valid MPE command.  It is decided>>      <<03.RO>>12810000
<<elsewhere if this is a UDC, so we don't worry about it here.><<03.RO>>12812000
<<Assuming it to be a valid command, we call the executor,>>   <<03.RO>>12814000
<<the plabel of which was returned by COMSEARCH.  >>           <<03.RO>>12816000
<<Finally we must decide where to go next.  If we entered>>    <<03.RO>>12818000
<<from the COMMAND intrinsic we return to the user.  If we>>   <<03.RO>>12820000
<<entered from UDC then we return there.  Otherwise we must>>  <<03.RO>>12822000
<<go back to the user for another command.  The entry >>       <<03.RO>>12824000
<<UDCCI is called from UDC to process the putative MPE>>       <<03.RO>>12826000
<<command found in the UDC being processed.  The primary>>     <<03.RO>>12828000
<<item of interest here is that it provides for the >>         <<03.RO>>12830000
<<possibility that the command being processed is actually>>   <<03.RO>>12832000
<<another UDC (nested).  The entry COMMAND' is the entry>>     <<03.RO>>12834000
<<from the COMMAND intrinsic.  It's primary function is >>     <<03.RO>>12836000
<<to set some flags indicating that we were actually called>>  <<03.RO>>12838000
<<programmatically.  The entry SYSBREAK is called whenever>>   <<03.RO>>12840000
<<the system decides that BREAK has been hit (either the key>> <<03.RO>>12842000
<<or the intrinsic CAUSEBREAK).  Note that it runs on the>>    <<03.RO>>12844000
<<CI stack, not the users stack.  COMMAND' runs on the >>      <<03.RO>>12846000
<<user's stack.  Label NEXT is branched to as the "normal" >>  <<03.RO>>12848000
<<place whenever we are doing the normal CI thing.>>           <<03.RO>>12850000
<<It has three claims to fame.  First it is the code>>         <<03.RO>>12852000
<<which handles the decay of a :CONTINUE.  >>                  <<03.RO>>12854000
<<Second it is the origination of the call to UDC.>>           <<03.RO>>12856000
<<Third it is the only place where GETIMAGE is called.>>       <<03.RO>>12858000
                                                               <<03.RO>>12860000
PUSH(STATUS);                                                  <<02.EB>>12862000
TOS.(2:1) := 0; << TURN OFF TRAPS >>                           <<02.EB>>12864000
SET(STATUS);                                                   <<02.EB>>12866000
CIS'UDCSPACE:= 0;   MOVE CIS'UDCSPACE(1) := CIS'UDCSPACE,(4);  << I.A >>12868000
INITJSMP(EXPCODE);                                             <<02.EB>>12870000
CIS'IFNESTING := CIS'IFSKIP := CIS'ELSESEEN := 0;              << I.A >>12872000
CIS'CIFLAGS := CIS'PENDINGCOMLEN := 0;                         << I.A >>12874000
CIS'CONTINUSTATESTK := 0D;                                     << I.A >>12876000
CIS'LINELENSTACK := 0;                                         << I.A >>12878000
MOVE CIS'LINELENSTACK(1)                                       << I.A >>12880000
   := CIS'LINELENSTACK, (CIS'MAXCONTLINES);                    << I.A >>12882000
CIS'NUMBLANKS := 0;                                            << I.A >>12884000
SPECIAL'BREAK:=FALSE;                                          <<00594>>12886000
IOERRCOUNT := 0;  <<INITIALIZE IO ERROR COUNTER>>              <<03.RO>>12888000
@CIS'BCOMIMAGE := @CIS'WCOMIMAGE&LSL(1); << INIT POINTER >>    << I.A >>12890000
@CIS'BLASTCOMIMAGE := @CIS'LASTCOMIMAGE&LSL(1);                << I.A >>12892000
CIS'BCOMIMAGE := CIS'BLASTCOMIMAGE := %15; <<FOR INITIAL REDO>><< I.A >>12894000
                                                               <<06.EB>>12896000
   << PREVENT BREAK IN EVENT OF (RUN)USER.ACCT OR A >>         <<08.EB>>12898000
   << OPTION LOGON UDC THAT RUNS A PROGRAM          >>         <<08.EB>>12900000
SETXPXGLOB;                                                    <<08.EB>>12902000
@PXGLOB := X;                                                  <<08.EB>>12904000
@JFLAGS := X +PXGWFLAGS;                                       <<08.EB>>12906000
                                                               <<00850>>12908000
   << HANDLE (CMD)USER.ACCT LOGON & APL CHAR SET >>            <<00850>>12910000
INSTANTLOGON;                                                  <<00850>>12912000
IF APLTERMTYPE <> 0 THEN                                       <<00850>>12914000
BEGIN                                                          <<00850>>12916000
   COMMANDPASSED := TRUE;                                      <<00850>>12918000
   IF APLTERMTYPE <> 1 THEN  <<NON-ASCII CHARACTERS>>          <<00850>>12920000
      FUNNYTERMINAL := TRUE                                    <<00850>>12922000
   ELSE   <<ASCII TERMINAL, JUST A SPECIAL LOGON>>             <<00850>>12924000
      APLTERMTYPE := 0;  <<CLEAR.  HENCEFORTH THIS>>           <<00850>>12926000
   <<FIELD JUST INDICATES WHICH APL TERMINAL IS IN USE>>       <<00850>>12928000
END;                                                           <<00850>>12930000
   << RESOLVE WELCOME MESSAGE >>                               <<00850>>12932000
X := ABSOLUTE(WELCOMEDST);                                     <<00850>>12934000
IF > THEN WELCOMEMES(X,PASSEDCOMMAND);                         <<00850>>12936000
                                                               <<00850>>12938000
                                                               <<02848>>12940000
IF GET'DSDEVICE( PXGLOB(3).(8:8) ) = 3 THEN                    <<02848>>12942000
                                                               <<02848>>12944000
      << Job/session $STDIN device is a DS pseudo terminal,  >><<02848>>12946000
      << so this is a slave session.  Perform the appropriate>><<02848>>12948000
      << DS initialization by calling the CXRFA procedure    >><<02848>>12950000
      << (in the DSSEG4 segment) with a fake "RFA" command.  >><<02848>>12952000
                                                               <<02848>>12954000
   BEGIN                                                       <<02848>>12956000
   CIS'WCOMIMAGE(0) := "RF";                                   << I.A >>12958000
   CIS'WCOMIMAGE(1) := "A ";                                   << I.A >>12960000
   CIS'WCOMIMAGE(2) := %27;                                    << I.A >>12962000
   CXRFAD(CIS'BCOMIMAGE(3) <<after RFA parsed>>                << I.A >>12964000
         , ERRNUM, PARMNUM);                                   << I.A >>12966000
   END;                                                        <<02848>>12968000
IF INTERACTF THEN << JFLAGS INDICATES SESSION >>               <<08.EB>>12970000
BEGIN                                                          <<08.EB>>12972000
   ATTACHIO(PXGLOB(3).(8:8),0,0,0,28,0,0,0,1);                 <<08.EB>>12974000
     <<QUIESCE I/O BEFORE BREAK DISALLOWED>>                   <<08.EB>>12976000
   SETSERVICE(TRUE);  <<DISABLE CI BREAK>>                     <<08.EB>>12978000
   ATTACHIO(PXGLOB(4).(8:8),0,0,0,25,0,%320,0,1);              <<08.EB>>12980000
     <<CLEAR BREAK FLAGS IN LDT IF SET>>                       <<08.EB>>12982000
END;                                                           <<08.EB>>12984000
TOS:=ABSOLUTE(SYSUDCFLAG);  <<GET SYSTEM LEVEL UDC FLAG>>      <<00416>>12986000
SETXPXFIXED;                                                   <<06.EB>>12988000
X:=X+PXFUDC;                                                   <<00416>>12990000
TOS:=TOS LOR DBARRAY(X).(0:1) LOR DBARRAY(X).(7:1);            <<00416>>12992000
IF TOS THEN INITUDC(FALSE); <<INIT UDC'S IF THEY EXIST>>       <<00416>>12994000
                                                               <<00416>>12996000
   << PXGLOB MUST BE SET AFTER INITUDC. PXFILE EXPANSION >>    <<06.EB>>12998000
SETXPXGLOB;                                                    <<02.EB>>13000000
@PXGLOB := X;                                                  <<02.EB>>13002000
@JFLAGS := X + PXGWFLAGS;                                      <<03.EB>>13004000
                                                               <<11.EB>>13006000
   << TURN BREAK OFF AGAIN IN CASE BREAK OCCURRED          >>  <<11.EB>>13008000
   << DURING LOGON UDC.                                    >>  <<11.EB>>13010000
IF CIS'UDC0 <> 0 AND INTERACTF THEN                            << I.A >>13012000
BEGIN                                                          <<11.EB>>13014000
   ATTACHIO(PXGLOB(3).(8:8),0,0,0,28,0,0,0,1);                 <<11.EB>>13016000
     <<QUIESCE I/O BEFORE BREAK DISALLOWED>>                   <<11.EB>>13018000
   ATTACHIO(PXGLOB(4).(8:8),0,0,0,25,0,%320,0,1);              <<11.EB>>13020000
     <<CLEAR BREAK FLAGS IN LDT IF SET>>                       <<11.EB>>13022000
END;                                                           <<11.EB>>13024000
                                                               <<02.EB>>13026000
<<NEXT SET A FLAG WHICH INDICATES IF SEQUENCED RECORDS ARE>>   <<01.RO>>13028000
<<EXPECTED.  THIS COMES FROM THE JMAT, SET BY SPOOLING, AND>>  <<01.RO>>13030000
<<CAUSES THE LAST 8 BYTES TO BE STRIPPED FROM EACH JOB RECORD>><<01.RO>>13032000
<<BEFORE INTERPRETATION.  THIS IS ONLY VALID FOR JOBS.>>       <<01.RO>>13034000
IF NOT INTERACTF THEN                                          <<01.RO>>13036000
   BEGIN                                                       <<01.RO>>13038000
   TOS := 0;  <<RETURN SPACE FOR MOVE FROM JMAT>>              <<01.RO>>13040000
   MOVEFROMDSEG(@S0, JMATDST,                                  <<01.RO>>13042000
      PXGLOB(PXGWJMATX).(0:8)*JMATLEN+JMATSEQUENCE,  1);       <<01.RO>>13044000
   TOS := TOS.(2:1);  <<EXTRACT FLAG FROM JMAT WORD>>          <<01.RO>>13046000
   CIS'SEQUENCED := TOS;  << STORE FLAG IN CI STACK >>         << I.A >>13048000
   END;                                                        <<01.RO>>13050000
                                                               <<01.RO>>13052000
      @CIS'BCOMIMAGE := @CIS'WCOMIMAGE&LSL(1);                 << I.A >>13054000
      IF COMMANDPASSED THEN  <<FAKE OUT CI GETIMAGE ROUTINE>> <<A00.04>>13056000
         BEGIN <<SEE PROCEDURE CIFINISH IN SUBSYSTEM SECTION>><<A00.04>>13058000
         IF NOT CILOGTABLE(1,PXGLOB(3).(0:8)*JMATLEN,LENGTH,   <<02.EB>>13060000
            CIS'WCOMIMAGE) THEN SUDDENDEATH(509);              << I.A >>13062000
         CIS'PENDINGCOMLEN := LENGTH.(2:14); <<PASSED COMD>>   << I.A >>13064000
         IF = THEN TERMINATE;  <<NO COMMAND PASSED>>          <<A00.04>>13066000
         END;                                                 <<A00.04>>13068000
<< GET RECORD SIZE OF STDLIST FOR USE IN SUBR. ECHO >>         <<00419>>13070000
FGETINFO(2,,,,STDLISTLENB);                                    <<00419>>13072000
STDLISTLENB := -STDLISTLENB;  << CONVERT LEN FROM - TO + >>    <<00419>>13074000
<< CONVERT LENGTH TO EVEN NUMBER <= ACTUAL LENGTH >>           <<00419>>13076000
STDLISTLENB.(15:1) := 0;                                       <<00419>>13078000
STDLISTLENW := STDLISTLENB/2;                                  <<00419>>13080000
      GO TO NEXT;                                                       13082000
                                                                        13084000
                                                                        13086000
<<             **********************               >>         <<U.RAO>>13088000
<<             *   ENTRY UDCCI      *               >>         <<U.RAO>>13090000
<<             **********************               >>         <<U.RAO>>13092000
                                                               <<U.RAO>>13094000
UDCCI:                                                         <<03.EB>>13096000
   IF ABSOLUTE(ABSOLUTE(CPCB)).(15:1)=1 THEN <<SPEC BRK>>      <<01549>>13098000
   BEGIN                                                       <<00831>>13100000
      SPECIAL'BREAK:=TRUE;                                     <<00831>>13102000
      SETSERVICE(0);  <<CLEAR BREAK IN LPDT, NOT REAL BREAK>>  <<00831>>13104000
   END                                                         <<00831>>13106000
   ELSE SPECIAL'BREAK:=FALSE;                                  <<00831>>13108000
      CIS'UDCFATALCIERR := FALSE;  << STOP FLUSHING UDC >>     << I.A >>13110000
      CIS'UDCBREAKDETECTED := FALSE;                           << I.A >>13112000
      CIS'UDCFLUSH := FALSE;                                   << I.A >>13114000
      TOS := 0; << FOR ZSIZE RETURN >>                         <<03.EB>>13116000
      PUSH(S);                                                 <<03.EB>>13118000
      TOS := S0 - (INTEGER( CIS'UDC1 )); << TOTAL UDC STACK >> << I.A >>13120000
      IF > THEN                                                <<03.EB>>13122000
      BEGIN << NEED MORE >>                                    <<03.EB>>13124000
         TOS := TOS + TOS; << NEEDS FOR ANOTHER CALL >>        <<03.EB>>13126000
         TOS := ZSIZE(*);                                      <<03.EB>>13128000
         IF > THEN                                             <<03.EB>>13130000
         BEGIN                                                 <<03.EB>>13132000
            CIERR(ERRNUM := UDCSTACKOVRFLOW);                  <<04787>>13134000
            RETURN;                                            <<03.EB>>13136000
         END;                                                  <<03.EB>>13138000
         PUSH(S);  CIS'UDC1 := TOS;  << SAVE CURRENT S AGAIN >><< I.A >>13140000
         DEL;<<TRICK:USED TO MAKE S SAME AS WHEN S PUSHED>>    <<03.EB>>13142000
      END                                                      <<03.EB>>13144000
      ELSE ASSEMBLE(DDEL); << POP 0 & SIZE >>                  <<03.EB>>13146000
      IF CIS'CONTSTATE >= 1 THEN << CONTINUE IN EFFECT >>      << I.A >>13148000
         IF = THEN  <<JUST SAW IT>>                            <<08.RO>>13150000
            CIS'CONTSTATE := 2                                 << I.A >>13152000
         ELSE  <<JUST EXECUTED NON-:CONTINUE, >>               <<08.RO>>13154000
            CIS'CONTSTATE := 0;  << CLEAR THE CONDITION >>     << I.A >>13156000
      << IF RFA CALLED FROM WITHIN UDC BODY BYPASS IT >>       <<01100>>13158000
      IF CIS'BCOMIMAGE <> "RFA " THEN                          << I.A >>13160000
         IF UDC( CIS'BCOMIMAGE, EXPCODE ) THEN                 << I.A >>13162000
            RETURN; << UDC NEST ? >>                           <<01100>>13164000
      UDCEXECED := TRUE;                                       <<03.EB>>13166000
      SETXPXGLOB;                                              <<03.EB>>13168000
      @PXGLOB := X;                                            <<03.EB>>13170000
      @JFLAGS := X +PXGWFLAGS;                                 <<03.EB>>13172000
      IF INTERACTF THEN << JFLAGS INDICATES SESSION >>         <<00451>>13174000
      BEGIN                                                    <<00451>>13176000
         ATTACHIO(PXGLOB(3).(8:8),0,0,0,28,0,0,0,1);           <<00451>>13178000
           <<QUIESCE I/O BEFORE BREAK DISALLOWED>>             <<00451>>13180000
         SETSERVICE(TRUE);  <<DISABLE CI BREAK>>               <<00451>>13182000
         ATTACHIO(PXGLOB(4).(8:8),0,0,0,25,0,%320,0,1);        <<00451>>13184000
           <<CLEAR BREAK FLUSH FLAG IN DIT IF SET>>            <<00451>>13186000
      END;                                                     <<00451>>13188000
      TOS := 0; <<RETURN SPACE FOR COMSEARCH>>                 <<U.RAO>>13190000
      TOS := @CIS'BCOMIMAGE;                                   << I.A >>13192000
      ASSEMBLE(DUP,DDUP);                                      <<03.EB>>13194000
      IF BPS0 = ALPHA                                          <<00184>>13196000
        THEN MOVE * := * WHILE AS,0                            <<00184>>13198000
        ELSE MOVE * := * WHILE ANS,0;                          <<00184>>13200000
      @PARMSP := TOS; << PARM PTR >>                           <<03.EB>>13202000
      ASSEMBLE(XCH,SUB); << LENGTH >>                          <<03.EB>>13204000
      GO XEQIT;                                                <<03.EB>>13206000
                                                               <<03.EB>>13208000
                                                               <<03.EB>>13210000
<<             **********************               >>         <<U.RAO>>13212000
<<             *   ENTRY COMMAND'   *               >>         <<U.RAO>>13214000
<<             **********************               >>         <<U.RAO>>13216000
                                                               <<U.RAO>>13218000
COMMAND':                                                               13220000
      SPECIAL'BREAK:=FALSE;                                    <<00594>>13222000
      PROGCALL := TRUE;                                                 13224000
      SETXPXGLOB;                                                       13226000
      @PXGLOB := X;                                                     13228000
      X := X + PXGWFLAGS;                                               13230000
      @JFLAGS := X;                                                     13232000
    << CHECK FOR CR AT END OF COMMAND IMAGE >>                 <<00257>>13234000
      TOS := @COMARRAY;      << SAVE VALUE >>                  <<00257>>13236000
      ASSEMBLE(DUP);                                           <<00257>>13238000
      << NOTE: COMARRAY IS LOCATED AT Q-10 AND IS THE >>       <<00257>>13240000
      << FIRST PARAMETER STACKED FROM THE 'COMMAND' CALL >>    <<00257>>13242000
      @COMARRAY := CR'CR;  << STOPPER IN CASE OF MISSING CR >> <<00257>>13244000
      SCAN * UNTIL CR'CR,1; << GET BYTE ADDR OF CR >>          <<00257>>13246000
      << CHECK IF SCAN STOP ADDR = STOPPER ADDR >>             <<00257>>13248000
      IF TOS = @LCOMARRAY&LSL(1) THEN                          <<00257>>13250000
         BEGIN                                                 <<00257>>13252000
         ERRPARM := ERRMISSINGCR;                              <<00257>>13254000
         CCC := CCG;                                           <<00257>>13256000
         RETURN 0;                                             <<00257>>13258000
         END;                                                  <<00257>>13260000
      @COMARRAY := TOS;      << RESTORE VALUE >>               <<00257>>13262000
      TOS := 0;  <<RETURN SPACE FOR COMSEARCH>>                <<U.RAO>>13264000
      TOS := @COMARRAY;                                                 13266000
      ASSEMBLE(DUP,DDUP);                                               13268000
      MOVE * := * WHILE AS, 0;                                          13270000
      @PARMSP := TOS;                                                   13272000
      ASSEMBLE(XCH,SUB);                                                13274000
      GO TO XEQIT;                                                      13276000
                                                                        13278000
                                                                        13280000
<<             **********************               >>         <<U.RAO>>13282000
<<             *   ENTRY SYSBREAK   *               >>         <<U.RAO>>13284000
<<             **********************               >>         <<U.RAO>>13286000
                                                               <<U.RAO>>13288000
SYSBREAK:                                                               13290000
   COMMENT:  IF A SON PROCESS HAS ENABLED BREAK IN  A          <<00851>>13292000
      NOBREAK UDC, IGNORE BREAK AND RETURN--TEMPORARY KLUDGE   <<01279>>13294000
      DOES NOT HANDLE DS--SHOULD BE FIXED;                     <<01279>>13296000
   OLDCRITICAL := SETCRITICAL;                                 <<04169>>13298000
   IF CIS'UDCNOBREAKOPT THEN                                   << I.A >>13300000
      BEGIN                                                    <<00851>>13302000
      FBREAK;                                                  <<01279>>13304000
      SETXPXGLOB; @PXGLOB := X;                                <<01279>>13306000
      CLEAN'TERMINAL'STATE(FALSE); << CLEAR FLUSH FLAGS >>     <<00851>>13308000
      FCONTROL(1,DISABLEBREAK,DUMMY);                          <<01455>>13310000
      FUNBREAK (FALSE);                                        <<01279>>13312000
      RESETCRITICAL(OLDCRITICAL);                              <<04169>>13314000
      RETURN 0;                                                <<00851>>13316000
      END;                                                     <<00851>>13318000
   IF ABSOLUTE(ABSOLUTE(CPCB)).(15:1)=1 THEN <<SPEC BRK>>      <<01549>>13320000
   BEGIN                                                       <<00594>>13322000
      SPECIAL'BREAK:=TRUE;                                     <<00594>>13324000
      SETSERVICE(0); <<CLEAR BREAK FLAG IN LPDT...NOT REAL BREA<<00594>>13326000
   END                                                         <<00594>>13328000
   ELSE SPECIAL'BREAK:=FALSE;                                  <<00594>>13330000
      SETXPXFIXED + PXFWBREAK;                                          13332000
      DBARRAY(X) := -1;                                                 13334000
      SETXPXGLOB;                                                       13336000
      @PXGLOB := X;                                                     13338000
      X := X + PXGWFLAGS;                                               13340000
      @JFLAGS := X;                                                     13342000
      FBREAK;                                                           13344000
      RESETCRITICAL(OLDCRITICAL);                              <<04169>>13346000
      IF LPDT(PXGLOB(3).(8:8)&LSL(1)+1).(7:3)=1 THEN           <<00540>>13348000
         HARDEOF'THEN'BRK:=TRUE; <<BREAK HIT AFTER :EOF:>>     <<00540>>13350000
                                                               <<00835>>13352000
      << SAVE UDC AND IF NESTING GLOBALS >>                    <<00835>>13354000
      SAVE'UDC3            := CIS'UDC3;                        << I.A >>13356000
      SAVE'UDC4            := CIS'UDC4;                        << I.A >>13358000
      SAVE'IFNESTING       := CIS'IFNESTING;                   << I.A >>13360000
      SAVE'IFSKIP          := CIS'IFSKIP;                      << I.A >>13362000
      SAVE'ELSESEEN        := CIS'ELSESEEN;                    << I.A >>13364000
      SAVE'CONTINUSTATESTK := CIS'CONTINUSTATESTK;             << I.A >>13366000
                                                               <<00835>>13368000
      << RESET UDC AND IF NESTING GLOBALS FOR BREAK >>         <<00835>>13370000
      CIS'UDC3 := CIS'UDC4 := CIS'IFNESTING                    << I.A >>13372000
               := CIS'IFSKIP := CIS'ELSESEEN    := 0;          << I.A >>13374000
      CIS'CONTINUSTATESTK := 0D;                               << I.A >>13376000
                                                                        13378000
<<             **********************               >>         <<U.RAO>>13380000
<<             *      NEXT          *               >>         <<U.RAO>>13382000
<<             **********************               >>         <<U.RAO>>13384000
                                                               <<U.RAO>>13386000
NEXT:                                                                   13388000
   IF COMMANDEXECED THEN TERMINATE; <<HAVE DONE PASSED COMMAND<<A00.04>>13390000
   IF UDCEXECED THEN RETURN; << UDC CALL >>                    <<03.EB>>13392000
   IF CIS'UDCEXITBREAK THEN                                    << I.A >>13394000
   BEGIN << ABORT FLAG SET >>                                           13396000
      CIS'UDCEXITBREAK := FALSE;                               << I.A >>13398000
      IF SPECIAL'BREAK THEN SETSERVICE(0);                     <<00835>>13400000
                                                               <<00835>>13402000
      << RESTORE UDC AND IF NESTING GLOBALS TO SAVED VALUES >> <<00835>>13404000
      CIS'UDC3             := SAVE'UDC3;                       << I.A >>13406000
      CIS'UDC4             := SAVE'UDC4;                       << I.A >>13408000
      CIS'IFNESTING        := SAVE'IFNESTING;                  << I.A >>13410000
      CIS'IFSKIP           := SAVE'IFSKIP;                     << I.A >>13412000
      CIS'ELSESEEN         := SAVE'ELSESEEN;                   << I.A >>13414000
      CIS'CONTINUSTATESTK  := SAVE'CONTINUSTATESTK;            << I.A >>13416000
                                                               <<00835>>13418000
      RETURN 0;                                                         13420000
   END;                                                                 13422000
   PUSH(S);                                                    <<03.EB>>13424000
   CIS'UDC1 := TOS;    << SAVE CURRENT "S" >>                  << I.A >>13426000
   IF CIS'CONTSTATE >= 1 THEN << CONTINUE IN EFFECT  >>        << I.A >>13428000
      IF = THEN                                                <<U.RAO>>13430000
         CIS'CONTSTATE := 2   << CONTINUE JUST READ  >>        << I.A >>13432000
      ELSE  <<JUST EXECUTED NON-:CONTINUE>>                    <<U.RAO>>13434000
         CIS'CONTSTATE := 0;  << CLEAR CONTINUE FLAG >>        << I.A >>13436000
   GETIMAGE;                                                            13438000
   << BYPASS UDC SEARCH IF COMMAND NAME IS RFA >>              <<01100>>13440000
   IF CIS'UDC0 <> 0 AND CIS'BCOMIMAGE <> "RFA " THEN           << I.A >>13442000
      IF UDC( CIS'BCOMIMAGE, 0 ) THEN                          << I.A >>13444000
         GO NEXT;                                              <<01100>>13446000
   TOS := 0;  <<RETURN SPACE FOR COMSEARCH>>                   <<U.RAO>>13448000
   TOS := @CIS'BCOMIMAGE;  << ADDRESS OF COMMAND NAME >>       << I.A >>13450000
   TOS := COMLEN;                                                       13452000
                                                                        13454000
                                                                        13456000
<<             **********************               >>         <<U.RAO>>13458000
<<             *      XEQIT         *               >>         <<U.RAO>>13460000
<<             **********************               >>         <<U.RAO>>13462000
                                                               <<U.RAO>>13464000
XEQIT:                                                                  13466000
   ERRNUM := 0;                                                <<U.RAO>>13468000
   PARMNUM := APLTERMTYPE;  <<0 UNLESS (APL) COMMAND>>         <<U.RAO>>13470000
   DUMMY := COMSEARCH(*,*,CAP,ACCESS,EXECPLABEL,CAPCHECKERR);  <<01455>>13472000
                                                               <<01455>>13474000
   << IF REDO ALLOWED, MOVE IMAGE INTO REDO BUFFER. >>         <<01455>>13476000
   IF NOT PROGCALL AND NOT UDCEXECED AND                       <<01455>>13478000
      NOT ( DUMMY LAND ANOTREDOABLE ) THEN                     <<01455>>13480000
      MOVE CIS'LASTCOMIMAGE                                    << I.A >>13482000
               := CIS'WCOMIMAGE, (CIS'WCOMBUFLEN);             << I.A >>13484000
                                                               <<01455>>13486000
   IF NOT DUMMY THEN     << UNKNOWN COMMAND >>                 <<01455>>13488000
      IF PROGCALL THEN                                         <<U.RAO>>13490000
         BEGIN   <<NO SUCH COMMAND AND PROGRAMMATIC>>          <<U.RAO>>13492000
         CCC := CCL;                                           <<U.RAO>>13494000
         ERRPARM := ERRUNDEF;                                  <<U.RAO>>13496000
         END                                                   <<U.RAO>>13498000
      ELSE                                                     <<U.RAO>>13500000
         BEGIN                                                 <<00856>>13502000
         IF NOT CIS'IFSKIP THEN                                << I.A >>13504000
            CIERR(ERRNUM := ERRUNDEF, CIS'BCOMIMAGE)           <<04787>>13506000
         END                                                   <<00856>>13508000
   ELSE  <<IS VALID COMMAND, TRY TO EXECUTE IT>>               <<U.RAO>>13510000
      IF PERMITACCESS THEN                                     <<U.RAO>>13512000
         BEGIN  <<LEGAL FOR THIS USER, IN THIS CASE>>          <<U.RAO>>13514000
         TOS := @PARMSP;                                       <<U.RAO>>13516000
         TOS := @ERRNUM;                                       <<U.RAO>>13518000
         TOS := @PARMNUM;                                      <<U.RAO>>13520000
         TOS := EXECPLABEL;                                    <<U.RAO>>13522000
         SETSERVICE(NONABORTABLE);  <<SET BREAK STATUS>>       <<U.RAO>>13524000
         ASSEMBLE(PCAL 0);                                     <<U.RAO>>13526000
                                                               <<04710>>13528000
      << Check here if the CI is left holding a SIR.  This >>  <<04710>>13530000
      << should never be the case.  Note that this check   >>  <<04710>>13532000
      << is encoded in a low level to minimize the         >>  <<04710>>13534000
      << disturbance to the stack (in case we want to      >>  <<04710>>13536000
      << crash).  What is being done, here, is to get the  >>  <<04710>>13538000
      << address of the first word of the CI's PCB entry   >>  <<04710>>13540000
      << by using the CPCB pointer in low core.  This word >>  <<04710>>13542000
      << contains the HASSIR pointer.                      >>  <<04710>>13544000
         IF ABSOLUTE( ABSOLUTE(CPCB) ).HASSIR                  <<04710>>13546000
            THEN SUDDENDEATH(315);                             <<04710>>13548000
                                                               <<04710>>13550000
         IF NOT PROGCALL AND NOT NONABORTABLE AND              <<U.RAO>>13552000
            CIS'UDCNESTLEVEL <> 0 AND REQUESTSERVICE THEN      << I.A >>13554000
            CIS'UDCBREAKDETECTED := TRUE;                      << I.A >>13556000
         IF PROGCALL THEN  <<MUST SET CONDITION CODE>>         <<U.RAO>>13558000
            IF ERRNUM = 0 THEN                                 <<00525>>13560000
               CCC := CCE   <<SUCCESSFUL COMMAND>>             <<U.RAO>>13562000
            ELSE   <<COMMAND FAILED, RETURN CODES>>            <<U.RAO>>13564000
               BEGIN                                           <<U.RAO>>13566000
               ERRPARM := ERRNUM;                              <<U.RAO>>13568000
               PARMPARM := PARMNUM;                            <<U.RAO>>13570000
               CCC := CCG;                                     <<U.RAO>>13572000
               END;                                            <<U.RAO>>13574000
         END                                                   <<U.RAO>>13576000
      ELSE   <<PERMITACCESS FAILED>>                           <<U.RAO>>13578000
         IF PROGCALL THEN                                      <<U.RAO>>13580000
            BEGIN                                              <<U.RAO>>13582000
            ERRPARM := ERRNUM;                                 <<U.RAO>>13584000
            CCC := CCG;                                        <<U.RAO>>13586000
            END;                                               <<U.RAO>>13588000
IF PROGCALL THEN RETURN 0;   <<NO PARAMETERS>>                 <<U.RAO>>13590000
GO TO NEXT;     <<LOOP>>                                       <<U.RAO>>13592000
END  <<COMMANDINTERP>>;                                                 13594000
PROCEDURE HELP; OPTION EXTERNAL;                               <<03.EB>>13596000
PROCEDURE COMMAND(COMIMAGE,ERROR,PARM);                                 13598000
   BYTE ARRAY COMIMAGE;                                                 13600000
   INTEGER ERROR,PARM;                                                  13602000
BEGIN                                                                   13604000
   ERRORON;                                                             13606000
   CHEK([10/68,6/3],3,%53D);                                            13608000
   ERROR := PARM := 0;  <<INITIALIZE RETURN VALUES>>          <<A01.01>>13610000
   COMMAND'(*);                                                         13612000
   ERROREXIT([10/68,6/3],0,0);                                          13614000
END;    <<COMMAND>>                                                     13616000
$CONTROL SEGMENT=MAIN                                                   13618000
END.                                                                    13620000
