                                                                        00020000
$CONTROL USLINIT,CODE,MAP                                      <<01549>>00030000
<< CIMAIN of the Command Interpreter.   Module 5B >>           <<04849>>00040000
<< HP32002C MPE SOURCE C.00.00 >>                                       00050000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00060000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00070000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00080000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00090000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00100000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00110000
$THIRTY                                                                 00120000
$TITLE "IMS"                                                            00130000
                                                               <<04710>>00140000
<<*********************************************************>>  <<04710>>00150000
<<                                                         >>  <<04710>>00160000
<<              CIMAIN  --  Module 5B                      >>  <<04710>>00170000
<<                                                         >>  <<04710>>00180000
<<*********************************************************>>  <<04710>>00190000
                                                               <<04710>>00200000
                                                               <<04710>>00210000
                                                               <<04710>>00220000
<<*************************************************************<<U.RAO>>00230000
<<*****************  Command Interpreter IMS  *****************<<U.RAO>>00240000
<<*************************************************************<<U.RAO>>00250000
<<                                                             <<U.RAO>>00260000
<<*************************************************************<<U.RAO>>00270000
<<************************  OVERVIEW  *************************<<U.RAO>>00280000
<<*************************************************************<<U.RAO>>00290000
<<                                                             <<U.RAO>>00300000
<<WHO:                                                         <<U.RAO>>00310000
<<   Larry Birenbaum designed the basic structures of the      <<U.RAO>>00320000
<<Command Interpreter for VERSION A of MPE.  Work was begun in <<U.RAO>>00330000
<<1970 or 1971.                                                <<U.RAO>>00340000
<<   Bob Olson substantially redesigned the parsers of the     <<U.RAO>>00350000
<<Command Interpreter for VERSION B of MPE II.  Work was begun <<U.RAO>>00360000
<<in November 1976 and completed in late 1977.  The basic      <<U.RAO>>00370000
<<algorithms for executing the commands remained essentially   <<U.RAO>>00380000
<<the same even though the parsers were rewritten.  Several    <<U.RAO>>00390000
<<new commands were added at this time, as were User Defined   <<U.RAO>>00400000
<<Commands.                                                    <<U.RAO>>00410000
<<   Other people who have added commands or modified existing <<U.RAO>>00420000
<<commands for MPE IIB are Ron Hoyt and Bob Vannucci (Private  <<U.RAO>>00430000
<<Volumes, including modification of the accounting commands   <<U.RAO>>00440000
<<and STORE/RESTORE), Neal Mack (Transaction Logging user      <<U.RAO>>00450000
<<commands), Mike Philben (revision of DS commands), Ed Basart <<U.RAO>>00460000
<<(revision of HELLO, JOB, and DATA and the addition of User   <<U.RAO>>00470000
<<Defined Commands), and Bob Gerstmeyer (CLINE command).       <<U.RAO>>00480000
<<                                                             <<U.RAO>>00490000
<<WHERE:                                                       <<U.RAO>>00500000
<<   Pieces of the Command Interpreter are scattered all over  <<U.RAO>>00510000
<<the system.  This module contains the bulk of the executors. <<U.RAO>>00520000
<<The spooling commands (SHOWJOB, SHOWOUT, STREAM, and SHOWIN) <<U.RAO>>00530000
<<may be found in the SPOOLCOMS module.  The DS commands       <<U.RAO>>00540000
<<(RFA, DSLINE, REMOTE) will be found in the DS code.  STORE   <<U.RAO>>00550000
<<and RESTORE have a module of their own.  The bulk of the work<<U.RAO>>00560000
<<for User Defined Commands is done in a module called UDC.    <<U.RAO>>00570000
<<HELP resides in module HELPUSER.  JOB, HELLO and DATA are    <<U.RAO>>00580000
<<parsed by code in module NURSERY.  In general, it is better  <<U.RAO>>00590000
<<to put the executors in the same module as the routines which<<U.RAO>>00600000
<<do the work.  This will reduce confusion and simplify        <<U.RAO>>00610000
<<maintenance.  There is no inherent benefit to accumulating   <<U.RAO>>00620000
<<executors in common segments, assuming that there is         <<U.RAO>>00630000
<<non-trivial work to do.                                      <<U.RAO>>00640000
<<                                                             <<U.RAO>>00650000
<<WHY:                                                         <<U.RAO>>00660000
<<   The purpose served by the Command Interpreter is to       <<U.RAO>>00670000
<<provide the user access to the operating system functions    <<U.RAO>>00680000
<<without requiring him/her to go through the irritation of    <<U.RAO>>00690000
<<writing a program to do so.  There are three primary function<<U.RAO>>00700000
<<provided by the commands.  Most important is the ability to  <<U.RAO>>00710000
<<execute programs, evidenced by the RUN command and the variou<<U.RAO>>00720000
<<compiler commands.  Second is the ability to manage one's    <<U.RAO>>00730000
<<resources, such as files.  Finally there are a large number o<<U.RAO>>00740000
<<utility functions, primarily for status checking.  When a new<<U.RAO>>00750000
<<capability is added to the system, the user should be given  <<U.RAO>>00760000
<<commands which allow him to manipulate the capability and to <<U.RAO>>00770000
<<determine the status of the new resource created by the      <<U.RAO>>00780000
<<capability.                                                  <<U.RAO>>00790000
<<                                                             <<U.RAO>>00800000
$PAGE                                                                   00810000
<<*************************************************************<<U.RAO>>00820000
<<****************  ADDING A COMMAND TO THE CI  ***************<<U.RAO>>00830000
<<*************************************************************<<U.RAO>>00840000
<<                                                             <<U.RAO>>00850000
<<Step 1:  Designing the command.                              <<U.RAO>>00860000
<<   A reasonable and parseable command syntax is one of the   <<U.RAO>>00870000
<<important parts of designing a good command.  Your goal is   <<U.RAO>>00880000
<<to minimize user irritation when using the command.  Always  <<U.RAO>>00890000
<<remember that for most users the problem for which they are  <<U.RAO>>00900000
<<using a computer is probably solved within an application    <<U.RAO>>00910000
<<program of some sort and the Command Interpreter in general  <<U.RAO>>00920000
<<and your command in particular are necessary annoyances.     <<U.RAO>>00930000
<<You must strive to limit that annoyance to the unavoidable.  <<U.RAO>>00940000
<<   Unfortunately, there are a wide variety of ways in which  <<U.RAO>>00950000
<<you can annoy people.  Some of the solutions are mutually    <<U.RAO>>00960000
<<incompatible.  The following is a list of the issues you     <<U.RAO>>00970000
<<should consider.                                             <<U.RAO>>00980000
<<   1)  Verbose versus terse command names                    <<U.RAO>>00990000
<<       In general it is desireable to have command names     <<U.RAO>>01000000
<<       which accurately reflect the function of the          <<U.RAO>>01010000
<<       command.  The tradeoff is that verbose command        <<U.RAO>>01020000
<<       names which describe the command are easier to        <<U.RAO>>01030000
<<       pick out in documentation whereas terse names are     <<U.RAO>>01040000
<<       easier to type.  Thus the deciding factor should      <<U.RAO>>01050000
<<       be how often the user will use the command.  A        <<U.RAO>>01060000
<<       side consideration is that the use of archaic         <<U.RAO>>01070000
<<       English or bizarre abbreviations will work a          <<U.RAO>>01080000
<<       hardship on our users who are not native English      <<U.RAO>>01090000
<<       speakers.                                             <<U.RAO>>01100000
<<   2)  Keyword versus positional parameters                  <<U.RAO>>01110000
<<       Positional parameters can be dangerous, especially    <<U.RAO>>01120000
<<       when the parameters can be similar data types.        <<U.RAO>>01130000
<<       For example, a positional string of numbers can       <<U.RAO>>01140000
<<       result in erroneous operation due to the accidental   <<U.RAO>>01150000
<<       omission of a delimiter.  Keyworded parameters        <<U.RAO>>01160000
<<       can be very verbose, especially on complex commands.  <<U.RAO>>01170000
<<       They can also work a hardship when a user uses a      <<U.RAO>>01180000
<<       particular command heavily, since it drastically      <<U.RAO>>01190000
<<       enlarges the amount of typing.  This last objection   <<U.RAO>>01200000
<<       can be gotten around through the agency of User       <<U.RAO>>01210000
<<       Defined Commands.  Another major objection to         <<U.RAO>>01220000
<<       keywords is that it requires several different        <<U.RAO>>01230000
<<       delimiters, often leading to typing errors and        <<U.RAO>>01240000
<<       mental confusion.                                     <<U.RAO>>01250000
<<   3)  Delimiters & other special characters                 <<U.RAO>>01260000
<<       The typical delimiters in commands are commas to      <<U.RAO>>01270000
<<       separate positional parameters and semicolons to      <<U.RAO>>01280000
<<       separate keywords.  The file command shows this       <<U.RAO>>01290000
<<       in full generality.  Periods are sometimes            <<U.RAO>>01300000
<<       terminators (as in the LABEL option on the FILE       <<U.RAO>>01310000
<<       command) and sometimes separators, as in the logon    <<U.RAO>>01320000
<<       user ID and file names.  Blanks are tough to deal     <<U.RAO>>01330000
<<       with and should be avoided as delimiters.             <<U.RAO>>01340000
<<       Non-printing characters should be avoided at all      <<U.RAO>>01350000
<<       costs.  All commands will be terminated with a        <<U.RAO>>01360000
<<       carriage return when passed to the command parser.    <<U.RAO>>01370000
<<   4)  Hardware/software peculiarities                       <<U.RAO>>01380000
<<       Too frequently the command syntax reflects some       <<U.RAO>>01390000
<<       strange and unpleasant aspect of the mechanism        <<U.RAO>>01400000
<<       underlying the command.  We should not require the    <<U.RAO>>01410000
<<       user to be cognizant of our design problems.  To      <<U.RAO>>01420000
<<       do so violates the principle of lowering the          <<U.RAO>>01430000
<<       annoyance factor.                                     <<U.RAO>>01440000
<<   5)  Extensibility                                         <<U.RAO>>01450000
<<       No matter how well your command does its job, one     <<U.RAO>>01460000
<<       of these days someone will want to modify or          <<U.RAO>>01470000
<<       extend it.  In particular, one should be careful      <<U.RAO>>01480000
<<       about the use of delimiters in ways other than the    <<U.RAO>>01490000
<<       "traditional" way.  For example, periods, commas,     <<U.RAO>>01500000
<<       semicolons and others have fairly standardized        <<U.RAO>>01510000
<<       meanings, and to use them in a different way reduces  <<U.RAO>>01520000
<<       the options of your successor to extend your command. <<U.RAO>>01530000
<<       Another related issue is that listing formats should  <<U.RAO>>01540000
<<       be extensible.                                        <<U.RAO>>01550000
<<   6)  Defaults                                              <<U.RAO>>01560000
<<       Defaults are vital, dangerous and difficult to choose.<<U.RAO>>01570000
<<       The design goal is that the command should be simple  <<U.RAO>>01580000
<<       for simple minded users.  This implies restraint in   <<U.RAO>>01590000
<<       the use of defaults which vary depending on some other<<U.RAO>>01600000
<<       parameter to the command.  Too smart defaults can be  <<U.RAO>>01610000
<<       just as bad as no defaults, since many users will     <<U.RAO>>01620000
<<       use the command defensively to avoid surprises from   <<U.RAO>>01630000
<<       the default mechanism.  Good luck.                    <<U.RAO>>01640000
<<   7)  Ambiguity                                             <<U.RAO>>01650000
<<       Careful design will avoid the need for lookahead to   <<U.RAO>>01660000
<<       resolve abiguous situations.  Lookahead should be     <<U.RAO>>01670000
<<       avoided if at all possible, as it results in          <<U.RAO>>01680000
<<       much code with complicated data structures.           <<U.RAO>>01690000
<<   8)  Computerese                                           <<U.RAO>>01700000
<<       Keywords should be couched in English, not computerese<<U.RAO>>01710000
<<                                                             <<U.RAO>>01720000
<<In summary, the user of your command will probably not be a  <<U.RAO>>01730000
<<computer professional and probably will be annoyed at the nee<<U.RAO>>01740000
<<to use your command at all.  Simplicity, understandability an<<U.RAO>>01750000
<<regularity are the keys to good command syntax.              <<U.RAO>>01760000
<<                                                             <<U.RAO>>01770000
<<Step 2: Code the Executor.                                   <<U.RAO>>01780000
<<   For the most part this is quite straightforward.  Most of <<U.RAO>>01790000
<<the existing executors can be used as models.  There are a fe<<U.RAO>>01800000
<<good concepts to keep in mind, however.                      <<U.RAO>>01810000
<<   Generating good error messages is just as important as    <<U.RAO>>01820000
<<executing the command.  The whole error message issue is deal<<U.RAO>>01830000
<<with below.                                                  <<U.RAO>>01840000
<<   The code of the command should be easily extensible.  This<<U.RAO>>01850000
<<implies the use of a simple parsing scheme with very obvious <<U.RAO>>01860000
<<techniques.  Probably more often than any other part of the  <<U.RAO>>01870000
<<system, the CI is modified by people who have no proprietary <<U.RAO>>01880000
<<interest in it.  In the interests of reliability and         <<U.RAO>>01890000
<<maintainability, it is desireable to start with as clean code<<U.RAO>>01900000
<<as possible.  Unfortunately, no universal parsing scheme has <<U.RAO>>01910000
<<yet been developed for the CI.                               <<U.RAO>>01920000
<<   A trap to avoid is called the "parse a little, execute a  <<U.RAO>>01930000
<<little" syndrome.  It results in the need to back out of a   <<U.RAO>>01940000
<<situation when an error is detected further down stream.  A  <<U.RAO>>01950000
<<secondary problem is that it tends to result in the          <<U.RAO>>01960000
<<partial destruction of the context of the error.  A command  <<U.RAO>>01970000
<<should be parsed completely before being executed at all.    <<U.RAO>>01980000
<<   Don't worry about having particularly efficient code.  The<<U.RAO>>01990000
<<CI's execution time is trivial compared to the time it takes <<U.RAO>>02000000
<<for the user to recover from a poorly designed error message <<U.RAO>>02010000
<<or even from a poorly designed syntax.  The customer always  <<U.RAO>>02020000
<<comes first.                                                 <<U.RAO>>02030000
<<   The use of global storage is discouraged.  Most important <<U.RAO>>02040000
<<is the fact that there are some performance consequences     <<U.RAO>>02050000
<<related to the need to constantly enlarge the CI's stack.    <<U.RAO>>02060000
<<If you find you do need global storage, be sure to initialize<<U.RAO>>02070000
<<it in procedure COMMANDINTERP, as the CI is procreated and   <<U.RAO>>02080000
<<thus has no global initialization capability.  Be careful    <<U.RAO>>02090000
<<about where you put new globals.  Certain other modules such <<U.RAO>>02100000
<<as UDC know about the CI global space.                       <<U.RAO>>02110000
<<   In general, the execution part of the command should simpl<<U.RAO>>02120000
<<be a call to the appropriate user callable intrinsic.  The   <<U.RAO>>02130000
<<CI usually should not provide the user any special services  <<U.RAO>>02140000
<<that are not available programmatically.  In this way we avoi<<U.RAO>>02150000
<<such undesireable situations as users getting their accountin<<U.RAO>>02160000
<<information through a call to the REPORT command and setting <<U.RAO>>02170000
<<up their files through a call to the FILE command through the<<U.RAO>>02180000
<<COMMAND intrinsic.  See the SETJCW command for an example of <<U.RAO>>02190000
<<this.                                                        <<U.RAO>>02200000
<<   EXCHANGEDB is to be avoided if at all possible, even if   <<U.RAO>>02210000
<<you have to do data segment moves iteratively.  The speed cos<<U.RAO>>02220000
<<is nothing compared to the cost of the crash which is        <<U.RAO>>02230000
<<inevitable when doing split stack operations.  All of the CI <<U.RAO>>02240000
<<utility routines assume no split stack operation.            <<U.RAO>>02250000
<<   Similarly there is rarely any valid reason for accessing  <<U.RAO>>02260000
<<system primitives directly from the CI.  The CI should be a  <<U.RAO>>02270000
<<very high level module.  It rarely has any business rooting  <<U.RAO>>02280000
<<around in some system table.  This principle unfortunately ha<<U.RAO>>02290000
<<been rather imperfectly adhered to.                          <<U.RAO>>02300000
<<   These almost random thoughts about writing executors hardl<<U.RAO>>02310000
<<provide a good framework for writing code.  Cursory          <<U.RAO>>02320000
<<examination of some of the executors currently in the module <<U.RAO>>02330000
<<probably will give you a better idea of the tricks of the    <<U.RAO>>02340000
<<trade.  A few ideas stand out.                               <<U.RAO>>02350000
<<                                                             <<U.RAO>>02360000
<<      Code assuming someone else will be changing it.        <<U.RAO>>02370000
<<                                                             <<U.RAO>>02380000
<<      Code for good error messages, not speed.               <<U.RAO>>02390000
<<                                                             <<U.RAO>>02400000
<<      It is far better to detect a problem at the            <<U.RAO>>02410000
<<      time the command is put in than when it is             <<U.RAO>>02420000
<<      executed.  That is, at parse time as opposed           <<U.RAO>>02430000
<<      to execution time.                                     <<U.RAO>>02440000
<<                                                             <<U.RAO>>02450000
<<      Cleverness will get you in trouble, usually for        <<U.RAO>>02460000
<<      no good reason.                                        <<U.RAO>>02470000
<<                                                             <<U.RAO>>02480000
<<Step 3:  Add the command to the Command Interpreter.         <<U.RAO>>02490000
<<   Other than physically adding the executor to the system,  <<U.RAO>>02500000
<<the only task is to add the command name to the list in      <<U.RAO>>02510000
<<procedure COMSEARCH.  This procedure is called for each      <<U.RAO>>02520000
<<command to determine if it is one of the ones known to the   <<U.RAO>>02530000
<<system.  The mechanics of this process are described in that <<U.RAO>>02540000
<<procedure.  If the executor is physically outside the CI     <<U.RAO>>02550000
<<module, don't forget to add the OPTION EXTERNAL declaration. <<U.RAO>>02560000
<<Congratulations.  Now all you need to do is make sure it     <<U.RAO>>02570000
<<works.                                                       <<U.RAO>>02580000
<<                                                             <<U.RAO>>02590000
$PAGE                                                                   02600000
<<*************************************************************<<U.RAO>>02610000
<<**************  ERROR MESSAGES FROM THE CI  **************** <<U.RAO>>02620000
<<*************************************************************<<U.RAO>>02630000
<<                                                             <<U.RAO>>02640000
<<Philosophical aspects:                                       <<U.RAO>>02650000
<<     The essential goal of an error message from the CI is to<<U.RAO>>02660000
<<help the user quickly recover from his problem.  In general, <<U.RAO>>02670000
<<a good error message should indicate:                        <<U.RAO>>02680000
<<    1)  What the CI did not like.  On syntax errors this     <<U.RAO>>02690000
<<        typically is done with a caret underneath where the  <<U.RAO>>02700000
<<        problem was detected.  If the caret isn't sufficient <<U.RAO>>02710000
<<        to identify the problem then some of the text of the <<U.RAO>>02720000
<<        message should further elaborate.  On semantic errors<<U.RAO>>02730000
<<        this usually is done with the text of the message.   <<U.RAO>>02740000
<<    2)  How to recover.  This usually will take the form of  <<U.RAO>>02750000
<<        telling the user what the valid input might be.  For <<U.RAO>>02760000
<<        example, on an invalid record type in the :FILE      <<U.RAO>>02770000
<<        command, the CI will put out a message something like<<U.RAO>>02780000
<<        EXPECTED RECORD TYPE TO BE F, V OR U.                <<U.RAO>>02790000
<<        This serves to identify to the user very quickly what<<U.RAO>>02800000
<<        the valid syntax is and thus how to get on with his  <<U.RAO>>02810000
<<        business.  Sometimes it is hard to figure out what th<<U.RAO>>02820000
<<        user had in mind.  For example, it isn't really      <<U.RAO>>02830000
<<        possible to second guess the user on an unknown      <<U.RAO>>02840000
<<        command name.  In these relatively rare cases, it is <<U.RAO>>02850000
<<        sufficient to tell the user just what was wrong.     <<U.RAO>>02860000
<<        In general, if it is a syntax error of any sort, it  <<U.RAO>>02870000
<<        is possible to give a good error message outlining   <<U.RAO>>02880000
<<        what was expected.  A cop-out on this is really      <<U.RAO>>02890000
<<        sloppy workmanship.                                  <<U.RAO>>02900000
<<    3)  In many cases it is desireable to tell the user what <<U.RAO>>02910000
<<        was done about the error.  This is particularly true <<U.RAO>>02920000
<<        in the case of warnings, where the user may be left  <<U.RAO>>02930000
<<        wondering whether some default was taken.  For exampl<<U.RAO>>02940000
<<        in the accounting structure commands we ignore many  <<U.RAO>>02950000
<<        errors.  In each case it is necessary to tell the use<<U.RAO>>02960000
<<        what default we took so that he can then do an ALTxxx<<U.RAO>>02970000
   STORE'FAILED    = 1090, <<STORE FAILED>>                    <<*7836>>02980000
<<        course, in each case we try to pick a reasonable     <<U.RAO>>02990000
   RESTORE'FAILED     = 1091, <<REST FAILED>>                  <<*7836>>03000000
<<        default so that he doesn't have to do any recovery.  <<U.RAO>>03010000
<<                                                             <<U.RAO>>03020000
<<In any case, messages should be very specific.  Given the    <<U.RAO>>03030000
<<very simple mechanism for generating error and warning       <<U.RAO>>03040000
<<messages, there is no acceptable excuse for generic messages.<<U.RAO>>03050000
<<Examples:                                                    <<U.RAO>>03060000
<<   "INVALID NUMBER" is unacceptable.  Such messages should be<<U.RAO>>03070000
<<of the form "EXPECTED <item> TO BE BETWEEN <n1> AND <n2>."   <<U.RAO>>03080000
<<This message should be used only once in the CI.             <<U.RAO>>03090000
<<   "UNKNOWN KEYWORD" is unacceptable.  The proper form is    <<U.RAO>>03100000
<<"EXPECTED ONE OF <item1>, <item2>....".                      <<U.RAO>>03110000
<<   In general, "<item>", "<n1>" and so forth should not be   <<U.RAO>>03120000
<<passed to CIERR as parameters but rather be embedded as part <<U.RAO>>03130000
<<of the error message.  The reason for this is that you will  <<U.RAO>>03140000
<<need to give a fuller description of the error in the Error  <<U.RAO>>03150000
<<Messages part of the MPE manual.  It is awkward at best and  <<U.RAO>>03160000
<<embarrassing at worst to have to tell the manual writer "Well<<U.RAO>>03170000
<<it could be this, or it could be that, or even this third    <<U.RAO>>03180000
<<thing."  The one exception is where truly dynamic information<<U.RAO>>03190000
<<is involved.  Examples might include configuration data and  <<U.RAO>>03200000
<<user supplied information like file names.>>                 <<U.RAO>>03210000
<<   In most cases, redundantly specified parameters should    <<U.RAO>>03220000
<<result not in a fatal error but in a warning.  If a value is <<U.RAO>>03230000
<<associated with the redundant keyword then the message should<<U.RAO>>03240000
<<specify that the last value found was used.                  <<U.RAO>>03250000
<<   Similarly unacceptable messages are                       <<U.RAO>>03260000
<<   "INSUFFICIENT PARAMETERS" - what is missing?              <<U.RAO>>03270000
<<   "INSUFFICIENT CAPABILITY" should say what capability is   <<U.RAO>>03280000
<<missing.                                                     <<U.RAO>>03290000
<<   "INSUFFICIENT RESOURCES" should say what resources are    <<U.RAO>>03300000
<<lacking.                                                     <<U.RAO>>03310000
<<And so forth for all messages.                               <<U.RAO>>03320000
<<                                                             <<U.RAO>>03330000
<<Mechanical aspects of adding error messages:                 <<U.RAO>>03340000
<<                                                             <<U.RAO>>03350000
<<1)  Numbering                                                <<U.RAO>>03360000
<<    The number chosen for a message is largely irrelevant.  I<<U.RAO>>03370000
<<    is nice, however, if it is near the other messages       <<U.RAO>>03380000
<<    associated with the same command.  Be sure to declare it <<U.RAO>>03390000
<<    as an equate in the CI globals (or SPOOLCOMS or whatever)<<U.RAO>>03400000
<<    Note that the message should be tagged as to whether it i<<U.RAO>>03410000
<<    a CIERR or CIWARN or whatever.  Put it in message set 2. <<U.RAO>>03420000
<<2)  Generation                                               <<U.RAO>>03430000
<<    There is a procedure called CIERR which is responsible fo<<U.RAO>>03440000
<<    processing related to the handling of errors.  In        <<U.RAO>>03450000
<<    particular this procedure decides whether to print the   <<U.RAO>>03460000
<<    message, abort the job, and other related cleanup        <<U.RAO>>03470000
<<    problems.  Note that it always returns to the caller if  <<U.RAO>>03480000
<<    the job is not aborted.  It is the responsibility of the <<U.RAO>>03490000
<<    caller to assure that the job is clean enough to be      <<U.RAO>>03500000
<<    aborted at the time of the call.  CIERR cannot be called <<U.RAO>>03510000
<<    in split stack mode.  See the listing of CIERR for the   <<U.RAO>>03520000
<<    details of the call.                                     <<U.RAO>>03530000
<<3)  Errors detected by other parts of the system.            <<U.RAO>>03540000
<<    Errors such as file system errors, loader errors, DS     <<U.RAO>>03550000
<<    runtime errors and private volume errors are really of   <<U.RAO>>03560000
<<    little meaning in the context of the CI.  Accordingly,   <<U.RAO>>03570000
<<    when such errors are detected, several messages may be   <<U.RAO>>03580000
<<    displayed.  This is done through the agency of routines  <<U.RAO>>03590000
<<    like FERROR', CYDIRERR', LOADERROR, and CREATEERROR.     <<U.RAO>>03600000
<<    The development of such routines is encouraged whenever  <<U.RAO>>03610000
<<    message sets outside the CI error message set is         <<U.RAO>>03620000
<<    involved.  When such a message is output, the CI should  <<U.RAO>>03630000
<<    also print a message translating the error into the      <<U.RAO>>03640000
<<    context of the command which failed.  For example, when  <<U.RAO>>03650000
<<    a purge fails for an unusual reason, we print the file   <<U.RAO>>03660000
<<    system error message as well as a message saying that the<<U.RAO>>03670000
<<    purge was not done.                                      <<U.RAO>>03680000
<<4)  General purpose parsing routines                         <<U.RAO>>03690000
<<    Some parses, such as file names, are done so often that  <<U.RAO>>03700000
<<    generalized routines exist.  Usually these will be found <<U.RAO>>03710000
<<    in the neighborhood of the error handling routines.      <<U.RAO>>03720000
<<5)  Programmatically callable commands                       <<U.RAO>>03730000
<<    For errors in programmatically callable commands you must<<U.RAO>>03740000
<<    also return the error number to the caller of the COMMAND<<U.RAO>>03750000
<<    intrinsic.  This is done by returning the number through <<U.RAO>>03760000
<<    the ERRNUM parameter to all executors.  Also it is       <<U.RAO>>03770000
<<    required that you return the parameter number in the     <<U.RAO>>03780000
<<    PARMNUM parameter.  Parameter number is roughly defined  <<U.RAO>>03790000
<<    as one for each entity such as a keyword or value past   <<U.RAO>>03800000
<<    the command name.  In other words, 1 is the first        <<U.RAO>>03810000
<<    parameter past the command name, 2 might be the value to <<U.RAO>>03820000
<<    be associated with the keyword which was parameter 1.    <<U.RAO>>03830000
<<                                                             <<U.RAO>>03840000
<<   Error message generation is one of the most important     <<U.RAO>>03850000
<<tasks to be performed by the Command Interpreter.  The best  <<U.RAO>>03860000
<<error messages are generated when the coder tries to envision<<U.RAO>>03870000
<<the user's perception of the error.  For example, in many    <<U.RAO>>03880000
<<cases it seems to the user that it was obvious what he meant <<U.RAO>>03890000
<<even though it was not expressed in correct form.  This      <<U.RAO>>03900000
<<includes redundantly specified keywords like NOCCTL in the   <<U.RAO>>03910000
<<file command.  The user does not think highly of a command   <<U.RAO>>03920000
<<parser which gives him an error message on something like tha<<U.RAO>>03930000
<<which is obviously non-fatal.  The key to success with error <<U.RAO>>03940000
<<messages is to identify errors in the user's frame of        <<U.RAO>>03950000
<<reference, not the system programmer's.                      <<U.RAO>>03960000
<<                                                             <<U.RAO>>03970000
$TITLE "GLOBAL DECLARATIONS"                                            03980000
$PAGE "GLOBAL DECLARATIONS"                                             03990000
$CONTROL MAIN=COMMAND'INTERP                                   <<06.EB>>04000000
BEGIN                                                                   04010000
      <<MISCELLANEOUS DECLARATIONS >>                                   04020000
      INTEGER                                                           04030000
      DELTAQ=Q-0,                                                       04040000
      S0=S-0,                                                           04050000
      S1=S-1,                                                           04060000
      S2=S-2,                                                           04070000
      S3=S-3,                                                           04080000
      S15=S-15,                                                         04090000
      XREG = X,                                                         04100000
      X=X;                                                              04110000
                                                                        04120000
      LOGICAL                                                           04130000
      LS0=S-0,                                                          04140000
      STATUS=Q-1;                                                       04150000
                                                                        04160000
      DOUBLE                                                            04170000
      DS1=S-1,                                                          04180000
      DS3=S-3,                                                          04190000
      DS13=S-13,                                                        04200000
      DS15=S-15;                                                        04210000
                                                                        04220000
      BYTE POINTER                                                      04230000
      BPS0=S-0;                                                << I.A >>04240000
                                                                        04250000
      INTEGER POINTER                                                   04260000
      PS0=S-0;                                                 <<06226>>04270000
                                                                        04280000
                                                                        04290000
      ARRAY DBARRAY(*)=DB+0;                                            04300000
      INTEGER ARRAY ARRDB0(*)=DB+0;                                     04310000
      INTEGER ARRAY ARRDB6(*)=DB+6;                                     04320000
$INCLUDE PCBFINCL                                              <<06580>>04330000
$INCLUDE INCLPXG                                               <<06580>>04340000
$SET X8=OFF                                                    <<06584>>04350000
$INCLUDE INCLJMAT                                              <<06584>>04360000
$INCLUDE INCLLPDT                                              <<06226>>04370000
$INCLUDE INCLCIS                                               << I.A >>04380000
$PAGE "GLOBAL DECLARATIONS"                                    << I.A >>04390000
                                                               <<09.EB>>04400000
      <<EQUATES USED THROUGHOUT>>                                       04410000
                                                                        04420000
      EQUATE                                                            04430000
      <<CONDITION CODES>>                                               04440000
      CCE=2,                                                            04450000
      CCL=1,                                                            04460000
      CCG=0,                                                            04470000
      <<CI MESSAGE SET NUMBERS>>                               <<U.RAO>>04480000
      CIERRMSGSET=2,                                           <<U.RAO>>04490000
      CIGENERALMSGSET=7,                                       <<U.RAO>>04500000
      FSERRORMSGSET = 8,                                       <<U.RAO>>04510000
      LOADERRMSGSET = 9,                                       <<U.RAO>>04520000
      CREATEERRMSGSET = 10,                                    <<U.RAO>>04530000
      PVERRMSGSET = 15,                                        <<RH.PV>>04540000
      INTRNLERRSET = 27,  << System internal error. >>         <<04193>>04550000
   <<EQUATES FOR GENERAL MESSAGES (NOT ERROR MESSAGES)>>       <<U.RAO>>04560000
   OPWARN=9,         <<OPERATOR WARNING MESSAGE #>>            <<00552>>04570000
   JOBFLUSHED      = 2,                                        <<U.RAO>>04580000
   TELLFROM        = 3,                                        <<U.RAO>>04590000
ENDOFFILEMSG    =  9,  <<END OF FILE DETECTED>>                <<00527>>04600000
   TELLNOTACCEPT   =  25,   <<! NOT ACCEPTING MESSAGES>>       <<U.RAO>>04610000
   ABORTQ          =  26,   <<ABORT?>>                         <<U.RAO>>04620000
   << END OF PREPARE = 51, >>                                  <<U.RAO>>04630000
   << END OF SUBSYSTEM = 52, >>                                <<U.RAO>>04640000
   << END OF COMPILE = 53, >>                                  <<U.RAO>>04650000
   << END OF REMOTE PROGRAM = 54>>                             <<U.RAO>>04660000
   SHOWJCWMSG      = 55,  << <jcw> = <value> >>                <<U.RAO>>04670000
   <<JCW = WARN, MSG 56>>                                      <<U.RAO>>04680000
   <<JCW = FATAL, MSG 57>>                                     <<U.RAO>>04690000
   <<JCW = SYSTEM, MSG 58>>                                    <<U.RAO>>04700000
   <<DS MESSAGE, MSG 59>>                                      <<U.RAO>>04710000
   <<DS MESSAGE, MSG 60>>                                      <<U.RAO>>04720000
   SHOWME1BRK      = 61,                                       <<U.RAO>>04730000
   SHOWME2         =  62,                                      <<U.RAO>>04740000
   SHOWME3         =  63,                                      <<U.RAO>>04750000
   SHOWME4         =  64,                                      <<U.RAO>>04760000
   SHOWME5         =  65,                                      <<U.RAO>>04770000
   SHOWME1NOBRK    = 70,                                       <<U.RAO>>04780000
   SHOWME6         = 71,                                       <<U.RAO>>04790000
   CONDITION'TRUE  = 40,                                       <<00849>>04800000
   CONDITION'FALSE = 41,                                       <<00849>>04810000
   RESUME'EXEC     = 42,                                       <<00849>>04820000
   IGNORE'COMM     = 43,                                       <<00849>>04830000
   SHOWME33        = 72,                                       <<00492>>04840000
   SHOWME55        = 74,                                       <<01403>>04850000
   SHOWMEINPROG    = 76,                                       <<04738>>04860000
   SHOWMEPROGCPU   = 77,                                       <<04738>>04870000
      <<ERROR EQUATES REFER TO C.I. ERROR NUMBER>>                      04880000
                                                                        04890000
                                                                        04900000
                                                                        04910000
      <<COMMAND RELATED ERRORS>>                                        04920000
      ERRNOTPROGRAMAT = 12,  <<DISALLOWED PROGRAMMATICALLY>>   <<U.RAO>>04930000
   ERRMISSINGCR    = 13,  << NO CR AT END OF COMMAND IMAGE >>  <<00257>>04940000
   NOSTACKSPACE    =  15,  << NOT ENOUGH STACK FOR COMMAND >>  <<01895>>04950000
   NOSUBPARMS      = 242,  <<no subparms for final parm>>      <<*7612>>04960000
<< FILE NAME ERRORS>>                                          <<U.RAO>>04970000
   FILEEXPECTALPHA = 530  ,                                    <<U.RAO>>04980000
   FFNAMEBASE=FILEEXPECTALPHA-1,                               <<U.RAO>>04990000
   FILENAMEMISSING = 531  ,                                    <<U.RAO>>05000000
<< GROUP NAME ERRORS >>                                        <<U.RAO>>05010000
   GRPEXPECTALPHA  = 540  ,                                    <<U.RAO>>05020000
   FGNAMEBASE=GRPEXPECTALPHA-1,                                <<U.RAO>>05030000
<< ACCOUNT NAME ERRORS >>                                      <<U.RAO>>05040000
   ACCTEXPECTALPHA = 550  ,                                    <<U.RAO>>05050000
   FANAMEBASE=ACCTEXPECTALPHA-1,                               <<U.RAO>>05060000
   ACCTNAMEMISSING = 551  ,                                    <<U.RAO>>05070000
   ACCTNAMETOOLONG = 552  ,                                    <<U.RAO>>05080000
   ACCTEXPECTNAMENOTAT= 553,                                   <<U.RAO>>05090000
<< LOCKWORD NAME ERRORS >>                                     <<U.RAO>>05100000
   LWDEXPECTALPHA  = 560  ,                                    <<U.RAO>>05110000
   FLWORDBASE=LWDEXPECTALPHA-1,                                <<U.RAO>>05120000
<< MISCELLANEOUS NAMING ERRORS >>                              <<U.RAO>>05130000
   UNKNOWNSYSDEF   = 580  ,                                    <<U.RAO>>05140000
   EXPECTPERIOD    = 581  ,                                    <<U.RAO>>05150000
   XPCTPERIODSLASH = 582  ,                                    <<U.RAO>>05160000
   EXTRANEOUSADESG = 583  ,                                    <<U.RAO>>05170000
<< USER NAME ERRORS >>                                         <<U.RAO>>05180000
   USEREXPECTALPHA = 590,                                      <<U.RAO>>05190000
   USERNAMEMISSING = 591,                                      <<U.RAO>>05200000
   USERNAMETOOLONG = 592,                                      <<U.RAO>>05210000
   OUTOFPCBS       = 629,  <<NO PCB, ETC. FOR CREATEPROCESS>>  <<01200>>05220000
   INVALIDPROG     = 630,  <<INVALID PROGRAM FILE>>            <<01200>>05230000
   BADENTRYPT      = 631,  <<UNKNOWN ENTRY POINT>>             <<01200>>05240000
   DFLTSTACK       = 632,  <<DEFAULT STACKSIZE USED>>          <<01200>>05250000
   DFLTDL          = 633,  <<DEFAULT DLSIZE USED>>             <<01200>>05260000
   DFLTMAXD        = 634,  <<DEFAULT MAXDATA USED>>            <<01200>>05270000
   DLRNDED         = 635,  <<DLSIZE ROUNDED TO 128 WRD MULT>>  <<01200>>05280000
   CONFMAXD        = 636,  <<CONFIGURATION MAXDATA USED>>      <<01200>>05290000
   STKRNDEDUP      = 637,  <<STACK SPACE SET TO CONF MAXDATA>> <<01200>>05300000
   STACKTOOBIG     = 638,  <<STACK SPACE > CONF MAXDATA>>      <<01200>>05310000
   SUBSNOTFOUND    = 641,  <<SUBSYSTEM NOT FOUND>>             <<*7836>>05320000
   APLTERM         = 658,  <<ERROR TRYING TO USE APL TERM>>    <<U.RAO>>05330000
   SUBSNOTCREATE   = 660,  <<CREATEPROCESS FAILED ON SUBSYS>>  <<*7836>>05340000
<< ADDITIONAL ERRORS FOR :RUN COMMAND >>                       <<01200>>05350000
   BADSTDIN        = 684,  <<COULN'T OPEN $STDIN FOR :RUN>>    <<01200>>05360000
   BADSTDLIST      = 685,  <<COULN'T OPEN $STDLIST FOR :RUN>>  <<01200>>05370000
   OTHERCREATERR   = 686,  << GENERAL CREATEPROC. ERROR >>     <<01452>>05380000
                           << TO TRAP INTERNAL PROBLEMS.>>     <<01452>>05390000
<< ERRORS ON $STDIN >>                                         <<U.RAO>>05400000
   ERRSTDINIO     =  901,     <<I/O ERROR ON $STDIN>>          <<U.RAO>>05410000
<< DIRECTORY PROBLEMS >>                                       <<U.RAO>>05420000
   DIRIOERR        = 905,                                      <<U.RAO>>05430000
   DIRDUPLNAME     = 906,  <<DUPLICATE NAME>>                  <<U.RAO>>05440000
   DIRNOSUCHFILE   = 907,  <<NON-EXISTENT NAME>>               <<U.RAO>>05450000
   DIRNOSUCHGROUP  = 908,  <<NON-EXISTENT GROUP>>              <<U.RAO>>05460000
   DIRNOSUCHACCT   = 909,  <<NO SUCH ACCOUNT>>                 <<U.RAO>>05470000
   DIRNOSUCHUSER   = 910,  <<NON-EXISTENT USER>>               <<U.RAO>>05480000
   DIRNOSUCHVSD    = 911,  <<NON-EXISTENT VSD>>                <<U.RAO>>05490000
   DIRNOSUCHVSL    = 912,  <<NON-EXISTENT VSL>>                <<U.RAO>>05500000
   DIRNOSAVEGROUP  = 913,  <<NO GROUP SAVE ACCESS>>            <<U.RAO>>05510000
   DIRNOSAVEACCT   = 914,  <<NO ACCT SAVE ACCESS>>             <<U.RAO>>05520000
   DIROVERFLOW     = 915,  <<DIRECTORY OUT OF SPACE>>          <<U.RAO>>05530000
   DIRINUSE        = 916,  <<SOMETHING IN USE, CAN'T BE PURGED><<U.RAO>>05540000
   DIRGRPFSPACE    = 917,  <<WOULD EXCEED GROUP FILE SPACE>>   <<U.RAO>>05550000
   DIRACCTFSPACE   = 918,  <<WOULD EXCEED ACCOUNT FILE SPACE>> <<U.RAO>>05560000
<< ERRORS ON $STDLIST >>                                       <<U.RAO>>05570000
   ERRSTDLISTEOF  =  950,     <<EOF ON $STDLIST>>              <<U.RAO>>05580000
   ERRSTDLISTIO   =  951,     <<I/O ERROR ON $STDLIST>>        <<U.RAO>>05590000
<< CAPABILITY ERRORS >>                                        <<U.RAO>>05600000
   CAPREQ'OP'      = 955,  <<REQUIRES OP CAPABILITY>>          <<U.RAO>>05610000
   CAPREQ'SM'      = 956,  <<REQUIRES SM CAPABILITY>>          <<U.RAO>>05620000
   CAPREQ'AM'      = 957,  <<REQUIRES AM CAPABILITY>>          <<U.RAO>>05630000
   CAPREQSMORAM    = 958,  <<REQUIRES SM OR AM CAPABILITY>>    <<U.RAO>>05640000
   CAPREQ'CS'      = 959,  <<REQUIRES CS CAPABILITY>>          <<U.RAO>>05650000
   CAPREQUVORCV    = 960,  <<REQUIRES UV OR CV CAPABILITY>>    <<U.RAO>>05660000
   CAPREQ'CV'      = 961,  <<REQUIRES CV CAPABILITY>>          <<U.RAO>>05670000
   CAPREQ'PM'      = 962,  <<REQUIRES PM CAPABILITY>>          <<U.RAO>>05680000
   CAPREQ'IA'      = 963,  <<REQUIRES IA CAPABILITY>>          <<U.RAO>>05690000
   CAPREQ'BA'      = 964,  <<REQUIRES BA CAPABILITY>>          <<U.RAO>>05700000
   CAPREQ'SF'      = 965,  <<REQUIRES SF CAPABILITY>>          <<U.RAO>>05710000
   CAPREQ'LG'      = 966,  <<REQUIRES LOGGING CAPABILITY>>     <<00506>>05720000
       CAPREQ'NM'      = 954,                                  <<07054>>05730000
   CAPREQSMOROP    = 967,  <<REQUIRES SM OR OP CAPABILITY>>    <<01724>>05740000
   ERRUNDEF        = 975, <<UNKNOWN COMMAND>>                  <<U.RAO>>05750000
   NOTINSESSION    = 977, <<NOT ALLOWED IN SESSION>>           <<U.RAO>>05760000
   NOTINJOB        = 978, <<NOT ALLOWED IN A JOB>>             <<U.RAO>>05770000
   NOTINUDC        = 979, <<NOT ALLOWED FROM WITHIN A UDC>>    <<01455>>05780000
   COMMAND'GT'BUFFER=980, <<COMMAND > 268 CHARACTERS>>         <<00287>>05790000
   NOCOLON         = 981, <<COMMAND LACKS LEADING COLON>>      <<U.RAO>>05800000
   BADSEQUENCEORDR = 982, <<COMMAND SEQNUM NOT NUMERIC OR BLANK<<01.RO>>05810000
   BADSEQUENCENUM  = 983, <<COMMAND SEQNUM OUT OF SEQUENCE>>   <<01.RO>>05820000
   NOTINBREAK      = 986, <<NOT ALLOWED IN BREAK>>             <<U.RAO>>05830000
   NOTYETIMPLEMENTED=987,                                      <<U.RAO>>05840000
   COMTOOMANYLINES = 988,  <<COMMAND HAS > 28 CONTINUATIONS>>  <<U.RAO>>05850000
   PGMABORT        = 989,  <<PROGRAM ABORTED BY USER>>         <<U.RAO>>05860000
   BRKINVLDRESP    = 990,  <<EXPECT "YES" OR "NO">>            <<U.RAO>>05870000
   NOABORTPARMS    = 991, << DISALLOW PARAMETERS WITH ABORT>>  <<01308>>05880000
<< 1000'S RESERVED FOR STORE/RESTORE >>                        <<U.RAO>>05890000
   STORE'FAILED    = 1090, << STORE FAILED >>                  <<04695>>05900000
   RESTORE'FAILED  = 1091, << RESTORE FAILED >>                         05910000
   STORE'JCW'FAILED= 1090, <<for right now>>                   <<*7836>>05920000
   RESTORE'JCW'FAILED = 1091, <<for right now>>                <<*7836>>05930000
<< 1100'S RESERVED FOR PRIVATE VOLUMES MESSAGES >>             <<U.RAO>>05940000
   <<1126-1135 RESERVED FOR IMPLICITMNT ERRORS>>               <<03.KM>>05950000
<< 1200'S RESERVED FOR USER LOGGING >>                         <<U.RAO>>05960000
<< 1300'S RESERVED FOR DS >>                                   <<U.RAO>>05970000
<< 1400'S RESERVED FOR STARTDEVICE (HELLO, JOB, DATA)>>        <<U.RAO>>05980000
<< 1500 - 1529 RESERVED FOR SHOWJOB >>                         <<U.RAO>>05990000
<< 1530 - 1579 RESERVED FOR SHOWIN AND SHOWOUT >>              <<U.RAO>>06000000
<< 1580 - 1589 RESERVED FOR SHOWDEV >>                         <<U.RAO>>06010000
<< 1590 - 1609 RESERVED FOR STREAM >>                          <<U.RAO>>06020000
<< TELL COMMAND >>                                             <<U.RAO>>06030000
   TELLINVSNUM     = 1611, <<INVALID SESSION NUMBER>>          <<U.RAO>>06040000
   TELLXPCTJORS    = 1612, <<EXPECT "J" OR "S">>               <<U.RAO>>06050000
   TELLXPCTJSORAT  = 1613, <<EXPECT "@J" OR "@S" OR "@">>      <<U.RAO>>06060000
   TELLJXPCTJUSTAT = 1614, <<JOB NAME CAN'T BE "@XX">>         <<U.RAO>>06070000
   TELLJNAME2LONG  = 1615, <<NAME > 8 CHARACTERS>>             <<U.RAO>>06080000
   TELLJXPCTALPHA  = 1616, <<JOB NAME MUST START WITH ALPHA>>  <<U.RAO>>06090000
   TELLXPCTPERIOD  = 1617, <<EXPECTED "." BETWEEN USER&ACCT>>  <<U.RAO>>06100000
   TELLJOBIDMISSIN = 1618, <<MISSING JOBID>>                   <<U.RAO>>06110000
   TELLNOSUCHJOBS  = 1619, <<NO MATCH ON JOBID>>               <<U.RAO>>06120000
   TELLSENDONLYTARGET                                          <<01652>>06130000
                   = 1620,  << ONLY TARGET IS SENDER >>        <<01652>>06140000
   TELLJOBINVALID  = 1627,     << TELL TO JOB INVALID>>        <<04208>>06150000
<< TELLOP COMMAND >>                                           <<U.RAO>>06160000
   TELLOPMSGPROBLEM= 1626,<<PROBLEM WITH GENMSG>>              <<U.RAO>>06170000
<< PTAPE COMMAND >>                                            <<U.RAO>>06180000
   PTAPE2MP        = 1630, <<PTAPE MORE THAN 1 PARAMETER>>     <<U.RAO>>06190000
   PTAPENOFILE     = 1631, <<NO TARGET FILE WAS SPECIFIED>>    <<U.RAO>>06200000
   PTAPEOPENFAILED = 1632, <<UNABLE TO OPEN DISC FILE>>        <<U.RAO>>06210000
   PTAPEFSERR      = 1633, <<READ ERROR ON PAPER TAPE>>        <<U.RAO>>06220000
   PTAPETOFSERR    = 1634, <<WRITE ERROR ON DISC FILE>>        <<U.RAO>>06230000
   PTAPECLOSEERR   = 1635, <<UNABLE TO CLOSE DISC FILE>>       <<U.RAO>>06240000
   PTAPETERMFILE   = 1636, <<TERMINAL IO ERROR>>               <<U.RAO>>06250000
<< SPEED COMMAND >>                                            <<U.RAO>>06260000
   SPEED2MP        = 1640, <<MORE THAN 2 PARAMETERS FOR SPEED>><<U.RAO>>06270000
   SPEEDNOTENUF    = 1641, <<NEITHER INPUT NOR OUTPUT SPEEDS>> <<U.RAO>>06280000
   ERRINSPEED      = 1642,<<ILLEGAL INPUT SPEED>>              <<U.RAO>>06290000
   ERROUTSPEED     = 1643,<<ILLEGAL OUTPUT SPEED>>             <<U.RAO>>06300000
   NOTVER          = 1644,<<SPEED CHANGE NOT VERIFIED>>        <<U.RAO>>06310000
   SPEEDINEQUALOUT = 1645,  <<WARN. IN = OUT. SERIES 33>>      <<0306>> 06320000
   SPEEDNOTEQUAL   = 1646,  <<IN MUST EQUAL OUT. SERIES 33>>   <<0306>> 06330000
<< SHOWQ COMMAND >>                                            <<U.RAO>>06340000
   WARNXPARMSIGNORED=1670, <<COMMAND HAS NO PARMS, PARMS IGNORE<<U.RAO>>06350000
<< EOD COMMAND >>                                              <<U.RAO>>06360000
      BADLOGONSTRING = 1684,  << BAD HELLO/JOB/DATA >>         <<02329>>06370000
   IGNORED         = 1685,<<:EOD IGNORED>>                     <<U.RAO>>06380000
<< RESUME COMMAND >>                                           <<U.RAO>>06390000
   ONLYINBREAK     = 1686,<<ONLY ALLOWED IN BREAK>>            <<U.RAO>>06400000
<< GETRIN AND FREERIN COMMANDS >>                              <<U.RAO>>06410000
   GETRINNOPASS    = 1690, <<NO RIN PASSWORD SUPPLIED>>        <<U.RAO>>06420000
   FREERINNORIN    = 1691, <<NO RIN NUMBER TO FREERIN>>        <<U.RAO>>06430000
   RINTABFULL      = 1692, <<RIN TABLE FULL>>                  <<U.RAO>>06440000
   RINNOTAL        = 1693, <<RIN NOT ALLOCATED, CAN'T BE FREED><<U.RAO>>06450000
   RININUSE        = 1694, <<RIN IN USE, CAN'T DEALLOCATE>>    <<U.RAO>>06460000
   RININVINT       = 1695, <<BAD INTEGER AS RIN NUMBER>>       <<U.RAO>>06470000
   RINPASS2LONG    = 1696, << PASSWORD LONGER THEN 8 CHARS>>   <<02367>>06480000
   RINPASSSPECHAR  = 1697, << " " CONTAINS SPECIAL CHARS  >>   <<02367>>06490000
   RINPASSTALPHA   = 1698, << MUST START W. ALPHA CHAR. >>     <<02367>>06500000
<< SETJCW COMMAND >>                                           <<U.RAO>>06510000
   SETJCWNONAME    = 1710, <<JCW NAME NOT FOUND>>              <<U.RAO>>06520000
   SETJCWNOVALUE   = 1711, <<VALUE NOT PRESENT>>               <<U.RAO>>06530000
   SETJCWNUM2LARGE = 1712, <<EXCEEDS 65535>>                   <<U.RAO>>06540000
   SETJCWINVOCTDGT = 1713, <<FOUND 8 OR 9>>                    <<U.RAO>>06550000
   SETJCWOKVAL2BIG = 1714, <<MAX OK IS 65535>>                 <<U.RAO>>06560000
   SETJCWWARNVAL   = 1715, <<MAX WARN IS 49151>>               <<U.RAO>>06570000
   SETJCWFATALVAL  = 1716, <<MAX FATAL IS 32767>>              <<U.RAO>>06580000
   SETJCWSYSTEMVAL = 1717, <<MAX SYSTEM IS 16383>>             <<U.RAO>>06590000
   SETJCWNAME2LONG = 1718, <<NAME > 255 CHAR.>>                <<U.RAO>>06600000
   SETJCWNAMENOALP = 1719, <<NO LEADING ALPHA>>                <<U.RAO>>06610000
   SETJCWNOSUCHJCW = 1720, <<VALUE JCW DOES NOT EXIST>>        <<U.RAO>>06620000
   SETJCW2MP       = 1721, <<EXTRANEOUS PARM TO SETJCW>>       <<U.RAO>>06630000
   JCWTABOVERFLOW  = 1722, <<JDT OVERFLOW>>                    <<U.RAO>>06640000
   SETJCWFATINUDC  = 1723, << UDC MAY FLUSH. >>                <<01893>>06650000
   SETJCWFATINJOB  = 1724, << JOB MAY FLUSH. >>                <<01893>>06660000
   SETJCWUNKNOWN   = 1725, << EXTRANEOUS CHAR >>               <<04708>>06670000
   SETJCWNAMERESV  = 1725, <<NAME HAS A RESERVED JCW MEANING>> <<04688>>06680000
<< SHOWJCW COMMAND >>                                          <<U.RAO>>06690000
   SHOWJCW2MP      = 1730, <<EXTRANEOUS PARM TO SHOWJCW>>      <<U.RAO>>06700000
   SHOWJCWNOSCHJCW = 1731, <<JCW NAMED NOT FOUND>>             <<U.RAO>>06710000
<< IF, ELSE, ENDIF COMMANDS >>                                 <<U.RAO>>06720000
   IFXPCTRELATION  = 1735, <<REST OF RELATIONAL MISSING>>      <<U.RAO>>06730000
   IFXPCTRELOP     = 1736, <<EXPECTED RELATIONAL OPERATOR>>    <<U.RAO>>06740000
   IFNOSUCHJCW     = 1737, <<JCW UNDEFINED>>                   <<U.RAO>>06750000
   IFXPCTJCWVAL    = 1738, <<EXPECTED A SECOND JCW>>           <<U.RAO>>06760000
   IFXPCTCLOSPAREN = 1739, <<EXPECTED A MATCHING ")">>         <<U.RAO>>06770000
   IFNOPARMS       = 1740, <<NO PARMS TO IF COMMAND>>          <<U.RAO>>06780000
   IFNOTHEN        = 1741, <<NO THEN FOUND>>                   <<U.RAO>>06790000
   IFEXTRANEOUS    = 1742, <<EXTRANEOUS PARMS TO IF>>          <<U.RAO>>06800000
   IFNESTINGTOOGREAT=1743, <<GT 15 LEVELS OF IF'S>>            <<U.RAO>>06810000
   ELSE2MP         = 1744, <<ELSE HAS NO PARMS>>               <<U.RAO>>06820000
   ELSEUNPAIRED    = 1745, <<UNPAIRED ELSE FOUND>>             <<U.RAO>>06830000
   ENDIF2MP        = 1746, <<ENDIF HAS NO PARMS>>              <<U.RAO>>06840000
   ENDIFUNPAIRED   = 1747, <<UNPAIRED IF FOUND>>               <<U.RAO>>06850000
   ELSE2MANYELSES  = 1748, <<REDUNDANT IF FOUND>>              <<U.RAO>>06860000
   IFS'NEQ'ENDIFS  = 1749, <<IFS <> ENDIFS WHEN EXITING BREAK>><<00835>>06870000
<< REDO COMMAND >>                                             <<U.RAO>>06880000
   REDOITOOLONG    = 1755, <<EXCEEDS MAX BUF LENGTH>>          <<U.RAO>>06890000
   REDODELGARBAGE  = 1756, <<GARBAGE IN DELETE FIELD>>         <<U.RAO>>06900000
<< HELP MESSAGES >>                                            <<01.EB>>06910000
   HELPOFFSET      =1751, << HELP RETURNS 50-60 >>             <<01.EB>>06920000
   OPENCATFAIL     = 1800,                                     <<01.EB>>06930000
   HELPTERMINATED  = 1801,                                     <<01.EB>>06940000
<< 1900 - 1999 RESERVED FOR USER DEFINED COMMANDS (UDC) >>     <<09.EB>>06950000
<< 3000-4000 ARE RESERVED FOR OPERATOR COMMANDS>>              <<00552>>06960000
                                                               <<00552>>06970000
OPCOMNOTALLOW=3000,      <<OPERATOR COMMAND IS NOT ALLOWED>>   <<00552>>06980000
   SPECIALCOM=3800,         <<ONLY RECALL,REPLY & RESUME ALLOWE<<00594>>06990000
   UDCSTACKOVRFLOW   = 1907,  <<STACK OVERFLOW WHILE>>         <<08.RO>>07000000
<< System Internal Errors.  Alternatives to SUDDENDEATH. >>    <<04193>>07010000
   COPYSCREEN         = 1,   << Request to send in screen. >>  <<04193>>07020000
   STATUS'AND'P       = 2,   << Reports caller's stack parms. ><<04193>>07030000
   PRINTCARETERR      = 101, << PRINTCICARET bounds error. >>  << 8560>>07040000
                                                               <<04193>>07050000
      <<DST ENTRIES USED THROUGHOUT>>                                   07060000
                                                                        07070000
                                                               <<00851>>07080000
      DISABLEBREAK = 14,                                       <<00851>>07090000
                                                                        07100000
                                                                        07110000
      <<SIRS USED THROUGHOUT>>                                          07120000
                                                                        07130000
                                                                        07140000
      <<WORDS/FLAGS>>                                                   07150000
                                                                        07160000
      WELCOMEDST = %1277,                                               07170000
   SYSUDCFLAG=%1376,      <<SYSTEM LEVEL UDC FLAG>>            <<00416>>07180000
   SYSVERSION      = %1116,  <<MPE VERSION LETTER>>            <<U.RAO>>07190000
   SYSUPDATE       = %1114,  <<MPE UPDATE LEVEL (ASCII)>>      <<U.RAO>>07200000
   SYSFIX          = %1115,  <<MPE FIX LEVEL>>                 <<U.RAO>>07210000
   PCBJSMAIN = 2;                                              <<06580>>07220000
                                                               <<06019>>07230000
DEFINE                                                         <<06019>>07240000
   SYSGLOBEXT        = ABSOLUTE( %1377 ) #,                    <<06019>>07250000
   BASE'VER          = SYSGLOBEXT + %1074 #,                   <<06019>>07260000
   BASE'UPD          = SYSGLOBEXT + %1075 #,                   <<06019>>07270000
   BASE'FIX          = SYSGLOBEXT + %1076 #;                   <<06019>>07280000
                                                                        07290000
      <<DEFINES USED THROUGHOUT>>                                       07300000
                                                                        07310000
      <<CODE DEFINITIONS>>                                              07320000
                                                                        07330000
      DEFINE                                                            07340000
      DISABLE=ASSEMBLE(SED 0)#,                                         07350000
      ENABLE=ASSEMBLE(SED 1)#,                                          07360000
      CC = STATUS . (6:2)#,                                             07370000
      NEXTLINE=ASSEMBLE (ZERO,DZRO);                           <<01881>>07380000
               PRINT (*, *, *)#,                               <<01881>>07390000
                                                               <<01709>>07400000
<<        DEF'MOVEFROMDSEG          >>                         <<U.RAO>>07410000
<< To use, declare SUBROUTINE DEF'MOVEFROMDSEG >>              <<U.RAO>>07420000
   DEF'MOVEFROMDSEG =                                          <<U.RAO>>07430000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                  <<U.RAO>>07440000
         VALUE TARGET,DSTN,OFFSET,COUNT;                       <<U.RAO>>07450000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                     <<U.RAO>>07460000
      BEGIN                                                    <<U.RAO>>07470000
         X := TOS; << SAVE RETURN ADDRESS >>                   <<U.RAO>>07480000
         ASSEMBLE(MFDS 0);                                     <<U.RAO>>07490000
         TOS := X; << RESTORE RETURN ADDRESS >>                <<U.RAO>>07500000
      END #,                                                   <<U.RAO>>07510000
                                                               <<U.RAO>>07520000
      << FIELDS/FLAGS>>                                                 07530000
                                                                        07540000
                                                               <<02.RO>>07550000
<<DELIMITER ARRAY DECLARATIONS>>                               <<U.RAO>>07560000
                                                               <<U.RAO>>07570000
COMMASEMICR = [8/",",8/";",8/%15,8/0]D#,                       <<U.RAO>>07580000
                                                               <<U.RAO>>07590000
      <<EXECUTOR PROCEDURE HEADING>>                                    07600000
                                                                        07610000
      EXECUTORHEAD =                                                    07620000
      (PARMSP,ERRNUM,PARMNUM);                                          07630000
      BYTE ARRAY PARMSP;                                                07640000
      INTEGER ERRNUM,PARMNUM #;                                << I.A >>07650000
EQUATE                                                         << 8152>>07660000
   EXPECT'SEMI           = 7010,                               << 8152>>07670000
   INVALID'LDEV          = 7011,                               << 8152>>07680000
   LDEV'MUST'BE'GT'0     = 7012;                               << 8152>>07690000
$INCLUDE INCLJIT                                               <<06846>>07700000
$INCLUDE INCLPCB5                                              <<06581>>07710000
LOGICAL POINTER PCB = SYSPCBINDEX;                             <<06581>>07720000
$PAGE   "EXTERNAL DECLARATIONS"                                         07730000
<<                                                                      07740000
   EXTERNAL MPE INTRINSICS                                              07750000
                           >>                                           07760000
   PROCEDURE DATE'LINE(STRING);                                <<0U.EB>>07770000
      BYTE ARRAY STRING; OPTION EXTERNAL;                      <<0U.EB>>07780000
                                                               <<0U.EB>>07790000
INTRINSIC ZSIZE;                                               << I.A >>07800000
                                                               <<00.EB>>07810000
INTRINSIC SETJCW,FCONTROL;                                     << I.A >>07820000
   LOGICAL PROCEDURE BINARY (STRING, LENGTH);                           07830000
   VALUE LENGTH;                                                        07840000
   BYTE ARRAY STRING;                                                   07850000
   INTEGER LENGTH;                                                      07860000
   OPTION EXTERNAL;                                                     07870000
                                                                        07880000
   INTEGER PROCEDURE EXCHANGEDB(DSTNO);                                 07890000
   VALUE DSTNO;                                                         07900000
   INTEGER DSTNO;                                                       07910000
   OPTION EXTERNAL;                                                     07920000
PROCEDURE CXDISCRPS EXECUTORHEAD;                                       07930000
OPTION EXTERNAL;                                                        07940000
                                                                        07950000
   DOUBLE PROCEDURE DBINARY(STRING,LENGTH);                             07960000
   VALUE LENGTH;                                                        07970000
   BYTE ARRAY STRING;  INTEGER LENGTH;                                  07980000
   OPTION EXTERNAL;                                                     07990000
                                                                        08000000
   INTEGER PROCEDURE ASCII (WORD, BASE, STRING);                        08010000
   VALUE WORD, BASE;                                                    08020000
   LOGICAL WORD;                                                        08030000
   INTEGER BASE;                                                        08040000
   BYTE ARRAY STRING;                                                   08050000
   OPTION EXTERNAL;                                                     08060000
                                                                        08070000
   INTEGER PROCEDURE READ (STRING, EXPECTEDL);                          08080000
   VALUE EXPECTEDL;                                                     08090000
   ARRAY STRING;                                                        08100000
   INTEGER EXPECTEDL;                                                   08110000
   OPTION EXTERNAL;                                                     08120000
                                                                        08130000
   PROCEDURE PRINT (STRING, LENGTH, TYPE);                              08140000
   VALUE LENGTH, TYPE;                                                  08150000
   ARRAY STRING;                                                        08160000
   INTEGER LENGTH;                                                      08170000
   LOGICAL TYPE;                                                        08180000
   OPTION EXTERNAL;                                                     08190000
                                                                        08200000
   INTEGER PROCEDURE SEARCH (TARGET, LENGTH, DICT, DEFN);               08210000
   VALUE LENGTH;                                                        08220000
   BYTE ARRAY TARGET, DICT;                                             08230000
   INTEGER LENGTH;                                                      08240000
   BYTE POINTER DEFN;                                                   08250000
   OPTION EXTERNAL, VARIABLE;                                           08260000
                                                               <<01.01>>08270000
PROCEDURE CLEAN'MESSAGE(MSG,LEN);                              <<01.01>>08280000
VALUE LEN;                                                     <<01.01>>08290000
INTEGER LEN;                                                   <<01.01>>08300000
BYTE ARRAY MSG;                                                <<U.RAO>>08310000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<01.01>>08320000
                                                                        08330000
   PROCEDURE DEBUG;                                                     08340000
   OPTION EXTERNAL;                                                     08350000
                                                                        08360000
   INTEGER PROCEDURE MYCOMMAND                                          08370000
   (COMIMAGE,DELIMS,MAXPARMS,NUMPARMS,PARMS,DICT,DEFN);                 08380000
   VALUE MAXPARMS;                                                      08390000
   BYTE ARRAY COMIMAGE,DELIMS,DICT;                                     08400000
   INTEGER MAXPARMS, NUMPARMS;                                          08410000
   DOUBLE ARRAY PARMS;                                                  08420000
   BYTE POINTER DEFN;                                                   08430000
   OPTION VARIABLE,EXTERNAL;                                            08440000
                                                                        08450000
   PROCEDURE WHO(MODE,CAP,LATTR,USERN,GROUPN,ACCTN,HOMEN,TERMNUM);      08460000
   LOGICAL MODE;                                                        08470000
   DOUBLE CAP,LATTR;                                                    08480000
   BYTE ARRAY USERN,GROUPN,ACCTN,HOMEN;                                 08490000
   LOGICAL TERMNUM;                                                     08500000
   OPTION VARIABLE,EXTERNAL;                                            08510000
                                                                        08520000
   LOGICAL PROCEDURE PARSE'DENSITY(PARM,PARMLEN,DEN'VALUE);    <<02569>>08530000
   VALUE PARMLEN;                                              <<02569>>08540000
   INTEGER DEN'VALUE,PARMLEN;                                  <<02569>>08550000
   BYTE ARRAY PARM;                                            <<02569>>08560000
   OPTION EXTERNAL;                                            <<02569>>08570000
                                                               <<02569>>08580000
   INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS, AOPTIONS, RECSIZE, 08590000
   DEVICE, FORMMSG, RECMODE, BLOCKFACTOR, NUMBUFFERS, FILESIZE,         08600000
   NUMEXTENTS, INITALLOC, FILECODE);                                    08610000
   VALUE FOPTIONS, AOPTIONS, RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, 08620000
   FILESIZE, NUMEXTENTS, INITALLOC, FILECODE;                           08630000
   BYTE ARRAY FILEDESIGNATOR,  DEVICE, FORMMSG;                         08640000
   LOGICAL FOPTIONS, AOPTIONS;                                          08650000
   INTEGER RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, NUMEXTENTS,       08660000
   INITALLOC, FILECODE;                                                 08670000
   DOUBLE FILESIZE;                                                     08680000
   OPTION VARIABLE, EXTERNAL;                                           08690000
                                                               <<00098>>08700000
   PROCEDURE FCLOSE (FILENUM, DISPOSITION, SECCODE);                    08710000
   VALUE FILENUM, DISPOSITION, SECCODE;                                 08720000
   INTEGER FILENUM, DISPOSITION, SECCODE;                               08730000
   OPTION EXTERNAL;                                                     08740000
                                                                        08750000
   PROCEDURE FWRITE(FNUM,TARGET,COUNT,CONT);                            08760000
   VALUE FNUM,COUNT,CONT;                                               08770000
   INTEGER FNUM,COUNT,CONT;                                             08780000
   ARRAY TARGET;                                                        08790000
   OPTION EXTERNAL;                                                     08800000
                                                                        08810000
   PROCEDURE FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);             08820000
   VALUE FILENUM;                                                       08830000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              08840000
   DOUBLE BLKNUM;                                                       08850000
   OPTION VARIABLE,EXTERNAL;                                            08860000
                                                                        08870000
   PROCEDURE FGETINFO                                                   08880000
   (FNUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,DEVTYPE,LDNUM,HDADDR,       08890000
    FILECODE,RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,BLKSIZE,EXTSIZE,       08900000
    NUMEXTENTS,USERLABELS,CREATORID,LABADDR);                           08910000
   VALUE FNUM;                                                          08920000
   INTEGER FNUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,USERLABELS; 08930000
   BYTE ARRAY FILENAME,CREATORID;                                       08940000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      08950000
   DOUBLE RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,LABADDR;                  08960000
   OPTION VARIABLE,EXTERNAL;                                            08970000
                                                                        08980000
   PROCEDURE FBREAK;                                                    08990000
   OPTION EXTERNAL;                                                     09000000
                                                                        09010000
   PROCEDURE FRESETEOF;                                                 09020000
   OPTION EXTERNAL;                                                     09030000
                                                                        09040000
   PROCEDURE FUNBREAK(DONOTREADFLAG);                                   09050000
   VALUE DONOTREADFLAG;                                                 09060000
   LOGICAL DONOTREADFLAG;                                               09070000
   OPTION EXTERNAL;                                                     09080000
                                                                        09090000
                                                               <<02318>>09100000
LOGICAL PROCEDURE SETCRITICAL;                                 <<02318>>09110000
OPTION EXTERNAL;                                               <<02318>>09120000
                                                                        09130000
   PROCEDURE RESETCRITICAL(PARM);                                       09140000
   VALUE PARM; LOGICAL PARM;                                            09150000
   OPTION EXTERNAL;                                                     09160000
                                                                        09170000
   LOGICAL PROCEDURE CALENDAR;                                          09180000
   OPTION EXTERNAL;                                                     09190000
                                                                        09200000
   DOUBLE PROCEDURE CLOCK;                                              09210000
   OPTION EXTERNAL;                                                     09220000
                                                                        09230000
   PROCEDURE TERMINATE;                                                 09240000
   OPTION EXTERNAL;                                                     09250000
                                                                        09260000
PROCEDURE FINDJCW(JCW, JCWVALUE, ERROR);                       <<U.RAO>>09270000
BYTE ARRAY JCW;                                                <<U.RAO>>09280000
LOGICAL JCWVALUE;                                              <<01461>>09290000
INTEGER ERROR;                                                 <<01461>>09300000
OPTION EXTERNAL;                                               <<U.RAO>>09310000
                                                               <<U.RAO>>09320000
PROCEDURE PUTJCW(JCW, JCWVALUE, ERROR);                        <<U.RAO>>09330000
BYTE ARRAY JCW;                                                <<U.RAO>>09340000
LOGICAL JCWVALUE;                                              <<01461>>09350000
INTEGER ERROR;                                                 <<01461>>09360000
OPTION EXTERNAL;                                               <<U.RAO>>09370000
                                                               <<U.RAO>>09380000
   LOGICAL PROCEDURE GETSIR (N);                                        09390000
   VALUE N;                                                             09400000
   LOGICAL N;                                                           09410000
   OPTION EXTERNAL;                                                     09420000
                                                                        09430000
   PROCEDURE RELSIR (N,T);                                              09440000
   VALUE N, T;                                                          09450000
   LOGICAL N, T;                                                        09460000
   OPTION EXTERNAL;                                                     09470000
                                                                        09480000
   PROCEDURE PTAPE(TF,DF);                                              09490000
   VALUE TF,DF;                                                         09500000
   INTEGER TF,DF;                                                       09510000
   OPTION EXTERNAL;                                                     09520000
                                                                        09530000
   DOUBLE PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);09540000
   VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     09550000
   INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                   09560000
   OPTION EXTERNAL;                                                     09570000
                                                                        09580000
   INTEGER PROCEDURE ALLORIN(RCODE,UNAM,PASS);                          09590000
   VALUE RCODE;                                                         09600000
   INTEGER RCODE;                                                       09610000
   ARRAY UNAM,PASS;                                                     09620000
   OPTION VARIABLE,EXTERNAL;                                            09630000
                                                                        09640000
   PROCEDURE DEALLORIN(RIN,UNAM);                                       09650000
   VALUE RIN;                                                           09660000
   INTEGER RIN;                                                         09670000
   ARRAY UNAM;                                                          09680000
   OPTION VARIABLE,EXTERNAL;                                            09690000
                                                                        09700000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<0U.EB>>09710000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>09720000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<0U.EB>>09730000
      DST,IOTYPE;                                              <<0U.EB>>09740000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<0U.EB>>09750000
      DST,IOTYPE;                                              <<0U.EB>>09760000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>09770000
                                                               <<U.RAO>>09780000
LOGICAL PROCEDURE PARSEJOBID(JOBID, RESULT);                   <<U.RAO>>09790000
BYTE ARRAY JOBID;                                              <<U.RAO>>09800000
INTEGER ARRAY RESULT;                                          <<U.RAO>>09810000
OPTION EXTERNAL;                                               <<U.RAO>>09820000
                                                               <<U.RAO>>09830000
LOGICAL PROCEDURE SCANJMAT(NEXTINDEX, JOBID, RESULT);          <<U.RAO>>09840000
INTEGER NEXTINDEX;                                             <<U.RAO>>09850000
INTEGER ARRAY JOBID;                                           <<U.RAO>>09860000
INTEGER ARRAY RESULT;                                          <<U.RAO>>09870000
OPTION EXTERNAL;                                               <<U.RAO>>09880000
                                                                        09890000
   INTEGER PROCEDURE ERRORGET(L);                                       09900000
   VALUE L;                                                             09910000
   INTEGER L;                                                           09920000
   OPTION EXTERNAL;                                                     09930000
                                                                        09940000
   PROCEDURE ERRORON;                                                   09950000
   OPTION EXTERNAL;                                                     09960000
                                                                        09970000
   PROCEDURE ABORTPROG;                                                 09980000
   OPTION EXTERNAL;                                                     09990000
                                                                        10000000
   PROCEDURE ERROREXIT(INTRINEXIT,ERRBYTES,PARAM);                      10010000
   VALUE INTRINEXIT,ERRBYTES,PARAM;                                     10020000
   LOGICAL INTRINEXIT,ERRBYTES,PARAM;                                   10030000
   OPTION EXTERNAL;                                                     10040000
                                                                        10050000
   DOUBLE PROCEDURE CHEK(INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK);          10060000
   VALUE INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK;                           10070000
   LOGICAL INTRIN,FLAGS,OPTVMASK;                                       10080000
   DOUBLE PARMS,CAPMASK;                                                10090000
   OPTION VARIABLE,EXTERNAL;                                            10100000
                                                               <<02.EB>>10110000
INTEGER PROCEDURE FORMNAME(TYPE,TARGET,BA1,BA2,BA3,BA4);       <<02.EB>>10120000
   VALUE TYPE; INTEGER TYPE;                                   <<02.EB>>10130000
   BYTE ARRAY TARGET,BA1,BA2,BA3,BA4; OPTION EXTERNAL;         <<02.EB>>10140000
                                                               <<02.EB>>10150000
PROCEDURE INITJSMP(EXPCODE); INTEGER EXPCODE;                  <<02.EB>>10160000
   OPTION EXTERNAL;                                            <<02.EB>>10170000
                                                                        10180000
PROCEDURE FMTDATE(CALENDAR',CLOCK',USERID);                    <<U.RAO>>10190000
VALUE CALENDAR', CLOCK';                                       <<U.RAO>>10200000
LOGICAL CALENDAR';                                             <<U.RAO>>10210000
DOUBLE CLOCK';                                                 <<U.RAO>>10220000
BYTE ARRAY USERID;                                             <<U.RAO>>10230000
OPTION EXTERNAL;                                               <<U.RAO>>10240000
                                                               <<U.RAO>>10250000
   PROCEDURE SUDDENDEATH(ERRORNUMBER);                                  10260000
   VALUE ERRORNUMBER;                                                   10270000
   INTEGER ERRORNUMBER;                                                 10280000
   OPTION EXTERNAL;                                                     10290000
                                                               <<*7836>>10300000
   PROCEDURE AWAKE(PCBPT,N,WTFLG);                             <<*7836>>10310000
      VALUE PCBPT,N,WTFLG;                                     <<*7836>>10320000
      INTEGER PCBPT,N,WTFLG;                                   <<*7836>>10330000
      OPTION EXTERNAL;                                         <<*7836>>10340000
                                                               <<*7836>>10350000
                                                                        10360000
PROCEDURE CXSHOWALLOW EXECUTORHEAD;                            <<00894>>10370000
OPTION EXTERNAL;                                               <<00894>>10380000
                                                               <<00894>>10390000
   PROCEDURE CXSHOWJOB EXECUTORHEAD;                                    10400000
   OPTION EXTERNAL;                                                     10410000
                                                                        10420000
   PROCEDURE CXSHOWIN EXECUTORHEAD;                                     10430000
   OPTION EXTERNAL;                                                     10440000
                                                                        10450000
   PROCEDURE CXSET EXECUTORHEAD;                                        10460000
   OPTION EXTERNAL;                                                     10470000
                                                                        10480000
   PROCEDURE CXSHOWOUT EXECUTORHEAD;                                    10490000
   OPTION EXTERNAL;                                                     10500000
                                                                        10510000
   PROCEDURE CXSHOWDEV EXECUTORHEAD;                                    10520000
   OPTION EXTERNAL;                                                     10530000
                                                                        10540000
   PROCEDURE CXSTREAM EXECUTORHEAD;                                     10550000
   OPTION EXTERNAL;                                                     10560000
LOGICAL PROCEDURE CILOGTABLE(CODE,JMATP,CNTWORD,COMMAND);    <<A00.04>> 10570000
   VALUE CODE,JMATP;                                          <<A00.04>>10580000
   INTEGER CODE,JMATP,CNTWORD;                                <<A00.04>>10590000
   INTEGER ARRAY COMMAND;                                     <<A00.04>>10600000
   OPTION EXTERNAL;                                           <<A00.04>>10610000
                                                               << 8958>>10620000
PROCEDURE RELDATASEG( DSTN );                                  << 8958>>10630000
   VALUE DSTN;                                                 << 8958>>10640000
   LOGICAL DSTN;                                               << 8958>>10650000
   OPTION EXTERNAL;                                            << 8958>>10660000
                                                               <<RH.PV>>10670000
INTEGER PROCEDURE GET'DSDEVICE( LDEV );                        <<02848>>10680000
   VALUE   LDEV;                                               <<02848>>10690000
   INTEGER LDEV;                                               <<02848>>10700000
   OPTION  PRIVILEGED, UNCALLABLE, EXTERNAL;                   <<02848>>10710000
                                                               <<02848>>10720000
PROCEDURE MOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,GEN,           <<00211>>10730000
                 PVINFO,SOME'OTHER'PIN);                       <<00211>>10740000
   VALUE GEN,SOME'OTHER'PIN;                                   <<00211>>10750000
   INTEGER REQTYPE,GEN,PVINFO,SOME'OTHER'PIN;                  <<00211>>10760000
   BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                          <<RH.PV>>10770000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>10780000
                                                               <<RH.PV>>10790000
PROCEDURE DISMOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,            <<00211>>10800000
                    MVTABX,SOME'OTHER'PIN);                    <<00211>>10810000
   VALUE MVTABX,SOME'OTHER'PIN;                                <<00211>>10820000
   INTEGER REQTYPE,MVTABX,SOME'OTHER'PIN;                      <<00211>>10830000
   BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                          <<RH.PV>>10840000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>10850000
                                                               <<RH.PV>>10860000
INTEGER PROCEDURE VSUSERCOM(REQTYPE,NUMPARMS,VSNAME);          <<RH.PV>>10870000
   VALUE REQTYPE,NUMPARMS;                                     <<RH.PV>>10880000
   INTEGER REQTYPE,NUMPARMS;                                   <<RH.PV>>10890000
   BYTE ARRAY VSNAME;                                          <<RH.PV>>10900000
   OPTION EXTERNAL;                                            <<RH.PV>>10910000
                                                               << 8152>>10920000
PROCEDURE DO'START(LDEV,LOGONSTR,JSID,JSNUM,ERR,W);            << 8152>>10930000
VALUE LDEV,W;                                                  << 8152>>10940000
LOGICAL LDEV,W;                                                << 8152>>10950000
BYTE ARRAY LOGONSTR;                                           << 8152>>10960000
INTEGER JSID;                                                  << 8152>>10970000
DOUBLE JSNUM;                                                  << 8152>>10980000
INTEGER ARRAY ERR;                                             << 8152>>10990000
OPTION EXTERNAL;                                               << 8152>>11000000
                                                               << 8152>>11010000
PROCEDURE CHECK'TERM'ATTRIBUTES(LDEV,ERR);                     << 8152>>11020000
VALUE LDEV;                                                    << 8152>>11030000
INTEGER ERR;                                                   << 8152>>11040000
LOGICAL LDEV;                                                  << 8152>>11050000
OPTION EXTERNAL;                                               << 8152>>11060000
                                                               <<RH.PV>>11070000
INTEGER PROCEDURE DSTATCOM(REQTYPE,LDEV);                      <<RH.PV>>11080000
   VALUE REQTYPE,LDEV;                                         <<RH.PV>>11090000
   INTEGER REQTYPE,LDEV;                                       <<RH.PV>>11100000
   OPTION EXTERNAL;                                            <<RH.PV>>11110000
                                                               <<RH.PV>>11120000
PROCEDURE INITUDC( SHOW, COMFN );                              <<03737>>11130000
   VALUE    SHOW, COMFN;                                       <<03737>>11140000
   LOGICAL  SHOW;                                              <<03737>>11150000
   INTEGER  COMFN;                                             <<03737>>11160000
   OPTION   VARIABLE, EXTERNAL;                                <<03737>>11170000
                                                               <<06.EB>>11180000
LOGICAL PROCEDURE UDC(COMIMAGE,OFFSET);                        <<06.EB>>11190000
   VALUE OFFSET; INTEGER OFFSET;                               <<06.EB>>11200000
   BYTE ARRAY COMIMAGE; OPTION EXTERNAL;                       <<06.EB>>11210000
                                                               <<06.EB>>11220000
PROCEDURE CXSETCATALOG EXECUTORHEAD;                           <<06.EB>>11230000
   OPTION EXTERNAL;                                            <<06.EB>>11240000
                                                               <<06.EB>>11250000
PROCEDURE CXSHOWCATALOG EXECUTORHEAD;                          <<06.EB>>11260000
   OPTION EXTERNAL;                                            <<06.EB>>11270000
PROCEDURE CXALTLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>11280000
PROCEDURE CXLISTLOG EXECUTORHEAD; OPTION EXTERNAL;             <<00506>>11290000
PROCEDURE CXSHOWLOGSTATUS EXECUTORHEAD; OPTION EXTERNAL;       <<00506>>11300000
PROCEDURE CXGETLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>11310000
PROCEDURE CXRELLOG EXECUTORHEAD; OPTION EXTERNAL;              <<00506>>11320000
                                                               <<00506>>11330000
                                                               <<06.EB>>11340000
                                                               <<00256>>11350000
INTEGER PROCEDURE THISCPU;                                     <<0306>> 11360000
   OPTION EXTERNAL;                                            <<0306>> 11370000
PROCEDURE CXOUTFENCE EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>11380000
                                                               <<00552>>11390000
PROCEDURE CXRECALL EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>11400000
                                                               <<00552>>11410000
PROCEDURE CXREFUSE EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>11420000
                                                               <<00552>>11430000
PROCEDURE CXREPLY EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>11440000
                                                               <<00552>>11450000
PROCEDURE CXRESUMEJOB EXECUTORHEAD;OPTION EXTERNAL;            <<00552>>11460000
                                                               <<00552>>11470000
<<PROCEDURE CXSPOOL EXECUTORHEAD; OPTION EXTERNAL;>>           <<00552>>11480000
                                                               <<00552>>11490000
PROCEDURE CXSTREAMS EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>11500000
                                                               <<00552>>11510000
PROCEDURE CXCONSOLE  EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>11520000
                                                               <<00552>>11530000
PROCEDURE CXTAKE EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>11540000
                                                               <<00552>>11550000
PROCEDURE CXUP EXECUTORHEAD; OPTION EXTERNAL;                  <<00552>>11560000
                                                               <<00552>>11570000
PROCEDURE CXWELCOME EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>11580000
                                                               <<00552>>11590000
PROCEDURE CXASSOCIATE EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>11600000
                                                               <<00552>>11610000
LOGICAL PROCEDURE MASTEROP; OPTION EXTERNAL;                   <<00552>>11620000
                                                               <<00552>>11630000
PROCEDURE CXMPLINE EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>11640000
                                                               <<00552>>11650000
PROCEDURE CXDSCONTROL EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>11660000
                                                               <<00552>>11670000
PROCEDURE CXMON EXECUTORHEAD; OPTION EXTERNAL;                 <<00552>>11680000
                                                               <<00552>>11690000
PROCEDURE CXMOFF EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>11700000
                                                               <<00552>>11710000
PROCEDURE CXVMOUNT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>11720000
                                                               <<00552>>11730000
PROCEDURE CXLMOUNT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>11740000
                                                               <<00552>>11750000
PROCEDURE CXLDISMOUNT EXECUTORHEAD; OPTION EXTERNAL;           <<00552>>11760000
                                                               <<00552>>11770000
PROCEDURE CXMRJECONTROL EXECUTORHEAD; OPTION EXTERNAL;         <<00552>>11780000
                                                               <<00552>>11790000
PROCEDURE CXJOBSECURITY EXECUTORHEAD; OPTION EXTERNAL;         <<00552>>11800000
                                                               <<00552>>11810000
PROCEDURE CXDISASSOCIATE EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>11820000
PROCEDURE CXRESUMENMLOG   EXECUTORHEAD; OPTION EXTERNAL;       <<06847>>11830000
                                                               <<06847>>11840000
PROCEDURE CXNETCONTROL    EXECUTORHEAD; OPTION EXTERNAL;       <<06847>>11850000
                                                               <<06847>>11860000
PROCEDURE CXSWITCHNMLOG   EXECUTORHEAD; OPTION EXTERNAL;       <<06847>>11870000
                                                               <<06847>>11880000
PROCEDURE CXSHOWNMLOG     EXECUTORHEAD; OPTION EXTERNAL;       <<06847>>11890000
                                                               <<06847>>11900000
PROCEDURE CXSNACONTROL    EXECUTORHEAD; OPTION EXTERNAL;       <<06847>>11910000
                                                               <<06847>>11920000
PROCEDURE CXNRJECONTROL2  EXECUTORHEAD; OPTION EXTERNAL;       <<06847>>11930000
                                                               <<06847>>11940000
PROCEDURE CXLINKCONTROL   EXECUTORHEAD; OPTION EXTERNAL;       <<06847>>11950000
                                                               <<06847>>11960000
PROCEDURE CXSTARTSPOOL EXECUTORHEAD; OPTION EXTERNAL;          <<00552>>11970000
PROCEDURE CXSTOPSPOOL  EXECUTORHEAD; OPTION EXTERNAL;          <<00552>>11980000
PROCEDURE CXSUSPENDSPOOL EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>11990000
PROCEDURE CXRESUMESPOOL  EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>12000000
PROCEDURE CXALTSPOOLFILE EXECUTORHEAD; OPTION EXTERNAL;        <<00552>>12010000
PROCEDURE CXDELETESPOOLFILE EXECUTORHEAD; OPTION EXTERNAL;     <<00552>>12020000
PROCEDURE CXOPENQ EXECUTORHEAD; OPTION EXTERNAL;               <<06851>>12030000
PROCEDURE CXSHUTQ EXECUTORHEAD; OPTION EXTERNAL;               <<06851>>12040000
                                                               <<00552>>12050000
PROCEDURE CXDOWNLOAD EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>12060000
                                                               <<00552>>12070000
PROCEDURE CXABORTIO EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>12080000
                                                               <<00552>>12090000
PROCEDURE CXABORTJOB EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>12100000
                                                               <<00552>>12110000
PROCEDURE CXACCEPT EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>12120000
                                                               <<00552>>12130000
PROCEDURE CXALLOW EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>12140000
                                                               <<00552>>12150000
<<PROCEDURE CXALTFILE EXECUTORHEAD; OPTION EXTERNAL;>>         <<00552>>12160000
                                                               <<00552>>12170000
PROCEDURE CXALTJOB EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>12180000
                                                               <<00552>>12190000
PROCEDURE CXBREAKJOB EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>12200000
                                                               <<00552>>12210000
<<PROCEDURE CXDELETE EXECUTORHEAD; OPTION EXTERNAL;>>          <<00552>>12220000
                                                               <<00552>>12230000
PROCEDURE CXDISALLOW EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>12240000
                                                               <<00552>>12250000
PROCEDURE CXDOWN EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>12260000
                                                               <<00552>>12270000
PROCEDURE CXGIVE EXECUTORHEAD; OPTION EXTERNAL;                <<00552>>12280000
                                                               <<00552>>12290000
PROCEDURE CXHEADOFF EXECUTORHEAD; OPTION EXTERNAL;             <<00552>>12300000
                                                               <<00552>>12310000
PROCEDURE CXHEADON EXECUTORHEAD; OPTION EXTERNAL;              <<00552>>12320000
                                                               <<00552>>12330000
PROCEDURE CXJOBFENCE EXECUTORHEAD; OPTION EXTERNAL;            <<00552>>12340000
                                                               <<00552>>12350000
PROCEDURE CXLIMIT EXECUTORHEAD; OPTION EXTERNAL;               <<00552>>12360000
                                                               <<06850>>12370000
PROCEDURE CXSTARTCACHE EXECUTORHEAD;  OPTION EXTERNAL;         <<06850>>12380000
                                                               <<06850>>12390000
PROCEDURE CXSTOPCACHE EXECUTORHEAD;  OPTION EXTERNAL;          <<06850>>12400000
                                                               <<06850>>12410000
PROCEDURE CXSHOWCACHE EXECUTORHEAD; OPTION EXTERNAL;           <<06850>>12420000
                                                               <<06850>>12430000
                                                               <<06850>>12440000
PROCEDURE CXCACHECONTROL EXECUTORHEAD;                                  12450000
OPTION EXTERNAL;                                                        12460000
                                                                        12470000
PROCEDURE CXNRJE EXECUTORHEAD;  OPTION EXTERNAL;                        12480000
                                                               <<00552>>12490000
PROCEDURE CRUNCH(N1,N2,N3,DEST,NWORDS);                        <<02554>>12500000
   INTEGER NWORDS;                                             <<02554>>12510000
   INTEGER ARRAY DEST;                                         <<02554>>12520000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>12530000
   OPTION EXTERNAL;                                            <<02554>>12540000
PROCEDURE CXLOG EXECUTORHEAD; OPTION EXTERNAL;                 <<00601>>12550000
PROCEDURE CXMIOENABLE EXECUTORHEAD; OPTION EXTERNAL;           <<00575>>12560000
                                                               <<00575>>12570000
PROCEDURE CXMIODISABLE EXECUTORHEAD; OPTION EXTERNAL;          <<00575>>12580000
                                                               <<00575>>12590000
PROCEDURE CXTUNE EXECUTORHEAD; OPTION EXTERNAL;                <<01549>>12600000
                                                               << I.A >>12610000
PROCEDURE APLTRANSLATEOUT(MESSAGE,LENGTH,TRANSTYPE);           << I.A >>12620000
  VALUE LENGTH,TRANSTYPE;                                      << I.A >>12630000
  INTEGER LENGTH,TRANSTYPE;                                    << I.A >>12640000
  BYTE ARRAY MESSAGE;                                          << I.A >>12650000
  OPTION EXTERNAL;                                             << I.A >>12660000
                                                               << I.A >>12670000
PROCEDURE CXRJE EXECUTORHEAD;                                  << I.A >>12680000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>12690000
         EXTERNAL;                                             << I.A >>12700000
                                                               << I.A >>12710000
PROCEDURE CXSETDUMP EXECUTORHEAD;                              << I.A >>12720000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>12730000
         EXTERNAL;                                             << I.A >>12740000
                                                               << I.A >>12750000
PROCEDURE CXSYSDUMP EXECUTORHEAD;                              << I.A >>12760000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>12770000
         EXTERNAL;                                             << I.A >>12780000
                                                               << I.A >>12790000
PROCEDURE CXNEWACCT EXECUTORHEAD;                              << I.A >>12800000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>12810000
         EXTERNAL;                                             << I.A >>12820000
                                                               << I.A >>12830000
PROCEDURE CXCLINE EXECUTORHEAD;                                << I.A >>12840000
  OPTION PRIVILEGED,                                           << I.A >>12850000
         EXTERNAL;                                             << I.A >>12860000
                                                               << I.A >>12870000
PROCEDURE CXSHOWLOG EXECUTORHEAD;                              << I.A >>12880000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>12890000
         EXTERNAL;                                             << I.A >>12900000
                                                               << I.A >>12910000
PROCEDURE CXBASICGO EXECUTORHEAD;                              << I.A >>12920000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>12930000
         EXTERNAL;                                             << I.A >>12940000
                                                               << I.A >>12950000
PROCEDURE CXBASICPREP EXECUTORHEAD;                            << I.A >>12960000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>12970000
         EXTERNAL;                                             << I.A >>12980000
                                                               << I.A >>12990000
PROCEDURE CXSHOWQ EXECUTORHEAD;                                << I.A >>13000000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13010000
         EXTERNAL;                                             << I.A >>13020000
                                                               << I.A >>13030000
PROCEDURE CXJOBPRI EXECUTORHEAD;                               << I.A >>13040000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13050000
         EXTERNAL;                                             << I.A >>13060000
                                                               << I.A >>13070000
PROCEDURE CXPURGE EXECUTORHEAD;                                << I.A >>13080000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13090000
         EXTERNAL;                                             << I.A >>13100000
                                                               << I.A >>13110000
PROCEDURE CXPURGEUSER EXECUTORHEAD;                            << I.A >>13120000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13130000
         EXTERNAL;                                             << I.A >>13140000
                                                               << I.A >>13150000
PROCEDURE CX3270MGR EXECUTORHEAD;                              << I.A >>13160000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13170000
         EXTERNAL;                                             << I.A >>13180000
                                                               << I.A >>13190000
PROCEDURE CXLISTVS EXECUTORHEAD;                               << I.A >>13200000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13210000
         EXTERNAL;                                             << I.A >>13220000
                                                               << I.A >>13230000
PROCEDURE CXRPGPREP EXECUTORHEAD;                              << I.A >>13240000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13250000
         EXTERNAL;                                             << I.A >>13260000
                                                               << I.A >>13270000
PROCEDURE CXPURGEACCT EXECUTORHEAD;                            << I.A >>13280000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13290000
         EXTERNAL;                                             << I.A >>13300000
                                                               << I.A >>13310000
PROCEDURE CXPURGEVSET EXECUTORHEAD;                            << I.A >>13320000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13330000
         EXTERNAL;                                             << I.A >>13340000
                                                               << I.A >>13350000
PROCEDURE CXFCOPY EXECUTORHEAD;                                << I.A >>13360000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13370000
         EXTERNAL;                                             << I.A >>13380000
                                                               << I.A >>13390000
PROCEDURE CXPREPRUN EXECUTORHEAD;                              << I.A >>13400000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13410000
         EXTERNAL;                                             << I.A >>13420000
                                                               << I.A >>13430000
PROCEDURE CXQUANTUM EXECUTORHEAD;                              << I.A >>13440000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13450000
         EXTERNAL;                                             << I.A >>13460000
                                                               << I.A >>13470000
PROCEDURE CXALLOCATE EXECUTORHEAD;                             << I.A >>13480000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13490000
         EXTERNAL;                                             << I.A >>13500000
                                                               << I.A >>13510000
PROCEDURE CXLISTACCT EXECUTORHEAD;                             << I.A >>13520000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13530000
         EXTERNAL;                                             << I.A >>13540000
                                                               << I.A >>13550000
PROCEDURE CXFORTGO EXECUTORHEAD;                               << I.A >>13560000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13570000
         EXTERNAL;                                             << I.A >>13580000
                                                               << I.A >>13590000
PROCEDURE CXPREP EXECUTORHEAD;                                 << I.A >>13600000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13610000
         EXTERNAL;                                             << I.A >>13620000
                                                               << I.A >>13630000
PROCEDURE CXSAVE EXECUTORHEAD;                                 << I.A >>13640000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13650000
         EXTERNAL;                                             << I.A >>13660000
                                                                        13670000
PROCEDURE CXPARTBACKUP EXECUTORHEAD;                                    13680000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                                  13690000
                                                                        13700000
PROCEDURE CXFULLBACKUP EXECUTORHEAD;                                    13710000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                                  13720000
                                                                        13730000
                                                               << I.A >>13740000
PROCEDURE CXRPG EXECUTORHEAD;                                  << I.A >>13750000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13760000
         EXTERNAL;                                             << I.A >>13770000
                                                               << I.A >>13780000
PROCEDURE CXALTUSER EXECUTORHEAD;                              << I.A >>13790000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13800000
         EXTERNAL;                                             << I.A >>13810000
                                                               << I.A >>13820000
PROCEDURE CXVINIT EXECUTORHEAD;                                << I.A >>13830000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13840000
         EXTERNAL;                                             << I.A >>13850000
                                                               << I.A >>13860000
PROCEDURE CXSECURE EXECUTORHEAD;                               << I.A >>13870000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>13880000
         EXTERNAL;                                             << I.A >>13890000
                                                               << I.A >>13900000
PROCEDURE CXFORTRAN EXECUTORHEAD;                              << I.A >>13910000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13920000
         EXTERNAL;                                             << I.A >>13930000
                                                               << I.A >>13940000
PROCEDURE CXSPLGO EXECUTORHEAD;                                << I.A >>13950000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>13960000
         EXTERNAL;                                             << I.A >>13970000
                                                               << I.A >>13980000
PROCEDURE CXRESETDUMP EXECUTORHEAD;                            << I.A >>13990000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14000000
         EXTERNAL;                                             << I.A >>14010000
                                                               << I.A >>14020000
PROCEDURE CXDSCOPY EXECUTORHEAD;                               << I.A >>14030000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>14040000
         EXTERNAL;                                             << I.A >>14050000
                                                               << I.A >>14060000
PROCEDURE CXRENAME EXECUTORHEAD;                               << I.A >>14070000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14080000
         EXTERNAL;                                             << I.A >>14090000
                                                               << I.A >>14100000
PROCEDURE CXALTSEC EXECUTORHEAD;                               << I.A >>14110000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14120000
         EXTERNAL;                                             << I.A >>14130000
                                                               << I.A >>14140000
PROCEDURE CXAPL EXECUTORHEAD;                                  << I.A >>14150000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14160000
         EXTERNAL;                                             << I.A >>14170000
                                                               << I.A >>14180000
PROCEDURE  CXNEWUSER EXECUTORHEAD;                             << I.A >>14190000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>14200000
         EXTERNAL;                                             << I.A >>14210000
                                                               << I.A >>14220000
PROCEDURE CXRELEASE EXECUTORHEAD;                              << I.A >>14230000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14240000
         EXTERNAL;                                             << I.A >>14250000
                                                               << I.A >>14260000
PROCEDURE CXRESETACCT EXECUTORHEAD;                            << I.A >>14270000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14280000
         EXTERNAL;                                             << I.A >>14290000
                                                               << I.A >>14300000
PROCEDURE CXLISTF EXECUTORHEAD;                                << I.A >>14310000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14320000
         EXTERNAL;                                             << I.A >>14330000
                                                               << I.A >>14340000
PROCEDURE CXBUILD EXECUTORHEAD;                                << I.A >>14350000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14360000
         EXTERNAL;                                             << I.A >>14370000
                                                               << I.A >>14380000
PROCEDURE CX3270 EXECUTORHEAD;                                 << I.A >>14390000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>14400000
         EXTERNAL;                                             << I.A >>14410000
                                                               << I.A >>14420000
PROCEDURE CXSEGMENTER EXECUTORHEAD;                            << I.A >>14430000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14440000
         EXTERNAL;                                             << I.A >>14450000
                                                               << I.A >>14460000
PROCEDURE CXCOBOLPREP EXECUTORHEAD;                            << I.A >>14470000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14480000
         EXTERNAL;                                             << I.A >>14490000
                                                               << I.A >>14500000
PROCEDURE CXCOBOL EXECUTORHEAD;                                << I.A >>14510000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14520000
         EXTERNAL;                                             << I.A >>14530000
                                                               <<06131>>14540000
PROCEDURE CXCOBOLII EXECUTORHEAD;                              <<06131>>14550000
  OPTION PRIVILEGED, UNCALLABLE,                               <<06131>>14560000
         EXTERNAL;                                             <<06131>>14570000
                                                               <<06131>>14580000
PROCEDURE CXCOBOLIIPREP EXECUTORHEAD;                          <<06131>>14590000
  OPTION PRIVILEGED, UNCALLABLE,                               <<06131>>14600000
         EXTERNAL;                                             <<06131>>14610000
                                                               <<06131>>14620000
PROCEDURE CXCOBOLIIGO EXECUTORHEAD;                            <<06131>>14630000
  OPTION PRIVILEGED, UNCALLABLE,                               <<06131>>14640000
         EXTERNAL;                                             <<06131>>14650000
                                                               << I.A >>14660000
PROCEDURE CXRUN EXECUTORHEAD;                                  << I.A >>14670000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14680000
         EXTERNAL;                                             << I.A >>14690000
                                                               << I.A >>14700000
PROCEDURE CXRESET EXECUTORHEAD;                                << I.A >>14710000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>14720000
         EXTERNAL;                                             << I.A >>14730000
                                                               << I.A >>14740000
PROCEDURE CXSETMSG EXECUTORHEAD;                               << I.A >>14750000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>14760000
         EXTERNAL;                                             << I.A >>14770000
                                                               << I.A >>14780000
PROCEDURE CXALTVSET EXECUTORHEAD;                              << I.A >>14790000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14800000
         EXTERNAL;                                             << I.A >>14810000
                                                               << I.A >>14820000
PROCEDURE CXSPLPREP EXECUTORHEAD;                              << I.A >>14830000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14840000
         EXTERNAL;                                             << I.A >>14850000
                                                               << I.A >>14860000
PROCEDURE CXRESUMELOG EXECUTORHEAD;                            << I.A >>14870000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>14880000
         EXTERNAL;                                             << I.A >>14890000
                                                               << I.A >>14900000
PROCEDURE CXDEALLOCATE EXECUTORHEAD;                           << I.A >>14910000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>14920000
         EXTERNAL;                                             << I.A >>14930000
                                                               << I.A >>14940000
PROCEDURE CXLISTGROUP EXECUTORHEAD;                            << I.A >>14950000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>14960000
         EXTERNAL;                                             << I.A >>14970000
                                                               << I.A >>14980000
PROCEDURE CXLISTUSER EXECUTORHEAD;                             << I.A >>14990000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15000000
         EXTERNAL;                                             << I.A >>15010000
                                                               << I.A >>15020000
PROCEDURE CXFORTPREP EXECUTORHEAD;                             << I.A >>15030000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15040000
         EXTERNAL;                                             << I.A >>15050000
                                                               << I.A >>15060000
PROCEDURE CXPURGEGROUP EXECUTORHEAD;                           << I.A >>15070000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15080000
         EXTERNAL;                                             << I.A >>15090000
                                                               << I.A >>15100000
PROCEDURE CXCRESET EXECUTORHEAD;                               << I.A >>15110000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15120000
         EXTERNAL;                                             << I.A >>15130000
                                                               << I.A >>15140000
PROCEDURE CXNEWVSET EXECUTORHEAD;                              << I.A >>15150000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15160000
         EXTERNAL;                                             << I.A >>15170000
                                                               << I.A >>15180000
PROCEDURE CXBASIC EXECUTORHEAD;                                << I.A >>15190000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15200000
         EXTERNAL;                                             << I.A >>15210000
                                                               << I.A >>15220000
PROCEDURE CXMRJE EXECUTORHEAD;                                 << I.A >>15230000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15240000
         EXTERNAL;                                             << I.A >>15250000
                                                               << I.A >>15260000
PROCEDURE CXRPGGO EXECUTORHEAD;                                << I.A >>15270000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15280000
         EXTERNAL;                                             << I.A >>15290000
                                                               << I.A >>15300000
PROCEDURE CXALTGROUP EXECUTORHEAD;                             << I.A >>15310000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15320000
         EXTERNAL;                                             << I.A >>15330000
                                                               << I.A >>15340000
PROCEDURE CXEDITOR EXECUTORHEAD;                               << I.A >>15350000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15360000
         EXTERNAL;                                             << I.A >>15370000
                                                               << I.A >>15380000
PROCEDURE CXREPORT EXECUTORHEAD;                               << I.A >>15390000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15400000
         EXTERNAL;                                             << I.A >>15410000
                                                               << I.A >>15420000
PROCEDURE CXSWITCHLOG;                                         << I.A >>15430000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15440000
         EXTERNAL;                                             << I.A >>15450000
                                                               << I.A >>15460000
PROCEDURE CXCOBOLGO EXECUTORHEAD;                              << I.A >>15470000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15480000
         EXTERNAL;                                             << I.A >>15490000
                                                               << I.A >>15500000
PROCEDURE CX3270CONTROL EXECUTORHEAD;                          << I.A >>15510000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15520000
         EXTERNAL;                                             << I.A >>15530000
                                                               << I.A >>15540000
PROCEDURE CXSPL EXECUTORHEAD;                                  << I.A >>15550000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15560000
         EXTERNAL;                                             << I.A >>15570000
                                                               << I.A >>15580000
PROCEDURE CXBASICOMP EXECUTORHEAD;                             << I.A >>15590000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15600000
         EXTERNAL;                                             << I.A >>15610000
                                                               << I.A >>15620000
PROCEDURE CXNEWGROUP EXECUTORHEAD;                             << I.A >>15630000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15640000
         EXTERNAL;                                             << I.A >>15650000
                                                               << I.A >>15660000
PROCEDURE CXALTACCT EXECUTORHEAD;                              << I.A >>15670000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15680000
         EXTERNAL;                                             << I.A >>15690000
                                                               << I.A >>15700000
PROCEDURE CXFILE EXECUTORHEAD;                                 << I.A >>15710000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15720000
         EXTERNAL;                                             << I.A >>15730000
                                                               << I.A >>15740000
PROCEDURE CXPASCAL EXECUTORHEAD;                               << I.A >>15750000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15760000
         EXTERNAL;                                             << I.A >>15770000
                                                               << I.A >>15780000
PROCEDURE CXPASCALPREP EXECUTORHEAD;                           << I.A >>15790000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>15800000
         EXTERNAL;                                             << I.A >>15810000
                                                               << I.A >>15820000
PROCEDURE CXPASCALGO EXECUTORHEAD;                             << I.A >>15830000
  OPTION PRIVILEGED, UNCALLABLE,                               << I.A >>15840000
         EXTERNAL;                                             << I.A >>15850000
                                                               << 8246>>15860000
PROCEDURE CXLISTEQ EXECUTORHEAD;                               << 8246>>15870000
  OPTION EXTERNAL, PRIVILEGED, UNCALLABLE;                     << 8246>>15880000
                                                               << 8246>>15890000
PROCEDURE CXLISTFTEMP EXECUTORHEAD;                            << 8246>>15900000
  OPTION EXTERNAL, PRIVILEGED, UNCALLABLE;                     << 8246>>15910000
                                                               << 8246>>15920000
                                                               << I.A >>15930000
                                                               << 8199>>15940000
INTEGER PROCEDURE XRETJTENTRY(N1,N2,N3,SIZE,INFO);             <<02554>>15950000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>15960000
   INTEGER SIZE;                                               <<02554>>15970000
   INTEGER ARRAY INFO;                                         <<02554>>15980000
   OPTION EXTERNAL;                                            <<02554>>15990000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<U.RAO>>16000000
VALUE FNUM;                                                    <<U.RAO>>16010000
INTEGER FNUM,PARMNUM;                                          <<U.RAO>>16020000
OPTION PRIVILEGED, UNCALLABLE,FORWARD;                         <<U.RAO>>16030000
                                                                        16040000
   PROCEDURE CIERR(ERRNUM,ERRADR,PARMMASK,PARM);               <<U.RAO>>16050000
   VALUE ERRNUM,PARMMASK,PARM;                                 <<U.RAO>>16060000
   INTEGER ERRNUM,PARMMASK,PARM;                               <<U.RAO>>16070000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>16080000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE,FORWARD;              <<U.RAO>>16090000
                                                               <<U.RAO>>16100000
   PROCEDURE PRINTCICARET(ERRADR);                             << 8560>>16110000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>16120000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                       <<U.RAO>>16130000
                                                               <<U.RAO>>16140000
                                                                        16150000
PROCEDURE CYDIRERR'(DIRECRETURN,OKMASK,ERRNUM);                <<U.RAO>>16160000
VALUE DIRECRETURN,OKMASK;                                      <<U.RAO>>16170000
DOUBLE DIRECRETURN;                                            <<U.RAO>>16180000
INTEGER ERRNUM;                                                <<U.RAO>>16190000
LOGICAL OKMASK;                                                <<U.RAO>>16200000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>16210000
                                                                        16220000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>16230000
VALUE PDEF; DOUBLE PDEF;                                       <<U.RAO>>16240000
LOGICAL GPTR,APTR,ERRPTR;                                      <<U.RAO>>16250000
OPTION PRIVILEGED, UNCALLABLE, FORWARD;                        <<U.RAO>>16260000
                                                               <<U.RAO>>16270000
LOGICAL PROCEDURE CIBADFILENAME(ERRNUM,PARM);                  <<U.RAO>>16280000
VALUE PARM;                                                    <<U.RAO>>16290000
INTEGER ERRNUM;                                                <<U.RAO>>16300000
DOUBLE PARM;                                                   <<U.RAO>>16310000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>16320000
                                                               <<U.RAO>>16330000
LOGICAL PROCEDURE CREATEERROR;                                 <<U.RAO>>16340000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<U.RAO>>16350000
                                                               <<U.RAO>>16360000
PROCEDURE CONDEXP(EXP,EVALUE,ERRNUM,ENDADR,PARMNUM);           <<U.RAO>>16370000
BYTE ARRAY EXP;                                                <<U.RAO>>16380000
LOGICAL EVALUE;                                                <<U.RAO>>16390000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>16400000
OPTION FORWARD;                                                <<U.RAO>>16410000
PROCEDURE TRANSJCWEQUATE(PARM, VAL, ERR, ADR);                 <<U.RAO>>16420000
BYTE ARRAY PARM;                                               <<U.RAO>>16430000
INTEGER VAL;                                                   <<U.RAO>>16440000
INTEGER ERR,ADR;                                               <<U.RAO>>16450000
OPTION FORWARD;                                                <<U.RAO>>16460000
                                                                        16470000
   LOGICAL PROCEDURE REQUESTSERVICE;                                    16480000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                16490000
                                                                        16500000
   PROCEDURE SETSERVICE(DISP);                                          16510000
   VALUE DISP;                                                          16520000
   LOGICAL DISP;                                                        16530000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                16540000
                                                                        16550000
   PROCEDURE WELCOMEMES(WDST,FUNNYTERMINAL);                  <<A00.04>>16560000
   VALUE WDST,FUNNYTERMINAL;                                  <<A00.04>>16570000
   LOGICAL FUNNYTERMINAL;                                     <<A00.04>>16580000
   INTEGER WDST;                                                        16590000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                16600000
                                                               <<DS0.0>>16610000
   PROCEDURE CXDSLINED EXECUTORHEAD;                           <<DS0.0>>16620000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                      << I.A >>16630000
                                                               <<DS0.0>>16640000
   PROCEDURE CXREMOTED EXECUTORHEAD;                           <<DS0.0>>16650000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                      << I.A >>16660000
                                                               <<DS0.0>>16670000
   LOGICAL PROCEDURE CREATEPROC'ERR(ERROR,ERRNUM);             <<01452>>16680000
   VALUE ERROR; INTEGER ERROR,ERRNUM;                          <<01452>>16690000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                       <<01452>>16700000
                                                               <<01452>>16710000
   PROCEDURE CXRFAD EXECUTORHEAD;                              <<DS0.0>>16720000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                      << I.A >>16730000
                                                                        16740000
   PROCEDURE CXSHOWCOM EXECUTORHEAD;                                    16750000
   OPTION EXTERNAL,PRIVILEGED,UNCALLABLE;                      << I.A >>16760000
                                                               <<01115>>16770000
PROCEDURE CXFOREIGN EXECUTORHEAD;                              <<01115>>16780000
OPTION EXTERNAL;                                               <<01115>>16790000
                                                               <<01452>>16800000
LOGICAL PROCEDURE JOBSESSIONMAIN; OPTION FORWARD;              <<14.EB>>16810000
                                                               <<04193>>16820000
PROCEDURE STACKMARK( WHICH, DELQ, STAT, RELP, XREG );          <<04193>>16830000
   VALUE WHICH;                                                <<04193>>16840000
   INTEGER WHICH, DELQ, STAT, RELP, XREG;                      <<04193>>16850000
OPTION VARIABLE, UNCALLABLE, PRIVILEGED, FORWARD;              <<04193>>16860000
                                                               <<04193>>16870000
PROCEDURE SYSINTERR( ERRN, BACK );                             <<04193>>16880000
   VALUE   ERRN, BACK;                                         <<04193>>16890000
   INTEGER ERRN, BACK;                                         <<04193>>16900000
OPTION UNCALLABLE, PRIVILEGED, FORWARD;                        <<04193>>16910000
                                                               << 8146>>16920000
PROCEDURE ALMANAC(DATE,ERROR,YEAR,MONTH,DAY,WEEKDAY);          << 8146>>16930000
VALUE DATE;                                                    << 8146>>16940000
LOGICAL DATE;                                                  << 8146>>16950000
INTEGER ERROR,YEAR,MONTH,DAY,WEEKDAY;                          << 8146>>16960000
OPTION EXTERNAL,VARIABLE;                                      << 8146>>16970000
                                                               <<04193>>16980000
                                                               <<14.EB>>16990000
$PAGE   "MISC. COMMAND EXECUTORS -- JOB, HELLO,BYE ETC."                17000000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>17010000
                                                                        17020000
      PROCEDURE CXJOB EXECUTORHEAD;                                     17030000
      OPTION PRIVILEGED, UNCALLABLE;                                    17040000
      BEGIN                                                             17050000
      COMMENT                                                           17060000
      CXJOB IS THE EXECUTOR FOR JOB,EOJ,HELLO,BYE&DATA                  17070000
      COMMAND FORMAT                                                    17080000
      JOB                                                               17090000
      EOJ                                                               17100000
      DATA                                                              17110000
      BYE                                                               17120000
      HELLO                                                             17130000
      ;                                                                 17140000
      ENTRY CXEOJ,CXHELLO,CXBYE,CXDATA;                                 17150000
CXHELLO: << HELLO COMMAND >>                                   <<02329>>17160000
CXDATA:  << DATA COMMAND >>                                    <<02329>>17170000
       CIERR(ERRNUM := BADLOGONSTRING);                        <<02329>>17180000
       RETURN;                                                 <<02329>>17190000
CXEOJ:  << END OF JOB >>                                       <<02329>>17200000
CXBYE:  << END CXJOB  >>                                       <<02329>>17210000
      TERMINATE;                                                        17220000
      END;<<CXJOB>>                                                     17230000
      PROCEDURE CXEOD EXECUTORHEAD;                                     17240000
      OPTION PRIVILEGED, UNCALLABLE;                                    17250000
      BEGIN                                                             17260000
      COMMENT                                                           17270000
      CXEOD IS THE EXECUTOR FOR THE EOD COMMAND                         17280000
      COMMAND FORMAT                                                    17290000
      EOD                                                               17300000
      ;                                                                 17310000
      CIERR(-IGNORED);  <<UNIMPORTANT TO CI>>                  <<U.RAO>>17320000
      END;<<EOD>>                                                       17330000
      PROCEDURE CXPTAPE EXECUTORHEAD;                                   17340000
      OPTION PRIVILEGED, UNCALLABLE;                                    17350000
      BEGIN                                                             17360000
      COMMENT                                                           17370000
      CXPTAPE IS THE EXECUTOR FOR THE PTAPE COMMAND                     17380000
      COMMAND FORMAT                                                    17390000
      PTAPE FILENAME                                                    17400000
      ;                                                                 17410000
      DOUBLE ARRAY PARM(0:1)=Q;                                <<U.RAO>>17420000
      BYTE POINTER BADPARM=PARM+2;                             <<U.RAO>>17430000
   DOUBLE DL := COMMASEMICR;                                   <<U.RAO>>17440000
      BYTE POINTER FNAME = PARM;                                        17450000
      BYTE LEN = PARM + 1;                                              17460000
      INTEGER NUMPARMS, FN1, FN2;                                       17470000
                                                                        17480000
      MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARM);                    <<U.RAO>>17490000
      IF NUMPARMS > 1 THEN  <<TOO MANY PARAMETERS>>            <<U.RAO>>17500000
         BEGIN                                                 <<U.RAO>>17510000
         PARMNUM := 2;                                         <<U.RAO>>17520000
         CIERR(ERRNUM := PTAPE2MP,BADPARM);                    <<U.RAO>>17530000
         RETURN;                                               <<U.RAO>>17540000
         END;                                                  <<U.RAO>>17550000
      IF NUMPARMS = 0 THEN  <<REQUIRES 1 PARM>>                <<U.RAO>>17560000
         BEGIN                                                 <<U.RAO>>17570000
         PARMNUM := 1;                                         <<U.RAO>>17580000
         CIERR(ERRNUM := PTAPENOFILE, PARMSP);                 <<U.RAO>>17590000
         RETURN;                                               <<U.RAO>>17600000
         END;                                                  <<U.RAO>>17610000
      IF CIBADFILENAME(ERRNUM,PARM) THEN                       <<U.RAO>>17620000
         BEGIN                                                 <<U.RAO>>17630000
         PARMNUM := 1;                                         <<U.RAO>>17640000
         RETURN                                                <<U.RAO>>17650000
         END;                                                  <<U.RAO>>17660000
      FN1 := FOPEN(,%44);<<OPEN $STDIN,ASCII>>                          17670000
      IF CARRY THEN  <<OPEN FAILED FOR SOME REASON>>           <<U.RAO>>17680000
         BEGIN                                                 <<U.RAO>>17690000
         CIERR(ERRNUM := PTAPETERMFILE);                       <<U.RAO>>17700000
         RETURN                                                <<U.RAO>>17710000
         END;                                                  <<U.RAO>>17720000
      FN2:=FOPEN(FNAME,%2107,%101);<<DISCFILE,OLD,ASCII,VAR,NO FILE EQ>>17730000
      IF CARRY THEN<<FOPEN OK?>>                                        17740000
         BEGIN<<NO>>                                                    17750000
         FCLOSE(FN1,0,0);<<CLOSE $STDIN>>                               17760000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>17770000
         FNAME(LEN) := 0;                                      <<U.RAO>>17780000
         CIERR(ERRNUM := PTAPEOPENFAILED,,0,@FNAME);           <<U.RAO>>17790000
         RETURN;                                               <<U.RAO>>17800000
         END;                                                           17810000
      PTAPE(FN1,FN2);<<READ PAPER TAPE IN>>                             17820000
      IF < THEN    <<CCL FROM PTAPE => ERROR ON $STDIN>>       <<U.RAO>>17830000
         BEGIN                                                 <<U.RAO>>17840000
         FERROR'(FN1,PARMNUM);                                 <<U.RAO>>17850000
         CIERR(ERRNUM := PTAPEFSERR,,%10000,PARMNUM);          <<U.RAO>>17860000
         FCLOSE(FN2,0,0);                                      <<U.RAO>>17870000
         RETURN;                                               <<U.RAO>>17880000
         END;                                                  <<U.RAO>>17890000
      IF > THEN  <<CCG FROM PTAPE => ERROR ON TARGET FILE>>    <<U.RAO>>17900000
         BEGIN                                                 <<U.RAO>>17910000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>17920000
         CIERR(ERRNUM := PTAPETOFSERR,,%10000,PARMNUM);        <<U.RAO>>17930000
         FCLOSE(FN1,0,0);                                      <<U.RAO>>17940000
         RETURN                                                <<U.RAO>>17950000
         END;                                                  <<U.RAO>>17960000
      FCLOSE(FN1,0,0);                                         <<U.RAO>>17970000
      FCLOSE(FN2,0,0);                                         <<U.RAO>>17980000
      IF CARRY THEN                                            <<U.RAO>>17990000
         BEGIN                                                 <<U.RAO>>18000000
         FERROR'(FN2,PARMNUM);                                 <<U.RAO>>18010000
         CIERR(ERRNUM := PTAPECLOSEERR,,%10000,PARMNUM);       <<U.RAO>>18020000
         END;                                                  <<U.RAO>>18030000
END;   <<CXPTAPE>>                                             <<U.RAO>>18040000
PROCEDURE FORMUSERID(USERID);                                  <<U.RAO>>18050000
BYTE ARRAY USERID;                                             <<U.RAO>>18060000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>18070000
<<THIS PROCEDURE FORMS A USER ID FOR THE CALLER'S USER>>       <<U.RAO>>18080000
<<OF THE FORM J/S NNN USER.ACCOUNT,LOGON GROUP>>               <<U.RAO>>18090000
BEGIN                                                          <<U.RAO>>18100000
INTEGER ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                      <<06846>>18110000
INTEGER JIT'DSTN;                                              <<06846>>18120000
BYTE ARRAY UNAME(*) = JITUSERNAME;                             <<06846>>18130000
BYTE ARRAY LGNAME(*) = JITLOGONGROUP;                          <<06846>>18140000
BYTE ARRAY ANAME(*) = JITHACCTNAME;                            <<06846>>18150000
BYTE ARRAY USERSNUM(0:5);  <<J/S NNN>>                         <<U.RAO>>18160000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>18170000
INTEGER PCBGLOBLOC;                                            <<06580>>18180000
EQUATE SESSIONTYPE = 1;  <<BIT PATTERN IN JOB NUMBER WORD>>    << I.A >>18190000
                                                               <<U.RAO>>18200000
PXGLOBAL;                                                      <<06580>>18210000
JIT'DSTN:=PXG'JITDST;                                          <<06846>>18220000
TOS:=@JITARR;                                                  <<06846>>18230000
TOS:=JIT'DSTN;                                                 <<06846>>18240000
TOS:=0;                                                        <<06846>>18250000
TOS:=JIT'ENTRY'SIZE;                                           <<06846>>18260000
ASSEMBLE(MFDS 4);                                              <<06846>>18270000
<<NOW CONVERT JOB TYPE/NUMBER TO STRING>>                      <<U.RAO>>18280000
USERSNUM(2) := " ";                                            <<U.RAO>>18290000
MOVE USERSNUM(3) := USERSNUM(2),(3);                           <<00749>>18300000
IF JITJSTYPE = SESSIONTYPE THEN                                <<06846>>18310000
   USERSNUM := "S"                                             <<U.RAO>>18320000
ELSE                                                           <<U.RAO>>18330000
   USERSNUM := "J";                                            <<U.RAO>>18340000
ASCII(JITJOBNUMBER,10,USERSNUM(1)); << Session number >>       <<06846>>18350000
FORMNAME(3,USERID,USERSNUM,UNAME,ANAME,LGNAME);                <<U.RAO>>18360000
END;                                                           <<U.RAO>>18370000
PROCEDURE CXSHOWME EXECUTORHEAD;                               <<U.RAO>>18380000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>18390000
BEGIN                                                          <<U.RAO>>18400000
INTEGER ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                      <<06846>>18410000
BYTE ARRAY USERID(0:24);  <<WILL HOLD J/S NN, USERNAME>>       <<U.RAO>>18420000
ARRAY PARTNO(0:4);                                             <<06019>>18430000
BYTE ARRAY BPARTNO(*) = PARTNO;                                <<06019>>18440000
DEFINE                                                         <<06019>>18450000
   VERPART = BPARTNO    #,                                     <<06019>>18460000
   UPDPART = BPARTNO(3) #,                                     <<06019>>18470000
   FIXPART = BPARTNO(6) #;                                     <<06019>>18480000
                                                               <<06019>>18490000
ARRAY BASEPARTNO(0:4);                                         <<06019>>18500000
BYTE ARRAY BBASEPARTNO(*) = BASEPARTNO;                        <<06019>>18510000
DEFINE                                                         <<06019>>18520000
   BASEVER = BBASEPARTNO    #,                                 <<06019>>18530000
   BASEUPD = BBASEPARTNO(3) #,                                 <<06019>>18540000
   BASEFIX = BBASEPARTNO(6) #;                                 <<06019>>18550000
LOGICAL PARTHOLD;                                              <<06019>>18560000
BYTE ARRAY BPARTHOLD(*) = PARTHOLD;                            <<06019>>18570000
INTEGER CURRENTDATE;  <<THIS INSTANT IN TIME>>                 <<U.RAO>>18580000
DOUBLE CURRENTTIME;  <<THIS INSTANT IN TIME>>                  <<U.RAO>>18590000
BYTE ARRAY DATEBUF(0:27);  <<HOLDS FORMATTED DATE>>            <<U.RAO>>18600000
INTEGER ARRAY LOGON(0:2)=Q;  <<LOGON DATE & TIME>>             <<U.RAO>>18610000
INTEGER LOGONDATE = LOGON;                                     <<U.RAO>>18620000
DOUBLE LOGONTIME = LOGON+1;                                    <<U.RAO>>18630000
LOGICAL ARRAY LJITCPU(0:1);                                    <<06846>>18640000
DOUBLE CPUTIME;             << CPU time in JIT >>              <<06846>>18650000
LOGICAL CPUTIME0 = CPUTIME;                                    <<06846>>18660000
LOGICAL CPUTIME1 = CPUTIME+1;                                  <<06846>>18670000
DOUBLE CONNECTTIME;  <<TOTAL CONNECT TIME UP TO NOW>>          <<U.RAO>>18680000
INTEGER STDINLDEV;  <<LDEV FOR $STDIN>>                        <<U.RAO>>18690000
INTEGER STDLISTLDEV;  <<LDEV FOR $STDLIST>>                    <<U.RAO>>18700000
INTEGER CURRENTTIME0=CURRENTTIME;                              <<U.RAO>>18710000
INTEGER CURRENTTIME1=CURRENTTIME+1;                            <<U.RAO>>18720000
INTEGER LOGONTIMEADR;    <<ADDRESS IN JMAT OF TIME STAMP>>     <<U.RAO>>18730000
INTEGER SHOWMEMSG;  <<CPU ID MESSAGE NUMBER>>                  <<01403>>18740000
INTEGER JITDSTN;                                               <<06846>>18750000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>18760000
INTEGER PCBGLOBLOC,PXFIXEDLOC;                                 <<06580>>18770000
DEFINE                                                         <<U.RAO>>18780000
   YEAR1 = LOGONDATE.(0:7)#,                                   <<U.RAO>>18790000
   YEAR2 = CURRENTDATE.(0:7)#,                                 <<U.RAO>>18800000
   DAY1  = LOGONDATE.(7:9)#,                                   <<U.RAO>>18810000
   DAY2  = CURRENTDATE.(7:9)#,                                 <<U.RAO>>18820000
   HOUR1 = LOGON(1).(0:8)#,                                    <<U.RAO>>18830000
   HOUR2 = CURRENTTIME0.(0:8)#,                                <<U.RAO>>18840000
   MIN1  = LOGON(1).(8:8)#,                                    <<U.RAO>>18850000
   MIN2  = CURRENTTIME0.(8:8)#,                                <<U.RAO>>18860000
   SEC1  = LOGON(2).(0:8)#,                                    <<U.RAO>>18870000
   SEC2  = CURRENTTIME1.(0:8)#;                                <<U.RAO>>18880000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>18890000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>18900000
PXGLOBAL;                                                      <<06580>>18910000
SCAN PARMSP WHILE %6440,1;  <<LOOK FOR ANY PARMS>>             <<U.RAO>>18920000
IF NOCARRY THEN                                                <<U.RAO>>18930000
   CIERR(ERRNUM := -WARNXPARMSIGNORED, BPS0);                  <<04787>>18940000
DEL;                                                           <<U.RAO>>18950000
<<FIRST LINE IS USER ID AND BREAK STATUS>>                     <<U.RAO>>18960000
FORMUSERID(USERID);                                            <<U.RAO>>18970000
PXFIXED;                                                       <<06580>>18980000
IF PXFXBRKMODE <> 0 THEN                                       <<06580>>18990000
   GENMSG(CIGENERALMSGSET, SHOWME1BRK, 0, @USERID)             <<U.RAO>>19000000
ELSE  <<NOT IN BREAK>>                                         <<U.RAO>>19010000
   IF JOBSESSIONMAIN                                           <<04738>>19020000
      THEN GENMSG(CIGENERALMSGSET, SHOWME1NOBRK, 0, @USERID)   <<04738>>19030000
      ELSE GENMSG(CIGENERALMSGSET, SHOWMEINPROG, 0, @USERID);  <<04738>>19040000
IF REQUESTSERVICE THEN RETURN;                                 <<U.RAO>>19050000
                                                               <<U.RAO>>19060000
<<NEXT LINE IS SYSTEM ID>>                                     <<U.RAO>>19070000
MOVE PARTNO := "..........";                                   <<06019>>19080000
PARTNO(4) := 0;    << GENMSG delimiter >>                      <<06019>>19090000
MOVE BASEPARTNO := "..........";                               <<06019>>19100000
BASEPARTNO(4) := 0;                                            <<06019>>19110000
PARTHOLD := ABSOLUTE( BASE'VER );                              <<06019>>19120000
MOVE BASEVER := BPARTHOLD,(2);                                 <<06019>>19130000
PARTHOLD := ABSOLUTE( BASE'UPD );                              <<06019>>19140000
MOVE BASEUPD := BPARTHOLD,(2);                                 <<06019>>19150000
PARTHOLD := ABSOLUTE( BASE'FIX );                              <<06019>>19160000
MOVE BASEFIX := BPARTHOLD,(2);                                 <<06019>>19170000
                                                               <<06019>>19180000
PARTHOLD := ABSOLUTE( SYSVERSION );                            <<06019>>19190000
MOVE VERPART := BPARTHOLD,(2);                                 <<06019>>19200000
PARTHOLD := ABSOLUTE( SYSUPDATE );                             <<06019>>19210000
MOVE UPDPART := BPARTHOLD,(2);                                 <<06019>>19220000
PARTHOLD := ABSOLUTE( SYSFIX );                                <<06019>>19230000
MOVE FIXPART := BPARTHOLD,(2);                                 <<06019>>19240000
                                                               <<06019>>19250000
  <<TAG THESE ASCII STRINGS WITH 0 FOR GENMSG.  THUS THE ARRAY.<<U.RAO>>19260000
CASE THISCPU OF                                                <<01403>>19270000
   BEGIN                                                       <<01403>>19280000
      SHOWMEMSG:=SHOWME6;  <<SERIES 1>>                        <<01403>>19290000
      SHOWMEMSG:=SHOWME6;  <<SERIES 2>>                        <<01403>>19300000
      SHOWMEMSG:=SHOWME33; <<SERIES 33>>                       <<01403>>19310000
      SHOWMEMSG:=SHOWME6;  <<SERIES 3>>                        <<01403>>19320000
      SHOWMEMSG:=SHOWME33; <<ICF/44>>                          <<01403>>19330000
      SHOWMEMSG:=SHOWME55; <<ICF/55>>                          <<01403>>19340000
      SHOWMEMSG := SHOWME55; <<ICF/55 - MOUSE >>               <<B8057>>19350000
   END;                                                        <<01403>>19360000
GENMSG (CIGENERALMSGSET, SHOWMEMSG, 0,                         <<01403>>19370000
        @BPARTNO(1), @BBASEPARTNO );                           <<06019>>19380000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>19390000
                                                               <<U.RAO>>19400000
<<NEXT LINE IS CURRENT DATE & TIME>>                           <<U.RAO>>19410000
CURRENTDATE := CALENDAR;                                       <<U.RAO>>19420000
CURRENTTIME := CLOCK;                                          <<U.RAO>>19430000
FMTDATE(CURRENTDATE, CURRENTTIME, DATEBUF);                    <<U.RAO>>19440000
DATEBUF(27) := 0;                                              <<U.RAO>>19450000
GENMSG(CIGENERALMSGSET, SHOWME2, 0, @DATEBUF);                 <<U.RAO>>19460000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>19470000
                                                               <<U.RAO>>19480000
<<NOW PUT OUT LOGON TIME AND DATE>>                            <<U.RAO>>19490000
PXGLOBAL;                                                      <<06580>>19500000
LOGONTIMEADR := PXG'JMATINX*JMATENTRYSIZE   <<Get time>>       <<06584>>19510000
                                +JMATCALENDAROFF; <<and date>> <<06584>>19520000
MOVEFROMDSEG(@LOGON, JMATDST, LOGONTIMEADR, 3);                <<U.RAO>>19530000
FMTDATE(LOGONDATE,LOGONTIME,DATEBUF);                          <<U.RAO>>19540000
DATEBUF(27):=0;                                                <<06584>>19550000
GENMSG(CIGENERALMSGSET, SHOWME3, 0, @DATEBUF);                 <<U.RAO>>19560000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>19570000
                                                               <<U.RAO>>19580000
<<NEXT DO CPU AND CONNECT TIME>>                               <<U.RAO>>19590000
<< For non-programmatic calls, CPU time is the CI's time   >>  <<04738>>19600000
<< plus the local process' time.  For programmatic calls,  >>  <<04738>>19610000
<< CPU time is simply the process' time.                   >>  <<04738>>19620000
PXGLOBAL;                                                      <<06580>>19630000
JITDSTN:=PXG'JITDST; << CPU Time Accummulator is in JIT >>     <<06846>>19640000
MOVEFROMDSEG(@JITARR,JITDSTN,0,JIT'ENTRY'SIZE);                <<06846>>19650000
MOVE LJITCPU(0):=JITCPUC,(2);                                  <<06846>>19660000
CPUTIME0:=LJITCPU(0);                                          <<06846>>19670000
CPUTIME1:=LJITCPU(1);                                          <<06846>>19680000
PXFIXED;                                                       <<06580>>19690000
TOS := PXFXPCPUTIME1;                                          <<06580>>19700000
TOS := PXFXPCPUTIME2;                                          <<06580>>19710000
IF JOBSESSIONMAIN                                              <<04738>>19720000
   THEN CPUTIME := TOS + CPUTIME + 999D                        <<04738>>19730000
   ELSE CPUTIME := TOS + 999D;                                 <<04738>>19740000
IF OVERFLOW THEN                                               <<U.RAO>>19750000
   CPUTIME := 2147483D  <<MAX CPU SECONDS>>                    <<U.RAO>>19760000
ELSE                                                           <<U.RAO>>19770000
   CPUTIME := CPUTIME/1000D;  <<MILLISEC TO SECONDS>>          <<U.RAO>>19780000
<<NOW COMPUTE CONNECT TIME>>                                   <<U.RAO>>19790000
<<ALGORITHM FOR COMPUTING MINUTES BETWEEN TWO TIME STAMPS:>>   <<U.RAO>>19800000
<< (M2-M1)                                                >>   <<U.RAO>>19810000
<< + 60*((H2-H1)                                          >>   <<U.RAO>>19820000
<< + 24*((D2-D1)+((Y2-1)/4*4-Y1+4)/4    (LEAP YEAR)       >>   <<U.RAO>>19830000
<< + 365*(Y2-Y1)))                                        >>   <<U.RAO>>19840000
<<                                                        >>   <<U.RAO>>19850000
TOS := ((YEAR2 - 1)&ASR(2)&ASL(2)-YEAR1+4)&ASR(2);             <<U.RAO>>19860000
TOS := 45; ASSEMBLE(MPYL);                                     <<U.RAO>>19870000
TOS := YEAR2-YEAR1;                                            <<U.RAO>>19880000
TOS := 16425;  ASSEMBLE(MPYL, DADD);                           <<U.RAO>>19890000
TOS := TOS&DASL(5);                                            <<U.RAO>>19900000
TOS := (DAY2-DAY1)*24+(HOUR2-HOUR1);                           <<U.RAO>>19910000
TOS := 60; ASSEMBLE(MPYL, DADD);                               <<U.RAO>>19920000
TOS := TOS+DOUBLE(MIN2-MIN1);                                  <<U.RAO>>19930000
IF SEC2 > SEC1 THEN TOS := TOS+1D;                             <<U.RAO>>19940000
CONNECTTIME := TOS;                                            <<U.RAO>>19950000
GENMSG( CIGENERALMSGSET,                                       <<04738>>19960000
        IF JOBSESSIONMAIN THEN SHOWME4 ELSE SHOWMEPROGCPU,     <<04738>>19970000
   %22000, @CPUTIME, @CONNECTTIME);                            <<U.RAO>>19980000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>19990000
                                                               <<U.RAO>>20000000
<<FINALLY DO $STDIN, $STDLIST>>                                <<U.RAO>>20010000
PXGLOBAL;                                                      <<06580>>20020000
STDINLDEV := PXG'INPUTLDEV;                                    <<06580>>20030000
STDLISTLDEV := PXG'OUTPUTLDEV;                                 <<06580>>20040000
GENMSG(CIGENERALMSGSET, SHOWME5,                               <<U.RAO>>20050000
   %11000, STDINLDEV, STDLISTLDEV);                            <<U.RAO>>20060000
IF REQUESTSERVICE THEN RETURN;  <<SAW BREAK REQUEST>>          <<U.RAO>>20070000
TOS := ABSOLUTE(WELCOMEDST);                                   <<U.RAO>>20080000
IF > THEN  <<WELCOME MESSAGE EXISTS>>                          <<U.RAO>>20090000
   WELCOMEMES(*,0); <<SECOND PARM IS FUNNY TERMINAL>>          <<U.RAO>>20100000
END;                                                           <<U.RAO>>20110000
PROCEDURE CXSPEED EXECUTORHEAD;                                <<U.RAO>>20120000
      OPTION PRIVILEGED, UNCALLABLE;                                    20130000
      BEGIN                                                             20140000
      COMMENT                                                           20150000
      CXSPEED IS THE EXECUTOR FOR THE SPEED COMMAND                     20160000
      COMMAND FORMAT                                                    20170000
      SPEED [INSPEED],OUTSPEED OR SPEED INSPEED                         20180000
  *** NOTE: IN AND OUT SPEEDS MUST BE EQUAL ON A SERIES 33 *** <<0306>> 20190000
      ;                                                                 20200000
      DOUBLE ARRAY PARMS(0:2);                                 <<U.RAO>>20210000
      LOGICAL DL := %26015;                                             20220000
      INTEGER NUMPARMS,INSPD,OTSPD,INLDEV,OUTLDEV,LEN1,LEN2;            20230000
      INTEGER OLDINSPD;                                        <<0306>> 20240000
      ARRAY QARRAY(*) = Q + 0;                                 <<06580>>20250000
      INTEGER PCBGLOBLOC;                                      <<06580>>20260000
      LOGICAL POSTSERIES3;  <<TRUE IF RUNNING ON SERIES 33 OR  <<01403>>20270000
                            <<ICF/44 OR ICF/55>>               <<01403>>20280000
      << Split speed is not supported on HPIB systems.       >><<B8057>>20290000
      BYTE POINTER NUMB1,NUMB2;                                         20300000
      ARRAY WOBUF (0:14),LPARM(*)=PARMS;                                20310000
      BYTE ARRAY OBUF (*) = WOBUF,BPARM(*)=PARMS;                       20320000
      ARRAY MSG(*)=PB:="CHANGE SPEED AND INPUT ""MPE"": ";              20330000
                                                                        20340000
      INTEGER SUBROUTINE CHANGEOUTSPD;                                  20350000
        <<                                                              20360000
           THIS SUBROUTINE CHANGES THE OUT SPEED TO THE VALUE SPECIFIED 20370000
          IN OTSPD AND SETS THE OLD SPEED IN OTSPD.IT RETURNS THE LAST  20380000
           3 BITS OF THE STATUS RETURNED FROM ATTACHIO.                 20390000
        >>                                                              20400000
        BEGIN                                                           20410000
          ASSEMBLE(DELB,DZRO);  << DELETE RETURN & ATTACHIO RETURN >>   20420000
          TOS := OUTLDEV;                                               20430000
          TOS := ATTACHIO(*,0,0,0,7,0,OTSPD,0,1);                       20440000
          OTSPD := TOS;  << SAVE OLD SPEED >>                           20450000
          TOS := TOS.(13:3);   << MASK TO GENERAL STATUS RETURN >>      20460000
          ASSEMBLE( XCH     );  << RETURN ADDRESS TO TOS >>             20470000
        END;   << CHANGE OUT SPEED >>                                   20480000
                                                                        20490000
                                                                        20500000
      SUBROUTINE RESTORESPEED(NP);                                      20510000
         VALUE NP; INTEGER NP;                                          20520000
      <<                                                                20530000
         THIS SUBROUTINE RESTORES THE INPUT AND OUTPUT SPEEDS TO THE    20540000
         VALUES SAVED IN INSPD AND OTSPD.                               20550000
      >>                                                                20560000
        BEGIN                                                           20570000
          IF LEN1<>0 THEN                                      <<0306>> 20580000
             ATTACHIO(INLDEV,0,0,0,6,0,OLDINSPD,0,1);          <<0306>> 20590000
          IF NP=2 THEN CHANGEOUTSPD;                                    20600000
        END;   << RESTORE SPEED >>                                      20610000
                                                                        20620000
                                                                        20630000
      POSTSERIES3 := THISCPU = 2 LOR THISCPU >= 4;             <<B8057>>20640000
      MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                   <<U.RAO>>20650000
      IF NUMPARMS > 2 THEN  <<ONLY ALLOW INPUT & OUTPUT SPEEDS><<U.RAO>>20660000
         BEGIN                                                 <<U.RAO>>20670000
         PARMNUM :=3;                                          <<U.RAO>>20680000
         TOS := ERRNUM := SPEED2MP;                            <<U.RAO>>20690000
         TOS := LPARM(4);                                      <<U.RAO>>20700000
         CIERR(*,*);                                           <<U.RAO>>20710000
         RETURN                                                <<U.RAO>>20720000
         END;                                                  <<U.RAO>>20730000
      LEN1 := BPARM(2);<<SET UP POINTERS TO QUANITIES RETURNED >>       20740000
      LEN2 := BPARM(6);<<BY MYCOMMAND>>                                 20750000
      @NUMB1 := LPARM;                                                  20760000
      @NUMB2 := LPARM(2);                                               20770000
      IF (NUMPARMS=0) OR (LEN1=0) AND (LEN2=0) THEN  <<NO PARMS<<U.RAO>>20780000
         BEGIN                                                 <<U.RAO>>20790000
         PARMNUM := 1;                                         <<U.RAO>>20800000
         CIERR(ERRNUM := SPEEDNOTENUF,PARMSP);                 <<U.RAO>>20810000
         RETURN                                                <<U.RAO>>20820000
         END;                                                  <<U.RAO>>20830000
      PXGLOBAL;                                                <<06580>>20840000
      INLDEV := PXG'INPUTLDEV;                                <<<06580>>20850000
      OUTLDEV := PXG'OUTPUTLDEV;                               <<06580>>20860000
                                                                        20870000
      IF LEN1<>0 THEN   << CHECK NEW IN SPEED >>                        20880000
        BEGIN                                                           20890000
          INSPD := BINARY(NUMB1,LEN1);                                  20900000
          IF <> THEN  <<BINARY FAILED>>                        <<U.RAO>>20910000
             BEGIN                                             <<U.RAO>>20920000
             PARMNUM := 1;                                     <<U.RAO>>20930000
             CIERR(ERRNUM := ERRINSPEED,NUMB1);                <<U.RAO>>20940000
             RETURN                                            <<U.RAO>>20950000
             END;                                              <<U.RAO>>20960000
          TOS := ATTACHIO(INLDEV,0,0,0,6,0,INSPD,0,1);                  20970000
          OLDINSPD := TOS;  << SAVE OLD IN SPEED >>            <<0306>> 20980000
          IF TOS.(13:3) <> 1 THEN  <<UNACCEPTABLE SPEED>>      <<U.RAO>>20990000
             BEGIN                                             <<U.RAO>>21000000
             PARMNUM := 1;                                     <<U.RAO>>21010000
             NUMB1(LEN1) := 0;                                 <<U.RAO>>21020000
             CIERR(ERRNUM := ERRINSPEED,NUMB1,0,@NUMB1);       <<U.RAO>>21030000
             RETURN;                                           <<U.RAO>>21040000
             END;                                              <<U.RAO>>21050000
        END;                                                            21060000
                                                                        21070000
      IF NUMPARMS=2 THEN  << CHECK OUT SPEED >>                         21080000
        BEGIN                                                           21090000
          OTSPD := BINARY(NUMB2,LEN2);                                  21100000
          IF <> THEN                                                    21110000
            BEGIN                                                       21120000
              RESTORESPEED(0);   << RESTORE IN SPEED ONLY >>            21130000
              PARMNUM := 2;                                    <<U.RAO>>21140000
             CIERR(ERRNUM := ERROUTSPEED,NUMB2);               <<U.RAO>>21150000
              RETURN                                           <<U.RAO>>21160000
            END;                                                        21170000
                                                               <<0306>> 21180000
          IF POSTSERIES3 THEN                                  <<01403>>21190000
             IF LEN1 = 0 THEN  << INPUT SPEED NOT SPECIFIED >> <<0306>> 21200000
                BEGIN                                          <<0306>> 21210000
                CIERR(ERRNUM := -SPEEDINEQUALOUT);             <<04787>>21220000
                TOS := ATTACHIO(INLDEV,0,0,0,6,0,OTSPD,0,1);   <<0306>> 21230000
                OLDINSPD := TOS;                               <<0306>> 21240000
                IF TOS.(13:3) <> 1 THEN                        <<0306>> 21250000
                   BEGIN                                       <<0306>> 21260000
                   CIERR(ERRNUM:=ERRINSPEED);                  <<0306>> 21270000
                   RETURN;                                     <<0306>> 21280000
                   END;                                        <<0306>> 21290000
                END                                            <<0306>> 21300000
             ELSE                                              <<0306>> 21310000
                BEGIN    << BOTH SPECIFIED. CHECK IF EQUAL >>  <<0306>> 21320000
                IF INSPD <> OTSPD THEN                         <<0306>> 21330000
                   BEGIN                                       <<0306>> 21340000
                   RESTORESPEED(0);  <<RESTORE IN SPEED>>      <<0306>> 21350000
                   PARMNUM := 2;                               <<0306>> 21360000
                   CIERR(ERRNUM:=SPEEDNOTEQUAL);               <<0306>> 21370000
                   RETURN;                                     <<0306>> 21380000
                   END;                                        <<0306>> 21390000
                END;                                           <<0306>> 21400000
                                                                        21410000
          IF CHANGEOUTSPD<>1 THEN   << BAD SPEED >>                     21420000
            BEGIN                                                       21430000
              RESTORESPEED(0);   << RESTORE IN SPEED ONLY >>            21440000
              PARMNUM := 2;                                    <<U.RAO>>21450000
              NUMB2(LEN2) := 0;                                <<U.RAO>>21460000
              CIERR(ERRNUM := ERROUTSPEED,NUMB2,0,@NUMB2);     <<U.RAO>>21470000
              RETURN                                           <<U.RAO>>21480000
            END;                                                        21490000
                                                                        21500000
          CHANGEOUTSPD;   << RESTORE OUT SPEED FOR PRINTING >>          21510000
        END                                                    <<0306>> 21520000
      ELSE      << OUTPUT SPEED NOT SPECIFIED >>               <<0306>> 21530000
        IF POSTSERIES3 THEN                                    <<01403>>21540000
           BEGIN                                               <<0306>> 21550000
           CIERR(ERRNUM := -SPEEDINEQUALOUT);                  <<04787>>21560000
           OTSPD := INSPD;                                     <<0306>> 21570000
           IF CHANGEOUTSPD <> 1 THEN                           <<0306>> 21580000
              BEGIN                                            <<0306>> 21590000
              RESTORESPEED(0);                                 <<0306>> 21600000
              CIERR(ERRNUM:=ERROUTSPEED);                      <<0306>> 21610000
              RETURN;                                          <<0306>> 21620000
              END;                                             <<0306>> 21630000
           CHANGEOUTSPD;  << RESTORE OUT SPEED FOR PRINTING >> <<0306>> 21640000
           END;                                                <<0306>> 21650000
                                                                        21660000
      MOVE WOBUF:=MSG,(15);                                             21670000
      PRINT(WOBUF,15,0);                                                21680000
                                                                        21690000
      IF NUMPARMS=2 OR POSTSERIES3 THEN CHANGEOUTSPD;          <<01403>>21700000
                                                                        21710000
                                                                        21720000
      TOS:=READ(WOBUF,-3);                                              21730000
      IF<> THEN TOS:=TOS+5;                                             21740000
      MOVE OBUF:=OBUF WHILE AS;                                         21750000
      IF(TOS<>3) OR(OBUF<>"MPE") THEN                                   21760000
         BEGIN                                                          21770000
         RESTORESPEED(IF POSTSERIES3 THEN 2 ELSE NUMPARMS);    <<01403>>21780000
         NEXTLINE;                                                      21790000
         CIERR(ERRNUM := -NOTVER);                             <<04787>>21800000
         END;                                                           21810000
                                                                        21820000
      NEXTLINE;                                                         21830000
      END;          <<CXSPEED>>                                         21840000
                                                               <<04738>>21850000
$CONTROL SEGMENT=CIMISC                                        <<U.RAO>>21860000
      PROCEDURE CXMOUNT EXECUTORHEAD;                          <<RH.PV>>21870000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>21880000
      BEGIN                                                    <<RH.PV>>21890000
      COMMENT                                                  <<RH.PV>>21900000
      CXMOUNT IS THE EXECUTOR FOR USER MOUNT AND DISMOUNT      <<RH.PV>>21910000
      REQUESTS;                                                <<RH.PV>>21920000
      ENTRY CXDISMOUNT;                                        <<RH.PV>>21930000
      INTEGER LEN,DELIM,NUMPARMS;                              <<RH.PV>>21940000
      ARRAY QARRAY(*) = Q + 0;                                 <<06580>>21950000
      INTEGER PCBGLOBLOC;                                      <<06580>>21960000
      INTEGER GEN:=-1,NPARM:=-1,REQTYPE:=0,ERRTYPE=REQTYPE,    <<RH.PV>>21970000
              MOUNTYPE:=0;                                     <<RH.PV>>21980000
      LOGICAL KEYWD:=FALSE,KEYPARM:=FALSE;                     <<RH.PV>>21990000
      LOGICAL PARMSPEC :=FALSE;                                <<RH.PV>>22000000
      LOGICAL BIND := FALSE;                                   <<RV.PV>>22010000
      DEFINE                                                   <<RH.PV>>22020000
         GENSPEC    = PARMSPEC.(15:1)#;                        <<RH.PV>>22030000
      INTEGER POINTER PARMVAL;                                 <<RH.PV>>22040000
      BYTE ARRAY DL(0:3);                                      <<RH.PV>>22050000
      BYTE ARRAY PDL(*)=PB:=".;=",%15;                         <<RH.PV>>22060000
      DOUBLE ARRAY PARMS(0:5) = Q;                             <<*7612>>22070000
      BYTE POINTER  FRSTPARM  = PARMS,                         <<*7612>>22080000
                    SXTHPARM  = PARMS + 10;                    <<*7612>>22090000
      ARRAY VSET(0:14);                                        <<RH.PV>>22100000
      BYTE ARRAY                                               <<RH.PV>>22110000
         VSETB(*)   = VSET,                                    <<RH.PV>>22120000
         VSNAME(*)  = VSET,                                    <<RH.PV>>22130000
         VSGROUP(*) = VSET(5),                                 <<RH.PV>>22140000
         VSACCNT(*) = VSET(10);                                <<RH.PV>>22150000
      BYTE ARRAY STRING'(*) = PB :=                            <<RH.PV>>22160000
         "VSET     ",                                          <<RH.PV>>22170000
         "GROUP    ",                                          <<RH.PV>>22180000
         "ACCOUNT  ",                                          <<RH.PV>>22190000
         "MOUNT    ",                                          <<RH.PV>>22200000
         "DISMOUNT ";                                          <<RH.PV>>22210000
      BYTE ARRAY STRING(0:17);                                 <<RH.PV>>22220000
      BYTE POINTER NAME;                                       <<RH.PV>>22230000
      LOGICAL POINTER PXPNTR;                                  <<RH.PV>>22240000
      EQUATE NOSTRING = -1;                                    <<RH.PV>>22250000
      EQUATE NOHVSET  = 28;  << PVERR 28 >>                    <<RH.PV>>22260000
      EQUATE DUPBIND  = 42;  << PVERR 42 >>                    <<RV.PV>>22270000
      EQUATE INVNAME  = 43;  << PVERR 43 >>                    <<RV.PV>>22280000
      EQUATE  <<DELIMETERS>>                                   <<RH.PV>>22290000
         SEMICOLON = 1,                                        <<RH.PV>>22300000
         EQUALSIGN = 2;                                        << I.A >>22310000
                                                               <<RH.PV>>22320000
      INTEGER JIT'DSTN;                                        <<06846>>22330000
      LOGICAL ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                <<06846>>22340000
                                                               <<RH.PV>>22350000
      SUBROUTINE CXEXIT(ERRN,EADDR,STRINGX);                   <<RH.PV>>22360000
      VALUE ERRN,EADDR,STRINGX;                                <<RH.PV>>22370000
      INTEGER ERRN,STRINGX;                                    <<RH.PV>>22380000
      BYTE POINTER EADDR;                                      <<RH.PV>>22390000
      BEGIN                                                    <<RH.PV>>22400000
         IF ERRN <> 0 THEN                                     <<RH.PV>>22410000
            BEGIN                                              <<RH.PV>>22420000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>22430000
            IF STRINGX = NOSTRING THEN                         <<RH.PV>>22440000
               CIERR(ERRNUM,EADDR)                             <<RH.PV>>22450000
            ELSE                                               <<RH.PV>>22460000
               BEGIN                                           <<RH.PV>>22470000
               MOVE STRING:=STRING'(STRINGX*9),(9);            <<RH.PV>>22480000
               MOVE STRING:=STRING WHILE AN,1;                 <<RH.PV>>22490000
               MOVE * :=%0;  <<GENMSG STOP>>                   <<RH.PV>>22500000
               IF (@NAME:=@EADDR) = 0 THEN  <<NO CARAT>>       <<RH.PV>>22510000
                  CIERR(ERRNUM,,0,@STRING)                     <<RH.PV>>22520000
               ELSE                                            <<RH.PV>>22530000
                  CIERR(ERRNUM,NAME,0,@STRING);                <<RH.PV>>22540000
               END;                                            <<RH.PV>>22550000
            END;                                               <<RH.PV>>22560000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>22570000
      END;<<CXEXIT>>                                           <<RH.PV>>22580000
                                                               <<RH.PV>>22590000
                                                               <<RH.PV>>22600000
      GO TO PROCESS;                                           <<RH.PV>>22610000
CXDISMOUNT:                                                    <<RH.PV>>22620000
      MOUNTYPE:=1;                                             <<RH.PV>>22630000
PROCESS:                                                       <<RH.PV>>22640000
      PXGLOBAL;                                                <<06580>>22650000
      MOVE DL:=PDL,(4);  <<DELIMITER ARRAY>>                   <<RH.PV>>22660000
      MOVE VSNAME:="*       ";  <<ASSUME HOME VOLUME SET>>     <<RH.PV>>22670000
      VSETB(8):=VSETB(18):=VSETB(28):=" ";  <<TERM CHARS>>     <<RH.PV>>22680000
      MYCOMMAND(PARMSP,DL,6,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>22690000
      IF <> THEN                                               <<RH.PV>>22700000
         BEGIN                                                 <<RH.PV>>22710000
         CIERR(ERRNUM := NOSUBPARMS,SXTHPARM,%10000,6);        <<*7612>>22720000
         RETURN;                                               <<01.RO>>22730000
         END;                                                  <<RH.PV>>22740000
      <<GET DEFAULT GROUP/ACCOUNT SPECIFIERS>>                 <<RH.PV>>22750000
      PXGLOBAL;                                                <<06580>>22760000
      JIT'DSTN:=PXG'JITDST;                                    <<06846>>22770000
      TOS:=@JITARR;                                            <<06846>>22780000
      TOS:=JIT'DSTN;                                           <<06846>>22790000
      TOS:=0;                                                  <<06846>>22800000
      TOS:=JIT'ENTRY'SIZE;                                     <<06846>>22810000
      ASSEMBLE(MFDS 4);                                        <<06846>>22820000
      MOVE VSET(5):=JITLOGONGROUP,(4);                         <<06846>>22830000
      MOVE VSET(10):=JITHACCTNAME,(4);                         <<06846>>22840000
      <<ANALYZE COMMAND - OVERWRITE DEFAULTS IF NECESSARY>>    <<RH.PV>>22850000
      WHILE NUMPARMS <> 0 DO  <<RUN THROUGH PARM LIST>>        <<RH.PV>>22860000
         BEGIN                                                 <<RH.PV>>22870000
         NPARM:=NPARM+1;                                       <<RH.PV>>22880000
         NUMPARMS:=NUMPARMS-1;                                 <<RH.PV>>22890000
         TOS:=PARMS(NPARM);                                    <<RH.PV>>22900000
         ASSEMBLE(XCH);                                        <<RH.PV>>22910000
         @NAME:=TOS;                                           <<RH.PV>>22920000
         DELIM:=LS0.(11:5);                                    <<RH.PV>>22930000
         IF KEYWD THEN  <<ENCOUNTERED A ";">>                  <<RH.PV>>22940000
            BEGIN                                              <<RH.PV>>22950000
            LEN:=TOS.(0:8);                                    <<RH.PV>>22960000
            IF KEYPARM THEN                                    <<RH.PV>>22970000
               BEGIN                                           <<RH.PV>>22980000
               IF LEN = 0 THEN CXEXIT(865,NAME,NOSTRING);      <<RH.PV>>22990000
               KEYWD:=FALSE;                                   <<RH.PV>>23000000
               KEYPARM:=FALSE;                                 <<RH.PV>>23010000
               PARMVAL:=BINARY(NAME,LEN);                      <<RH.PV>>23020000
               IF <> THEN CXEXIT(866,NAME,NOSTRING);           <<RH.PV>>23030000
               IF GENSPEC THEN CIERR(ERRNUM := -320,NAME);     <<04787>>23040000
               GENSPEC:=TRUE;                                  <<RH.PV>>23050000
               END ELSE                                        <<RH.PV>>23060000
            IF LEN = 0 THEN CXEXIT(864,NAME,NOSTRING) ELSE     <<RH.PV>>23070000
            IF NAME = "GEN" THEN  <<GENERATION INDEX>>         <<RH.PV>>23080000
               BEGIN                                           <<RH.PV>>23090000
               IF LEN <> 3 THEN CXEXIT(860,NAME,NOSTRING);     <<RH.PV>>23100000
               IF LOGICAL(MOUNTYPE) THEN                       <<RH.PV>>23110000
                  CXEXIT(867,NAME,NOSTRING);                   <<RH.PV>>23120000
               IF DELIM <> EQUALSIGN THEN                      <<RH.PV>>23130000
                  CXEXIT(312,NAME(LEN+1),NOSTRING);            <<RH.PV>>23140000
               KEYPARM:=TRUE;                                  <<RH.PV>>23150000
               @PARMVAL:=@GEN;                                 <<RH.PV>>23160000
               END ELSE                                        <<RH.PV>>23170000
            CXEXIT(860,NAME,NOSTRING);                         <<RH.PV>>23180000
            IF DELIM=SEMICOLON THEN KEYWD:=TRUE;               <<RH.PV>>23190000
            END                                                <<RH.PV>>23200000
         ELSE                                                  <<RH.PV>>23210000
            BEGIN   <<MUST BE PART OF VOLUME SET NAME>>        <<RH.PV>>23220000
            IF (LS0.(0:8) = 0) AND NUMPARMS = 0 THEN           <<RH.PV>>23230000
               CXEXIT(-306,NAME(-1),NOSTRING);                 <<RH.PV>>23240000
            IF NPARM > 2 THEN CXEXIT(854,NAME,0);              <<RH.PV>>23250000
            IF DELIM = EQUALSIGN THEN                          <<RH.PV>>23260000
               CXEXIT(305,NAME(1),NOSTRING);                   <<RH.PV>>23270000
            IF LS0.(10:1) THEN  <<SPECIAL CHARACTER IN NAME>>  <<RH.PV>>23280000
               IF NOT (BIND := NPARM=0 LAND NAME="*") THEN     <<RV.PV>>23290000
                  CXEXIT(850,NAME,NPARM);                      <<RH.PV>>23300000
            IF LS0.( 9:1) THEN  <<NUMERIC CHARACTER IN NAME>>  <<RH.PV>>23310000
               IF NAME<>ALPHA THEN CXEXIT(851,NAME,NOSTRING);  <<RH.PV>>23320000
            IF (LEN:=TOS.(0:8)) > 8 THEN                       <<RH.PV>>23330000
               CXEXIT(852,NAME,NPARM);                         <<RH.PV>>23340000
            IF LEN = 0 THEN  <<NULL PARAMETER>>                <<RH.PV>>23350000
            IF NPARM > 0 THEN CXEXIT(853,NAME,NPARM) ELSE ELSE <<RH.PV>>23360000
               BEGIN  <<VALID PART OF VS SPECIFIER ENTERED>>   <<RH.PV>>23370000
               REQTYPE := (NOT BIND).(15:1);                   <<RV.PV>>23380000
               MOVE VSETB(NPARM*10):=NAME,(LEN);               <<RH.PV>>23390000
               IF (8-LEN) > 0 THEN <<BLANK REMAINDER OF NAME>> <<RH.PV>>23400000
                  BEGIN                                        <<RH.PV>>23410000
                  MOVE VSETB((NPARM*10)+LEN):=" ",2;           <<RH.PV>>23420000
                  ASSEMBLE(DUP,DECA);                          <<RH.PV>>23430000
                  MOVE * := *,(7-LEN);                         <<RH.PV>>23440000
                  END;                                         <<RH.PV>>23450000
               END;                                            <<RH.PV>>23460000
            END;                                               <<RH.PV>>23470000
            IF DELIM = SEMICOLON THEN KEYWD:=TRUE;             <<RH.PV>>23480000
         END;                                                  <<RH.PV>>23490000
      CASE *MOUNTYPE OF                                        <<RH.PV>>23500000
         BEGIN                                                 <<RH.PV>>23510000
         MOUNT(VSNAME,VSGROUP,VSACCNT,REQTYPE,GEN);            <<RH.PV>>23520000
         DISMOUNT(VSNAME,VSGROUP,VSACCNT,REQTYPE);             <<RH.PV>>23530000
         END;                                                  <<RH.PV>>23540000
      IF <> THEN  <<AN ERROR OF SOME SORT OCCURED>>            <<RH.PV>>23550000
         BEGIN                                                 <<RH.PV>>23560000
         IF ERRTYPE = NOHVSET OR ERRTYPE = DUPBIND OR          <<RV.PV>>23570000
            ERRTYPE = INVNAME THEN                             <<RV.PV>>23580000
            BEGIN                                              <<RH.PV>>23590000
            MOVE STRING:=VSGROUP WHILE AN,1;                   <<RH.PV>>23600000
            MOVE * :=".",2;                                    <<RH.PV>>23610000
            MOVE * :=VSACCNT WHILE AN,1;                       <<RH.PV>>23620000
            MOVE * :=%0;                                       <<RH.PV>>23630000
            GENMSG(PVERRMSGSET,ERRTYPE,0,@STRING);             <<RH.PV>>23640000
            END                                                <<RH.PV>>23650000
         ELSE                                                  <<RH.PV>>23660000
            GENMSG(PVERRMSGSET,ERRTYPE);                       <<RH.PV>>23670000
         CXEXIT(868,ARRDB0,(MOUNTYPE+3));                      <<03.KM>>23680000
         END;                                                  <<RH.PV>>23690000
      END;<<CXMOUNT/CXDISMOUNT>>                               <<RH.PV>>23700000
PROCEDURE CXSTARTSESS EXECUTORHEAD;                            << 8152>>23710000
BEGIN                                                          << 8152>>23720000
<<**********************************************************>> << 8152>>23730000
<<                                                          >> << 8152>>23740000
<< CXSTARTSESS is the executor for the :STARTSESS command.  >> << 8152>>23750000
<< The syntax is:                                           >> << 8152>>23760000
<<                                                          >> << 8152>>23770000
<<              :STARTSESS ldev;<logon string>              >> << 8152>>23780000
<<                                                          >> << 8152>>23790000
<< Where ldev is a hardwired terminal, and logon string has >> << 8152>>23800000
<< the same syntax as the :HELLO command.                   >> << 8152>>23810000
<< Because the logon string will be parsed in STARTDEVICE,  >> << 8152>>23820000
<< we will not parse it here (ie. We won't use MYCOMMAND to >> << 8152>>23830000
<< parse it).  We will call the intrinsic STARTSESS to      >> << 8152>>23840000
<< execute the command.                                     >> << 8152>>23850000
<<                                                          >> << 8152>>23860000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8152>>23870000
<<                                                          >> << 8152>>23880000
<<  Written by:                Ken Jordan                   >> << 8152>>23890000
<<  Written on:                10/14/83                     >> << 8152>>23900000
<<  Last Modification:         01/23/83                     >> << 8152>>23910000
<<  Target Segment:            CIMISC - Module 5B           >> << 8152>>23920000
<<                                                          >> << 8152>>23930000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8152>>23940000
<<**********************************************************>> << 8152>>23950000
                                                               << 8152>>23960000
INTEGER ARRAY ERR(0:2);                                        << 8152>>23970000
INTEGER LDEV;                                                  << 8152>>23980000
INTEGER JSTYPE;                                                << 8152>>23990000
DOUBLE JSNO;                                                   << 8152>>24000000
INTEGER I,NUM;                                                 << 8152>>24010000
INTEGER LDEVLEN,DS'RESULT;                                     << 8152>>24020000
EQUATE                                                         << 8152>>24030000
   LDEV'CAN'NOT'BE'DS'DEVICE = 7008;                           << 8152>>24040000
ERR := 0;                                                      << 8934>>24050000
                                                               << 8152>>24060000
WHILE PARMSP = %40                                             << 8152>>24070000
  DO @PARMSP := @PARMSP + 1;  << SKIP BLANKS >>                << 8152>>24080000
                                                               << 8152>>24090000
<< First, get LDEV length. >>                                  << 8152>>24100000
MOVE PARMSP := PARMSP WHILE N,1;                               << 8152>>24110000
                                                               << 8152>>24120000
<< The LDEV parameter end address is now on TOS. >>            << 8152>>24130000
LDEVLEN := TOS - @PARMSP;                                      << 8152>>24140000
IF LDEVLEN <= 0 THEN                                           << 8152>>24150000
BEGIN                                                          << 8152>>24160000
  CIERR(ERRNUM:=LDEV'MUST'BE'GT'0,PARMSP);                     << 8152>>24170000
  RETURN;                                                      << 8152>>24180000
END;                                                           << 8152>>24190000
                                                               << 8152>>24200000
<< Next, convert ldev to binary. >>                            << 8152>>24210000
LDEV := BINARY(PARMSP,LDEVLEN);                                << 8152>>24220000
IF <> THEN                                                     << 8152>>24230000
BEGIN                                                          << 8152>>24240000
  CIERR(ERRNUM:=INVALID'LDEV,PARMSP);                          << 8152>>24250000
  RETURN;                                                      << 8152>>24260000
END;                                                           << 8152>>24270000
                                                               << 8152>>24280000
<< Update PARMSP. >>                                           << 8152>>24290000
@PARMSP := @PARMSP + LDEVLEN;                                  << 8152>>24300000
                                                               << 8152>>24310000
WHILE PARMSP = %40 DO                                          << 8152>>24320000
  @PARMSP := @PARMSP + 1;  << SKIP BLANKS >>                   << 8152>>24330000
                                                               << 8152>>24340000
IF PARMSP <> ";" THEN                                          << 8152>>24350000
BEGIN                                                          << 8152>>24360000
  CIERR(ERRNUM:=EXPECT'SEMI,PARMSP);                           << 8152>>24370000
  RETURN;                                                      << 8152>>24380000
END;                                                           << 8152>>24390000
                                                               << 8152>>24400000
<< At this point, we can pass the remainder to STARTSESS and>> << 8152>>24410000
<< the parsing for that part of the command will be done    >> << 8152>>24420000
<< there.                                                   >> << 8152>>24430000
@PARMSP := @PARMSP + 1;                                        << 8152>>24440000
WHILE PARMSP = %40                                             << 8152>>24450000
  DO @PARMSP := @PARMSP + 1;  << SKIP BLANKS >>                << 8152>>24460000
                                                               << 8152>>24470000
<< Make sure <ldev> is not a DS device. >>                     << 8152>>24480000
    DS'RESULT := GET'DSDEVICE(LDEV);                           << 8152>>24490000
<< This procedure retrieves entries from the DSDEVICE table >> << 8152>>24500000
<< (In the DS Global Dataseg.)                              >> << 8152>>24510000
<< The functional returns are:                              >> << 8152>>24520000
<<                         -2 - No DSlines are configured.  >> << 8152>>24530000
<<                         -1 - Illegal LDEV passed.        >> << 8152>>24540000
<<                          0 - Non DS related device.      >> << 8152>>24550000
<<                          1 - DS related CS device.       >> << 8152>>24560000
<<                          2 - DS device.                  >> << 8152>>24570000
<<                          3 - DS psuedo terminal.         >> << 8152>>24580000
<<                          4 - ???                         >> << 8152>>24590000
<<                          5 - AdvanceNet Pseudo term      >> << 8886>>24600000
<<                                                          >> << 8152>>24610000
    IF (DS'RESULT > 0)                                         << 9047>>24620000
       THEN ERR := LDEV'CAN'NOT'BE'DS'DEVICE;                  << 8152>>24630000
IF ERR = 0 THEN CHECK'TERM'ATTRIBUTES(LDEV,ERR);               << 8886>>24640000
IF ERR = 0 THEN                                                << 8152>>24650000
   DO'START(LDEV,PARMSP,JSTYPE,JSNO,ERR,TRUE);                 << 8152>>24660000
IF ERR <> 0                                                    << 8152>>24670000
   THEN CIERR(ERRNUM := ERR)                                   << 8152>>24680000
   ELSE BEGIN                                                  << 8152>>24690000
          TOS := JSNO;                                         << 8152>>24700000
          NUM := TOS;                                          << 8152>>24710000
          DEL;                                                 << 8152>>24720000
          GENMSG(CIGENERALMSGSET,46,%10000,NUM);               << 8152>>24730000
        END;                                                   << 8152>>24740000
                                                               << 8152>>24750000
END;  << CXSTARTSESS >>                                        << 8152>>24760000
                                                               <<RH.PV>>24770000
      PROCEDURE CXVSUSER EXECUTORHEAD;                         <<RH.PV>>24780000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>24790000
      BEGIN                                                    <<RH.PV>>24800000
      COMMENT CXVSUSER IS THE EXECUTOR FOR DISPLAYING USERS OF <<RH.PV>>24810000
      MOUNTED VOLUME SETS;                                     <<RH.PV>>24820000
                                                               <<RH.PV>>24830000
      INTEGER NPARM:=-1;                                       <<RH.PV>>24840000
      ARRAY QARRAY(*) = Q + 0;                                 <<06580>>24850000
      INTEGER PCBGLOBLOC;                                      <<06580>>24860000
      INTEGER LEN,DELIM,NUMPARMS,ERRTYPE;                      <<RH.PV>>24870000
      LOGICAL DL:=%27015;  <<PERIOD, CARRIAGE RETURN>>         <<RH.PV>>24880000
      DOUBLE ARRAY PARMS(0:3)=Q;                               <<*7612>>24890000
      BYTE POINTER FRSTPARM  = PARMS,                          <<*7612>>24900000
                   SNDPARM   = PARMS + 2,                      <<*7612>>24910000
                   TRDPARM   = PARMS + 4;                      <<*7612>>24920000
      ARRAY VSET(0:11);                                        <<RH.PV>>24930000
      BYTE ARRAY                                               <<RH.PV>>24940000
         VSETB(*)   = VSET,                                    <<RH.PV>>24950000
         VSNAME(*)  = VSET,                                    <<RH.PV>>24960000
         VSGROUP(*) = VSET(4),                                 <<RH.PV>>24970000
         VSACCNT(*) = VSET(8);                                 <<RH.PV>>24980000
      BYTE ARRAY STRING'(*) = PB :=                            <<RH.PV>>24990000
         "VSET     ",                                          <<RH.PV>>25000000
         "GROUP    ",                                          <<RH.PV>>25010000
         "ACCOUNT  ";                                          <<RH.PV>>25020000
      BYTE ARRAY STRING(0:17);                                 <<RH.PV>>25030000
      BYTE POINTER NAME;                                       <<RH.PV>>25040000
      LOGICAL POINTER PXPNTR;                                  <<RH.PV>>25050000
      EQUATE NOSTRING = -1;                                    <<RH.PV>>25060000
      EQUATE NOHVSET  = 28;                                    <<RH.PV>>25070000
      INTEGER JIT'DSTN;                                        <<06846>>25080000
      LOGICAL ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                <<06846>>25090000
                                                               <<RH.PV>>25100000
                                                               <<RH.PV>>25110000
      SUBROUTINE CXEXIT(ERRN,EADDR,STRINGX);                   <<RH.PV>>25120000
      VALUE ERRN,EADDR,STRINGX;                                <<RH.PV>>25130000
      INTEGER ERRN,STRINGX;                                    <<RH.PV>>25140000
      BYTE POINTER EADDR;                                      <<RH.PV>>25150000
      BEGIN                                                    <<RH.PV>>25160000
         IF ERRN <> 0 THEN                                     <<RH.PV>>25170000
            BEGIN                                              <<RH.PV>>25180000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>25190000
            IF STRINGX = NOSTRING THEN                         <<RH.PV>>25200000
               CIERR(ERRNUM,EADDR)                             <<RH.PV>>25210000
            ELSE                                               <<RH.PV>>25220000
               BEGIN                                           <<RH.PV>>25230000
               MOVE STRING:=STRING'(STRINGX*9),(9);            <<RH.PV>>25240000
               MOVE STRING:=STRING WHILE AN,1;                 <<RH.PV>>25250000
               MOVE * :=%0;  <<GENMSG STOP>>                   <<RH.PV>>25260000
               IF (@NAME:=@EADDR) = 0 THEN  <<NO CARAT>>       <<RH.PV>>25270000
                  CIERR(ERRNUM,,0,@STRING)                     <<RH.PV>>25280000
               ELSE                                            <<RH.PV>>25290000
                  CIERR(ERRNUM,NAME,0,@STRING);                <<RH.PV>>25300000
               END;                                            <<RH.PV>>25310000
            END;                                               <<RH.PV>>25320000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>25330000
      END;<<CXEXIT>>                                           <<RH.PV>>25340000
                                                               <<RH.PV>>25350000
                                                               <<RH.PV>>25360000
      PXGLOBAL;                                                <<06580>>25370000
      MOVE VSNAME:="*       ";  <<ASSUME HOME VOLUME SET>>     <<RH.PV>>25380000
      MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>25390000
      IF <> THEN                                               <<RH.PV>>25400000
         BEGIN                                                 <<RH.PV>>25410000
         CIERR(ERRNUM := NOSUBPARMS,TRDPARM,%10000,3);         <<*7612>>25420000
         RETURN;                                               <<01.RO>>25430000
         END;                                                  <<RH.PV>>25440000
      <<GET DEFAULT GROUP/ACCOUNT SPECIFIERS>>                 <<RH.PV>>25450000
      JIT'DSTN:=PXG'JITDST;                                    <<06846>>25460000
      TOS:=@JITARR;                                            <<06846>>25470000
      TOS:=JIT'DSTN;                                           <<06846>>25480000
      TOS:=0;                                                  <<06846>>25490000
      TOS:=JIT'ENTRY'SIZE;                                     <<06846>>25500000
      ASSEMBLE(MFDS 4);                                        <<06846>>25510000
      MOVE VSET(4):=JITLOGONGROUP,(4);                         <<06846>>25520000
      MOVE VSET(8):=JITHACCTNAME,(4);                          <<06846>>25530000
      <<ANALYZE COMMAND - OVERWRITE DEFAULTS IF NECESSARY>>    <<RH.PV>>25540000
      WHILE (NPARM:=NPARM+1) < NUMPARMS DO                     <<RH.PV>>25550000
         BEGIN                                                 <<RH.PV>>25560000
         TOS:=PARMS(NPARM);                                    <<RH.PV>>25570000
         ASSEMBLE(XCH);                                        <<RH.PV>>25580000
         @NAME:=TOS;                                           <<RH.PV>>25590000
         DELIM:=LS0.(11:5);                                    <<RH.PV>>25600000
         IF (LS0.(0:8) = 0) AND NUMPARMS = 0 THEN              <<RH.PV>>25610000
            CXEXIT(-306,NAME(-1),NOSTRING);                    <<RH.PV>>25620000
         IF NPARM > 2 THEN CXEXIT(854,NAME,0);                 <<RH.PV>>25630000
         IF LS0.(10:1) THEN  <<SPECIAL CHARACTER IN NAME>>     <<RH.PV>>25640000
            IF NOT(NPARM=0 LAND NAME="*") THEN                 <<RH.PV>>25650000
               CXEXIT(850,NAME,NPARM);                         <<RH.PV>>25660000
         IF LS0.( 9:1) THEN  <<NUMERIC CHARACTER IN NAME>>     <<RH.PV>>25670000
            IF NAME<>ALPHA THEN CXEXIT(851,NAME,NOSTRING);     <<RH.PV>>25680000
         IF (LEN:=TOS.(0:8)) > 8 THEN                          <<RH.PV>>25690000
            CXEXIT(852,NAME,NPARM);                            <<RH.PV>>25700000
         IF LEN = 0 THEN  <<NULL PARAMETER>>                   <<RH.PV>>25710000
         IF NPARM > 0 THEN CXEXIT(853,NAME,NPARM) ELSE ELSE    <<RH.PV>>25720000
            BEGIN  <<VALID PART OF VS SPECIFIER ENTERED>>      <<RH.PV>>25730000
            MOVE VSETB(NPARM*8):=NAME,(LEN);                   <<RH.PV>>25740000
            IF (8-LEN) > 0 THEN <<BLANK REMAINDER OF NAME>>    <<RH.PV>>25750000
               BEGIN                                           <<RH.PV>>25760000
               MOVE VSETB((NPARM*8)+LEN):=" ",2;               <<RH.PV>>25770000
               ASSEMBLE(DUP,DECA);                             <<RH.PV>>25780000
               MOVE * := *,(7-LEN);                            <<RH.PV>>25790000
               END;                                            <<RH.PV>>25800000
            END;                                               <<RH.PV>>25810000
         END;                                                  <<RH.PV>>25820000
      ERRTYPE:=VSUSERCOM(0,NUMPARMS,VSNAME);                   <<RH.PV>>25830000
      IF <> THEN  <<AN ERROR OF SOME SORT OCCURED>>            <<RH.PV>>25840000
         BEGIN                                                 <<RH.PV>>25850000
         IF ERRTYPE = NOHVSET  THEN                            <<RH.PV>>25860000
            BEGIN                                              <<RH.PV>>25870000
            MOVE STRING:=VSGROUP WHILE AN,1;                   <<RH.PV>>25880000
            MOVE * :=".",2;                                    <<RH.PV>>25890000
            MOVE * :=VSACCNT WHILE AN,1;                       <<RH.PV>>25900000
            MOVE * :=%0;                                       <<RH.PV>>25910000
            GENMSG(PVERRMSGSET,ERRTYPE,0,@STRING);             <<RH.PV>>25920000
            END                                                <<RH.PV>>25930000
         ELSE                                                  <<RH.PV>>25940000
            GENMSG(PVERRMSGSET,ERRTYPE);                       <<RH.PV>>25950000
         END;                                                  <<RH.PV>>25960000
      END;<<CXVSUSER>>                                         <<RH.PV>>25970000
                                                               <<RH.PV>>25980000
      PROCEDURE CXDSTAT EXECUTORHEAD;                          <<RH.PV>>25990000
      OPTION PRIVILEGED, UNCALLABLE;                           <<RH.PV>>26000000
      BEGIN                                                    <<RH.PV>>26010000
      COMMENT CXDSTAT IS THE EXECUTOR FOR DISPLAYING THE STATUS<<RH.PV>>26020000
      OF DISC DEVICES ON THE SYSTEM;                           <<RH.PV>>26030000
                                                               <<RH.PV>>26040000
      INTEGER LDEV:=0;  <<ASSUME PV DEVICES ONLY>>             <<RH.PV>>26050000
      INTEGER LEN,NUMPARMS,ERRTYPE;                            << I.A >>26060000
      LOGICAL DL:=%15;  <<carriage return>>                    <<*7612>>26070000
      DOUBLE ARRAY PARMS(0:1)=Q;                               <<*7612>>26080000
      BYTE POINTER  FRSTPARM = PARMS,                          <<*7612>>26090000
                    SNDPARM  = PARMS + 2;                      <<*7612>>26100000
      BYTE POINTER PARM;                                       <<RH.PV>>26110000
                                                               <<RH.PV>>26120000
                                                               <<RH.PV>>26130000
      SUBROUTINE CXEXIT(ERRN,EADDR);                           <<RH.PV>>26140000
      VALUE ERRN; INTEGER ERRN;                                <<RH.PV>>26150000
      BYTE ARRAY EADDR;                                        <<RH.PV>>26160000
      BEGIN                                                    <<RH.PV>>26170000
         IF ERRN <> 0 THEN                                     <<RH.PV>>26180000
            BEGIN                                              <<RH.PV>>26190000
            ERRNUM:=ERRN;  <<RETURN ERROR CODE>>               <<RH.PV>>26200000
            CIERR(ERRNUM,EADDR);                               <<RH.PV>>26210000
            END;                                               <<RH.PV>>26220000
         ASSEMBLE(EXIT 3);                                     <<RH.PV>>26230000
      END;<<CXEXIT>>                                           <<RH.PV>>26240000
                                                               <<RH.PV>>26250000
                                                               <<RH.PV>>26260000
      MYCOMMAND(PARMSP,DL,1,NUMPARMS,PARMS);  <<CHECK COMMAND>><<RH.PV>>26270000
      IF <> THEN                                               <<RH.PV>>26280000
         BEGIN                                                 <<RH.PV>>26290000
         CIERR(ERRNUM := NOSUBPARMS,SNDPARM,%10000,1);         <<*7612>>26300000
         RETURN;                                               <<01.RO>>26310000
         END;                                                  <<RH.PV>>26320000
      IF NUMPARMS <> 0 THEN  <<PARM ENTERED>>                  <<RH.PV>>26330000
         BEGIN                                                 <<RH.PV>>26340000
         TOS:=PARMS;                                           <<RH.PV>>26350000
         ASSEMBLE(XCH);                                        <<RH.PV>>26360000
         @PARM:=TOS; <<BYTE ADDRESS OF PARAMETER STRING>>      <<RH.PV>>26370000
         IF (LEN:=LS0.(0:8)) > 3 THEN                          <<RH.PV>>26380000
            CXEXIT(860,PARM);                                  <<RH.PV>>26390000
         IF PARM = "ALL" THEN LDEV:=-1 ELSE                    <<RH.PV>>26400000
         IF (TOS.(8:3) = %2) THEN  <<NUMERIC ONLY>>            <<RH.PV>>26410000
            BEGIN                                              <<RH.PV>>26420000
            LDEV:=BINARY(PARM,LEN);                            <<RH.PV>>26430000
            IF <> OR LDEV <= 0 THEN                            <<RH.PV>>26440000
               CXEXIT(866,PARM);                               <<RH.PV>>26450000
            END                                                <<RH.PV>>26460000
         ELSE                                                  <<RH.PV>>26470000
            CXEXIT(860,PARM);                                  <<RH.PV>>26480000
         END;                                                  <<RH.PV>>26490000
      ERRTYPE:=DSTATCOM(0,LDEV);                               <<RH.PV>>26500000
      IF <> THEN GENMSG(PVERRMSGSET,ERRTYPE,%10000,LDEV);      <<RH.PV>>26510000
      END<<CXDSTAT>>;                                          <<RH.PV>>26520000
                                                               <<RH.PV>>26530000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>26540000
      PROCEDURE CXCONTINUE EXECUTORHEAD;                                26550000
      OPTION PRIVILEGED,UNCALLABLE;                                     26560000
      BEGIN                                                             26570000
      COMMENT                                                           26580000
      CXCONTINUE IS THE EXECUTOR FOR THE CONTINUE,ABORT AND             26590000
      RESUME COMMANDS                                                   26600000
      COMMAND FORMAT                                                    26610000
      ABORT                                                             26620000
      CONTINUE                                                          26630000
      RESUME                                                            26640000
      ;                                                                 26650000
      ENTRY CXABORT,CXRESUME;                                  <<DS.06>>26660000
      INTEGER NUMPARMS;                                                 26670000
      DOUBLE  PARMS;                                           <<DS.06>>26680000
      LOGICAL CONTINUE:=0,ABORT:=0;                                     26690000
      LOGICAL READFLAG := FALSE;                               <<DS0.0>>26700000
      LOGICAL RMOTBRK:=FALSE;                                  <<DS.06>>26710000
      INTEGER IABORT  = ABORT;                                 <<DS.06>>26720000
      INTEGER IRDFLAG = READFLAG;                              <<DS.06>>26730000
      ARRAY QARRAY(*) = Q + 0;                                 <<06580>>26740000
      INTEGER PXFIXEDLOC;                                      <<06580>>26750000
                                                                        26760000
      CONTINUE:=CONTINUE+1;<<SET CONTINUE FLAG>>                        26770000
CXABORT:                                                                26780000
      IABORT:=IABORT+1;                                        <<DS.06>>26790000
      IRDFLAG:=IRDFLAG-1;                                      <<DS.06>>26800000
CXRESUME:                                                               26810000
      MYCOMMAND(PARMSP,,0,NUMPARMS,PARMS);<<CHECK COMMAND>>             26820000
      IF <> THEN                                               <<01308>>26830000
      BEGIN                                                    <<01308>>26840000
         IF ABORT AND NOT CONTINUE THEN                        <<01652>>26850000
         BEGIN                                                 <<01308>>26860000
            CIERR( ERRNUM := NOABORTPARMS, PARMSP );           <<01308>>26870000
            RETURN;                                            <<01308>>26880000
         END                                                   <<01308>>26890000
         ELSE                                                  <<01308>>26900000
            CIERR( ERRNUM := -WARNXPARMSIGNORED, PARMSP );     <<04787>>26910000
      END;                                                     <<01308>>26920000
      IF CONTINUE THEN                                                  26930000
         BEGIN<<CONTINUE>>                                              26940000
         CIS'CONTSTATE := 1;  << FLAG CONTINUE JUST READ >>    << I.A >>26950000
         RETURN;                                                        26960000
         END;                                                           26970000
<< We must handle Breaks, ABORTs, and RESUMEs if there is >>   <<07106>>26980000
<< DS3000 on the system.  Since it does not always exist, >>   <<07106>>26990000
<< we must stack parameters and check the sysglob location>>   <<07106>>27000000
<< to see if the DSBREAK Plabel is there.  If so, we will >>   <<07106>>27010000
<< PCAL it, else we will just go on.                      >>   <<07106>>27020000
<<                                                        >>   <<07106>>27030000
<< LOGICAL PROCEDURE DSBREAK(TYPE,MAINPINX,CYPINX);       >>   <<07106>>27040000
<< LOGICAL TYPE,MAINPINX,CYPINX;                          >>   <<07106>>27050000
<< VALUE TYPE,MAINPINX,CYPINX;                            >>   <<07106>>27060000
<<                                                        >>   <<07106>>27070000
<< TYPE.(0:1) = 1 IMPLIES THAT DS CALLED BREAKJOB.        >>   <<07106>>27080000
<< TYPE.(1:13)= NOT USED, SHOULD BE SET TO 0.             >>   <<07106>>27090000
<< TYPE.(14:2)= 0 IMPLIES THAT CNTL-Y IS BEING PROCESSED. >>   <<07106>>27100000
<<              1 IMPLIES THAT BREAK IS BEING PROCESSED.  >>   <<07106>>27110000
<<              2 IMPLIES THAT RESUME IS BEING PROCESSED. >>   <<07106>>27120000
<<              3 IMPLIES THAT :ABORT OR :CONTINUE ARE    >>   <<07106>>27130000
<<                BEING PROCESSED.                        >>   <<07106>>27140000
<< MAINPINX  - THIS IS THE MAIN PIN INDEX( INTO THE PCB   >>   <<07106>>27150000
<<             TABLE) OF THE PIN THAT INITIATED THE ABOVE >>   <<07106>>27160000
<<             ACTIVITIES.                                >>   <<07106>>27170000
<< CYPINX    - THE CNTL-Y PIN INDEX ( INTO THE PCB TABLE).>>   <<07106>>27180000
<< DSBREAK   - TRUE IF AN ATTACHIO IS DONE TO THE DS      >>   <<07106>>27190000
<<             PSEUDO DRIVER.                             >>   <<07106>>27200000
<<                                                        >>   <<07106>>27210000
      TOS:=0;   << Return value from DSBREAK >>                <<07106>>27220000
      TOS := IABORT + 2;  << Type of call >>                   <<07106>>27230000
      TOS := CURPRC;   << Current PCB table rel. index >>      <<07106>>27240000
      TOS := 0;    << Used only for Control-Y break >>         <<07106>>27250000
      TOS:=ABSOLUTE(%1360);  << DSBREAK plabel >>              <<07106>>27260000
      IF <> THEN ASSEMBLE(PCAL 0) ELSE ASSEMBLE(DDEL,DDEL);    <<06581>>27270000
      RMOTBRK:=TOS;                                            <<DS.06>>27280000
      PXFIXED;                                                 <<06580>>27290000
      IF PXFXBRKMODE = 0 THEN                                  <<06580>>27300000
         BEGIN<<RESUME & ABORT ALLOWED ONLY IN BREAK>>                  27310000
         IF NOT RMOTBRK THEN CIERR(ERRNUM := -ONLYINBREAK);    <<04787>>27320000
         RETURN;                                                        27330000
         END;                                                           27340000
      PXFXBRKMODE := 0; << RESET BREAK >>                      <<06580>>27350000
                                                               <<00835>>27360000
      << CHECK IF EXITING BREAK MODE WHILE 'IF' NESTED >>      <<00835>>27370000
      IF CIS'IFNESTING <>0 THEN CIERR(ERRNUM:=-IFS'NEQ'ENDIFS);<<04787>>27380000
                                                               <<00835>>27390000
      FUNBREAK(READFLAG);                                               27400000
      IF ABORT THEN ABORTPROG;                                          27410000
      CIS'UDCEXITBREAK := TRUE;                                << I.A >>27420000
END;  <<CXCONTINUE/CXRESUME/CXABORT>>                          <<U.RAO>>27430000
$TITLE "REDO COMMAND"                                          <<08.RO>>27440000
PROCEDURE CXREDO EXECUTORHEAD;                                 <<U.RAO>>27450000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>27460000
BEGIN  <<EXECUTOR FOR THE REDO COMMAND>>                       <<U.RAO>>27470000
<<BASIC SCHEME FOR REDO COMMAND IS AS FOLLOWS.                 <<U.RAO>>27480000
<<THE CI COMMAND BUFFER IS ACTUALLY DOUBLE BUFFERED.  AFTER    <<U.RAO>>27490000
<<EACH COMMAND IS EXECUTED, IT IS COPIED TO THE BUFFER         <<U.RAO>>27500000
<<LASTCOMIMAGE.  WHEN REDO IS INVOKED IT REACHES BACK TO THIS  <<U.RAO>>27510000
<<COPY FOR THE LAST COMMAND BEFORE REDO.                       <<U.RAO>>27520000
<<REDO ITSELF HAS A THIRD OPERATIONAL BUFFER, CALLED           <<U.RAO>>27530000
<<LOCALCOMIMAGE.  ALL OPERATIONS, EXCEPT REDO, ARE PERFORMED IN<<U.RAO>>27540000
<<THIS BUFFER, SO THAT WE CAN RECOVER FROM ERRORS AND DO THE   <<U.RAO>>27550000
<<UNDO FUNCTION.                                               <<U.RAO>>27560000
<<THE BASIC SCHEME IS VERY STRAIGHTFORWARD.  IT CONSISTS OF    <<U.RAO>>27570000
<<LOOPING, READING AND EXECUTING THE USER'S REQUESTS FOR       <<U.RAO>>27580000
<<EDITING FUNCTIONS, UNTIL THE USER DECIDES TO STOP.  EACH OF  <<U.RAO>>27590000
<<THE FUNCTIONS IS DESCRIBED IN ITS SUBROUTINE.  COMMUNICATION <<U.RAO>>27600000
<<BACK TO THE CI IS THROUGH THE "ALREADY READ" FLAG AT         <<U.RAO>>27610000
<<PXFIXED(32).  THIS COMMAND IS BREAKABLE, WITH BREAK BEING    <<U.RAO>>27620000
<<DEFINED AS "FORGET IT".  AN EDIT REQUEST LINE WITH JUST      <<U.RAO>>27630000
<<BLANKS IN IT IS IGNORED.  A REQUEST READ OF 0 SAYS "I'M      <<U.RAO>>27640000
<<FINISHED, EXECUTE IT."                                       <<U.RAO>>27650000
ARRAY LOCALCOMIMAGE(0:CIS'WCOMBUFLEN); << LOCAL WORK SPACE >>  << I.A >>27660000
BYTE ARRAY BLOCALCOMIMAGE(*) = LOCALCOMIMAGE;                  <<U.RAO>>27670000
ARRAY USERREQBUF(0:CIS'WCOMBUFLEN);  << FOR USER REQUESTS >>   << I.A >>27680000
BYTE ARRAY BUSERREQBUF(*) = USERREQBUF;                        <<U.RAO>>27690000
INTEGER LOCALCOMLEN;  <<LENGTH OF COMMAND IN LOCALCOMIMAGE>>   <<U.RAO>>27700000
INTEGER COMLEN;  <<LENGTH OF COMMAND IN WCOMIMAGE (IN DB SPACE)<<U.RAO>>27710000
INTEGER LASTCOMLEN;  <<LENGTH OF COMMAND IN LASTCOMIMAGE>>     <<U.RAO>>27720000
INTEGER USERREQLEN;  <<LENGTH OF IMAGE IN USERREQBUF>>         <<U.RAO>>27730000
INTEGER DATAOFFSET;  <<DISTANCE TO DATA IN USERREQBUF>>        <<U.RAO>>27740000
INTEGER DATALEN;  <<LENGTH OF OPERATIVE FIELD IN USERREQBUF>>  <<U.RAO>>27750000
INTEGER UNDOCOUNT := 0;  <<# UNDO REQUESTS SEEN>>              <<U.RAO>>27760000
LOGICAL LOOPING := TRUE;  <<CONTROL FLAG ON WHILE LOOP>>       <<U.RAO>>27770000
LOGICAL DL := %6400;  <<FOR MYCOMMAND SEARCH FOR PARMS>>       <<U.RAO>>27780000
                                                               <<U.RAO>>27790000
<<                 *********************                   >>  <<U.RAO>>27800000
<<                 *      DOUNDO       *                   >>  <<U.RAO>>27810000
<<                 *********************                   >>  <<U.RAO>>27820000
                                                               <<U.RAO>>27830000
SUBROUTINE DOUNDO(UPTR);                                       <<U.RAO>>27840000
BYTE ARRAY UPTR;  << POINTS TO "U" IN USERREQBUF.  UNUSED.>>   <<U.RAO>>27850000
BEGIN                                                          <<U.RAO>>27860000
<<UNDO CAN DO TWO LEVELS: UNDO THE LAST COMMAND, AND, IF >>    <<U.RAO>>27870000
<<REQUESTED AGAIN, UNDO ALL THE WAY BACK TO THE ORIGINAL.>>    <<U.RAO>>27880000
<<THE ORIGINAL IS STASHED IN LASTCOMIMAGE AND IS NEVER   >>    <<U.RAO>>27890000
<<TOUCHED BY REDO.                                       >>    <<U.RAO>>27900000
<<NOTE THAT UNDOCOUNT IS CLEARED WHENEVER ANY OF THE     >>    <<U.RAO>>27910000
<<OTHER FUNCTIONS IS EXECUTED.                           >>    <<U.RAO>>27920000
IF UNDOCOUNT>0 THEN   <<SECOND OR LATER UNDO>>                 <<U.RAO>>27930000
   BEGIN                                                       <<U.RAO>>27940000
   COMLEN := LASTCOMLEN;                                       <<U.RAO>>27950000
   MOVE CIS'WCOMIMAGE := CIS'LASTCOMIMAGE, (LASTCOMLEN/2+1);   << I.A >>27960000
   END;                                                        <<U.RAO>>27970000
MOVE LOCALCOMIMAGE := CIS'WCOMIMAGE, (COMLEN/2+1);             << I.A >>27980000
LOCALCOMLEN := COMLEN;                                         <<U.RAO>>27990000
UNDOCOUNT := UNDOCOUNT+1;                                      <<U.RAO>>28000000
END;  <<SUBROUTINE DOUNDO>>                                    <<U.RAO>>28010000
                                                               <<U.RAO>>28020000
<<                 *********************                   >>  <<U.RAO>>28030000
<<                 *     DOREPLACE     *                   >>  <<U.RAO>>28040000
<<                 *********************                   >>  <<U.RAO>>28050000
                                                               <<U.RAO>>28060000
SUBROUTINE DOREPLACE(RPTR);                                    <<U.RAO>>28070000
BYTE ARRAY RPTR;  <<POINTS TO "R" IN USERREQBUF>>              <<U.RAO>>28080000
BEGIN                                                          <<U.RAO>>28090000
<<STRATEGY FOR REPLACE FUNCTION:                         >>    <<U.RAO>>28100000
<<SIMPLY DO MOVE TO REPLACE OLD DATA WITH NEW DATA.      >>    <<U.RAO>>28110000
<<ONLY COMPLICATION IS IF START OF MOVE IS BEYOND END OF >>    <<U.RAO>>28120000
<<CURRENT COMMAND, MUST BLANK FILL CURRENTLY UNUSED SPACE>>    <<U.RAO>>28130000
<<NOTE THAT THE REPLACE FUNCTION IS THE DEFAULT CASE, IF >>    <<U.RAO>>28140000
<<THE FUNCTION CODE IS NOT U,R,I,D,u,r,i,d.  IN THIS CASE>>    <<U.RAO>>28150000
<<IT IS ASSUMED THAT NO FUNCTION CODE WAS SUPPLIED.      >>    <<U.RAO>>28160000
                                                               <<U.RAO>>28170000
<<ADJUST POINTER FOR "R">>                                     <<U.RAO>>28180000
DATAOFFSET := @RPTR-@BUSERREQBUF;  <<START ADDR OF REPLACE>>   <<U.RAO>>28190000
IF RPTR ="R" OR RPTR ="r" THEN                                 <<U.RAO>>28200000
   BEGIN  <<SKIP OVER "R" FOR ACTUAL DATA>>                    <<U.RAO>>28210000
   @RPTR := @RPTR+1;                                           <<U.RAO>>28220000
   USERREQLEN := USERREQLEN-1;                                 <<U.RAO>>28230000
   END;                                                        <<U.RAO>>28240000
IF USERREQLEN > CIS'MAXCOMLEN THEN                             << I.A >>28250000
   CIERR(ERRNUM := REDOITOOLONG,,%10000,      << OVERFLOW >>   <<04787>>28260000
           CIS'MAXCOMLEN)                                      <<04787>>28270000
ELSE                                                           <<01455>>28280000
BEGIN                                                          <<01455>>28290000
IF DATAOFFSET>LOCALCOMLEN THEN                                 <<U.RAO>>28300000
   BEGIN  <<BLANK FILL SPACE BETWEEN END OF COMMAND AND DATA>> <<U.RAO>>28310000
   BLOCALCOMIMAGE(LOCALCOMLEN) := " ";                         <<U.RAO>>28320000
   MOVE BLOCALCOMIMAGE(LOCALCOMLEN+1) :=                       <<U.RAO>>28330000
       BLOCALCOMIMAGE(LOCALCOMLEN), (DATAOFFSET-1-LOCALCOMLEN);<<U.RAO>>28340000
   END;                                                        <<U.RAO>>28350000
<<NOW DO REPLACE>>                                             <<U.RAO>>28360000
MOVE BLOCALCOMIMAGE(DATAOFFSET) := RPTR,                       <<U.RAO>>28370000
      (USERREQLEN-DATAOFFSET);                                 <<U.RAO>>28380000
IF LOCALCOMLEN < USERREQLEN THEN                               <<U.RAO>>28390000
   BEGIN  <<ADJUST END OF COMMAND LINE>>                       <<U.RAO>>28400000
   LOCALCOMLEN := USERREQLEN;                                  <<U.RAO>>28410000
   BLOCALCOMIMAGE(LOCALCOMLEN) := %15;                         <<U.RAO>>28420000
   END;                                                        <<U.RAO>>28430000
END;                                                           <<01455>>28440000
END;  <<SUBROUTINE DOREPLACE>>                                 <<U.RAO>>28450000
                                                               <<U.RAO>>28460000
<<                 *********************                   >>  <<U.RAO>>28470000
<<                 *     DOINSERT      *                   >>  <<U.RAO>>28480000
<<                 *********************                   >>  <<U.RAO>>28490000
                                                               <<U.RAO>>28500000
SUBROUTINE DOINSERT(IPTR);                                     <<U.RAO>>28510000
BYTE ARRAY IPTR;  <<BYTE POINTER TO "I" IN USERREQBUF>>        <<U.RAO>>28520000
BEGIN                                                          <<U.RAO>>28530000
<<STRATEGY FOR INSERT:                               >>        <<U.RAO>>28540000
<<    CASE 1:  ENTIRE INSERT IS BEYOND CURRENT END OF>>        <<U.RAO>>28550000
<<       LINE.  DO REPLACE INSTEAD.                  >>        <<U.RAO>>28560000
<<    CASE 2:  INSERT IS WITHIN CURRENT END OF LINE. >>        <<U.RAO>>28570000
<<       MUST CHECK TO SEE THAT NEW LINE LENGTH IS   >>        <<U.RAO>>28580000
<<       GOING TO FIT OUR BUFFERS.  IF IT DOES, WE   >>        <<U.RAO>>28590000
<<       THEN OPEN A HOLE IN LOCALCOMIMAGE THE SIZE  >>        <<U.RAO>>28600000
<<       OF THE INSERT, THEN DO THE INSERT.          >>        <<U.RAO>>28610000
DATAOFFSET := @IPTR-@BUSERREQBUF;  <<DISTANCE TO INPUT DATA>>  <<U.RAO>>28620000
IF DATAOFFSET >= LOCALCOMLEN THEN                              <<U.RAO>>28630000
   BEGIN  <<ADDING BEYOND CURRENT END OF LINE>>                <<U.RAO>>28640000
   IPTR := "R";  <<SIMULATE REPLACE INSTEAD.>>                 <<U.RAO>>28650000
   DOREPLACE(IPTR)                                             <<U.RAO>>28660000
   END                                                         <<U.RAO>>28670000
ELSE  <<INSERT WITHIN CURRENT END OF LINE.>>                   <<U.RAO>>28680000
   BEGIN                                                       <<U.RAO>>28690000
   DATALEN := USERREQLEN-DATAOFFSET-1;  <<AMOUNT TO INSERT>>   <<U.RAO>>28700000
   IF LOCALCOMLEN + DATALEN > CIS'MAXCOMLEN THEN               << I.A >>28710000
      CIERR(ERRNUM := REDOITOOLONG,,%10000,      << OVERFLOW >><<04787>>28720000
           CIS'MAXCOMLEN)                                      <<04787>>28730000
   ELSE                                                        <<U.RAO>>28740000
      BEGIN  <<NEW LINE WILL FIT BUFFER, DO INSERT>>           <<U.RAO>>28750000
      <<FIRST ADJUST OLD LINE TO OPEN HOLE FOR INSERT>>        <<U.RAO>>28760000
      MOVE BLOCALCOMIMAGE(LOCALCOMLEN+DATALEN) <<END OF NEW CMD<<U.RAO>>28770000
           := BLOCALCOMIMAGE(LOCALCOMLEN),  <<END OF OLD CMD>> <<U.RAO>>28780000
              (DATAOFFSET-LOCALCOMLEN-1);  <<GETS CR AS WELL>> <<U.RAO>>28790000
      <<OLD LINE IS NOW ADJUSTED IN LOCALCOMIMAGE.  INSERT DATA<<U.RAO>>28800000
      MOVE BLOCALCOMIMAGE(DATAOFFSET) := IPTR(1),(DATALEN);    <<U.RAO>>28810000
      LOCALCOMLEN := LOCALCOMLEN+DATALEN;                      <<U.RAO>>28820000
      END;                                                     <<U.RAO>>28830000
   END;                                                        <<U.RAO>>28840000
END;   <<SUBROUTINE DOINSERT>>                                 <<U.RAO>>28850000
                                                               <<U.RAO>>28860000
<<                 *********************                   >>  <<U.RAO>>28870000
<<                 *     DODELETE      *                   >>  <<U.RAO>>28880000
<<                 *********************                   >>  <<U.RAO>>28890000
                                                               <<U.RAO>>28900000
SUBROUTINE DODELETE(DPTR);                                     <<U.RAO>>28910000
BYTE ARRAY DPTR;  <<POINTER TO "D" IN USERREQBUF>>             <<U.RAO>>28920000
BEGIN                                                          <<U.RAO>>28930000
<<DELETE IS THE MOST COMPLICATED OF THE EDIT FUNCTIONS.      >><<U.RAO>>28940000
<<POSSIBLE INPUTS ARE:                                       >><<U.RAO>>28950000
<<   "D", "D..D","D    D","D   ","DI...","D  DI","DDDI",D..XX>><<U.RAO>>28960000
<<THE STRATEGY IS: FIRST DEAL WITH THE DELETION PART. COMPUTE>><<U.RAO>>28970000
<<THE NUMBER OF DELETIONS TO DO AND THE LOCATION AT WHICH TO >><<U.RAO>>28980000
<<DO THEM.  THEN DO THE DELETIONS.  FINALLY, IF NECESSARY,   >><<U.RAO>>28990000
<<DEAL WITH THE INSERTION QUESTION OR THE GARBAGE BEYOND THE >><<U.RAO>>29000000
<<LAST DELETION.                                             >><<U.RAO>>29010000
DATAOFFSET := @DPTR-@BUSERREQBUF;                              <<U.RAO>>29020000
<<COUNT THE NUMBER TO DELETE.  THIS IS A COMPLICATED FUNCTION>><<U.RAO>>29030000
<<DUE TO THE NUMBER OF DIFFERENT WAYS OF SPECIFYING THIS.    >><<U.RAO>>29040000
DATALEN := 1;  <<SINCE WE KNOW WE HAVE AT LEAST ONE DELETION>> <<U.RAO>>29050000
@DPTR := @DPTR+1;  <<SKIP THE FIRST "D">>                      <<U.RAO>>29060000
IF DPTR = "D" OR DPTR = "d" THEN  <<CONTIGUOUS D'S>>           <<U.RAO>>29070000
   DO   <<COUNT OF CONTIGUOUS D'S>>                            <<U.RAO>>29080000
      BEGIN                                                    <<U.RAO>>29090000
      DATALEN := DATALEN+1;                                    <<U.RAO>>29100000
      @DPTR := @DPTR+1;  <<SKIP THIS D>>                       <<U.RAO>>29110000
      END                                                      <<U.RAO>>29120000
   UNTIL DPTR <> "D" AND DPTR <> "d"                           <<U.RAO>>29130000
ELSE  <<COULD BE "D  D" OR "D  " OR "D(CR)">>                  <<U.RAO>>29140000
   BEGIN                                                       <<U.RAO>>29150000
   SCAN DPTR WHILE %6440,1;  <<FIND NEXT NON-BLANK>>           <<U.RAO>>29160000
   S2 := TOS;  <<SAVE ITS ADDRESS IN DPTR>>                 <<U.RAO>>   29170000
   IF NOCARRY THEN   <<NOT CR, COULD BE "D">>                  <<U.RAO>>29180000
      IF DPTR = "D" OR DPTR = "d" THEN  <<FOUND D'S SEPARATED>><<U.RAO>>29190000
         BEGIN  <<BY BLANKS, COUNT THE SPACES BETWEEN.>>       <<U.RAO>>29200000
         DATALEN := @DPTR-@BUSERREQBUF-DATAOFFSET+1;           <<U.RAO>>29210000
         @DPTR := @DPTR+1;  <<SKIP TRAILING D>>                <<U.RAO>>29220000
         END;                                                  <<U.RAO>>29230000
   END;                                                        <<U.RAO>>29240000
<<DPTR = ADDR OF a) (CR), b) "I", c) NEXT CHAR BEYOND "D">>    <<U.RAO>>29250000
<<HAVE COMPLETED FIRST STEP, COUNTING THE NUMBER OF DELETIONS.><<U.RAO>>29260000
<<ALSO HAVE DISTANCE TO START OF DELETIONS IN DATAOFFSET.>>    <<U.RAO>>29270000
<<NEXT STEP IS TO PERFORM DELETION.>>                          <<U.RAO>>29280000
<<THREE CASES:                                           >>    <<U.RAO>>29290000
<< 1)  DELETION IS COMPLETELY BEYOND CURRENT END OF LINE.>>    <<U.RAO>>29300000
<<     ACTION IS DO NOTHING.                             >>    <<U.RAO>>29310000
<< 2)  DELETION CROSSES END OF CURRENT LINE.             >>    <<U.RAO>>29320000
<<     ACTION IS MOVE TRAILING CR, ADJUST LINE LENGTH.   >>    <<U.RAO>>29330000
<< 3)  DELETION IS COMPLETELY WITHIN CURRENT LINE.       >>    <<U.RAO>>29340000
<<     ACTION IS DO MOVE WITHIN LINE, DESTROYING DELETED >>    <<U.RAO>>29350000
<<     DATA.                                             >>    <<U.RAO>>29360000
IF DATAOFFSET < LOCALCOMLEN THEN  <<DELETE STARTS WITHIN LINE>><<U.RAO>>29370000
   BEGIN                                                       <<U.RAO>>29380000
   IF DATAOFFSET+DATALEN > LOCALCOMLEN THEN                    <<U.RAO>>29390000
      BEGIN  <<DELETE CROSSES END OF LINE.>>                   <<U.RAO>>29400000
      BLOCALCOMIMAGE(DATAOFFSET) := %15;                       <<U.RAO>>29410000
      LOCALCOMLEN := DATAOFFSET;                               <<U.RAO>>29420000
      END                                                      <<U.RAO>>29430000
   ELSE  <<DELETE ENTIRELY WITHIN CURRENT LINE>>               <<U.RAO>>29440000
      BEGIN                                                    <<U.RAO>>29450000
      MOVE BLOCALCOMIMAGE(DATAOFFSET) <<START ADDRESS OF DELETE<<U.RAO>>29460000
         := BLOCALCOMIMAGE(DATAOFFSET+DATALEN)  <<END ADDRESS>><<U.RAO>>29470000
            ,(LOCALCOMLEN-DATAOFFSET-DATALEN+1);<<TO END OF BUF<<U.RAO>>29480000
      LOCALCOMLEN := LOCALCOMLEN-DATALEN;                      <<U.RAO>>29490000
      END;                                                     <<U.RAO>>29500000
   END;  <<OF DELETION PHASE>>                                 <<U.RAO>>29510000
<<NOW HAVE FINISHED DOING DELETION OPERATION.  NOW JUST >>     <<U.RAO>>29520000
<<DEAL WITH ANY TRAILING GARBAGE OR INSERTION REQUEST.>>       <<U.RAO>>29530000
<<REMEMBER THAT DPTR POINTS TO THE PLACE WHERE WE LEFT>>       <<U.RAO>>29540000
<<OFF OUR SCAN.  A SIDE POINT: EVEN IF GARBAGE IS OUT THERE,>> <<U.RAO>>29550000
<<WE WILL STILL DO THE DELETION, SO WHAT IS IN LASTCOMIMAGE>>  <<U.RAO>>29560000
<<ON THE NEXT TIME THROUGH THE LOOP WILL REFLECT THE DELETE.>> <<U.RAO>>29570000
<<THIS IS PROBABLY A FEATURE.>>                                <<U.RAO>>29580000
SCAN DPTR WHILE %6440,1;  <<SKIP BLANKS TO NEXT NON-BLANK>>    <<U.RAO>>29590000
S2 := TOS;   <<SAVE ITS ADDRESS IN DPTR>>                   <<U.RAO>>   29600000
IF NOCARRY THEN   <<SOMETHING THERE.>>                         <<U.RAO>>29610000
   IF DPTR="I" OR DPTR="i" THEN                                <<U.RAO>>29620000
      BEGIN   <<DO INSERTION TRICK>>                           <<U.RAO>>29630000
      @DPTR := @DPTR-DATALEN;  <<AS IF DELETE WASN'T THERE>>   <<U.RAO>>29640000
      USERREQLEN := USERREQLEN-DATALEN;                        <<U.RAO>>29650000
      MOVE DPTR := DPTR(DATALEN)                               <<U.RAO>>29660000
            ,(USERREQLEN-DATAOFFSET+1);                        <<U.RAO>>29670000
      DOINSERT(DPTR);                                          <<U.RAO>>29680000
      END                                                      <<U.RAO>>29690000
   ELSE  <<GARBAGE THERE>>                                     <<U.RAO>>29700000
      CIERR(ERRNUM := REDODELGARBAGE);                         <<04787>>29710000
END;   <<SUBROUTINE DODELETE>>                                 <<U.RAO>>29720000
<<**********  MAIN BODY  *************>>                       <<U.RAO>>29730000
<<STEP 1 - CHECK FOR (ILLEGAL) PARAMETERS>>                    <<U.RAO>>29740000
MYCOMMAND(PARMSP, DL, 0);                                      <<U.RAO>>29750000
IF <> THEN                                                     <<U.RAO>>29760000
   CIERR(ERRNUM := -WARNXPARMSIGNORED, PARMSP);                <<04787>>29770000
<<STEP 2 - SET UP BUFFERS AND BUFFER LENGTHS>>                 <<U.RAO>>29780000
SCAN CIS'BLASTCOMIMAGE UNTIL %6415, 1;                         << I.A >>29790000
COMLEN := TOS - @CIS'BLASTCOMIMAGE;                            << I.A >>29800000
IF COMLEN > CIS'BCOMBUFLEN THEN  << ERROR:  NO <CR>  >>        << I.A >>29810000
   BEGIN                                                       <<01455>>29820000
   COMLEN := CIS'MAXCOMLEN;                                    << I.A >>29830000
   CIS'BLASTCOMIMAGE( CIS'MAXCOMLEN ) := %15;                  << I.A >>29840000
   END;                                                        <<01455>>29850000
LOCALCOMLEN := LASTCOMLEN := COMLEN;                           <<00526>>29860000
MOVE CIS'WCOMIMAGE := CIS'LASTCOMIMAGE, (COMLEN/2+1);          << I.A >>29870000
MOVE LOCALCOMIMAGE := CIS'LASTCOMIMAGE, (COMLEN/2+1);          << I.A >>29880000
<<NOW LOOP WHILE DOING USER EDIT REQUESTS>>                    <<U.RAO>>29890000
WHILE LOOPING AND NOT REQUESTSERVICE DO                        <<U.RAO>>29900000
   BEGIN                                                       <<U.RAO>>29910000
   <<READ USER REQUEST>>                                       <<U.RAO>>29920000
   PRINT(LOCALCOMIMAGE, -LOCALCOMLEN, 0);                      <<U.RAO>>29930000
   USERREQLEN := READ(USERREQBUF, -CIS'BCOMBUFLEN );           << I.A >>29940000
   IF <> THEN << EOF OR IO ERROR ON  $STDIN >>                 <<00832>>29950000
      BEGIN   << ABORT REDO >>                                 <<00832>>29960000
      CIS'PENDINGCOMLEN := 0;  << SO CI WILL TRY READ >>       << I.A >>29970000
      IF < THEN CIERR(ERRNUM := ERRSTDINIO);                   <<04787>>29980000
      RETURN;                                                  <<00832>>29990000
      END;                                                     <<00832>>30000000
   BUSERREQBUF(USERREQLEN) := %15;  <<ADD TRAILING CR>>        <<U.RAO>>30010000
   IF REQUESTSERVICE THEN <<HIT BREAK DURING READ, BAIL OUT>>  <<U.RAO>>30020000
      LOOPING := FALSE                                         <<U.RAO>>30030000
   ELSE IF USERREQLEN = 0 THEN  <<FINISHED EDITING,>>          <<U.RAO>>30040000
      BEGIN  <<SET CI "COMMAND ALREADY READ" FLAG, EXIT>>      <<U.RAO>>30050000
      MOVE CIS'WCOMIMAGE := LOCALCOMIMAGE, (LOCALCOMLEN/2+1);  << I.A >>30060000
      CIS'PENDINGCOMLEN := LOCALCOMLEN; << GETIMAGE FLAG >>    << I.A >>30070000
      CIS'LINELENSTACK(1) := 0;  << KILL ERR CARET ROUTINE >>  << I.A >>30080000
      CIS'LINELENSTACK := LOCALCOMLEN;                         << I.A >>30090000
      LOOPING := FALSE;                                        <<U.RAO>>30100000
      END                                                      <<U.RAO>>30110000
   ELSE   <<REAL EDIT REQUEST (PROBABLY)>>                     <<U.RAO>>30120000
      BEGIN                                                    <<U.RAO>>30130000
      SCAN BUSERREQBUF WHILE %6440,1;  <<SCAN UNTIL NON-BLANK>><<U.RAO>>30140000
      IF CARRY THEN   <<FOUND BLANKS, CR  => NO REQUEST>>      <<U.RAO>>30150000
         DEL  <<POP POINTER, LOOP FOR ANOTHER TRY>>            <<U.RAO>>30160000
      ELSE                                                     <<U.RAO>>30170000
         BEGIN  <<CHOOSE ROUTINE BASED ON CHARACTER FOUND>>    <<U.RAO>>30180000
         XREG := BPS0;  <<STASH CHARACTER IN XREG>>            <<U.RAO>>30190000
         IF XREG = "U" OR XREG = "u" THEN                      <<U.RAO>>30200000
            DOUNDO(*)                                          <<U.RAO>>30210000
         ELSE                                                  <<U.RAO>>30220000
            BEGIN   <<NON-UNDO FUNCTION, SAVE RESULTS OF LAST E<<U.RAO>>30230000
            MOVE CIS'WCOMIMAGE                                 << I.A >>30240000
               := LOCALCOMIMAGE, (LOCALCOMLEN/2+1);            << I.A >>30250000
            COMLEN := LOCALCOMLEN;                             <<U.RAO>>30260000
            UNDOCOUNT := 0;                                    <<U.RAO>>30270000
            IF XREG = "D" OR XREG = "d" THEN                   <<U.RAO>>30280000
               DODELETE(*)                                     <<U.RAO>>30290000
            ELSE IF XREG = "I" OR XREG = "i" THEN              <<U.RAO>>30300000
               DOINSERT(*)                                     <<U.RAO>>30310000
            ELSE                                               <<U.RAO>>30320000
               DOREPLACE(*);                                   <<U.RAO>>30330000
            END;                                               <<U.RAO>>30340000
         END;                                                  <<U.RAO>>30350000
      END;                                                     <<U.RAO>>30360000
   END;                                                        <<U.RAO>>30370000
END;   <<PROCEDURE CXREDO>>                                    <<U.RAO>>30380000
$PAGE "CXSTORENEW"                                             <<*7836>>30390000
PROCEDURE CXSTORENEW EXECUTORHEAD;                             <<*7836>>30400000
   OPTION PRIVILEGED, UNCALLABLE;                              <<*7836>>30410000
                                                               <<*7836>>30420000
<< This procedure creates the STORE "subsystem" and passes >>  <<*7836>>30430000
<< any "INFO" specified with the STORE command with the    >>  <<*7836>>30440000
<< INFO parameter in the CREATEPROCESS call.               >>  <<*7836>>30450000
<<                                                         >>  <<*7836>>30460000
<< It builds an INFO string within a local array, and then >>  <<*7836>>30470000
<< passes it to STORE.PUB.SYS.   This string consists of   >>  <<*7836>>30480000
<< "STORE " and then any leftover text from the user's     >>  <<*7836>>30490000
<< input (e.g: whatever followed "STORE").                 >>  <<*7836>>30500000
<<                                                         >>  <<*7836>>30510000
<< STORE will, if all goes well, communicate via the MAIL  >>  <<*7836>>30520000
<< intrinsics.  This feature is invoked by running STORE   >>  <<*7836>>30530000
<< with a non-zero PARM.                                   >>  <<*7836>>30540000
<<                                                         >>  <<*7836>>30550000
<< Because STORE must be callable from the COMMAND intrin- >>  <<*7836>>30560000
<< sic by even a non-PH user, we must disregard normal PH  >>  <<*7836>>30570000
<< restrictions.  This opens a very small "security" hole; >>  <<*7836>>30580000
<< if the non-PH user has created a temporary PROG file of >>  <<*7836>>30590000
<< the name: STORE.PUB.SYS, we have no way of telling the  >>  <<*7836>>30600000
<< CREATEPROCESS intrinsic to NOT run it and to run the    >>  <<*7836>>30610000
<< "real" one (the permanent one) instead.  Hence, in such >>  <<*7836>>30620000
<< a situation, the non-PH user could conceivably be able  >>  <<*7836>>30630000
<< to run processes despite lacking PH!  To plug this small>>  <<*7836>>30640000
<< hole, this code will either: (1) do nothing;  or        >>  <<*7836>>30650000
<< (2) issue an implicit file equate of the form:          >>  <<*7836>>30660000
<< FILE STORE = STORE.PUB.SYS, OLD                         >>  <<*7836>>30670000
<< and then do a CREATEPROCESS of *STORE.                  >>  <<*7836>>30680000
                                                               <<*7836>>30690000
   BEGIN                                                       <<*7836>>30700000
                                                               <<*7836>>30710000
   EQUATE                                                      <<*7836>>30720000
      INFO'OVERHEAD = 10;     <<number of chars in "STORE " +>><<*7836>>30730000
                                                               <<*7836>>30740000
   INTEGER ARRAY                                               <<*7836>>30750000
      ITEMS       (0:10),     <<CREATEPROCESS items>>          <<*7836>>30760000
      ITEMCODES   (0:10),     <<   "  "     item codes>>       <<*7836>>30770000
      PROGNAME    (0:8);      <<name of STORE.PUB.SYS>>        <<*7836>>30780000
                                                               <<*7836>>30790000
   INTEGER                                                     <<*7836>>30800000
      ERROR       := 0,       <<Error from CREATEPROCESS>>     <<*7836>>30810000
      I           := 0,       <<scratch integer>>              <<*7836>>30820000
      PIN         := 0,       <<Pin# of STORE.PUB.SYS>>        <<*7836>>30830000
      CMDERR      := 0,       <<ERR RETURN FROM COMMAND>>      <<*7836>>30840000
      CMDPARM     := 0;       <<PARM RETURN FROM COMMAND>>     <<*7836>>30850000
                                                               <<*7836>>30860000
   LOGICAL                                                     <<*7836>>30870000
      LEN         := 0;       <<length of text>>               <<*7836>>30880000
                                                               <<*7836>>30890000
   BYTE ARRAY                                                  <<*7836>>30900000
      INFO'       (0:CIS'BCOMBUFLEN+INFO'OVERHEAD),            <<*7836>>30910000
      PROGNAME'   (*) = PROGNAME (0);                          <<*7836>>30920000
                                                               <<*7836>>30930000
   BYTE POINTER                                                <<*7836>>30940000
      P';                     <<pointer along INFO'>>          <<*7836>>30950000
                                                               <<*7836>>30960000
   DEFINE                                                      <<*7836>>30970000
      FAILED      = FALSE #,                                   <<*7836>>30980000
      GOOD        = TRUE #,                                    <<*7836>>30990000
      NO'MSG      = -1 #,     <<flag to FAIL>>                 <<*7836>>31000000
      STORE'FORMAL'NAME'  = "STOREPRG" #,                      <<*7836>>31010000
      STORE'JCW'          = "STOREJCW" #,                      <<*7836>>31020000
      STORE'PROGRAM'NAME' = "STORE.PUB.SYS" #,                 <<*7836>>31030000
      UNKNOWN'PROG'FILE   =  (ERROR = 6)#;                     <<*7836>>31040000
                                                               <<*7836>>31050000
   EQUATE                                                      <<*7836>>31060000
                                                               <<*7836>>31070000
         <<equates for STOREJCW value...>>                     <<*7836>>31080000
                                                               <<*7836>>31090000
      WHY'GOOD       = 0,     <<no error found>>               <<*7836>>31100000
      WHY'SYNTAX     = 1,     <<parsing syntax>>               <<*7836>>31110000
      WHY'OPENING'FILES=2,    <<opening utility files>>        <<*7836>>31120000
      WHY'INDIRECT   = 3,     <<opening indirect file>>        <<*7836>>31130000
      WHY'OPENING'TAPE=4,     <<opening tape file>>            <<*7836>>31140000
      WHY'SCANNING  = 5,    <<scanning files to STORE/RESTORE>><<*7836>>31150000
      WHY'DOING      = 6;     <<doing actual STORE/RESTORE>>   <<*7836>>31160000
                                                               <<*7836>>31170000
   INTRINSIC                                                   <<*7836>>31180000
      ACTIVATE,                                                <<*7836>>31190000
      CREATEPROCESS,                                           <<*7836>>31200000
      COMMAND,                                                 <<*7836>>31210000
      FINDJCW,                                                 <<*7836>>31220000
      PUTJCW;                                                  <<*7836>>31230000
                                                               <<*7836>>31240000
   LABEL                                                       <<*7836>>31250000
      END'CXSTORENEW;                                          <<*7836>>31260000
                                                               <<*7836>>31270000
                                                               <<*7836>>31280000
   <<-------->>                                                <<*7836>>31290000
   <<  FAIL  >>                                                <<*7836>>31300000
   <<-------->>                                                <<*7836>>31310000
                                                               <<*7836>>31320000
   SUBROUTINE FAIL (WHY, SUB'WHY);                             <<*7836>>31330000
            VALUE   WHY, SUB'WHY;                              <<*7836>>31340000
            INTEGER WHY, SUB'WHY;                              <<*7836>>31350000
                                                               <<*7836>>31360000
         <<setup ERRNUM and PARMNUM return values, call >>     <<*7836>>31370000
         <<CIERR to print the error message, return from>>     <<*7836>>31380000
         <<procedure...                                 >>     <<*7836>>31390000
                                                               <<*7836>>31400000
      BEGIN                                                    <<*7836>>31410000
                                                               <<*7836>>31420000
      IF WHY <> NO'MSG THEN                                    <<*7836>>31430000
         BEGIN                                                 <<*7836>>31440000
         ERRNUM:=WHY;                                          <<*7836>>31450000
         PARMNUM:=SUB'WHY;                                     <<*7836>>31460000
         CIERR (ERRNUM);                                       <<*7836>>31470000
         END;                                                  <<*7836>>31480000
                                                               <<*7836>>31490000
      GO END'CXSTORENEW;                                       <<*7836>>31500000
                                                               <<*7836>>31510000
      END <<FAIL SUB>>;                                        <<*7836>>31520000
                                                               <<*7836>>31530000
   <<------------------>>                                      <<*7836>>31540000
   <<  INITIALIZE'JCW  >>                                      <<*7836>>31550000
   <<------------------>>                                      <<*7836>>31560000
                                                               <<*7836>>31570000
   SUBROUTINE INITIALIZE'JCW;                                  <<*7836>>31580000
                                                               <<*7836>>31590000
      <<Does a PUTJCW to setup the JCW called STOREJCW.>>      <<*7836>>31600000
      <<The jcw is set to the value of WHY'GOOD.       >>      <<*7836>>31610000
      <<This "initialization" is done prior to starting>>      <<*7836>>31620000
      <<the STORE program, so that if we are unable to >>      <<*7836>>31630000
      <<add a jcw to the current session's table, we   >>      <<*7836>>31640000
      <<will find out now instead of later.            >>      <<*7836>>31650000
                                                               <<*7836>>31660000
      BEGIN                                                    <<*7836>>31670000
                                                               <<*7836>>31680000
      MOVE INFO':=(STORE'JCW', " ", %15);                      <<*7836>>31690000
                                                               <<*7836>>31700000
      I:=WHY'GOOD;                                             <<*7836>>31710000
                                                               <<*7836>>31720000
      PUTJCW (INFO', I, ERROR);                                <<*7836>>31730000
                                                               <<*7836>>31740000
      IF ERROR <> 0 THEN                                       <<*7836>>31750000
         FAIL (STORE'JCW'FAILED, ERROR);                       <<*7836>>31760000
                                                               <<*7836>>31770000
      END <<INITIALIZE'JCW SUB>>;                              <<*7836>>31780000
                                                               <<*7836>>31790000
   <<--------------------->>                                   <<*7836>>31800000
   <<  ISSUE'FILE'EQUATE  >>                                   <<*7836>>31810000
   <<--------------------->>                                   <<*7836>>31820000
                                                               <<*7836>>31830000
   SUBROUTINE ISSUE'FILE'EQUATE;                               <<*7836>>31840000
                                                               <<*7836>>31850000
      <<Issues a file equate of the form: >>                   <<*7836>>31860000
      <<  FILE STORE=STORE.PUB.SYS,OLD    >>                   <<*7836>>31870000
                                                               <<*7836>>31880000
      BEGIN                                                    <<*7836>>31890000
                                                               <<*7836>>31900000
      MOVE INFO':=(STORE'FORMAL'NAME', "=",                    <<*7836>>31910000
                   STORE'PROGRAM'NAME',                        <<*7836>>31920000
                   %15);                                       <<*7836>>31930000
                                                               <<*7836>>31940000
      CXFILE (INFO', ERRNUM, PARMNUM);                         <<*7836>>31950000
                                                               <<*7836>>31960000
      IF ERRNUM <> 0 THEN                                      <<*7836>>31970000
         FAIL (STORE'FAILED, ERRNUM);                          <<*7836>>31980000
                                                               <<*7836>>31990000
      END <<ISSUE'FILE'EQUATE SUB>>;                           <<*7836>>32000000
                                                               <<*7836>>32010000
   <<-------------->>                                          <<*7836>>32020000
   <<  BUILD'INFO  >>                                          <<*7836>>32030000
   <<-------------->>                                          <<*7836>>32040000
                                                               <<*7836>>32050000
   SUBROUTINE BUILD'INFO;                                      <<*7836>>32060000
                                                               <<*7836>>32070000
      <<This routine builds the INFO string for STORE>>        <<*7836>>32080000
                                                               <<*7836>>32090000
      BEGIN                                                    <<*7836>>32100000
                                                               <<*7836>>32110000
            <<initialize the start of INFO'...>>               <<*7836>>32120000
                                                               <<*7836>>32130000
      MOVE INFO':="STORE ", 2;         <<leave dest pointer>>  <<*7836>>32140000
      @P':=TOS;                        <<save it in P'>>       <<*7836>>32150000
                                                               <<*7836>>32160000
            <<copy PARMSP text into INFO...>>                  <<*7836>>32170000
                                                               <<*7836>>32180000
      SCAN PARMSP UNTIL %15, 1;        <<find CR>>             <<*7836>>32190000
      LEN:=TOS - LOGICAL(@PARMSP);     <<text length>>         <<*7836>>32200000
      IF LEN > CIS'BCOMBUFLEN THEN     <<safety precaution>>   <<*7836>>32210000
         LEN:=CIS'BCOMBUFLEN;        <<just truncate for now>> <<*7836>>32220000
      MOVE P':=PARMSP, (LEN), 2;       <<leave new P'>>        <<*7836>>32230000
      @P':=TOS;                        <<pick it up, store it>><<*7836>>32240000
                                                               <<*7836>>32250000
      LEN:=LOGICAL(@P')-LOGICAL(@INFO');  <<overall length>>   <<*7836>>32260000
                                                               <<*7836>>32270000
      END <<BUILD'INFO SUB>>;                                  <<*7836>>32280000
                                                               <<*7836>>32290000
   <<--------------->>                                         <<*7836>>32300000
   <<  START'STORE  >>                                         <<*7836>>32310000
   <<--------------->>                                         <<*7836>>32320000
                                                               <<*7836>>32330000
   SUBROUTINE START'STORE;                                     <<*7836>>32340000
                                                               <<*7836>>32350000
      <<This routine starts the STORE process, but >>          <<*7836>>32360000
      <<does not ACTIVATE it...if any errors occur >>          <<*7836>>32370000
      <<FAIL is called.                            >>          <<*7836>>32380000
                                                               <<*7836>>32390000
      BEGIN                                                    <<*7836>>32400000
                                                               <<*7836>>32410000
                                                               <<*7836>>32420000
            <<setup CREATEPROCESS parameters...>>              <<*7836>>32430000
                                                               <<*7836>>32440000
      MOVE PROGNAME' := ("*", STORE'FORMAL'NAME', " ");        <<*7836>>32450000
                                                               <<*7836>>32460000
      MOVE ITEMCODES := (  3, <<flags              >>          <<*7836>>32470000
                          11, <<INFO string address>>          <<*7836>>32480000
                          12, <<INFO string length >>          <<*7836>>32490000
                           2, <<PARM>>                         <<*7836>>32500000
                           0  <<item terminator    >>  );      <<*7836>>32510000
                                                               <<*7836>>32520000
      ITEMS(0) := 1;          <<reactivate when son done>>     <<*7836>>32530000
      ITEMS(1) := @INFO';     <<INFO string address>>          <<*7836>>32540000
      ITEMS(2) := LEN;        <<INFO string length>>           <<*7836>>32550000
      ITEMS(3) := 1;          <<PARM=1 --> STORE>>             <<*7836>>32560000
      ITEMS(4) := 0;          <<item terminator>>              <<*7836>>32570000
                                                               <<*7836>>32580000
            <<STORE is created with a PARM of 1, which >>      <<*7836>>32590000
            <<tells STORE that it was called from the  >>      <<*7836>>32600000
            <<CI, and therefore should communicate its >>      <<*7836>>32610000
            <<results via the JCW called STOREJCW.     >>      <<*7836>>32620000
                                                               <<*7836>>32630000
            <<create the process (without activating it)...>>  <<*7836>>32640000
                                                               <<*7836>>32650000
      CREATEPROCESS (ERROR, PIN, PROGNAME', ITEMCODES, ITEMS); <<*7836>>32660000
                                                               <<*7836>>32670000
      IF ERROR > 0 THEN       <<CREATEPROCESS error>>          <<*7836>>32680000
         BEGIN                                                 <<*7836>>32690000
         MOVE PROGNAME':=(STORE'PROGRAM'NAME', 0);             <<*7836>>32700000
               <<report the error...>>                         <<*7836>>32710000
         IF UNKNOWN'PROG'FILE THEN                             <<*7836>>32720000
            CIERR (ERRNUM:=SUBSNOTFOUND, , 0, @PROGNAME')      <<*7836>>32730000
         ELSE                                                  <<*7836>>32740000
            BEGIN                                              <<*7836>>32750000
            CREATEPROC'ERR (ERROR, ERRNUM);                    <<*7836>>32760000
            CIERR (ERRNUM:=SUBSNOTCREATE, , 0, @PROGNAME');    <<*7836>>32770000
            END;                                               <<*7836>>32780000
         FAIL (NO'MSG, 0);          <<Message already sent>>   <<*7836>>32790000
         END;                                                  <<*7836>>32800000
                                                               <<*7836>>32810000
            <<If CREATEPROCESS returned a negative >>          <<*7836>>32820000
            <<value in ERROR, then the process was >>          <<*7836>>32830000
            <<created ok, but a warning was sent   >>          <<*7836>>32840000
            <<back, which we want to print...      >>          <<*7836>>32850000
                                                               <<*7836>>32860000
      IF ERROR < 0 THEN                                        <<*7836>>32870000
         CREATEPROC'ERR (-ERROR, ERRNUM);                      <<*7836>>32880000
                                                               <<*7836>>32890000
      ERRNUM:=PARMNUM:=0;     <<cleanup>>                      <<*7836>>32900000
                                                               <<*7836>>32910000
      END <<START'STORE SUB>>;                                 <<*7836>>32920000
                                                               <<*7836>>32930000
   <<------------------>>                                      <<*7836>>32940000
   <<  WAIT'FOR'STORE  >>                                      <<*7836>>32950000
   <<------------------>>                                      <<*7836>>32960000
                                                               <<*7836>>32970000
   SUBROUTINE WAIT'FOR'STORE;                                  <<*7836>>32980000
                                                               <<*7836>>32990000
      <<This routine activates STORE and then waits >>         <<*7836>>33000000
      <<for it to finish.  It then examines the JCW >>         <<*7836>>33010000
      <<called STOREJCW, which communicates error#s >>         <<*7836>>33020000
      <<back to us.  A value of 0 = no error.       >>         <<*7836>>33030000
                                                               <<*7836>>33040000
      BEGIN                                                    <<*7836>>33050000
                                                               <<*7836>>33060000
            <<STORE.PUB.SYS created ok...>>                    <<*7836>>33070000
                                                               <<*7836>>33080000
      AWAKE (PIN*PCBSIZE, 1, 2);     <<wait till done>>        <<*7836>>33090000
                                                               <<*7836>>33100000
            <<see what was put in the STOREJCW jcw...>>        <<*7836>>33110000
                                                               <<*7836>>33120000
      MOVE INFO':=(STORE'JCW', " ", %15);                      <<*7836>>33130000
                                                               <<*7836>>33140000
      FINDJCW (INFO', I, ERROR);                               <<*7836>>33150000
                                                               <<*7836>>33160000
            <<note: I has value, ERROR has FINDJCW error>>     <<*7836>>33170000
                                                               <<*7836>>33180000
      IF ERROR = 0 THEN       <<found the JCW!>>               <<*7836>>33190000
         IF I <> 0 THEN       <<did STORE return an error?>>   <<*7836>>33200000
            FAIL (STORE'FAILED, I)                             <<*7836>>33210000
         ELSE                                                  <<*7836>>33220000
            <<no error!>>                                      <<*7836>>33230000
      ELSE                                                     <<*7836>>33240000
         FAIL (STORE'JCW'FAILED, ERROR);                       <<*7836>>33250000
                                                               <<*7836>>33260000
      END <<WAIT'FOR'STORE SUB>>;                              <<*7836>>33270000
                                                               <<*7836>>33280000
                                                               <<*7836>>33290000
   <<--------------------->>                                   <<*7836>>33300000
   <<  RESET'FILE'EQUATE  >>                                   <<*7836>>33310000
   <<--------------------->>                                   <<*7836>>33320000
                                                               <<*7836>>33330000
   SUBROUTINE RESET'FILE'EQUATE;                               <<*7836>>33340000
                                                               <<*7836>>33350000
      <<This routine resets the "STORE" file equation>>        <<*7836>>33360000
                                                               <<*7836>>33370000
      BEGIN                                                    <<*7836>>33380000
                                                               <<*7836>>33390000
      MOVE INFO' := ("RESET ", STORE'FORMAL'NAME, %15);        <<*7836>>33400000
                                                               <<*7836>>33410000
      COMMAND (INFO', CMDERR, CMDPARM);                        <<*7836>>33420000
                                                               <<*7836>>33430000
      END;  <<RESET'FILE'EQUATE' SUB>>                         <<*7836>>33440000
   <<------------------------------->>                         <<*7836>>33450000
                                                               <<*7836>>33460000
   INITIALIZE'JCW;                                             <<*7836>>33470000
                                                               <<*7836>>33480000
   ISSUE'FILE'EQUATE;                                          <<*7836>>33490000
                                                               <<*7836>>33500000
   BUILD'INFO;                                                 <<*7836>>33510000
                                                               <<*7836>>33520000
   START'STORE;                                                <<*7836>>33530000
                                                               <<*7836>>33540000
   WAIT'FOR'STORE;                                             <<*7836>>33550000
                                                               <<*7836>>33560000
         <<if we get here, all worked fine!>>                  <<*7836>>33570000
                                                               <<*7836>>33580000
   RESET'FILE'EQUATE';                                         <<*7836>>33590000
                                                               <<*7836>>33600000
   ERRNUM:=0;                                                  <<*7836>>33610000
   PARMNUM:=0;                                                 <<*7836>>33620000
                                                               <<*7836>>33630000
END'CXSTORENEW:                                                <<*7836>>33640000
                                                               <<*7836>>33650000
   END <<CXSTORENEW PROC>>;                                    <<*7836>>33660000
$PAGE "CXRESTORENEW"                                           <<*7836>>33670000
PROCEDURE CXRESTORENEW EXECUTORHEAD;                           <<*7836>>33680000
   OPTION PRIVILEGED, UNCALLABLE;                              <<*7836>>33690000
                                                               <<*7836>>33700000
<< This procedure creates the RESTORE "subsystem" and passes >><<*7836>>33710000
<< any "INFO" specified with the RESTORE command with the    >><<*7836>>33720000
<< INFO parameter in the CREATEPROCESS call.                 >><<*7836>>33730000
<<                                                           >><<*7836>>33740000
<< It builds an INFO string within a local array, and then   >><<*7836>>33750000
<< passes it to STORE.PUB.SYS.   This string consists of     >><<*7836>>33760000
<< "RESTORE " and then any leftover text from the user's     >><<*7836>>33770000
<< input (e.g: whatever followed "RESTORE").                 >><<*7836>>33780000
<<                                                           >><<*7836>>33790000
<< RESTORE will, if all goes well, communicate via the MAIL  >><<*7836>>33800000
<< intrinsics.  This feature is invoked by running RESTORE   >><<*7836>>33810000
<< with a non-zero PARM.                                     >><<*7836>>33820000
<<                                                           >><<*7836>>33830000
<< Because RESTORE must be callable from the COMMAND intrin- >><<*7836>>33840000
<< sic by even a non-PH user, we must disregard normal PH    >><<*7836>>33850000
<< restrictions.  This opens a very small "security" hole;   >><<*7836>>33860000
<< if the non-PH user has created a temporary PROG file of   >><<*7836>>33870000
<< the name: STORE.PUB.SYS, we have no way of telling the    >><<*7836>>33880000
<< CREATEPROCESS intrinsic to NOT run it and to run the      >><<*7836>>33890000
<< "real" one (the permanent one) instead.  Hence, in such   >><<*7836>>33900000
<< a situation, the non-PH user could conceivably be able    >><<*7836>>33910000
<< to run processes despite lacking PH!  To plug this small  >><<*7836>>33920000
<< hole, this code will either: (1) do nothing;  or          >><<*7836>>33930000
<< (2) issue an implicit file equate of the form:            >><<*7836>>33940000
<< FILE STORE = STORE.PUB.SYS, OLD                           >><<*7836>>33950000
<< and then do a CREATEPROCESS of *STORE.                    >><<*7836>>33960000
                                                               <<*7836>>33970000
   BEGIN                                                       <<*7836>>33980000
                                                               <<*7836>>33990000
   EQUATE                                                      <<*7836>>34000000
      INFO'OVERHEAD = 10;     <<number chars in "RESTORE " +>> <<*7836>>34010000
                                                               <<*7836>>34020000
   INTEGER ARRAY                                               <<*7836>>34030000
      ITEMS       (0:10),     <<CREATEPROCESS items>>          <<*7836>>34040000
      ITEMCODES   (0:10),     <<   "  "     item codes>>       <<*7836>>34050000
      PROGNAME    (0:8);      <<name of STORE.PUB.SYS>>        <<*7836>>34060000
                                                               <<*7836>>34070000
   INTEGER                                                     <<*7836>>34080000
      ERROR       := 0,       <<Error from CREATEPROCESS>>     <<*7836>>34090000
      I           := 0,       <<scratch integer>>              <<*7836>>34100000
      PIN         := 0,       <<Pin# of STORE.PUB.SYS>>        <<*7836>>34110000
      CMDERR      := 0,       <<ERR RETURN FROM COMMAND>>      <<*7836>>34120000
      CMDPARM     := 0;       <<PARM RETURN FROM COMMAND>>     <<*7836>>34130000
                                                               <<*7836>>34140000
   LOGICAL                                                     <<*7836>>34150000
      LEN         := 0;       <<length of text>>               <<*7836>>34160000
                                                               <<*7836>>34170000
   BYTE ARRAY                                                  <<*7836>>34180000
      INFO'       (0:CIS'BCOMBUFLEN+INFO'OVERHEAD),            <<*7836>>34190000
      PROGNAME'   (*) = PROGNAME (0);                          <<*7836>>34200000
                                                               <<*7836>>34210000
   BYTE POINTER                                                <<*7836>>34220000
      P';                     <<pointer along INFO'>>          <<*7836>>34230000
                                                               <<*7836>>34240000
   DEFINE                                                      <<*7836>>34250000
      FAILED      = FALSE #,                                   <<*7836>>34260000
      GOOD        = TRUE #,                                    <<*7836>>34270000
      NO'MSG      = -1 #,     <<flag to FAIL>>                 <<*7836>>34280000
      STORE'FORMAL'NAME'  = "STOREPRG" #,                      <<*7836>>34290000
      RESTORE'JCW'        = "STOREJCW" #,                      <<*7836>>34300000
      STORE'PROGRAM'NAME' = "STORE.PUB.SYS" #,                 <<*7836>>34310000
      UNKNOWN'PROG'FILE   =  (ERROR = 6)#;                     <<*7836>>34320000
                                                               <<*7836>>34330000
   EQUATE                                                      <<*7836>>34340000
                                                               <<*7836>>34350000
         <<equates for RESTOREJCW value...>>                   <<*7836>>34360000
                                                               <<*7836>>34370000
      WHY'GOOD          = 0,     <<no error found>>            <<*7836>>34380000
      WHY'SYNTAX        = 1,     <<parsing syntax>>            <<*7836>>34390000
      WHY'OPENING'FILES = 2,     <<opening utility files>>     <<*7836>>34400000
      WHY'INDIRECT      = 3,     <<opening indirect file>>     <<*7836>>34410000
      WHY'OPENING'TAPE  = 4,     <<opening tape file>>         <<*7836>>34420000
      WHY'SCANNING      = 5,     <<scanning to STORE/RESTORE>> <<*7836>>34430000
      WHY'DOING         = 6;     <<doing actual STORE/RESTORE>><<*7836>>34440000
                                                               <<*7836>>34450000
   INTRINSIC                                                   <<*7836>>34460000
      ACTIVATE,                                                <<*7836>>34470000
      COMMAND,                                                 <<*7836>>34480000
      CREATEPROCESS,                                           <<*7836>>34490000
      FINDJCW,                                                 <<*7836>>34500000
      PUTJCW;                                                  <<*7836>>34510000
                                                               <<*7836>>34520000
   LABEL                                                       <<*7836>>34530000
      END'CXRESTORENEW;                                        <<*7836>>34540000
                                                               <<*7836>>34550000
                                                               <<*7836>>34560000
   <<-------->>                                                <<*7836>>34570000
   <<  FAIL  >>                                                <<*7836>>34580000
   <<-------->>                                                <<*7836>>34590000
                                                               <<*7836>>34600000
   SUBROUTINE FAIL (WHY, SUB'WHY);                             <<*7836>>34610000
            VALUE   WHY, SUB'WHY;                              <<*7836>>34620000
            INTEGER WHY, SUB'WHY;                              <<*7836>>34630000
                                                               <<*7836>>34640000
         <<setup ERRNUM and PARMNUM return values, call >>     <<*7836>>34650000
         <<CIERR to print the error message, return from>>     <<*7836>>34660000
         <<procedure...                                 >>     <<*7836>>34670000
                                                               <<*7836>>34680000
      BEGIN                                                    <<*7836>>34690000
                                                               <<*7836>>34700000
      IF WHY <> NO'MSG THEN                                    <<*7836>>34710000
         BEGIN                                                 <<*7836>>34720000
         ERRNUM:=WHY;                                          <<*7836>>34730000
         PARMNUM:=SUB'WHY;                                     <<*7836>>34740000
         CIERR (ERRNUM);                                       <<*7836>>34750000
         END;                                                  <<*7836>>34760000
                                                               <<*7836>>34770000
      GO END'CXRESTORENEW;                                     <<*7836>>34780000
                                                               <<*7836>>34790000
      END <<FAIL SUB>>;                                        <<*7836>>34800000
                                                               <<*7836>>34810000
   <<------------------>>                                      <<*7836>>34820000
   <<  INITIALIZE'JCW  >>                                      <<*7836>>34830000
   <<------------------>>                                      <<*7836>>34840000
                                                               <<*7836>>34850000
   SUBROUTINE INITIALIZE'JCW;                                  <<*7836>>34860000
                                                               <<*7836>>34870000
      <<Does a PUTJCW to setup the JCW called RESTOREJCW.>>    <<*7836>>34880000
      <<The jcw is set to the value of WHY'GOOD.       >>      <<*7836>>34890000
      <<This "initialization" is done prior to starting>>      <<*7836>>34900000
      <<the STORE program, so that if we are unable to >>      <<*7836>>34910000
      <<add a jcw to the current session's table, we   >>      <<*7836>>34920000
      <<will find out now instead of later.            >>      <<*7836>>34930000
                                                               <<*7836>>34940000
      BEGIN                                                    <<*7836>>34950000
                                                               <<*7836>>34960000
      MOVE INFO':=(RESTORE'JCW', " ", %15);                    <<*7836>>34970000
                                                               <<*7836>>34980000
      I:=WHY'GOOD;                                             <<*7836>>34990000
                                                               <<*7836>>35000000
      PUTJCW (INFO', I, ERROR);                                <<*7836>>35010000
                                                               <<*7836>>35020000
      IF ERROR <> 0 THEN                                       <<*7836>>35030000
         FAIL (RESTORE'JCW'FAILED, ERROR);                     <<*7836>>35040000
                                                               <<*7836>>35050000
      END <<INITIALIZE'JCW SUB>>;                              <<*7836>>35060000
                                                               <<*7836>>35070000
   <<--------------------->>                                   <<*7836>>35080000
   <<  ISSUE'FILE'EQUATE  >>                                   <<*7836>>35090000
   <<--------------------->>                                   <<*7836>>35100000
                                                               <<*7836>>35110000
   SUBROUTINE ISSUE'FILE'EQUATE;                               <<*7836>>35120000
                                                               <<*7836>>35130000
      <<Issues a file equate of the form: >>                   <<*7836>>35140000
      <<  FILE STORE=STORE.PUB.SYS,OLD    >>                   <<*7836>>35150000
                                                               <<*7836>>35160000
      BEGIN                                                    <<*7836>>35170000
                                                               <<*7836>>35180000
      MOVE INFO':=(STORE'FORMAL'NAME', "=",                    <<*7836>>35190000
                   STORE'PROGRAM'NAME',                        <<*7836>>35200000
                   %15);                                       <<*7836>>35210000
                                                               <<*7836>>35220000
      CXFILE (INFO', ERRNUM, PARMNUM);                         <<*7836>>35230000
                                                               <<*7836>>35240000
      IF ERRNUM <> 0 THEN                                      <<*7836>>35250000
         FAIL (RESTORE'FAILED, ERRNUM);                        <<*7836>>35260000
                                                               <<*7836>>35270000
      END <<ISSUE'FILE'EQUATE SUB>>;                           <<*7836>>35280000
                                                               <<*7836>>35290000
   <<-------------->>                                          <<*7836>>35300000
   <<  BUILD'INFO  >>                                          <<*7836>>35310000
   <<-------------->>                                          <<*7836>>35320000
                                                               <<*7836>>35330000
   SUBROUTINE BUILD'INFO;                                      <<*7836>>35340000
                                                               <<*7836>>35350000
      <<This routine builds the INFO string for RESTORE>>      <<*7836>>35360000
                                                               <<*7836>>35370000
      BEGIN                                                    <<*7836>>35380000
                                                               <<*7836>>35390000
            <<initialize the start of INFO'...>>               <<*7836>>35400000
                                                               <<*7836>>35410000
      MOVE INFO':="RESTORE ", 2;         <<leave dest pointer>><<*7836>>35420000
      @P':=TOS;                        <<save it in P'>>       <<*7836>>35430000
                                                               <<*7836>>35440000
            <<copy PARMSP text into INFO...>>                  <<*7836>>35450000
                                                               <<*7836>>35460000
      SCAN PARMSP UNTIL %15, 1;       <<find CR>>              <<*7836>>35470000
      LEN:=TOS - LOGICAL(@PARMSP);    <<text length>>          <<*7836>>35480000
      IF LEN > CIS'BCOMBUFLEN THEN    <<safety precaution>>    <<*7836>>35490000
         LEN:=CIS'BCOMBUFLEN;         <<just truncate for now>><<*7836>>35500000
      MOVE P':=PARMSP, (LEN), 2;      <<leave new P'>>         <<*7836>>35510000
      @P':=TOS;                       <<pick it up, store it>> <<*7836>>35520000
                                                               <<*7836>>35530000
      LEN:=LOGICAL(@P')-LOGICAL(@INFO');  <<overall length>>   <<*7836>>35540000
                                                               <<*7836>>35550000
      END <<BUILD'INFO SUB>>;                                  <<*7836>>35560000
                                                               <<*7836>>35570000
   <<----------------->>                                       <<*7836>>35580000
   <<  START'RESTORE  >>                                       <<*7836>>35590000
   <<----------------->>                                       <<*7836>>35600000
                                                               <<*7836>>35610000
   SUBROUTINE START'RESTORE;                                   <<*7836>>35620000
                                                               <<*7836>>35630000
      <<This routine starts the RESTORE process, but >>        <<*7836>>35640000
      <<does not ACTIVATE it...if any errors occur   >>        <<*7836>>35650000
      <<FAIL is called.                              >>        <<*7836>>35660000
                                                               <<*7836>>35670000
      BEGIN                                                    <<*7836>>35680000
                                                               <<*7836>>35690000
                                                               <<*7836>>35700000
            <<setup CREATEPROCESS parameters...>>              <<*7836>>35710000
                                                               <<*7836>>35720000
      MOVE PROGNAME' := ("*", STORE'FORMAL'NAME', " ");        <<*7836>>35730000
                                                               <<*7836>>35740000
      MOVE ITEMCODES := (  3, <<flags              >>          <<*7836>>35750000
                          11, <<INFO string address>>          <<*7836>>35760000
                          12, <<INFO string length >>          <<*7836>>35770000
                           2, <<PARM>>                         <<*7836>>35780000
                           0  <<item terminator    >>  );      <<*7836>>35790000
                                                               <<*7836>>35800000
      ITEMS(0) := 1;          <<reactivate when son done>>     <<*7836>>35810000
      ITEMS(1) := @INFO';     <<INFO string address>>          <<*7836>>35820000
      ITEMS(2) := LEN;        <<INFO string length>>           <<*7836>>35830000
      ITEMS(3) := 2;          <<PARM=2 --> RESTORE>>           <<*7836>>35840000
      ITEMS(4) := 0;          <<item terminator>>              <<*7836>>35850000
                                                               <<*7836>>35860000
            <<RESTORE is created with a PARM of 1, which >>    <<*7836>>35870000
            <<tells STORE that it was called from the    >>    <<*7836>>35880000
            <<CI, and therefore should communicate its   >>    <<*7836>>35890000
            <<results via the JCW called RESTOREJCW.     >>    <<*7836>>35900000
                                                               <<*7836>>35910000
            <<create the process (without activating it)...>>  <<*7836>>35920000
                                                               <<*7836>>35930000
      CREATEPROCESS (ERROR, PIN, PROGNAME', ITEMCODES, ITEMS); <<*7836>>35940000
                                                               <<*7836>>35950000
      IF ERROR > 0 THEN       <<CREATEPROCESS error>>          <<*7836>>35960000
         BEGIN                                                 <<*7836>>35970000
         MOVE PROGNAME':=(STORE'PROGRAM'NAME', 0);             <<*7836>>35980000
               <<report the error...>>                         <<*7836>>35990000
         IF UNKNOWN'PROG'FILE THEN                             <<*7836>>36000000
            CIERR (ERRNUM:=SUBSNOTFOUND, , 0, @PROGNAME')      <<*7836>>36010000
         ELSE                                                  <<*7836>>36020000
            BEGIN                                              <<*7836>>36030000
            CREATEPROC'ERR (ERROR, ERRNUM);                    <<*7836>>36040000
            CIERR (ERRNUM:=SUBSNOTCREATE, , 0, @PROGNAME');    <<*7836>>36050000
            END;                                               <<*7836>>36060000
         FAIL (NO'MSG, 0);          <<Message already sent>>   <<*7836>>36070000
         END;                                                  <<*7836>>36080000
                                                               <<*7836>>36090000
            <<If CREATEPROCESS returned a negative >>          <<*7836>>36100000
            <<value in ERROR, then the process was >>          <<*7836>>36110000
            <<created ok, but a warning was sent   >>          <<*7836>>36120000
            <<back, which we want to print...      >>          <<*7836>>36130000
                                                               <<*7836>>36140000
      IF ERROR < 0 THEN                                        <<*7836>>36150000
         CREATEPROC'ERR (-ERROR, ERRNUM);                      <<*7836>>36160000
                                                               <<*7836>>36170000
      ERRNUM:=PARMNUM:=0;     <<cleanup>>                      <<*7836>>36180000
                                                               <<*7836>>36190000
      END <<START'RESTORE SUB>>;                               <<*7836>>36200000
                                                               <<*7836>>36210000
   <<------------------>>                                      <<*7836>>36220000
   <<  WAIT'FOR'RESTORE  >>                                    <<*7836>>36230000
   <<------------------>>                                      <<*7836>>36240000
                                                               <<*7836>>36250000
   SUBROUTINE WAIT'FOR'RESTORE;                                <<*7836>>36260000
                                                               <<*7836>>36270000
      <<This routine activates RESTORE and then waits >>       <<*7836>>36280000
      <<for it to finish.  It then examines the JCW   >>       <<*7836>>36290000
      <<called RESTOREJCW, which communicates error#s >>       <<*7836>>36300000
      <<back to us.  A value of 0 = no error.         >>       <<*7836>>36310000
                                                               <<*7836>>36320000
      BEGIN                                                    <<*7836>>36330000
                                                               <<*7836>>36340000
            <<STORE.PUB.SYS created ok...>>                    <<*7836>>36350000
                                                               <<*7836>>36360000
      ACTIVATE (PIN, 2);            <<wait till done>>         <<*7836>>36370000
                                                               <<*7836>>36380000
            <<see what was put in the RESTOREJCW jcw...>>      <<*7836>>36390000
                                                               <<*7836>>36400000
      MOVE INFO':=(RESTORE'JCW', " ", %15);                    <<*7836>>36410000
                                                               <<*7836>>36420000
      FINDJCW (INFO', I, ERROR);                               <<*7836>>36430000
                                                               <<*7836>>36440000
            <<note: I has value, ERROR has FINDJCW error>>     <<*7836>>36450000
                                                               <<*7836>>36460000
      IF ERROR = 0 THEN       <<found the JCW!>>               <<*7836>>36470000
         IF I <> 0 THEN       <<did STORE return an error?>>   <<*7836>>36480000
            FAIL (RESTORE'FAILED, I)                           <<*7836>>36490000
         ELSE                                                  <<*7836>>36500000
            <<no error!>>                                      <<*7836>>36510000
      ELSE                                                     <<*7836>>36520000
         FAIL (RESTORE'JCW'FAILED, ERROR);                     <<*7836>>36530000
                                                               <<*7836>>36540000
      END <<WAIT'FOR'RESTORE SUB>>;                            <<*7836>>36550000
   <<--------------------------->>                             <<*7836>>36560000
                                                               <<*7836>>36570000
   <<--------------------->>                                   <<*7836>>36580000
   <<  RESET'FILE'EQUATE  >>                                   <<*7836>>36590000
   <<--------------------->>                                   <<*7836>>36600000
                                                               <<*7836>>36610000
   SUBROUTINE RESET'FILE'EQUATE;                               <<*7836>>36620000
                                                               <<*7836>>36630000
      <<This routine resets the "STORE" file equation>>        <<*7836>>36640000
                                                               <<*7836>>36650000
      BEGIN                                                    <<*7836>>36660000
                                                               <<*7836>>36670000
      MOVE INFO' := ("RESET ", STORE'FORMAL'NAME, %15);        <<*7836>>36680000
                                                               <<*7836>>36690000
      COMMAND (INFO', CMDERR, CMDPARM);                        <<*7836>>36700000
                                                               <<*7836>>36710000
      END;  <<RESET'FILE'EQUATE' SUB>>                         <<*7836>>36720000
   <<------------------------------->>                         <<*7836>>36730000
                                                               <<*7836>>36740000
   INITIALIZE'JCW;                                             <<*7836>>36750000
                                                               <<*7836>>36760000
   ISSUE'FILE'EQUATE;                                          <<*7836>>36770000
                                                               <<*7836>>36780000
   BUILD'INFO;                                                 <<*7836>>36790000
                                                               <<*7836>>36800000
   START'RESTORE;                                              <<*7836>>36810000
                                                               <<*7836>>36820000
   WAIT'FOR'RESTORE;                                           <<*7836>>36830000
                                                               <<*7836>>36840000
         <<if we get here, all worked fine!>>                  <<*7836>>36850000
                                                               <<*7836>>36860000
   RESET'FILE'EQUATE';                                         <<*7836>>36870000
                                                               <<*7836>>36880000
   ERRNUM:=0;                                                  <<*7836>>36890000
   PARMNUM:=0;                                                 <<*7836>>36900000
                                                               <<*7836>>36910000
END'CXRESTORENEW:                                              <<*7836>>36920000
                                                               <<*7836>>36930000
   END <<CXRESTORENEW PROC>>;                                  <<*7836>>36940000
$TITLE "MISCELLANEOUS COMMANDS, SECOND BLOCK"                  <<08.RO>>36950000
      PROCEDURE CXSHOWTIME EXECUTORHEAD;                                36960000
      OPTION PRIVILEGED, UNCALLABLE;                                    36970000
      BEGIN                                                             36980000
      COMMENT                                                           36990000
      CXSHOWTIME IS THE EXECUTOR FOR THE SHOWTIME COMMAND               37000000
      COMMAND FORMAT                                                    37010000
      SHOWTIME                                                          37020000
      ;                                                                 37030000
      INTEGER NUMPARMS;                                                 37040000
      DOUBLE PARMS;                                                     37050000
      ARRAY WOBUF (0:13);                                               37060000
      BYTE ARRAY OBUF (*) = WOBUF;                                      37070000
                                                                        37080000
      MYCOMMAND(PARMSP,,0,NUMPARMS,PARMS);<<CHECK COMMAND>>             37090000
      IF <> THEN CIERR(ERRNUM := -WARNXPARMSIGNORED,PARMSP);   <<04787>>37100000
      DATE'LINE(OBUF);<<GET DATE AND TIME>>                             37110000
      PRINT (WOBUF, -27, 0);<<PRINT IT>>                                37120000
      END;  <<CXSHOWTIME>>                                              37130000
      PROCEDURE CXFREERIN EXECUTORHEAD;                                 37140000
      OPTION PRIVILEGED,UNCALLABLE;                                     37150000
      BEGIN                                                             37160000
      COMMENT                                                           37170000
      CXFREERIN IS THE EXECUTOR FOR FREERIN & GETRIN                    37180000
      COMMAND FORMAT                                                    37190000
      GETRIN RINPASSWORD                                                37200000
      FREERIN RIN#                                                      37210000
      ;                                                                 37220000
      ENTRY CXGETRIN;                                                   37230000
      ARRAY QARRAY(*) = Q + 0;                                 <<06580>>37240000
      INTEGER PCBGLOBLOC;                                      <<06580>>37250000
      LOGICAL DL:=%6400,GETRIN:=0;                                      37260000
      INTEGER NUMPARMS,RIN,LEN;                                         37270000
      LOGICAL ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                <<06846>>37280000
      INTEGER JIT'DSTN;                                        <<06846>>37290000
      DOUBLE ARRAY PARM(0:1)=Q;                                <<U.RAO>>37300000
      BYTE POINTER BADPARM=PARM+2;                             <<U.RAO>>37310000
      BYTE LENG=PARM+1;                                                 37320000
      LOGICAL PARM'DATA = PARM + 1;                            <<02367>>37330000
      BYTE POINTER PASS=PARM;                                           37340000
      LOGICAL ARRAY UNAME(0:7);                                <<06846>>37350000
      ARRAY WOBUF(0:4),LPWORD(0:3);                                     37360000
      BYTE ARRAY PWORD(*)=LPWORD,OBUF(*)=WOBUF;                         37370000
      DEFINE SPECIAL' = (10:1)#;                               <<02367>>37380000
                                                                        37390000
      GO TO PROCESS;<<CXFREERIN ENTRY>>                                 37400000
CXGETRIN:                                                               37410000
      GETRIN:=GETRIN+1;<<GET RIN>>                                      37420000
PROCESS:                                                                37430000
      PXGLOBAL;                                                <<06580>>37440000
      MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARM);                    <<U.RAO>>37450000
      IF NUMPARMS <> 1 THEN                                    <<U.RAO>>37460000
         BEGIN  <<EXACTLY ONE PARM IS REQUIRED>>               <<U.RAO>>37470000
         PARMNUM := (IF < THEN 1 ELSE 2);                      <<U.RAO>>37480000
         TOS := ERRNUM :=  (IF GETRIN THEN GETRINNOPASS        <<U.RAO>>37490000
                                      ELSE FREERINNORIN);      <<U.RAO>>37500000
         TOS := (IF PARMNUM=1 THEN @PARMSP ELSE @BADPARM);     <<U.RAO>>37510000
         CIERR(*,*);                                           <<U.RAO>>37520000
         RETURN                                                <<U.RAO>>37530000
         END;                                                  <<U.RAO>>37540000
         JIT'DSTN:=PXG'JITDST;                                 <<06846>>37550000
         TOS:=@JITARR;                                         <<06846>>37560000
         TOS:=JIT'DSTN;                                        <<06846>>37570000
         TOS:=0;                                               <<06846>>37580000
         TOS:=JIT'ENTRY'SIZE;                                  <<06846>>37590000
         ASSEMBLE(MFDS 4);                                     <<06846>>37600000
         MOVE UNAME(0):=JITUSERNAME,(4);                       <<06846>>37610000
         MOVE UNAME(4):=JITHACCTNAME,(4);                      <<06846>>37620000
      IF GETRIN THEN                                                    37630000
         BEGIN                                                          37640000
         IF LENG > 8 THEN                                      <<02367>>37650000
            BEGIN                                              <<02367>>37660000
               CIERR(ERRNUM := RINPASS2LONG,PASS);             <<02367>>37670000
               RETURN                                          <<02367>>37680000
            END;                                               <<02367>>37690000
         IF PARM'DATA.SPECIAL' THEN                            <<02367>>37700000
            BEGIN                                              <<02367>>37710000
               CIERR(ERRNUM := RINPASSSPECHAR,PASS);           <<02367>>37720000
               RETURN                                          <<02367>>37730000
            END;                                               <<02367>>37740000
         IF PASS <> ALPHA THEN                                 <<02367>>37750000
            BEGIN                                              <<02367>>37760000
               CIERR(ERRNUM := RINPASSTALPHA,PASS);            <<02367>>37770000
               RETURN                                          <<02367>>37780000
            END;                                               <<02367>>37790000
         MOVE PWORD := "        "; <<BLANK OUT STRING>>                 37800000
         MOVE PWORD := PASS,(LENG);<<FORM STRING>>                      37810000
         RIN:=ALLORIN (2,UNAME,LPWORD);<<GET RIN>>                      37820000
         IF RIN=0 THEN   <<RIN TABLE EVIDENTLY FULL>>          <<U.RAO>>37830000
            BEGIN                                              <<U.RAO>>37840000
            CIERR(ERRNUM := RINTABFULL);                       <<U.RAO>>37850000
            RETURN                                             <<U.RAO>>37860000
            END;                                               <<U.RAO>>37870000
         MOVE OBUF:="RIN: ";<<FORM OUTPUT STRING>>                      37880000
         LEN:=ASCII(RIN,10,OBUF(5))+5;<<COMPLETE STRING>>               37890000
         PRINT(WOBUF,-LEN,0);                                           37900000
         END                                                            37910000
      ELSE                                                              37920000
         BEGIN<<FREE RIN>>                                              37930000
         TOS:=0;<<PUT CELL ON FOR RETURN>>                              37940000
         TOS:=@PASS;<<BYTE POINTER TO RIN #>>                           37950000
         RIN:=BINARY(*,LENG);<<CONVERT RIN>>                            37960000
         IF <> OR RIN<=0 THEN  <<BAD CONVERT ON RIN NUMBER>>   <<U.RAO>>37970000
            BEGIN                                              <<U.RAO>>37980000
            ERRNUM := RININVINT;  <<BAD NUMBER AS RIN NUMBER>> <<U.RAO>>37990000
            PARMNUM := 1;                                      <<U.RAO>>38000000
            PASS(LENG) := 0;                                   <<U.RAO>>38010000
            CIERR(ERRNUM,PASS,LENG,@PASS);                     <<U.RAO>>38020000
            END                                                <<U.RAO>>38030000
         ELSE                                                  <<U.RAO>>38040000
            BEGIN                                              <<U.RAO>>38050000
            DEALLORIN(RIN,UNAME);  <<ATTEMPT TO DEALLOCATE>>   <<U.RAO>>38060000
            IF < THEN CIERR(ERRNUM := RINNOTAL)                <<04787>>38070000
            ELSE IF > THEN CIERR(ERRNUM := RININUSE);          <<04787>>38080000
            END;                                               <<U.RAO>>38090000
         END;                                                           38100000
      END;<<CXGETRIN/CXFREERIN>>                                        38110000
PROCEDURE CXTELLOP EXECUTORHEAD;                               <<U.RAO>>38120000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>38130000
BEGIN                                                          <<U.RAO>>38140000
COMMENT                                                        <<U.RAO>>38150000
CXTELLOP IS THE EXECUTOR FOR THE TELLOP COMMAND                <<U.RAO>>38160000
COMMAND FORMAT                                                 <<U.RAO>>38170000
TELLOP [MESSAGE]                                               <<U.RAO>>38180000
;                                                              <<U.RAO>>38190000
                                                               <<U.RAO>>38200000
INTEGER ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                      <<06846>>38210000
INTEGER JITDSTN;                                               <<06846>>38220000
BYTE ARRAY ANAME(*) = JITHACCTNAME;                            <<06846>>38230000
BYTE ARRAY UNAME(*) = JITUSERNAME;                             <<06846>>38240000
BYTE ARRAY DUMMY(*) = JITARR; << Dummy arguements >>           <<06846>>38250000
BYTE ARRAY USERID(0:17);                                       <<U.RAO>>38260000
BYTE POINTER MSGSTART;  <<START OF MESSAGE>>                   <<U.RAO>>38270000
BYTE POINTER MSGEND;    <<END OF MESSAGE>>                     <<U.RAO>>38280000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>38290000
INTEGER PCBGLOBLOC;                                            <<06580>>38300000
INTEGER MSGLEN;   <<LENGTH OF MESSAGE TO BE SENT.>>            <<U.RAO>>38310000
EQUATE CONSOLE = 0;   <<FILE NUMBER FOR GENMSG>>               <<U.RAO>>38320000
                                                               <<U.RAO>>38330000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>38340000
                                                               <<U.RAO>>38350000
PXGLOBAL;                                                      <<06580>>38360000
SCAN PARMSP WHILE %6440,1;  <<SCAN FOR START OF MESSAGE>>      <<U.RAO>>38370000
@MSGSTART := TOS;                                              <<U.RAO>>38380000
SCAN MSGSTART UNTIL %6415,1;  <<SCAN FOR END OF MESSAGE>>      <<U.RAO>>38390000
@MSGEND := TOS;                                                <<U.RAO>>38400000
MSGLEN := @MSGEND-@MSGSTART+1;                                 <<U.RAO>>38410000
CLEAN'MESSAGE(MSGSTART, MSGLEN-1);                             <<U.RAO>>38420000
MSGEND := 0;  <<TERMINATOR FOR GENMSG>>                        <<U.RAO>>38430000
JITDSTN:=PXG'JITDST;                                           <<06846>>38440000
MOVEFROMDSEG(@JITARR,JITDSTN,0,JIT'ENTRY'SIZE);                <<06846>>38450000
FORMNAME(4, USERID, UNAME, ANAME, DUMMY, DUMMY);               <<U.RAO>>38460000
   <<FORMAT USER ID - "S/J nnn , USER.ACCT">>                  <<U.RAO>>38470000
GENMSG(CIGENERALMSGSET, TELLFROM, 0, @USERID, @MSGSTART,,,,    <<U.RAO>>38480000
   CONSOLE);                                                   <<U.RAO>>38490000
IF <> THEN CIERR(ERRNUM := TELLOPMSGPROBLEM);                  <<U.RAO>>38500000
MSGEND := %15;  <<RESTORE CR TERMINATOR>>                      <<U.RAO>>38510000
END;      <<CXTELLOP>>                                         <<U.RAO>>38520000
PROCEDURE CXTELL EXECUTORHEAD;                                 <<U.RAO>>38530000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>38540000
<<CXTELL IS THE EXECUTOR FOR THE TELL COMMAND>>                <<U.RAO>>38550000
<<THERE ARE THREE BASIC STEPS TO THE ALGORITHM:>>              <<U.RAO>>38560000
<<    1)  PARSE THE JOBID                      >>              <<U.RAO>>38570000
<<    2)  PREPARE THE MESSAGE FOR SENDING      >>              <<U.RAO>>38580000
<<    3)  SEND THE MESSAGE                     >>              <<U.RAO>>38590000
<<                                             >>              <<U.RAO>>38600000
BEGIN                                                          <<U.RAO>>38610000
ENTRY CXWARN;                                                  <<00552>>38620000
INTEGER ARRAY RESULT(0:16);  <<RETURN VARIABLE FROM PARSEJOBID><<U.RAO>>38630000
BYTE ARRAY BRESULT(*) = RESULT;                                <<U.RAO>>38640000
INTEGER ARRAY JMATRETURN(0:2);  <<RETURN FROM SCANJMAT>>       <<U.RAO>>38650000
INTEGER ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                      <<06846>>38660000
INTEGER JITDSTN;                                               <<06846>>38670000
BYTE ARRAY UNAME(*) = JITUSERNAME; << This user's name/JIT >>  <<06846>>38680000
BYTE ARRAY ANAME(*) = JITHACCTNAME; << This user's acct/JIT >> <<06846>>38690000
BYTE ARRAY DUMMY(*) = ANAME;                                   <<U.RAO>>38700000
BYTE ARRAY USERID(0:24);  <<HOLDS THIS USER'S NAME>>           <<U.RAO>>38710000
BYTE ARRAY USERSNUM(0:5);  <<S/J NNN>>                         <<U.RAO>>38720000
BYTE ARRAY RECIPID(0:24);  <<HOLDS OTHER USER'S NAME>>         <<U.RAO>>38730000
BYTE ARRAY RECIPSNUM(0:5);                                     <<U.RAO>>38740000
BYTE POINTER MSGADR;  <<ADDRESS OF MESSAGE TO BE SENT>>        <<U.RAO>>38750000
INTEGER MSGLEN;  <<LENGTH OF MESSAGE TO BE SENT>>              <<U.RAO>>38760000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>38770000
INTEGER PCBGLOBLOC;                                            <<06580>>38780000
LOGICAL FOUNDENTRY;  <<SCAN WAS SUCCESSFUL>>                   <<U.RAO>>38790000
INTEGER NEXTJMATINDEX := 1;  <<FOR SCAN THROUGH JMAT>>         <<U.RAO>>38800000
LOGICAL MSGMOVED := FALSE;  <<HAD TO ADJUST MSG TO WORD BDY>>  <<U.RAO>>38810000
LOGICAL TELLTOJOB := FALSE;  <<FOR TRYING TO TELL TO A JOB>>   <<04208>>38820000
LOGICAL WARNFLG;        <<TRUE=>DO WARN, NOT TELL>>            <<00552>>38830000
LOGICAL SENDER'IS'TARGET     << DOES SENDER QUALIFY? >>        <<01652>>38840000
           := FALSE;                                           <<01652>>38850000
BYTE SAVEDBYTE;  <<BYTE DESTROYED BY ADJUSTMENT OF MSG>>       <<U.RAO>>38860000
INTEGER ARRAY ERRTRANS(0:1) = PB :=                            <<U.RAO>>38870000
 0,TELLJOBINVALID,TELLINVSNUM,TELLXPCTJORS,TELLXPCTJSORAT,     <<04208>>38880000
TELLJXPCTJUSTAT,TELLJNAME2LONG,TELLJXPCTALPHA,USERNAMEMISSING, <<U.RAO>>38890000
USERNAMETOOLONG,USEREXPECTALPHA,TELLXPCTPERIOD,                <<U.RAO>>38900000
ACCTNAMEMISSING,ACCTEXPECTNAMENOTAT,ACCTNAMETOOLONG,           <<U.RAO>>38910000
ACCTEXPECTALPHA,TELLJOBIDMISSING;                              <<U.RAO>>38920000
DEFINE JOBFIELD = (0:2)#;  <<JOB TYPE FIELD>>                  <<U.RAO>>38930000
DEFINE JOBNM = (2:14)#;                                        <<07160>>38940000
EQUATE SESSIONTYPE = 1,                                        <<U.RAO>>38950000
       JOBTYPE = 2;                                            <<U.RAO>>38960000
DEFINE JMATTYPE = (0:6)#;   <<JMAT ENTRY TYPE FIELD>>          <<U.RAO>>38970000
EQUATE RUNNINGJOB = 2;  <<JMAT TYPE>>                          <<U.RAO>>38980000
DEFINE QUIETBIT = (8:1)#;  <<JMAT BIT => NOT ACCEPTING MSGS>>  <<U.RAO>>38990000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<06846>>39000000
                                                               <<00552>>39010000
WARNFLG:=FALSE;         <<NOT WARN>>                           <<00552>>39020000
GO TO CXTELLMAIN;                                              <<00552>>39030000
                                                               <<00552>>39040000
CXWARN:                                                        <<00552>>39050000
WARNFLG:=TRUE;          <<SET WARN FLAG>>                      <<00552>>39060000
                                                               <<00552>>39070000
CXTELLMAIN:                                                    <<00552>>39080000
<<    MAIN BODY     >>                                         <<U.RAO>>39090000
<<STEP 1 - PARSE THE JOBID>>                                   <<U.RAO>>39100000
PXGLOBAL;                                                      <<06580>>39110000
IF NOT PARSEJOBID(PARMSP, RESULT) THEN  <<SYNTAX ERROR>>       <<U.RAO>>39120000
   BEGIN                                                       <<U.RAO>>39130000
   TOS := ERRNUM := ERRTRANS(RESULT(15));  <<GET CI ERR NO.>>  <<U.RAO>>39140000
   TOS := RESULT(14);  <<ADDRESS OF ERROR>>                    <<U.RAO>>39150000
   CIERR(*,*);                                                 <<U.RAO>>39160000
   PARMNUM := RESULT(16);                                      <<U.RAO>>39170000
   END                                                         <<U.RAO>>39180000
ELSE                                                           <<U.RAO>>39190000
   BEGIN  <<JOB NAME PARSED OK>>                               <<U.RAO>>39200000
   <<STEP 2 IS TO PREPARE THE MESSAGE FOR SENDING>>            <<U.RAO>>39210000
   <<STEP 2 PART 1 - GET SENDER'S INFO FROM JIT>>              <<U.RAO>>39220000
   JITDSTN:=PXG'JITDST;                                        <<06846>>39230000
   MOVEFROMDSEG(@JITARR,JITDSTN,0,JIT'ENTRY'SIZE);             <<06846>>39240000
   <<PART 2 - CONVERT JOB TYPE/NUMBER TO STRING>>              <<U.RAO>>39250000
   USERSNUM(2) := " ";                                         <<U.RAO>>39260000
   MOVE USERSNUM(3) := USERSNUM(2),(3);                        <<06846>>39270000
   IF JITJSTYPE = SESSIONTYPE THEN                             <<06846>>39280000
      USERSNUM := "S"                                          <<U.RAO>>39290000
   ELSE                                                        <<U.RAO>>39300000
      USERSNUM := "J";                                         <<U.RAO>>39310000
   ASCII(JITJOBNUMBER,10,USERSNUM(1));                         <<06846>>39320000
   <<PART 3 - FORMAT USER NAME>>                               <<U.RAO>>39330000
   FORMNAME(5,USERID,USERSNUM,UNAME,ANAME,DUMMY);              <<U.RAO>>39340000
   <<PART 4 - ADJUST MESSAGE TO WORD BOUNDARY>>                <<U.RAO>>39350000
   IF RESULT(15) <> ";" THEN  <<ALLOW ";" EVEN THOUGH OBSOLETE><<U.RAO>>39360000
      RESULT(14) := RESULT(14)-1;  <<ACTUAL START OF MESSAGE>> <<U.RAO>>39370000
   @MSGADR := RESULT(14);                                      <<U.RAO>>39380000
   <<GET MESSAGE LENGTH>>                                      <<U.RAO>>39390000
   SCAN MSGADR UNTIL %6400, 1;   <<FIND END OF MESSAGE>>       <<U.RAO>>39400000
   MSGLEN := TOS-@MSGADR;                                      <<U.RAO>>39410000
   MSGADR(MSGLEN) := 0;  <<TERMINATOR FOR GENMSG>>             <<U.RAO>>39420000
   <<PART 5 - PURGE MESSAGE OF BAD CHARACTER SEQUENCES>>       <<U.RAO>>39430000
   CLEAN'MESSAGE(MSGADR, MSGLEN);                              <<U.RAO>>39440000
   <<THE MESSAGE IS NOW READY TO GO.>>                         <<U.RAO>>39450000
   <<STEP 3 - SENDING THE MESSAGE.  THERE ARE 3 PROBLEMS HERE.><<U.RAO>>39460000
   <<IF THERE ARE NO JOBS MATCHING THE DESCRIPTION, THE SENDER><<U.RAO>>39470000
   <<MUST BE TOLD;  IF ANY JOB SELECTED IS RUNNING QUIET, THE>><<U.RAO>>39480000
   <<SENDER MUST BE TOLD;  FINALLY, THE MESSAGE MUST BE SENT>> <<U.RAO>>39490000
                                                               <<01652>>39500000
   DO   << SCAN FOR THE FIRST ACCEPTABLE ENTRY. >>             <<01652>>39510000
   BEGIN                                                       <<01652>>39520000
                                                               <<01652>>39530000
      FOUNDENTRY := SCANJMAT( NEXTJMATINDEX, RESULT,           <<01652>>39540000
                              JMATRETURN             );        <<01652>>39550000
                                                               <<01652>>39560000
   << THE SENDER IS NOT A QUALIFED TARGET.  IF THE SENDER >>   <<01652>>39570000
   << IS SELECTED, SKIP OVER IT.                          >>   <<01652>>39580000
      IF((RESULT.JOBNM=JITJOBNUMBER) LAND                      << 7683>>39590000
         (RESULT.JOBFIELD=JITJSTYPE)) THEN                     <<06846>>39600000
      BEGIN                                                    <<01652>>39610000
         SENDER'IS'TARGET := TRUE;                             <<01652>>39620000
         FOUNDENTRY := SCANJMAT( NEXTJMATINDEX, RESULT,        <<01652>>39630000
                                 JMATRETURN             );     <<01652>>39640000
      END;                                                     <<01652>>39650000
                                                               <<01652>>39660000
   END                                                         <<01652>>39670000
   UNTIL  NOT FOUNDENTRY                                       <<01652>>39680000
          OR  (JMATRETURN.JMATTYPE = RUNNINGJOB);              <<01652>>39690000
                                                               <<01652>>39700000
   IF NOT FOUNDENTRY THEN   <<NO SUCH JOBS FITTING JOBID FOUND><<U.RAO>>39710000
      IF SENDER'IS'TARGET                                      <<01652>>39720000
         THEN CIERR( ERRNUM := -TELLSENDONLYTARGET, PARMSP )   <<04787>>39730000
         ELSE CIERR( ERRNUM := -TELLNOSUCHJOBS,     PARMSP )   <<04787>>39740000
   ELSE   <<HAVE AT LEAST ONE WINNER>>                         <<U.RAO>>39750000
      DO   <<LOOP THROUGH JMAT, SENDING MESSAGES>>             <<U.RAO>>39760000
         IF(( JMATRETURN.JMATTYPE = RUNNINGJOB ) LAND          << 7683>>39770000
            ( (RESULT.JOBNM <> JITJOBNUMBER) LOR               << 7683>>39780000
              (RESULT.JOBFIELD <> JITJSTYPE)   )) <<NOTSENDER>><< 7683>>39790000
         THEN                                                           39800000
         IF LOGICAL(JMATRETURN.QUIETBIT) AND NOT WARNFLG THEN  <<00552>>39810000
               BEGIN   <<TELL SENDER>>                         <<U.RAO>>39820000
               <<FORMAT JOBID OF TARGET>>                      <<U.RAO>>39830000
               RECIPSNUM(2) := " ";                            <<U.RAO>>39840000
               MOVE RECIPSNUM(3) := RECIPSNUM(2),(3);          <<U.RAO>>39850000
               IF RESULT.JOBFIELD = SESSIONTYPE THEN           <<U.RAO>>39860000
                  RECIPSNUM := "S"                             <<U.RAO>>39870000
               ELSE                                            <<U.RAO>>39880000
                  RECIPSNUM := "J";                            <<U.RAO>>39890000
               ASCII(RESULT.(2:14), 10, RECIPSNUM(1));         <<U.RAO>>39900000
               FORMNAME(5,RECIPID,RECIPSNUM,BRESULT(2),BRESULT(10),     39910000
                  DUMMY);                                      <<U.RAO>>39920000
               GENMSG(CIGENERALMSGSET, TELLNOTACCEPT, 0, @RECIPID);     39930000
               END                                             <<U.RAO>>39940000
            ELSE   <<ACCEPTING MESSAGES, SEND MESSAGE>>        <<U.RAO>>39950000
         IF RESULT.JOBFIELD = JOBTYPE THEN << TELL TO JOB>>    <<04208>>39960000
            TELLTOJOB := TRUE                                  <<04208>>39970000
         ELSE                                                  <<04208>>39980000
         IF WARNFLG THEN GENMSG(1,OPWARN,0,@MSGADR,,,,,        <<00552>>39990000
               JMATRETURN(1),,,,JMATRETURN(2)&LSL(12)+2)       <<01317>>40000000
                                                               <<00552>>40010000
         ELSE <<OP.01>>                                        <<00552>>40020000
               GENMSG(CIGENERALMSGSET, TELLFROM, 0, @USERID, @MSGADR,   40030000
                  ,,,JMATRETURN(1),,,,JMATRETURN(2)&LSL(12)+1) <<U.RAO>>40040000
         UNTIL NOT SCANJMAT(NEXTJMATINDEX, RESULT, JMATRETURN);<<U.RAO>>40050000
   <<MESSAGES ALL SENT.  NOW CLEAN UP AND RETURN>>             <<U.RAO>>40060000
    IF TELLTOJOB THEN                                          <<04208>>40070000
       CIERR(ERRNUM := -TELLJOBINVALID,PARMSP);                <<04787>>40080000
   IF MSGMOVED THEN   <<SHIFT RIGHT 1 BYTE>>                   <<U.RAO>>40090000
      BEGIN                                                    <<U.RAO>>40100000
      MOVE MSGADR(MSGLEN) := MSGADR(MSGLEN-1), (-MSGLEN);      <<U.RAO>>40110000
      MSGADR := SAVEDBYTE;                                     <<U.RAO>>40120000
      @MSGADR := @MSGADR+1;                                    <<U.RAO>>40130000
      END;                                                     <<U.RAO>>40140000
   MSGADR(MSGLEN) := %15;  <<RESTORE OVER TRAILING 0>>         <<U.RAO>>40150000
   END;                                                        <<U.RAO>>40160000
END;  <<PROCEDURE CXTELL>>                                     <<U.RAO>>40170000
PROCEDURE CXHELP EXECUTORHEAD;                                 <<01.EB>>40180000
   OPTION UNCALLABLE;                                          <<01.EB>>40190000
BEGIN                                                          <<01.EB>>40200000
                                                               <<01.EB>>40210000
EQUATE                                                         <<01.EB>>40220000
   BREAKHIT  = 41,                                             <<01.EB>>40230000
   FATALERR  = 50,                                             <<01.EB>>40240000
   HELPSPACE         = 3650,  << HELPROC NEEDS AS OF FIX. >>   <<01895>>40250000
   CATERR            = 51,                                     <<06.EB>>40260000
   USERLABELERR      = 54;                                     <<06.EB>>40270000
                                                               <<01.EB>>40280000
BYTE ARRAY BUFF(0:13);                                         <<01.EB>>40290000
INTEGER                                                        <<01895>>40300000
   OLD'RELZ,   << Z BEFORE ZSIZE CALL. >>                      <<01895>>40310000
   HELPCATFN;                                                  <<01895>>40320000
                                                               <<01.EB>>40330000
PROCEDURE HELPROC(CATFN,LISTFN,COMIMAGE,COMBASE,ERRNO,         <<01.EB>>40340000
      INTACTIVE);                                              <<01.EB>>40350000
   VALUE CATFN,LISTFN,INTACTIVE;                               <<01.EB>>40360000
   INTEGER CATFN,LISTFN,ERRNO;                                 <<01.EB>>40370000
   BYTE ARRAY COMIMAGE,COMBASE;                                <<01.EB>>40380000
   LOGICAL INTACTIVE;                                          <<01.EB>>40390000
   OPTION EXTERNAL;                                            <<01.EB>>40400000
                                                               <<01.EB>>40410000
<< NEED TO MAKE SURE THAT THERE IS ENOUGH STACK SPACE >>       <<01895>>40420000
<< FOR PROGRAMMATIC CALLS TO HELP.                    >>       <<01895>>40430000
                                                               <<01895>>40440000
PUSH(Z);                                                       <<01895>>40450000
OLD'RELZ := TOS;                                               <<01895>>40460000
                                                               <<01895>>40470000
TOS := 0;  << GET SPACE FOR ZSIZE RETURN VALUE. >>             <<01895>>40480000
PUSH(S);                                                       <<01895>>40490000
TOS := TOS + HELPSPACE;                                        <<01895>>40500000
ZSIZE(*);                                                      <<01895>>40510000
IF <> THEN                                                     <<01895>>40520000
   BEGIN                                                       <<01895>>40530000
   ZSIZE(OLD'RELZ);                                            <<01895>>40540000
   CIERR( ERRNUM := NOSTACKSPACE );                            <<01895>>40550000
   RETURN;                                                     <<01895>>40560000
   END;                                                        <<01895>>40570000
                                                               <<01895>>40580000
MOVE BUFF := "CICAT.PUB.SYS ";                                 <<14.EB>>40590000
HELPCATFN := FOPEN(BUFF,1,%300);                               <<14.EB>>40600000
IF <> THEN                                                     <<14.EB>>40610000
BEGIN                                                          <<14.EB>>40620000
   FERROR'(HELPCATFN,PARMNUM);                                 <<14.EB>>40630000
   CIERR( ERRNUM := OPENCATFAIL );                             <<01895>>40640000
   ZSIZE(OLD'RELZ);  << GET Z BACK DOWN. >>                    <<01895>>40650000
   RETURN;                                                     <<14.EB>>40660000
END;                                                           <<14.EB>>40670000
HELPROC( HELPCATFN, 2, PARMSP, CIS'BCOMIMAGE,                  << I.A >>40680000
         ERRNUM, JOBSESSIONMAIN               );               << I.A >>40690000
IF ERRNUM >= FATALERR THEN                                     <<06.EB>>40700000
BEGIN                                                          <<01.EB>>40710000
   IF ERRNUM = CATERR OR ERRNUM = USERLABELERR THEN            <<06.EB>>40720000
      FERROR'(HELPCATFN,PARMNUM);                              <<06.EB>>40730000
   CIERR(ERRNUM := ERRNUM +HELPOFFSET);                        <<01.EB>>40740000
END                                                            <<01.EB>>40750000
ELSE                                                           <<01.EB>>40760000
BEGIN                                                          <<01.EB>>40770000
   IF ERRNUM = BREAKHIT THEN GENMSG(CIERRMSGSET,               <<01.EB>>40780000
      HELPTERMINATED);                                         <<01.EB>>40790000
   ERRNUM := 0; << EVERYTHING PEACHY >>                        <<01.EB>>40800000
END;                                                           <<01.EB>>40810000
                                                               <<01.EB>>40820000
FCLOSE(HELPCATFN, 0, 0);                                       <<U.RAO>>40830000
                                                               <<01895>>40840000
ZSIZE(OLD'RELZ);     << RETURN Z TO PREVIOUS VALUE >>          <<01895>>40850000
                                                               <<01895>>40860000
END; << CXHELP >>                                              <<01.EB>>40870000
$CONTROL SEGMENT=CIUSERUTIL                                    <<U.RAO>>40880000
      PROCEDURE CXDEBUG EXECUTORHEAD;                                   40890000
      OPTION PRIVILEGED,UNCALLABLE;                                     40900000
      BEGIN                                                             40910000
      COMMENT                                                           40920000
      CXDEBUG IS THE EXECUTOR FOR THE DEBUG COMMAND                     40930000
      COMMAND FORMAT                                                    40940000
      DEBUG                                                             40950000
;                                                              <<U.RAO>>40960000
SCAN PARMSP WHILE %6440;                                       <<U.RAO>>40970000
IF NOCARRY THEN CIERR(ERRNUM := -WARNXPARMSIGNORED, PARMSP);   <<04787>>40980000
DEBUG;                                                         <<U.RAO>>40990000
END;   <<CXDEBUG>>                                             <<U.RAO>>41000000
$PAGE "IF, ELSE, ENDIF AND JCW RELATED PROCEDURES"             <<08.RO>>41010000
<< There are really just two issues to be dealt with>>         <<08.RO>>41020000
<< in the IF command jungle of procedures.  The bulk >>        <<08.RO>>41030000
<< of the code is for parsing the JCW expression in   >>       <<08.RO>>41040000
<< the IF command header.  That problem is handled in >>       <<08.RO>>41050000
<< a more or less standard interpreter manner, with   >>       <<08.RO>>41060000
<< recursive descent parsers which return subexpression>>      <<08.RO>>41070000
<< values to the caller.  Eventually CXIF gets a      >>       <<08.RO>>41080000
<< TRUE/FALSE/ERROR return as the value of the        >>       <<08.RO>>41090000
<< expression.  The second issue to be dealt with is  >>       <<08.RO>>41100000
<< the actual functional operation of the commands.   >>       <<08.RO>>41110000
<< There are three global CI variables used for keeping>>      <<08.RO>>41120000
<< track of the current if levels.  IFNESTING is a    >>       <<08.RO>>41130000
<< count of the IF levels.  It is incremented by CXIF >>       <<08.RO>>41140000
<< and decremented by CXENDIF.  IFSKIP is a flag      >>       <<08.RO>>41150000
<< indicating whether we are currently in the false   >>       <<08.RO>>41160000
<< block of an IF expression, in which case the       >>       <<08.RO>>41170000
<< CI commands are ignored.  NOTE that there are some >>       <<08.RO>>41180000
<< problems in this area.  These problems will be     >>       <<08.RO>>41190000
<< described below.  Management of IFSKIP is very     >>       <<08.RO>>41200000
<< tricky, due to handling nesting levels.  See the   >>       <<08.RO>>41210000
<< code for details.  Finally, the global variable    >>       <<08.RO>>41220000
<< ELSESEEN is used for avoiding mishandling          >>       <<08.RO>>41230000
<< redundantly specified ELSE's.                      >>       <<08.RO>>41240000
<< There are two significant, perhaps incompletely    >>       <<08.RO>>41250000
<< resolved problems with the IF construct.  It has   >>       <<08.RO>>41260000
<< been suggested, and I concur, that the IF level on >>       <<08.RO>>41270000
<< exit from a UDC should be the same as the level on >>       <<08.RO>>41280000
<< entry to that same UDC.  A mechanism will have to  >>       <<08.RO>>41290000
<< be invented to solve this problem.  This probably  >>       <<08.RO>>41300000
<< just requires that the current values be saved on  >>       <<08.RO>>41310000
<< entry to a UDC and restored on exit.  The second   >>       <<08.RO>>41320000
<< problem is to make sure that all commands which    >>       <<08.RO>>41330000
<< MUST be recognized, regardless of whether we are   >>       <<08.RO>>41340000
<< flushing or not, are seen by the appropriate       >>       <<08.RO>>41350000
<< executor.  There are currently four such commands, >>       <<08.RO>>41360000
<< IF, ELSE, ENDIF and RFA.  Job terminating commands >>       <<08.RO>>41370000
<< such as BYE, JOB, HELLO etc. are also automatically>>       <<08.RO>>41380000
<< seen by the I/O system.  There is a bit in the     >>       <<08.RO>>41390000
<< access entry in COMSEARCH which controls whether a >>       <<08.RO>>41400000
<< command is recognized while flushing.              >>       <<08.RO>>41410000
<<                                                    >>       <<08.RO>>41420000
$CONTROL SEGMENT=CIMISC                                        <<U.RAO>>41430000
PROCEDURE GETNEXTIFOP(OP, OPARR);                              <<U.RAO>>41440000
BYTE ARRAY OP, OPARR;                                          <<U.RAO>>41450000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>41460000
BEGIN                                                          <<U.RAO>>41470000
BYTE ARRAY LOCOP(0:4);                                         <<U.RAO>>41480000
MOVE OPARR := "     ";                                         <<U.RAO>>41490000
LOCOP(4) := " ";                                               <<U.RAO>>41500000
MOVE LOCOP := OP, (4);                                         <<U.RAO>>41510000
MOVE OPARR := LOCOP WHILE ANS;                                 <<U.RAO>>41520000
END;   <<PROCEDURE GETNEXTIFOP>>                               <<U.RAO>>41530000
PROCEDURE JCWPRIMARY(PARMPTR,JCWVALUE,ERRNUM,ERRADR,PARMNUM);  <<U.RAO>>41540000
BYTE ARRAY PARMPTR;                                            <<U.RAO>>41550000
LOGICAL JCWVALUE;                                              <<U.RAO>>41560000
INTEGER ERRNUM, ERRADR, PARMNUM;                               <<U.RAO>>41570000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>41580000
BEGIN                                                          <<U.RAO>>41590000
<<THIS PROCEDURE DETERMINES IF A GIVEN TOKEN IS A JCW PRIMARY. <<U.RAO>>41600000
<<A JCW PRIMARY IS EITHER A NUMBER (POSSIBLY OCTAL), A JCW     <<U.RAO>>41610000
<<EQUATE (SEE TRANSJCWEQUATE), OR AN EXISTING JCW NAME.        <<U.RAO>>41620000
<<PARMPTR POINTS AT THE FIRST BYTE OF THE TOKEN ON ENTRY.      <<U.RAO>>41630000
<<JCWVALUE WILL BE RETURNED THE VALUE OF THE PRIMARY, IF NO    <<U.RAO>>41640000
<<   ERRORS WERE DETECTED.  IT HAS NO INPUT SIGNIFICANCE.      <<U.RAO>>41650000
<<ERRNUM IS RETURNED AN ERROR CODE (SEE TRANSJCWEQUATE).       <<U.RAO>>41660000
<<   IT IS ASSUMED TO BE 0 ON ENTRY.  THE POSSIBLE ERRORS ARE  <<U.RAO>>41670000
<<   DETAILED BELOW.                                           <<U.RAO>>41680000
<<ERRADR IS RETURNED EITHER THE BYTE ADDRESS AT WHICH AN ERROR <<U.RAO>>41690000
<<   WAS DETECTED OR THE ADDRESS OF THE NEXT NON-BLANK BEYOND  <<U.RAO>>41700000
<<   THE CURRENT PRIMARY.                                      <<U.RAO>>41710000
<<PARMNUM IS THE ORDINAL OF THE CURRENT PARM.  IT IS ASSUMED   <<U.RAO>>41720000
<<   TO BE THE PREVIOUS TOKEN UPON ENTRY AND WILL BE UPDATED.  <<U.RAO>>41730000
<<THE CONDITION CODE IS UNCHANGED.                             <<U.RAO>>41740000
<<THE ALGORITHM IS NOT PARTICULARLY INTERESTING OR TRICKY.     <<U.RAO>>41750000
INTEGER PARMLEN;  <<LENGTH OF THE TOKEN BEING PROCESSED.>>     <<U.RAO>>41760000
INTEGER TRANSERR;  <<RETURNED ERROR CODE FROM TRANSJCWEQUATE.>><<U.RAO>>41770000
INTEGER TRANSERRPTR;  <<RETURNED ERROR/END AROM TRANSJCWEQUATE.<<U.RAO>>41780000
DOUBLE TEMPJCWVALUE := 0D;  <<HOLDS CONVERTED RESULT>>         <<02.RO>>41790000
LOGICAL REALJCWVALUE = TEMPJCWVALUE+1; <<SIGNIFICANT PART>>    <<02.RO>>41800000
EQUATE                                                         <<U.RAO>>41810000
   NOJCWERR       = 0,  <<NO ERRORS ENCOUNTERED.>>             <<U.RAO>>41820000
   NOPRIMARY      = 1,  <<NOTHING FOUND AT ALL.>>              <<U.RAO>>41830000
   NUM2LARGE      = 2,  <<NUM EXCEEDS 65535.>>                 <<U.RAO>>41840000
   INVOCTDGT      = 3,  <<8 OR 9 IN OCTAL NUMBER.>>            <<U.RAO>>41850000
   INVJCWEQNUM    = 2,  <<INVALID NUMBER WITH THIS EQUATE TYPE><<U.RAO>>41860000
   <<5,6,7 USED>>                                              <<U.RAO>>41870000
   JCWNAME2LONG   = 8,  <<NAME > 255 CHARACTERS LONG.>>        <<U.RAO>>41880000
   JCWNAMENOALPHA = 9,  <<NAME DOES NOT START WITH ALPHA.>>    <<U.RAO>>41890000
   NOSUCHJCW      = 10, <<NO SUCH JCW IN JCW TABLE.>>          <<U.RAO>>41900000
   INVJCWTYPE     = 1;  <<TYPE PART OF JCW NOT RECOGNIZED.>>   <<U.RAO>>41910000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>41920000
SCAN PARMPTR WHILE %6440,1;  <<SKIP LEADING BLANKS>>           <<U.RAO>>41930000
@PARMPTR := ERRADR := TOS;                                     <<U.RAO>>41940000
IF CARRY THEN   <<HIT CARRIAGE RETURN, NO PARM SUPPLIED>>      <<U.RAO>>41950000
   ERRNUM := NOPRIMARY                                         <<U.RAO>>41960000
ELSE                                                           <<U.RAO>>41970000
   BEGIN                                                       <<U.RAO>>41980000
   IF (PARMPTR=NUMERIC) OR (PARMPTR="%") THEN                  <<U.RAO>>41990000
      BEGIN   <<GUESS THAT IT IS A NUMBER>>                    <<U.RAO>>42000000
      IF PARMPTR = "%" THEN   <<OCTAL VALUE>>                  <<U.RAO>>42010000
         PARMLEN := 1                                          <<U.RAO>>42020000
      ELSE                                                     <<U.RAO>>42030000
         PARMLEN := 0;                                         <<U.RAO>>42040000
      MOVE PARMPTR(PARMLEN) := PARMPTR(PARMLEN) WHILE N,1;     <<U.RAO>>42050000
      PARMLEN := TOS-@PARMPTR;  <<TOKEN LEN>>                  <<U.RAO>>42060000
      TEMPJCWVALUE := DBINARY(PARMPTR, PARMLEN);               <<02.RO>>42070000
      IF < THEN   <<INVALID NUMBER>>                           <<02.RO>>42080000
         ERRNUM := INVOCTDGT                                   <<02.RO>>42090000
      ELSE IF > OR TEMPJCWVALUE > 65535D THEN                  <<02.RO>>42100000
         ERRNUM := NUM2LARGE                                   <<02.RO>>42110000
      ELSE  <<VALID NUMBER>>                                   <<02.RO>>42120000
         @PARMPTR := @PARMPTR+PARMLEN;  <<GOOD, MOVE PAST TOKEN<<02.RO>>42130000
      JCWVALUE := REALJCWVALUE;   <<RETURN SIGNIFICANT WORD>>  <<02.RO>>42140000
      END                                                      <<U.RAO>>42150000
   ELSE  <<IS ALPHA, 2 POSSIBILITIES>>                         <<U.RAO>>42160000
      BEGIN                                                    <<U.RAO>>42170000
      TRANSJCWEQUATE(PARMPTR, JCWVALUE, TRANSERR, TRANSERRPTR);<<U.RAO>>42180000
      IF (TRANSERR <> INVJCWTYPE)AND(TRANSERR <> NOJCWERR) THEN<<U.RAO>>42190000
         BEGIN  <<BAD JCW EQUATE>>                             <<U.RAO>>42200000
         ERRNUM := INVJCWEQNUM+TRANSERR;                       <<U.RAO>>42210000
         ERRADR := TRANSERRPTR;                                <<U.RAO>>42220000
         END                                                   <<U.RAO>>42230000
      ELSE IF TRANSERR = NOJCWERR THEN   <<IS VALID JCW EQUATE><<U.RAO>>42240000
         @PARMPTR := TRANSERRPTR  <<JUST UPDATE END POINTER>>  <<U.RAO>>42250000
      ELSE  <<WAS NOT A JCW EQUATE EITHER.>>                   <<U.RAO>>42260000
         BEGIN  <<LAST CHANCE IS ANOTHER JCW>>                 <<U.RAO>>42270000
         FINDJCW(PARMPTR, JCWVALUE, TRANSERR);                 <<U.RAO>>42280000
         CASE *TRANSERR OF                                     <<U.RAO>>42290000
            BEGIN                                              <<U.RAO>>42300000
               BEGIN  <<NO ERROR, UPDATE POINTER.>>            <<U.RAO>>42310000
               MOVE PARMPTR := PARMPTR WHILE AN,1;             <<U.RAO>>42320000
               @PARMPTR := TOS;                                <<U.RAO>>42330000
               END;                                            <<U.RAO>>42340000
                                                               <<U.RAO>>42350000
               ERRNUM := JCWNAME2LONG;                         <<U.RAO>>42360000
                                                               <<U.RAO>>42370000
               ERRNUM := JCWNAMENOALPHA;                       <<U.RAO>>42380000
                                                               <<U.RAO>>42390000
               ERRNUM := NOSUCHJCW;                            <<U.RAO>>42400000
            END;                                               <<U.RAO>>42410000
         END;   <<OTHER JCW CASE>>                             <<U.RAO>>42420000
      END;  <<ALPHA CASE>>                                     <<U.RAO>>42430000
   END;  <<PARM EXISTS CASE>>                                  <<U.RAO>>42440000
IF ERRNUM = NOJCWERR THEN                                      <<U.RAO>>42450000
   BEGIN  <<LAST JOB IS TO SKIP BLANKS TO NEXT TOKEN>>         <<U.RAO>>42460000
   SCAN PARMPTR WHILE %6440,1;                                 <<U.RAO>>42470000
   ERRADR := TOS;                                              <<U.RAO>>42480000
   END;                                                        <<U.RAO>>42490000
END;   <<JCWPRIMARY>>                                          <<U.RAO>>42500000
PROCEDURE CPRIMARY(PRIMARY,PRIMARYVALUE,ERRNUM,ENDADR,PARMNUM);<<U.RAO>>42510000
BYTE ARRAY PRIMARY;                                            <<U.RAO>>42520000
LOGICAL PRIMARYVALUE;                                          <<U.RAO>>42530000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>42540000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>42550000
BEGIN                                                          <<U.RAO>>42560000
<<This procedure determines if a particular part of the        <<U.RAO>>42570000
<<conditional expression is a conditional primary.  In BNF terms U.RAO>>42580000
<<it is looking for <cprimary>::=<jcwprimary><relop><jcwprimary>.U.RAO>>42590000
<<PRIMARY is a byte pointer to the suspected conditional primary.U.RAO>>42600000
<<PRIMARYVALUE will be returned the value of the conditional   <<U.RAO>>42610000
<<   primary.                                                  <<U.RAO>>42620000
<<ERRNUM will be the (already sent) CI error number, if any.   <<U.RAO>>42630000
<<ENDADR is the address of the error or of the next token,     <<U.RAO>>42640000
<<   if no errors were encountered.                            <<U.RAO>>42650000
<<PARMNUM is the ordinal of the current parameter.             <<U.RAO>>42660000
<<The condition code is unaffected.                            <<U.RAO>>42670000
EQUATE CR=%15;                                                 <<U.RAO>>42680000
INTEGER TRANSERR:=0; <<INTERNAL ERROR CODE RETURNED BY JCWPRIMA<<U.RAO>>42690000
INTEGER TRANSERRADR;  <<ADDRESS OF END/ERROR FROM JCWPRIMARY>> <<U.RAO>>42700000
INTEGER RELOPLEN;   <<LENGTH OF THE RELATIONAL OPERATOR.>>     <<U.RAO>>42710000
BYTE ARRAY RELOPDICTP(0:1) = PB :=                             <<U.RAO>>42720000
   3,1,"<",                                                    <<U.RAO>>42730000
   3,1,"=",                                                    <<U.RAO>>42740000
   3,1,">",                                                    <<U.RAO>>42750000
   4,2,"<=",                                                   <<U.RAO>>42760000
   4,2,">=",                                                   <<U.RAO>>42770000
   4,2,"<>",                                                   <<U.RAO>>42780000
   0;                                                          <<U.RAO>>42790000
EQUATE RELOPDICTLEN=3+3+3+4+4+4+1;                             <<U.RAO>>42800000
BYTE ARRAY RELOPDICT(0:RELOPDICTLEN-1);                        <<U.RAO>>42810000
INTEGER RELOPINDEX; <<WHICH RELATIONAL OPERATOR WAS FOUND>>    <<U.RAO>>42820000
   << 1 <, 2 =, 3 >, 4 <=, 5 >=, 6 <>  >>                      <<U.RAO>>42830000
LOGICAL PRIMARY2VALUE;<<TEMPORARY FOR SECOND JCW PRIMARY VALUE><<U.RAO>>42840000
<<***  START OF BODY  ***>>                                    <<U.RAO>>42850000
JCWPRIMARY(PRIMARY,PRIMARYVALUE,TRANSERR,TRANSERRADR,PARMNUM); <<U.RAO>>42860000
@PRIMARY := TRANSERRADR;                                       <<U.RAO>>42870000
CASE *TRANSERR OF                                              <<U.RAO>>42880000
   BEGIN                                                       <<U.RAO>>42890000
      IF PRIMARY = CR THEN  <<REST OF RELATIONAL MISSING>>     <<U.RAO>>42900000
         ERRNUM := IFXPCTRELATION;                             <<U.RAO>>42910000
      ERRNUM := IFXPCTRELOP;                                   <<U.RAO>>42920000
      ERRNUM := SETJCWNUM2LARGE;                               <<U.RAO>>42930000
      ERRNUM := SETJCWINVOCTDGT;                               <<U.RAO>>42940000
      ERRNUM := SETJCWOKVAL2BIG;                               <<U.RAO>>42950000
      ERRNUM := SETJCWWARNVAL;                                 <<U.RAO>>42960000
      ERRNUM := SETJCWFATALVAL;                                <<U.RAO>>42970000
      ERRNUM := SETJCWSYSTEMVAL;                               <<U.RAO>>42980000
      ERRNUM := SETJCWNAME2LONG;                               <<U.RAO>>42990000
      ERRNUM := SETJCWNAMENOALP;                               <<U.RAO>>43000000
      ERRNUM := IFNOSUCHJCW;                                   <<U.RAO>>43010000
   END;                                                        <<U.RAO>>43020000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>43030000
   CIERR(ERRNUM, PRIMARY)                                      <<U.RAO>>43040000
   <<  If this is a session executing CIERR will >>            <<07367>>43050000
   <<  RETURN to here and then this will return  >>            <<07367>>43060000
   <<  to CFACTOR.                               >>            <<07367>>43070000
ELSE                                                           <<U.RAO>>43080000
   BEGIN  <<HAVE FIRST ELEMENT, GO FOR RELATIONAL OP>>         <<U.RAO>>43090000
   IF "<" <= INTEGER(PRIMARY(1)) <= ">" THEN                   <<U.RAO>>43100000
      RELOPLEN := 2                                            <<U.RAO>>43110000
   ELSE                                                        <<U.RAO>>43120000
      RELOPLEN := 1;                                           <<U.RAO>>43130000
   MOVE RELOPDICT := RELOPDICTP, (RELOPDICTLEN);               <<U.RAO>>43140000
   RELOPINDEX := SEARCH(PRIMARY, RELOPLEN, RELOPDICT);         <<U.RAO>>43150000
   IF (RELOPINDEX=0) OR (PRIMARY(RELOPLEN)<>" ") AND           <<U.RAO>>43160000
         (PRIMARY(RELOPLEN)<>"%") AND                          <<U.RAO>>43170000
         (PRIMARY(RELOPLEN)<>CR) AND                           <<U.RAO>>43180000
         (PRIMARY(RELOPLEN)=SPECIAL) THEN  <<BAD RELOP>>       <<U.RAO>>43190000
      CIERR(ERRNUM := IFXPCTRELOP, PRIMARY)                    <<U.RAO>>43200000
   ELSE                                                        <<U.RAO>>43210000
      BEGIN  <<HAVE FIRST PRIMARY AND RELOP>>                  <<U.RAO>>43220000
      @PRIMARY := @PRIMARY+RELOPLEN;                           <<U.RAO>>43230000
      JCWPRIMARY(PRIMARY, PRIMARY2VALUE, TRANSERR, TRANSERRADR,<<U.RAO>>43240000
         PARMNUM);  <<CHECK SECOND PRIMARY>>                   <<U.RAO>>43250000
      @PRIMARY := TRANSERRADR;                                 <<U.RAO>>43260000
      CASE *TRANSERR OF                                        <<U.RAO>>43270000
         BEGIN                                                 <<U.RAO>>43280000
            BEGIN  <<NO ERROR, DO RETURN STUFF>>               <<U.RAO>>43290000
            ENDADR := @PRIMARY;                                <<U.RAO>>43300000
            CASE *RELOPINDEX-1 OF  <<COMPUTE RETURN VALUE>>    <<U.RAO>>43310000
               BEGIN                                           <<U.RAO>>43320000
               PRIMARYVALUE := PRIMARYVALUE < PRIMARY2VALUE;   <<U.RAO>>43330000
               PRIMARYVALUE := PRIMARYVALUE = PRIMARY2VALUE;   <<U.RAO>>43340000
               PRIMARYVALUE := PRIMARYVALUE > PRIMARY2VALUE;   <<U.RAO>>43350000
               PRIMARYVALUE := PRIMARYVALUE <= PRIMARY2VALUE;  <<U.RAO>>43360000
               PRIMARYVALUE := PRIMARYVALUE >= PRIMARY2VALUE;  <<U.RAO>>43370000
               PRIMARYVALUE := PRIMARYVALUE <> PRIMARY2VALUE;  <<U.RAO>>43380000
               END;                                            <<U.RAO>>43390000
            END;  <<SUCCESS CASE>>                             <<U.RAO>>43400000
            ERRNUM := IFXPCTJCWVAL;                            <<U.RAO>>43410000
            ERRNUM := SETJCWNUM2LARGE;                         <<U.RAO>>43420000
            ERRNUM := SETJCWINVOCTDGT;                         <<U.RAO>>43430000
            ERRNUM := SETJCWOKVAL2BIG;                         <<U.RAO>>43440000
            ERRNUM := SETJCWWARNVAL;                           <<U.RAO>>43450000
            ERRNUM := SETJCWFATALVAL;                          <<U.RAO>>43460000
            ERRNUM := SETJCWSYSTEMVAL;                         <<U.RAO>>43470000
            ERRNUM := SETJCWNAME2LONG;                         <<U.RAO>>43480000
            ERRNUM := SETJCWNAMENOALP;                         <<U.RAO>>43490000
            ERRNUM := IFNOSUCHJCW;                             <<U.RAO>>43500000
         END;                                                  <<U.RAO>>43510000
      IF ERRNUM <> 0 THEN  <<SEND ERROR MESSAGE>>              <<U.RAO>>43520000
         CIERR(ERRNUM, PRIMARY);                               <<U.RAO>>43530000
      END;                                                     <<U.RAO>>43540000
   END;                                                        <<U.RAO>>43550000
END;   <<PROCEDURE CPRIMARY>>                                  <<U.RAO>>43560000
PROCEDURE CFACTOR(FACTOR,FACTORVALUE,ERRNUM,ENDADR,PARMNUM);   <<U.RAO>>43570000
BYTE ARRAY FACTOR;                                             <<U.RAO>>43580000
LOGICAL FACTORVALUE;                                           <<U.RAO>>43590000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>43600000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>43610000
BEGIN                                                          <<U.RAO>>43620000
<<This procedure determines if the tokens following FACTOR >>  <<U.RAO>>43630000
<<constitute a conditional factor in the terms of the      >>  <<U.RAO>>43640000
<<IF command.  In BNF terms it is looking for              >>  <<U.RAO>>43650000
<< <cfactor> ::= (<cexpression>) | <cprimary>              >>  <<U.RAO>>43660000
<<FACTOR is a byte pointer to the suspected factor.        >>  <<U.RAO>>43670000
<<FACTORVALUE will be returned the value of the factor.    >>  <<U.RAO>>43680000
<<ERRNUM, ENDADR, PARMNUM are defined as usual for this set>>  <<U.RAO>>43690000
<<   of procedures.                                        >>  <<U.RAO>>43700000
                                                               <<U.RAO>>43710000
IF FACTOR = "(" THEN                                           <<U.RAO>>43720000
   BEGIN  <<ASSUME EXPRESSION FOLLOWS.>>                       <<U.RAO>>43730000
   SCAN FACTOR(1) WHILE %6440,1;  <<SKIP BLANKS TO FIRST TOKEN><<U.RAO>>43740000
   @FACTOR := TOS;                                             <<U.RAO>>43750000
   CONDEXP(FACTOR, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);      <<U.RAO>>43760000
   IF ERRNUM = 0 THEN   <<NO ERRORS IN EXPRESSION>>            <<U.RAO>>43770000
      BEGIN  <<CHECK END OF EXPRESSION, RETURN>>               <<U.RAO>>43780000
      @FACTOR := ENDADR;                                       <<U.RAO>>43790000
      IF FACTOR <> ")" THEN   <<MISSING TRAILING PAREN>>       <<U.RAO>>43800000
         CIERR(ERRNUM := IFXPCTCLOSPAREN, FACTOR)              <<U.RAO>>43810000
      ELSE  <<EVERYTHING IS FINE.>>                            <<U.RAO>>43820000
         BEGIN  <<CLEANUP, EXIT>>                              <<U.RAO>>43830000
         SCAN FACTOR(1) WHILE %6440,1;                         <<U.RAO>>43840000
         ENDADR := TOS;  <<SKIP TO NEXT TOKEN>>                <<U.RAO>>43850000
         END                                                   <<U.RAO>>43860000
      END                                                      <<U.RAO>>43870000
   END                                                         <<U.RAO>>43880000
ELSE   <<MUST BE CONDITIONAL PRIMARY>>                         <<U.RAO>>43890000
   CPRIMARY(FACTOR, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>43900000
END;   <<CFACTOR>>                                             <<U.RAO>>43910000
PROCEDURE CTERM(TERM, TERMVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>43920000
BYTE ARRAY TERM;                                               <<U.RAO>>43930000
LOGICAL TERMVALUE;                                             <<U.RAO>>43940000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>43950000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>43960000
BEGIN                                                          <<U.RAO>>43970000
<<This procedure checks for a conditional term.  In BNF it is>><<U.RAO>>43980000
<<   looking for                                             >><<U.RAO>>43990000
<<      <cterm> ::= <cterm> { AND <cterm> }                  >><<U.RAO>>44000000
<<                                                           >><<U.RAO>>44010000
<<TERM is a byte pointer to the start of the <term>.         >><<U.RAO>>44020000
<<TERMVALUE will be returned the value of the <term>.        >><<U.RAO>>44030000
<<ERRNUM, ENDADR, PARMNUM are as usual under these procedures>><<U.RAO>>44040000
                                                               <<U.RAO>>44050000
BYTE ARRAY ANDARRAY(0:4);  <<LOCAL FOR "AND" OPERATOR IN PARSE.<<U.RAO>>44060000
LOGICAL FACTORVALUE;   <<TEMPORARY FOR RETURN FROM CFACTOR>>   <<U.RAO>>44070000
CFACTOR(TERM, TERMVALUE, ERRNUM, ENDADR, PARMNUM);             <<U.RAO>>44080000
IF ERRNUM <> 0 THEN RETURN; << no sense in going on >>         <<07367>>44090000
                                                               <<07367>>44100000
@TERM := ENDADR;                                               <<U.RAO>>44110000
GETNEXTIFOP(TERM, ANDARRAY);  <<EXTRACT NEXT TOKEN FOR CHECK>> <<U.RAO>>44120000
WHILE (ERRNUM=0) AND (ANDARRAY="AND ") DO                      <<U.RAO>>44130000
   BEGIN  <<LOOP THROUGH "AND <factor>"'s    >>                <<U.RAO>>44140000
   SCAN TERM(3) WHILE %6440,1;  <<SKIP TO START OF FACTOR>>    <<U.RAO>>44150000
   @TERM := TOS;                                               <<U.RAO>>44160000
   CFACTOR(TERM, FACTORVALUE, ERRNUM, ENDADR, PARMNUM);        <<U.RAO>>44170000
   @TERM := ENDADR;                                            <<U.RAO>>44180000
   TERMVALUE := TERMVALUE LAND FACTORVALUE;                    <<U.RAO>>44190000
   GETNEXTIFOP(TERM, ANDARRAY);  <<PREP FOR NEXT LOOP>>        <<U.RAO>>44200000
   END;                                                        <<U.RAO>>44210000
END;  <<PROCEDURE CTERM>>                                      <<U.RAO>>44220000
PROCEDURE CONDEXP(EXP, EXPVALUE, ERRNUM, ENDADR, PARMNUM);     <<U.RAO>>44230000
BYTE ARRAY EXP;                                                <<U.RAO>>44240000
LOGICAL EXPVALUE;                                              <<U.RAO>>44250000
INTEGER ERRNUM, ENDADR, PARMNUM;                               <<U.RAO>>44260000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>44270000
BEGIN                                                          <<U.RAO>>44280000
<<This procedure checks for a conditional expression.        >><<U.RAO>>44290000
<<The BNF is   <cexpression> ::= <cterm> { OR <cterm> }      >><<U.RAO>>44300000
<<The parameters are analogous to those under CTERM.         >><<U.RAO>>44310000
                                                               <<U.RAO>>44320000
BYTE ARRAY ORARRAY(0:4);  <<HOLDS "OR" OPERATOR FOR LOOP TEST>><<U.RAO>>44330000
LOGICAL TERMVALUE;   <<TEMP FOR SECOND CALL TO CTERM>>         <<U.RAO>>44340000
                                                               <<U.RAO>>44350000
CTERM(EXP, EXPVALUE, ERRNUM, ENDADR, PARMNUM);                 <<U.RAO>>44360000
IF ERRNUM <> 0 THEN RETURN; << no sense in going on >>         <<07367>>44370000
@EXP := ENDADR;                                                <<U.RAO>>44380000
GETNEXTIFOP(EXP, ORARRAY);                                     <<U.RAO>>44390000
WHILE (ERRNUM=0) AND (ORARRAY="OR ") DO                        <<U.RAO>>44400000
   BEGIN   <<LOOP THROUGH "OR <term>"'s >>                     <<U.RAO>>44410000
   SCAN EXP(2) WHILE %6440,1;                                  <<U.RAO>>44420000
   @EXP := TOS;                                                <<U.RAO>>44430000
   CTERM(EXP, TERMVALUE, ERRNUM, ENDADR, PARMNUM);             <<U.RAO>>44440000
   @EXP := ENDADR;                                             <<U.RAO>>44450000
   EXPVALUE := EXPVALUE LOR TERMVALUE;                         <<U.RAO>>44460000
   GETNEXTIFOP(EXP, ORARRAY);                                  <<U.RAO>>44470000
   END;                                                        <<U.RAO>>44480000
END;   <<PROCEDURE CONDEXP>>                                   <<U.RAO>>44490000
PROCEDURE CXIF EXECUTORHEAD;                                   <<U.RAO>>44500000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>44510000
BEGIN                                                          <<U.RAO>>44520000
LOGICAL EXPVALUE;  <<RETURNED VALUE OF CONDITIONAL EXPRESSION>><<U.RAO>>44530000
INTEGER EXPEND;   <<HOLDS ADDRESS OF END OF EXPRESSION>>       <<U.RAO>>44540000
BYTE ARRAY THENLOC(0:5);                                       <<04710>>44550000
IF CIS'IFNESTING >= 15 THEN  << HAS OR WILL OVERFLOW >>        << I.A >>44560000
   begin                                                       <<U.RAO>>44570000
   CIS'IFNESTING := CIS'IFNESTING + 1;                         << I.A >>44580000
   cierr(errnum := ifnestingtoogreat);                         <<U.RAO>>44590000
   end                                                         <<U.RAO>>44600000
ELSE IF CIS'IFSKIP THEN << FLUSH "IF", BUT ACCOUNT >>          << I.A >>44610000
   begin   <<for it since it will have matching endif>>        <<U.RAO>>44620000
   CIS'IFNESTING := CIS'IFNESTING + 1;                         << I.A >>44630000
   CIS'IFSKIP := CIS'IFSKIP & LSL(1) LOR 1;  << FLAG FLUSH >>  << I.A >>44640000
   CIS'ELSESEEN := CIS'ELSESEEN & LSL(1);  << NEW ELSE LEVEL >><< I.A >>44650000
   end                                                         <<U.RAO>>44660000
else  <<no strange problems, just do it>>                      <<U.RAO>>44670000
   begin                                                       <<U.RAO>>44680000
   parmnum := 0;                                               <<U.RAO>>44690000
   SCAN PARMSP WHILE %6440,1;                                  <<U.RAO>>44700000
   @PARMSP := TOS;                                             <<U.RAO>>44710000
   IF CARRY THEN                                               <<U.RAO>>44720000
      BEGIN   <<NO PARAMETERS>>                                <<U.RAO>>44730000
      CIERR(ERRNUM := IFNOPARMS, PARMSP);                      <<U.RAO>>44740000
      RETURN;                                                  <<U.RAO>>44750000
      END;                                                     <<U.RAO>>44760000
   CONDEXP(PARMSP, EXPVALUE, ERRNUM, EXPEND, PARMNUM);         <<U.RAO>>44770000
   IF ERRNUM = 0 THEN   <<HAVE VALID EXPRESSION, WE THINK>>    <<U.RAO>>44780000
      BEGIN                                                    <<U.RAO>>44790000
      @PARMSP := EXPEND;                                       <<07367>>44800000
      PARMNUM := PARMNUM+1;  <<TO TAKE INTO ACCOUNT THE THEN>> <<U.RAO>>44810000
      MOVE PARMSP := PARMSP WHILE AN,1;                        <<U.RAO>>44820000
      IF TOS-@PARMSP <> 4 THEN   <<NEXT TOKEN <> "THEN">>      <<U.RAO>>44830000
         CIERR(ERRNUM := IFNOTHEN, PARMSP)                     <<U.RAO>>44840000
      ELSE                                                     <<U.RAO>>44850000
         BEGIN   <<CHECK FOR ACTUAL THEN>>                     <<U.RAO>>44860000
         MOVE THENLOC := PARMSP WHILE ANS;                     <<U.RAO>>44870000
         IF THENLOC <> "THEN" THEN  <<NEXT TOKEN <> "THEN">>   <<U.RAO>>44880000
            CIERR(ERRNUM := IFNOTHEN, PARMSP)                  <<U.RAO>>44890000
         ELSE   <<HAVE THEN, LOOK FOR EXTRANEOUS GARBAGE>>     <<U.RAO>>44900000
            BEGIN                                              <<U.RAO>>44910000
            SCAN PARMSP(4) WHILE %6440,1;                      <<U.RAO>>44920000
            @PARMSP := TOS;                                    <<U.RAO>>44930000
            IF NOCARRY THEN   <<IS EXTRANEOUS GARBAGE>>        <<U.RAO>>44940000
               CIERR(ERRNUM := IFEXTRANEOUS, PARMSP)           <<U.RAO>>44950000
            ELSE  <<IT ALL LOOKS GOOD FROM HERE>>              <<U.RAO>>44960000
               BEGIN                                           <<U.RAO>>44970000
               PARMNUM := 0;                                   <<U.RAO>>44980000
               CIS'IFNESTING := CIS'IFNESTING + 1;             << I.A >>44990000
               CIS'ELSESEEN := CIS'ELSESEEN & LSL(1);          << I.A >>45000000
               IF EXPVALUE THEN   <<DO IF BLOCK>>              <<U.RAO>>45010000
                  BEGIN                                        <<00849>>45020000
                  CIS'IFSKIP := 0;  << 0 -> NOT FLUSHING >>    << I.A >>45030000
                  IF CIS'UDCNESTLEVEL = 0                      << I.A >>45040000
                     OR CIS'UDCLISTOPT      THEN               << I.A >>45050000
                     GENMSG(CIGENERALMSGSET,CONDITION'TRUE);   <<00849>>45060000
                  END                                          <<00849>>45070000
               ELSE   <<DO ELSE BLOCK, FLUSH IF BLOCK>>        <<U.RAO>>45080000
                  BEGIN                                        <<00849>>45090000
                     CIS'IFSKIP := 1; << 1 -> FLUSH >>         << I.A >>45100000
                  IF CIS'UDCNESTLEVEL = 0                      << I.A >>45110000
                     OR CIS'UDCLISTOPT      THEN               << I.A >>45120000
                     GENMSG(CIGENERALMSGSET,CONDITION'FALSE);  <<00849>>45130000
                  END;                                         <<00849>>45140000
               END   <<SUCCESS BLOCK>>                         <<U.RAO>>45150000
            END  <<FOUND THEN BLOCK>>                          <<U.RAO>>45160000
         END  <<CHECK FOR ACTUAL THEN BLOCK>>                  <<U.RAO>>45170000
      END  <<HAVE VALID EXPRESSION BLOCK>>                     <<U.RAO>>45180000
   END;   <<PROCEDURE CXIF>>                                   <<U.RAO>>45190000
end;                                                           <<U.RAO>>45200000
PROCEDURE CXELSE EXECUTORHEAD;                                 <<U.RAO>>45210000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>45220000
BEGIN                                                          <<U.RAO>>45230000
PARMNUM := 0;                                                  <<U.RAO>>45240000
SCAN PARMSP WHILE %6440,1;  <<SKIP ANY LEADING BLANKS>>        <<U.RAO>>45250000
@PARMSP := TOS;                                                <<U.RAO>>45260000
IF NOCARRY THEN   <<FOUND SOME EXTRANEOUS PARMS>>              <<U.RAO>>45270000
   CIERR(ERRNUM := -ELSE2MP, PARMSP);                          <<U.RAO>>45280000
IF CIS'IFNESTING <= 0 THEN                                     << I.A >>45290000
   CIERR(ERRNUM := ELSEUNPAIRED)                               <<U.RAO>>45300000
ELSE IF CIS'IFNESTING <= 15 THEN  << >15 IF'S ARE IGNORED. >>  << I.A >>45310000
   begin                                                       <<U.RAO>>45320000
   IF CIS'ELSESEEN THEN << ALREADY HAVE ELSE FOR THIS LEVEL >> << I.A >>45330000
      cierr(errnum := else2manyelses)                          <<U.RAO>>45340000
   else                                                        <<U.RAO>>45350000
      begin  <<have valid if-else paIR>>                       <<U.RAO>>45360000
      CIS'ELSESEEN := CIS'ELSESEEN LOR 1; << THIS LEVEL >>     << I.A >>45370000
      <<next step is to toggle flush bit.  tricky bit is, if>> <<U.RAO>>45380000
      <<this whole "if" level is being flushed due to a flush ><<U.RAO>>45390000
      <<at a lower level, we don't want to start executing now.<<U.RAO>>45400000
      <<so must check to see if we are being flushed from a>>  <<U.RAO>>45410000
      <<lower level.  this is done by counting the number of>> <<U.RAO>>45420000
      <<flushing levels as recorded by ifskip.>>               <<U.RAO>>45430000
      IF CIS'IFSKIP <= 1 THEN  << AT MOST 1 FLUSHING LEVEL >>  << I.A >>45440000
         begin   <<toggle bit.  if flushing (1) then want>>    <<U.RAO>>45450000
         <<not flushing (0) or vice versa.>>                   <<U.RAO>>45460000
         <<INDICATE WHETHER SUBSEQUENT COMMANDS WILL BE>>      <<00849>>45470000
         <<IGNORED OR EXECUTED                         >>      <<00849>>45480000
         IF CIS'UDCNESTLEVEL = 0                               << I.A >>45490000
            OR CIS'UDCLISTOPT       THEN                       << I.A >>45500000
            GENMSG( CIGENERALMSGSET, (IF CIS'IFSKIP=1 THEN     << I.A >>45510000
                   RESUME'EXEC ELSE IGNORE'COMM));             <<00849>>45520000
         TOS := CIS'IFSKIP;                                    << I.A >>45530000
         aSsemble(tcbc 15);                                    <<U.RAO>>45540000
         CIS'IFSKIP := TOS;                                    << I.A >>45550000
         end;                                                  <<U.RAO>>45560000
      end;                                                     <<U.RAO>>45570000
   END;                                                        <<U.RAO>>45580000
END;   <<PROCEDURE CXELSE>>                                    <<U.RAO>>45590000
PROCEDURE CXENDIF EXECUTORHEAD;                                <<U.RAO>>45600000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>45610000
BEGIN                                                          <<U.RAO>>45620000
PARMNUM := 0;                                                  <<U.RAO>>45630000
SCAN PARMSP WHILE %6440,1;                                     <<U.RAO>>45640000
@PARMSP := TOS;  <<SKIP ANY LEADING BLANKS>>                   <<U.RAO>>45650000
IF NOCARRY THEN  <<EXTRANEOUS DATA FOUND>>                     <<U.RAO>>45660000
   CIERR(ERRNUM := -ENDIF2MP, PARMSP);                         <<U.RAO>>45670000
IF CIS'IFNESTING <= 0 THEN                                     << I.A >>45680000
   CIERR(ERRNUM := -ENDIFUNPAIRED)                             <<U.RAO>>45690000
ELSE IF CIS'IFNESTING > 15 THEN  << HANDLING IGNORED OVFL >>   << I.A >>45700000
   CIS'IFNESTING := CIS'IFNESTING - 1                          << I.A >>45710000
ELSE  <<ITS OK, DELETE THIS NESTING LEVEL>>                    <<U.RAO>>45720000
   BEGIN                                                       <<U.RAO>>45730000
   CIS'IFNESTING := CIS'IFNESTING - 1;                         << I.A >>45740000
   <<IF ENDING AN 'IFSKIP' THEN INFORM USER>>                  <<00849>>45750000
   <<THAT EXECTION OF COMMANDS WILL RESUME >>                  <<00849>>45760000
   IF CIS'IFSKIP = 1   AND                                     << I.A >>45770000
      ( CIS'UDCNESTLEVEL=0 OR CIS'UDCLISTOPT  ) THEN           << I.A >>45780000
      GENMSG(CIGENERALMSGSET,RESUME'EXEC);                     <<00849>>45790000
   CIS'IFSKIP := CIS'IFSKIP & LSR(1);                          << I.A >>45800000
   CIS'ELSESEEN := CIS'ELSESEEN & LSR(1);                      << I.A >>45810000
   END;                                                        <<U.RAO>>45820000
END;                                                           <<U.RAO>>45830000
PROCEDURE TRANSJCWEQUATE(EQ, JCW, ERRNUM, ERRPTR);             <<U.RAO>>45840000
BYTE ARRAY EQ;                                                 <<U.RAO>>45850000
INTEGER JCW, ERRNUM, ERRPTR;                                   <<U.RAO>>45860000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>45870000
<<THIS PROCEDURE TRANSLATES JCW EQUATES INTO AN INTEGER.       <<U.RAO>>45880000
<<EQ IS A BYTE ARRAY HOLDING THE PUTATIVE JCW EQUATE.          <<U.RAO>>45890000
<<JCW WILL BE RETURNED THE EQUIVALENT INTEGER VALUE OF THE EQUA<<U.RAO>>45900000
<<ERRNUM INDICATES WHAT, IF ANY, ERRORS WERE DETECTED.         <<U.RAO>>45910000
<<   0 => NO ERRORS.                                           <<U.RAO>>45920000
<<   1 => INVALID TYPE PART (I.E., NOT OK, WARN, FATAL, OR SYST<<U.RAO>>45930000
<<   2 => NUMBER PART OF OK > 65535                            <<U.RAO>>45940000
<<   3 => NUMBER PART OF WARN > 49151                          <<U.RAO>>45950000
<<   4 => NUMBER PART OF FATAL > 32767                         <<U.RAO>>45960000
<<   5 => NUMBER PART OF SYSTEM > 16383                        <<U.RAO>>45970000
<<ERRPTR WILL BE RETURNED A BYTE ADDRESS.  IF NO ERROR WAS DETE<<U.RAO>>45980000
<<   IT WILL BE THE ADDRESS OF THE NEXT BYTE BEYOND THE NAME.  <<U.RAO>>45990000
<<   ERROR WAS DETECTED, IT WILL POINT TO THE ITEM PROBABLY AT <<U.RAO>>46000000
BEGIN                                                          <<U.RAO>>46010000
  INTEGER                                                      << 8146>>46020000
     DATE,                                                     << 8146>>46030000
     YEAR,                                                     << 8146>>46040000
     MONTH,                                                    << 8146>>46050000
     WEEKDAY,                                                  << 8146>>46060000
     HOUR,                                                     << 8146>>46070000
     MINUTE,                                                   << 8146>>46080000
     ERRORNUM;                                                 << 8146>>46090000
BYTE ARRAY TYPE(0:1) = PB :=                                   <<U.RAO>>46100000
   4,2,"OK",                                                   <<U.RAO>>46110000
   6,4,"WARN",                                                 <<U.RAO>>46120000
   7,5,"FATAL",                                                <<U.RAO>>46130000
   8,6,"SYSTEM",                                               <<U.RAO>>46140000
   7,5,"HPDAY",                                                << 8146>>46150000
   8,6,"HPDATE",                                               << 8146>>46160000
   9,7,"HPMONTH",                                              << 8146>>46170000
   8,6,"HPYEAR",                                               << 8146>>46180000
   8,6,"HPHOUR",                                               << 8146>>46190000
   10,8,"HPMINUTE",                                            << 8146>>46200000
   0;                                                          <<U.RAO>>46210000
EQUATE TYPEARRAYLEN = 4+6+7+8+7+8+9+8+8+10+1;                  << 8146>>46220000
BYTE ARRAY LOCALTYPE(0:TYPEARRAYLEN-1);  <<HOLDS DB REL ARRAY T<<U.RAO>>46230000
INTEGER TYPELEN;  <<LENGTH OF TYPE PART OF EQUATE FOR SEARCH IN<<U.RAO>>46240000
EQUATE MAXTYPELEN = 8;   << "HPMINUTE" >>                      << 8146>>46250000
BYTE ARRAY LOCALEQ(0:MAXTYPELEN-1); <<HOLDS LOCAL COPY OF TYPE <<U.RAO>>46260000
INTEGER EQTYPE;  <<RESULT FROM SEARCH OF TYPE ARRAY>>          <<U.RAO>>46270000
INTEGER NUMLEN;  <<LENGTH OF NUMERIC PART OF EQUATE>>          <<U.RAO>>46280000
DOUBLE DNUMVAL;  <<HOLDS VALUE OF NUMERIC PART OF EQUATE>>     <<U.RAO>>46290000
EQUATE NOERROR = 0,                                            <<U.RAO>>46300000
       INVALIDTYPE = 1,                                        <<U.RAO>>46310000
       INVALIDNUM = 2;                                         << I.A >>46320000
ERRPTR := @EQ;                                                 <<U.RAO>>46330000
<<FIRST STEP IS TO EXTRACT TYPE FIELD>>                        <<U.RAO>>46340000
MOVE LOCALTYPE := TYPE,(TYPEARRAYLEN);                         <<U.RAO>>46350000
MOVE EQ := EQ WHILE A,1;  <<TO GET TOKEN LENGTH>>              <<U.RAO>>46360000
TYPELEN := TOS-@EQ;                                            <<U.RAO>>46370000
IF TYPELEN > MAXTYPELEN THEN                                   <<U.RAO>>46380000
   ERRNUM := INVALIDTYPE                                       <<U.RAO>>46390000
ELSE                                                           <<U.RAO>>46400000
   BEGIN                                                       <<U.RAO>>46410000
   MOVE LOCALEQ := EQ WHILE AS;  <<GET SHIFTED LOCAL COPY>>    <<U.RAO>>46420000
   EQTYPE := SEARCH(LOCALEQ, TYPELEN, LOCALTYPE) -1;           <<U.RAO>>46430000
   IF < THEN                                                   <<U.RAO>>46440000
      ERRNUM := INVALIDTYPE                                    <<U.RAO>>46450000
   ELSE                                                        <<U.RAO>>46460000
      BEGIN  <<HAVE VALID TYPE, NOW CHECK NUMERIC PART>>       <<U.RAO>>46470000
      ERRPTR := @EQ + TYPELEN;                                 <<U.RAO>>46480000
      MOVE EQ(TYPELEN) := EQ(TYPELEN) WHILE N,1;               <<U.RAO>>46490000
      NUMLEN := TOS-@EQ(TYPELEN);                              <<U.RAO>>46500000
      IF EQTYPE > 3 THEN << MAYBE DATE/TIME SYSTEM JCW >>      << 8146>>46510000
      BEGIN                                                    << 8146>>46520000
        IF NUMLEN <> 0 THEN                                    << 8146>>46530000
        BEGIN                                                  << 8146>>46540000
          ERRNUM := INVALIDTYPE;<< NOT DATE/TIME JCW >>        << 8146>>46550000
          << MUST BACK UP POINTER >>                           << 8146>>46560000
          ERRPTR := ERRPTR - TYPELEN;                          << 8146>>46570000
        END                                                    << 8146>>46580000
        ELSE                                                   << 8146>>46590000
        BEGIN                                                  << 8146>>46600000
          ERRNUM := NOERROR;                                   << 8146>>46610000
          IF EQTYPE < 8 THEN                                   << 8146>>46620000
          BEGIN                                                << 8146>>46630000
            DATE := CALENDAR;                                  << 8146>>46640000
            ALMANAC(DATE,ERRORNUM,YEAR,MONTH,DATE,WEEKDAY);    << 8146>>46650000
            IF EQTYPE = 4                                      << 8146>>46660000
               THEN JCW := WEEKDAY                             << 8146>>46670000
            ELSE IF EQTYPE = 5                                 << 8146>>46680000
               THEN JCW := DATE                                << 8146>>46690000
            ELSE IF EQTYPE = 6                                 << 8146>>46700000
               THEN JCW := MONTH                               << 8146>>46710000
            ELSE JCW := YEAR;                                  << 8146>>46720000
          END                                                  << 8146>>46730000
          ELSE                                                 << 8146>>46740000
          BEGIN                                                << 8146>>46750000
            ERRNUM := NOERROR;                                 << 8146>>46760000
            TOS := CLOCK;                                      << 8146>>46770000
            ASSEMBLE(DEL);                                     << 8146>>46780000
            HOUR := S0.(0:8);                                  << 8146>>46790000
            MINUTE := S0.(8:8);                                << 8146>>46800000
            ASSEMBLE(DEL);                                     << 8146>>46810000
            IF EQTYPE = 8                                      << 8146>>46820000
               THEN JCW := HOUR                                << 8146>>46830000
               ELSE JCW := MINUTE;                             << 8146>>46840000
          END;                                                 << 8146>>46850000
        END; << NUMLEN = 0 >>                                  << 8146>>46860000
      END  << EQTYPE > 3 >>                                    << 8146>>46870000
      ELSE                                                     << 8146>>46880000
      BEGIN                                                    << 8146>>46890000
      DNUMVAL := DBINARY(EQ(TYPELEN), NUMLEN);                 <<U.RAO>>46900000
      IF <> OR (DNUMVAL>%177777D) THEN                         <<U.RAO>>46910000
         ERRNUM := INVALIDNUM+EQTYPE                           <<U.RAO>>46920000
      ELSE                                                     <<U.RAO>>46930000
         BEGIN  <<DO RANGE CHECKS>>                            <<U.RAO>>46940000
         <<WHOLE TRICK HERE IS, MUST FIT IN 16 BITS.>>         <<U.RAO>>46950000
         <<CALCULATE RESULT VALUE, CHECK < %177777D >>         <<U.RAO>>46960000
         TOS := 0;                                             <<U.RAO>>46970000
         TOS := EQTYPE&CSR(2);  <<SET UP TYPE INDUCED MASK>>   <<U.RAO>>46980000
         TOS := TOS+DNUMVAL;  <<MASK + NUMERIC PART>>          <<U.RAO>>46990000
         IF DS1 > %177777D THEN                                <<U.RAO>>47000000
            ERRNUM := INVALIDNUM+EQTYPE                        <<U.RAO>>47010000
         ELSE  <<EVERYTHING FINE, RETURN VALUES>>              <<U.RAO>>47020000
            BEGIN                                              <<U.RAO>>47030000
            ERRNUM := NOERROR;                                 <<U.RAO>>47040000
            ERRPTR := @EQ+TYPELEN+NUMLEN;                      <<U.RAO>>47050000
            JCW := TOS;  <<RESULT VALUE WAS ON TOS, REMEMBER>> <<U.RAO>>47060000
            END;                                               <<U.RAO>>47070000
         END;                                                  <<U.RAO>>47080000
        END; << EQTYPE <= 3 >>                                 << 8146>>47090000
      END;                                                     <<U.RAO>>47100000
   END;                                                        <<U.RAO>>47110000
END;   <<TRANSJCWEQUATE>>                                      <<U.RAO>>47120000
PROCEDURE CXSETJCW EXECUTORHEAD;                               <<U.RAO>>47130000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>47140000
<<THE SYNTAX OF THE SETJCW COMMAND IS                          <<U.RAO>>47150000
<<                                                  {<number>} <<U.RAO>>47160000
<<   SETJCW  <jcwname><non-alphanumeric except cr,%>{<equate>} <<U.RAO>>47170000
<<                                                  {<existing <<U.RAO>>47180000
<<                                                             <<U.RAO>>47190000
BEGIN                                                          <<U.RAO>>47200000
BYTE POINTER PARMPTR;  <<LOCAL POINTER INTO PARAMETER STRING>> <<U.RAO>>47210000
EQUATE CR=%15;  <<CARRIAGE RETURN>>                            <<U.RAO>>47220000
INTEGER NAMELEN;  <<HOLDS JCW NAME LENGTH>>                    <<U.RAO>>47230000
                                                               <<04708>>47240000
LOGICAL INTERACTIVE;  << TRUE IF IN A SESSION. >>              <<01893>>47250000
INTEGER TRANSERR:=0;<<ERROR RETURNS FROM EXTERNAL PROCEDURES>> <<U.RAO>>47260000
INTEGER TRANSERRPTR:=0; <<ERROR ADDRESS FROM TRANSJCWEQUATE>>  <<U.RAO>>47270000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>47280000
INTEGER PCBGLOBLOC;                                            <<06580>>47290000
                                                               <<04708>>47300000
DOUBLE DOUBLE'NEWVALUE:=0D;         << LOGICAL ARITHEMETIC >>  <<04708>>47310000
LOGICAL NEWVALUE=DOUBLE'NEWVALUE+1; << SIGNIFICANT PART    >>  <<04708>>47320000
DOUBLE TEMPJCWVALUE;                << LOGICAL ARITHMETIC  >>  <<04708>>47330000
LOGICAL REALJCWVALUE=TEMPJCWVALUE+1;<< SIGNIFICANT PART    >>  <<04708>>47340000
LOGICAL ADD;                        << OPERATION TYPE      >>  <<04708>>47350000
DOUBLE SECOND'VALUE:=0D;            << LOGICAL ARITHMETIC  >>  <<04708>>47360000
LOGICAL SECOND=SECOND'VALUE+1;      << SIGNIFICANT PART    >>  <<04708>>47370000
EQUATE PLUS="+";                                               <<04708>>47380000
EQUATE MINUS="-";                                              <<04708>>47390000
                                                               <<04708>>47400000
<<BASIC SCHEME: 1) FIND NAME, 2) FIND DELIMITER, 3) GET VALUE>><<U.RAO>>47410000
ERRNUM := 0;                                                   <<U.RAO>>47420000
PARMNUM := 1;                                                  <<U.RAO>>47430000
WHILE PARMSP=" " DO @PARMSP := @PARMSP+1;                      <<U.RAO>>47440000
MOVE PARMSP := PARMSP WHILE ANS,1; <<RESULT IS ADDR OF DELIM>> <<U.RAO>>47450000
@PARMPTR := TOS;                                               <<U.RAO>>47460000
IF (@PARMPTR = @PARMSP) AND PARMPTR <> "@" THEN                <<04.RO>>47470000
   CIERR(ERRNUM := SETJCWNONAME, PARMSP)                       <<U.RAO>>47480000
ELSE                                                           <<U.RAO>>47490000
   BEGIN  <<NAME IS NON-NULL.  GET VALUE>>                     <<U.RAO>>47500000
   NAMELEN := @PARMPTR - @PARMSP;                              <<U.RAO>>47510000
   IF NAMELEN = 0 THEN   <<WAS "@", SKIP OVER>>                <<04.RO>>47520000
      @PARMPTR := @PARMPTR+1;                                  <<04.RO>>47530000
   WHILE (PARMPTR = SPECIAL) AND (PARMPTR <> CR) AND           <<04708>>47540000
        (PARMPTR<>"%") AND (PARMPTR<>MINUS) DO                 <<04708>>47550000
      @PARMPTR := @PARMPTR+1;                                  <<U.RAO>>47560000
   IF PARMPTR = MINUS THEN                                     <<04708>>47570000
      ERRNUM := SETJCWNUM2LARGE                                <<04708>>47580000
   ELSE                                                        <<04708>>47590000
   BEGIN                                                       <<04708>>47600000
   JCWPRIMARY(PARMPTR, NEWVALUE, TRANSERR, TRANSERRPTR,        <<U.RAO>>47610000
      PARMNUM);                                                <<U.RAO>>47620000
   @PARMPTR := TRANSERRPTR;                                    <<U.RAO>>47630000
   CASE *TRANSERR OF                                           <<U.RAO>>47640000
      BEGIN                                                    <<U.RAO>>47650000
      IF (PARMPTR<>CR) AND                                     <<04708>>47660000
         (PARMPTR<>PLUS) AND (PARMPTR<>MINUS) THEN             <<04708>>47670000
            ERRNUM := SETJCW2MP;                               <<04708>>47680000
         ERRNUM := SETJCWNOVALUE;                              <<U.RAO>>47690000
         ERRNUM := SETJCWNUM2LARGE;                            <<U.RAO>>47700000
         ERRNUM := SETJCWINVOCTDGT;                            <<U.RAO>>47710000
         ERRNUM := SETJCWOKVAL2BIG;                            <<U.RAO>>47720000
         ERRNUM := SETJCWWARNVAL;                              <<U.RAO>>47730000
         ERRNUM := SETJCWFATALVAL;                             <<U.RAO>>47740000
         ERRNUM := SETJCWSYSTEMVAL;                            <<U.RAO>>47750000
         ERRNUM := SETJCWNAME2LONG;                            <<U.RAO>>47760000
         ERRNUM := SETJCWNAMENOALP;                            <<U.RAO>>47770000
         ERRNUM := SETJCWNOSUCHJCW;                            <<U.RAO>>47780000
      END;                                                     <<U.RAO>>47790000
   END;                                                        <<04708>>47800000
   IF ERRNUM <> 0 THEN                                         <<U.RAO>>47810000
      CIERR(ERRNUM, PARMPTR)                                   <<U.RAO>>47820000
   ELSE   <<HAVE VALID JCW VALUE IN "NEWVALUE".  EXECUTE!>>    <<U.RAO>>47830000
      BEGIN                                                    <<U.RAO>>47840000
                                                               <<04708>>47850000
<<  NOW CHECK IF ANY ARITHMETIC OPERATIONS NEED TO BE >>       <<04708>>47860000
<<  PERFORMED ON THE PARAMETERS.                      >>       <<04708>>47870000
                                                               <<04708>>47880000
      IF (PARMPTR=PLUS) OR (PARMPTR=MINUS) THEN                <<04708>>47890000
       BEGIN                                                   <<04708>>47900000
                                                               <<04708>>47910000
<<  DETERMINE OPERATION TYPE                          >>       <<04708>>47920000
                                                               <<04708>>47930000
         IF (PARMPTR=PLUS) THEN                                <<04708>>47940000
            ADD:=TRUE                                          <<04708>>47950000
         ELSE ADD:=FALSE;                                      <<04708>>47960000
         @PARMPTR:=@PARMPTR+1;                                 <<04708>>47970000
                                                               <<04708>>47980000
<<  GET A VALUE FOR THE SECOND JCW VALUE              >>       <<04708>>47990000
                                                               <<04708>>48000000
         JCWPRIMARY(PARMPTR,SECOND,TRANSERR,TRANSERRPTR,       <<04708>>48010000
            PARMNUM);                                          <<04708>>48020000
         @PARMPTR:=TRANSERRPTR;                                <<04708>>48030000
         CASE *TRANSERR OF                                     <<04708>>48040000
            BEGIN                                              <<04708>>48050000
               IF (PARMPTR<>CR) THEN                           <<04708>>48060000
                  ERRNUM := SETJCW2MP;                         <<04708>>48070000
               ERRNUM := SETJCWNOVALUE;                        <<04708>>48080000
               ERRNUM := SETJCWNUM2LARGE;                      <<04708>>48090000
               ERRNUM := SETJCWINVOCTDGT;                      <<04708>>48100000
               ERRNUM := SETJCWOKVAL2BIG;                      <<04708>>48110000
               ERRNUM := SETJCWWARNVAL;                        <<04708>>48120000
               ERRNUM := SETJCWFATALVAL;                       <<04708>>48130000
               ERRNUM := SETJCWSYSTEMVAL;                      <<04708>>48140000
               ERRNUM := SETJCWNAME2LONG;                      <<04708>>48150000
               ERRNUM := SETJCWNAMENOALP;                      <<04708>>48160000
               ERRNUM := SETJCWNOSUCHJCW;                      <<04708>>48170000
            END;                                               <<04708>>48180000
         IF ERRNUM <> 0 THEN                                   <<04708>>48190000
            BEGIN                                              <<04708>>48200000
              CIERR(ERRNUM,PARMPTR);                           <<04708>>48210000
              RETURN;                                          <<04708>>48220000
            END;                                               <<04708>>48230000
                                                               <<04708>>48240000
<<  NO ERRORS YET--NOW PERFORM THE ARITHMETIC         >>       <<04708>>48250000
                                                               <<04708>>48260000
         IF NOT ADD THEN                                       <<04708>>48270000
            SECOND'VALUE := -SECOND'VALUE;                     <<04708>>48280000
         TEMPJCWVALUE := DOUBLE'NEWVALUE + SECOND'VALUE;       <<04708>>48290000
                                                               <<04708>>48300000
<<  NOW CHECK IF THE RESULT IS TOO LARGE              >>       <<04708>>48310000
                                                               <<04708>>48320000
         IF (TEMPJCWVALUE > 65535D) OR (TEMPJCWVALUE < 0D) THEN<<04708>>48330000
            BEGIN                                              <<04708>>48340000
              ERRNUM := SETJCWNUM2LARGE;                       <<04708>>48350000
              @PARMPTR := @PARMPTR-2;                          <<04708>>48360000
              CIERR(ERRNUM, PARMPTR);                          <<04708>>48370000
              RETURN;                                          <<04708>>48380000
            END                                                <<04708>>48390000
         ELSE                                                  <<04708>>48400000
            NEWVALUE := REALJCWVALUE;                          <<04708>>48410000
       END;                                                    <<04708>>48420000
      PUTJCW(PARMSP, NEWVALUE, TRANSERR);  <<SEND NEW VALUE>>  <<U.RAO>>48430000
      CASE *TRANSERR OF                                        <<U.RAO>>48440000
         BEGIN                                                 <<U.RAO>>48450000
            <<NO ERRORS, SEE IF IT WAS "JCW">>                 <<U.RAO>>48460000
            IF NEWVALUE.(0:1) <<BIT 0 SET>> THEN               <<04.RO>>48470000
               IF (NAMELEN=3) AND PARMSP="JCW"                 <<04.RO>>48480000
                  OR PARMSP="@" THEN                           <<04.RO>>48490000
               BEGIN                                           <<01893>>48500000
               << IF :SETJCW IS EXECUTED PROGRAMMATICALLY, >>  <<01893>>48510000
               << DON'T BOTHER WITH ANY ERROR MESSAGES.    >>  <<01893>>48520000
                  IF JOBSESSIONMAIN THEN                       <<01893>>48530000
                  BEGIN                                        <<01893>>48540000
                  << WARNING ABOUT POSSIBLE FLUSHING OF UDC. >><<01893>>48550000
                     IF CIS'UDC4.CIS'NESTLEVEL <> 0 THEN       << I.A >>48560000
                        CIERR( ERRNUM := -SETJCWFATINUDC );    <<04787>>48570000
                                                               <<01893>>48580000
                  << WARNING ABOUT POSSIBLE JOB FLUSHING. >>   <<01893>>48590000
                     PXGLOBAL;                                 <<06580>>48600000
                     INTERACTIVE := PXG'INTERACTIVE;           <<06580>>48610000
                     IF NOT INTERACTIVE THEN                   <<01893>>48620000
                        CIERR( ERRNUM := -SETJCWFATINJOB );    <<04787>>48630000
                                                               <<01893>>48640000
                  END;                                         <<01893>>48650000
                                                               <<01893>>48660000
               << KILL JOB IF APPROPRIATE.           >>        <<01893>>48670000
                                                               <<01893>>48680000
                   CIERR;                                      <<01893>>48690000
                END;                                           <<01893>>48700000
            CIERR(ERRNUM := SETJCWNAME2LONG, PARMSP);          <<01893>>48710000
            CIERR(ERRNUM := SETJCWNAMENOALP, PARMSP);          <<U.RAO>>48720000
            CIERR(ERRNUM := JCWTABOVERFLOW, PARMSP);           <<U.RAO>>48730000
            CIERR(ERRNUM := SETJCWNAMERESV,PARMSP);            <<04688>>48740000
            CIERR(ERRNUM := 1726);                             << 8146>>48750000
         END;                                                  <<U.RAO>>48760000
      END;                                                     <<U.RAO>>48770000
   END;                                                        <<U.RAO>>48780000
END;   <<PROCEDURE CXSETJCW>>                                  <<U.RAO>>48790000
PROCEDURE CXSHOWJCW EXECUTORHEAD;                              <<U.RAO>>48800000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>48810000
<<SYNTAX     SHOWJCW [<jcwname>]    >>                         <<U.RAO>>48820000
BEGIN                                                          <<U.RAO>>48830000
INTEGER NAMELEN;   <<LENGTH OF JCW NAME>>                      <<U.RAO>>48840000
INTEGER JDTDST;   <<HOLDS DST NUMBER OF JDT>>                  <<U.RAO>>48850000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>48860000
INTEGER PCBGLOBLOC;                                            <<06580>>48870000
EQUATE JJCWADR = 5;                                            <<U.RAO>>48880000
DOUBLE JCWTABLIMITS;                                           <<U.RAO>>48890000
INTEGER NEXTJCWADR = JCWTABLIMITS;  <<LOWER BOUND OF JCW TABLE><<U.RAO>>48900000
INTEGER JCWTABEND = JCWTABLIMITS+1; <<UPPER BOUND OF JCW TABLE><<U.RAO>>48910000
INTEGER ARRAY CANDIDATEW(0:128);                               <<U.RAO>>48920000
BYTE ARRAY CANDIDATE(*) = CANDIDATEW;                          <<U.RAO>>48930000
INTEGER ERROR;  <<FOR CALL TO FINDJCW>>                        <<U.RAO>>48940000
INTEGER JCWGROUP;  <<NEED TO ACCOUNT FOR OK, WARN, ETC.>>      <<U.RAO>>48950000
INTEGER DUMMY1,DUMMY2; << As name implies, just dummies. >>    << 8146>>48960000
INTEGER ERR; << Used with TRANSJCWEQUATE. >>                   << 8146>>48970000
BYTE ARRAY JCWRESERVED(0:19);                                  << 8146>>48980000
INTEGER JCWVALUE;                 <<ACTUAL JCWVALUE PART>>     <<U.RAO>>48990000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>49000000
                                                               <<U.RAO>>49010000
MOVE JCWRESERVED := ("SYSTEM RESERVED JCW",0);                 << 8146>>49020000
PXGLOBAL;                                                      <<06580>>49030000
<<FIRST CHECK FOR PARM>>                                       <<U.RAO>>49040000
SCAN PARMSP WHILE %6440,1;  <<SKIP ANY LEADING BLANKS>>        <<U.RAO>>49050000
@PARMSP := TOS;                                                <<U.RAO>>49060000
IF NOCARRY THEN   <<SOMETHING ELSE BEFORE CR>>                 <<U.RAO>>49070000
   BEGIN                                                       <<U.RAO>>49080000
   PARMNUM := 1;                                               <<U.RAO>>49090000
   MOVE PARMSP := PARMSP WHILE AN,1;  <<TO GET NAME LENGTH>>   <<U.RAO>>49100000
   NAMELEN := TOS-@PARMSP;                                     <<U.RAO>>49110000
   IF NAMELEN > 255 THEN                                       <<U.RAO>>49120000
      CIERR(ERRNUM := SETJCWNAME2LONG, PARMSP)                 <<U.RAO>>49130000
   ELSE  <<NAME IS LEGAL LENGTH>>                              <<U.RAO>>49140000
      BEGIN   <<TRY TO GET IT>>                                <<U.RAO>>49150000
      MOVE CANDIDATE := PARMSP WHILE ANS,0;                    <<U.RAO>>49160000
      SCAN * WHILE %6440,1;  <<LOOK FOR EXTRANEOUS DATA>>      <<U.RAO>>49170000
      IF NOCARRY THEN   <<IS SOME EXTRANEOUS PARM, WARN>>      <<U.RAO>>49180000
         BEGIN                                                 <<U.RAO>>49190000
         TOS := ERRNUM := -SHOWJCW2MP;                         <<U.RAO>>49200000
         ASSEMBLE(XCH);                                        <<U.RAO>>49210000
         CIERR(*,*);                                           <<U.RAO>>49220000
         END;                                                  <<U.RAO>>49230000
      CANDIDATE(NAMELEN) := 0;  <<END OF NAME STOPPER>>        <<U.RAO>>49240000
      FINDJCW(CANDIDATE, JCWVALUE, ERROR);                     <<U.RAO>>49250000
      << This fix is to support the new System Reserved     >> << 8146>>49260000
      << JCW's.  If the users specifies a System Reserved   >> << 8146>>49270000
      << JCW name in SHOWJCW, then we will print it with the>> << 8146>>49280000
      << value, but we must also tell him that it is        >> << 8146>>49290000
      << reserved to avoid confusion.  Therefore, to do this>> << 8146>>49300000
      << without changing the externals we will call        >> << 8146>>49310000
      << TRANJCWEQUATE which will (among other things)      >> << 8146>>49320000
      << return a 0 if it is a System Reserved JCW.         >> << 8146>>49330000
                                                               << 8146>>49340000
      JCWGROUP := JCWVALUE.(0:2);  <<EXTRACT TYPE FIELD>>      <<U.RAO>>49350000
      JCWVALUE := JCWVALUE.(2:14);  <<MODIFIER FIELD>>         <<U.RAO>>49360000
      TRANSJCWEQUATE(CANDIDATE,DUMMY1,ERR,DUMMY2);             << 8146>>49370000
      IF ERR = 0 THEN                                          << 8146>>49380000
      BEGIN  << System Reserved JCW. >>                        << 8146>>49390000
        GENMSG(CIGENERALMSGSET,SHOWJCWMSG+JCWGROUP,            << 8146>>49400000
               %01000,@CANDIDATE,JCWVALUE,@JCWRESERVED);       << 8146>>49410000
      END                                                      << 8146>>49420000
      ELSE                                                     << 8146>>49430000
      BEGIN                                                    << 8146>>49440000
      CASE *ERROR OF                                           <<U.RAO>>49450000
         BEGIN                                                 <<U.RAO>>49460000
            GENMSG(CIGENERALMSGSET, SHOWJCWMSG+JCWGROUP,       <<U.RAO>>49470000
                     %01000, @CANDIDATE, JCWVALUE);            <<U.RAO>>49480000
            ;  <<NAME > 255 CHAR CAN'T HAPPEN>>                <<U.RAO>>49490000
            CIERR(ERRNUM := SETJCWNAMENOALP, PARMSP);          <<U.RAO>>49500000
            CIERR(ERRNUM := SHOWJCWNOSCHJCW, PARMSP);          <<U.RAO>>49510000
         END;                                                  <<U.RAO>>49520000
      END;                                                     << 8146>>49530000
      END;                                                     <<U.RAO>>49540000
   END                                                         <<U.RAO>>49550000
ELSE   <<NO PARAMETERS, LIST ALL JCWS>>                        <<U.RAO>>49560000
   BEGIN                                                       <<U.RAO>>49570000
   <<FIRST GET BOUNDS ON TABLE>>                               <<U.RAO>>49580000
   JDTDST := PXG'JDTDST;                                       <<06580>>49590000
   MOVEFROMDSEG(@JCWTABLIMITS, JDTDST, JJCWADR, 2);            <<U.RAO>>49600000
   <<NOW LOOP THROUGH JCW TABLE, PRINTING ENTRIES>>            <<U.RAO>>49610000
   WHILE NEXTJCWADR < JCWTABEND DO                             <<U.RAO>>49620000
      BEGIN                                                    <<U.RAO>>49630000
      <<FIRST GET NEXT ENTRY IN FROM TABLE.>>                  <<U.RAO>>49640000
      TOS := @CANDIDATEW;                                      <<U.RAO>>49650000
      TOS := JDTDST;                                           <<U.RAO>>49660000
      TOS := NEXTJCWADR;                                       <<U.RAO>>49670000
      <<LENGTH TO READ IS MIN OF 129 OR THE SPACE LEFT IN TABLE<<U.RAO>>49680000
      IF JCWTABEND-NEXTJCWADR > 129 THEN                       <<U.RAO>>49690000
         TOS := 129                                            <<U.RAO>>49700000
      ELSE  <<TABLE HAS LESS THAN 129 WORDS LEFT IN IT>>       <<U.RAO>>49710000
         TOS := JCWTABEND-NEXTJCWADR;                          <<U.RAO>>49720000
      ASSEMBLE(MFDS);  <<GET ITEM IN>>                         <<U.RAO>>49730000
      <<NOW HAVE NEXT CANDIDATE IN LOCAL ARRAY, PREP FOR MESSAG<<U.RAO>>49740000
      JCWVALUE := CANDIDATEW(CANDIDATE&LSR(1)+1);              <<U.RAO>>49750000
      JCWGROUP := JCWVALUE.(0:2);  <<GET TYPE FIELD>>          <<U.RAO>>49760000
      JCWVALUE := JCWVALUE.(2:14);  <<ISOLATE MODIFIER PART>>           49770000
      CANDIDATE(CANDIDATE+1) := 0;  <<STOPPER FOR GENMSG>>     <<U.RAO>>49780000
      <<FINALLY PRINT MESSAGE>>                                <<U.RAO>>49790000
      GENMSG(CIGENERALMSGSET, SHOWJCWMSG+JCWGROUP,             <<U.RAO>>49800000
             %01000, @CANDIDATE(1), JCWVALUE);                 <<U.RAO>>49810000
      NEXTJCWADR := NEXTJCWADR+INTEGER(CANDIDATE)&LSR(1)+2;    <<U.RAO>>49820000
      IF REQUESTSERVICE THEN NEXTJCWADR := JCWTABEND;          <<U.RAO>>49830000
      END;                                                     <<U.RAO>>49840000
   END;                                                        <<U.RAO>>49850000
END;   <<PROCEDURE SHOWJCW>>                                   <<U.RAO>>49860000
$PAGE "MISCELLANEOUS COMMANDS, THIRD BLOCK"                    <<08.RO>>49870000
PROCEDURE CXCOMMENT EXECUTORHEAD;                              <<U.RAO>>49880000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>49890000
      BEGIN                                                             49900000
      <<NOP PROCEDURE...COMMENT ALREADY LISTED BY GETIMAGE>>            49910000
      END;                                                              49920000
$PAGE       "ERROR HANLDERS AND MISC ROUTINES"                          49930000
$CONTROL   SEGMENT  = CIERR                                             49940000
LOGICAL PROCEDURE JOBSESSIONMAIN;                              <<U.RAO>>49950000
   OPTION UNCALLABLE;                                          <<U.RAO>>49960000
COMMENT                                                        <<U.RAO>>49970000
   RETURNS TRUE IF CURRENT PROCESS IS J/S MAIN                 <<U.RAO>>49980000
;                                                              <<U.RAO>>49990000
BEGIN                                                          <<06581>>50000000
LOGICAL PCBPT;                                                 <<06581>>50010000
PCBPT := CURPRC;                                               <<06581>>50020000
IF SPCBPTYPE =PCBJSMAIN THEN JOBSESSIONMAIN := TRUE;           <<06581>>50030000
END; << JOBSESSIONMAIN >>                                      <<06581>>50040000
LOGICAL PROCEDURE CIBADFILENAME(ERRNUM,PARM);                  <<U.RAO>>50050000
VALUE PARM;                                                    <<U.RAO>>50060000
DOUBLE PARM;                                                   <<U.RAO>>50070000
INTEGER ERRNUM;                                                <<U.RAO>>50080000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>50090000
BEGIN                                                          <<U.RAO>>50100000
   <<THIS PROCEDURE IS AN INTERFACE ROUTINE BETWEEN>>          <<U.RAO>>50110000
   <<CHECKFILENAME' AND THOSE ROUTINES WHICH WANT A FILE NAME ><<U.RAO>>50120000
   <<CHECKED AND ANY SYNTACTIC ERRORS REPORTED.  IT ONLY >>    <<U.RAO>>50130000
   <<RETURNS TRUE IF AN ERROR WAS DETECTED AND ONLY RETURNS>>  <<U.RAO>>50140000
   <<FALSE IF THE FILE NAME WAS NOT BAD.  >>                   <<U.RAO>>50150000
   <<ERRNUM IS A POINTER TO THE PARAMETER ERRNUM KNOWN THROUGOU<<U.RAO>>50160000
   <<THE CI.  PARM IS A DOUBLE DESCRIBING THE FILE NAME IN>>   <<U.RAO>>50170000
   <<THE FORMAT RETURNED BY MYCOMMAND.  IN PARTICULAR, THE FIRS<<U.RAO>>50180000
   <<WORD IS THE BYTE ADDRESS OF THE NAME AND THE FIRST BYTE>> <<U.RAO>>50190000
   <<OF THE SECOND WORD IS THE LENGTH OF THE NAME>>            <<U.RAO>>50200000
                                                               <<U.RAO>>50210000
LOGICAL DUMMY;                                                 <<U.RAO>>50220000
BYTE POINTER ERRPTR;                                           <<U.RAO>>50230000
LOGICAL LERRPTR = ERRPTR;                                      <<U.RAO>>50240000
                                                               <<U.RAO>>50250000
TOS := CHECKFILENAME'(PARM&LSR(8), DUMMY, DUMMY, LERRPTR);     <<U.RAO>>50260000
IF < THEN                                                      <<U.RAO>>50270000
   BEGIN                                                       <<U.RAO>>50280000
   ERRNUM := S0;                                               <<U.RAO>>50290000
   CIERR(*,ERRPTR);                                            <<U.RAO>>50300000
   CIBADFILENAME := TRUE;                                      <<U.RAO>>50310000
   END                                                         <<U.RAO>>50320000
ELSE                                                           <<U.RAO>>50330000
   CIBADFILENAME := FALSE;                                     <<U.RAO>>50340000
END;  <<CIBADFILENAME>>                                        <<U.RAO>>50350000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>50360000
VALUE PDEF; DOUBLE PDEF;                                       <<U.RAO>>50370000
LOGICAL GPTR,APTR,ERRPTR;                                      <<U.RAO>>50380000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>50390000
BEGIN                                                          <<U.RAO>>50400000
COMMENT                                                                 50410000
  THIS PROCEDURE DOES A COMPLETE VALIDATION OF THE FORM OF AN           50420000
ACTUAL FILE DESIGNATOR, INCLUDING SPECIAL FILES.                        50430000
                                                                        50440000
PARAMETERS:                                                             50450000
  PDEF - THE FIRST WORD IS A BYTE POINTER TO THE START OF THE           50460000
         ACTUAL FILE DESIGNATOR AND THE SECOND WORD IS A COUNT          50470000
         OF THE NUMBER OF CHARACTERS IN THE NAME,                       50480000
         INCLUDING SPECIAL CHARACTERS IF ANY.  IT IS A DOUBLE           50490000
         BECAUSE THAT IS THE MOST CONVENIENT FORM FOR ROUTINES WHICH    50500000
         HAVE THEIR PARAMETERS PARSED BY MYCOMMAND.                     50510000
  GPTR - IF A REASONABLY VALID GROUP NAME IS PARSED, A BYTE POINTER     50520000
         TO THE START OF THAT NAME IS PASSED THROUGH THIS LOGICAL       50530000
         BY REFERENCE.  IF NO VALID GROUP NAME IS FOUND, THIS IS        50540000
         UNCHANGED.                                                     50550000
  APTR - AN ACCOUNT POINTER SIMILAR TO THE GPTR.                        50560000
  ERRPTR - A MEANS BY WHICH THIS PROCEDURE MAY RETURN A POINTER TO      50570000
           ANY ERROR FOUND IN THE BODY OF THE NAME.                     50580000
  CHECKFILENAME' - SEE CONDITION CODE FOR INTERPRETATION.               50590000
  CONDITION CODE:                                                       50600000
     CCE => FOUND NORMAL ACTUAL FILE DESIGNATOR, NO ERRORS, RETURNS     50610000
            A 0.                                                        50620000
     CCL => FOUND ERROR.  CHECKFILENAME' IS THE CIERROR NUMBER.         50630000
     CCG => NO ERRORS. FOUND BACKREFERENCED FILE NAME OR SYSTEM         50640000
            DEFINED FILE NAME.  IF CHECKFILENAME' = 0, THEN IS          50650000
            BACKREFERENCED FILE NAME. IF <> 0 THEN IS INDEX OF          50660000
            SYSTEM DEFINED FILE NAME, AS DEFINED IN THE DEFAULT         50670000
            DESIGNATOR FIELD OF THE FOPTION WORD IN FOPEN.              50680000
                                                                        50690000
ALGORITHM - THE SCHEME IS TO SIMPLY CRUNCH THROUGH, LOOKING AT EACH     50700000
         PART AS WE COME TO IT.                                         50710000
                                                               <<04849>>50720000
                                                               <<04849>>50730000
The entry point, "CHK'DESCRIBE'FNAME", was added to show       <<04849>>50740000
which options where present in the file name.  If an error     <<04849>>50750000
is found, CCL is returned as before.  If a regular file        <<04849>>50760000
or a system file was correctly specified, then the top         <<04849>>50770000
eight bits indicate what was specified--for CCE (file name     <<04849>>50780000
specified), the top three bits have the meanings listed        <<04849>>50790000
below.  For CCG (back-referenced file name), the top three     <<04849>>50800000
bits have the same meaning.  For CCG (system file name),       <<04849>>50810000
the lower eight bits indicate which system file was            <<04849>>50820000
specifed, and the upper eight bits will be zero.               <<04849>>50830000
                                                               <<04849>>50840000
     CHK'DESCRIBE'FNAME.(0:1) - lockword present,              <<04849>>50850000
     CHK'DESCRIBE'FNAME.(1:1) - group name present, and        <<04849>>50860000
     CHK'DESCRIBE'FNAME.(2:1) - account name present.          <<04849>>50870000
                                                               <<04849>>50880000
;                                                                       50890000
                                                               <<U.RAO>>50900000
INTEGER RESULTSPACE=CHECKFILENAME';                            <<U.RAO>>50910000
BYTE POINTER PARMPTR = PDEF;  <<POINTER TO CURRENT LOCATION IN NAME>>   50920000
INTEGER LENGTH = PDEF+1;                                       <<U.RAO>>50930000
BYTE ARRAY PSYSDEFLIST(0:1)=PB :=                              <<U.RAO>>50940000
  10, 8, "$STDLIST",                                           <<U.RAO>>50950000
  10, 8, "$NEWPASS",                                           <<U.RAO>>50960000
  10, 8, "$OLDPASS",                                           <<U.RAO>>50970000
   8, 6, "$STDIN",                                             <<U.RAO>>50980000
   9, 7, "$STDINX",                                            <<U.RAO>>50990000
   7, 5, "$NULL",                                              <<U.RAO>>51000000
   0;                                                          <<U.RAO>>51010000
EQUATE PSYSDEFLISTL = 55;                                      <<U.RAO>>51020000
BYTE ARRAY SYSDEFLIST(0:PSYSDEFLISTL-1);                       <<U.RAO>>51030000
LOGICAL LOCKWORD := FALSE;                                     <<U.RAO>>51040000
INTEGER TEMPLEN;                                               <<U.RAO>>51050000
                                                               <<U.RAO>>51060000
EQUATE EXPECTALPHA = 1,                                        <<U.RAO>>51070000
       NAMEMISSING = 2,                                        <<U.RAO>>51080000
       NAMETOOLONG = 3;                                        <<U.RAO>>51090000
                                                               <<04849>>51100000
<< Declarations used by the entry point, CHK'DESCRIBE'FNAME. >><<04849>>51110000
   ENTRY                                                       <<04849>>51120000
      CHK'DESCRIBE'FNAME;                                      <<04849>>51130000
                                                               <<04849>>51140000
   LOGICAL                                                     <<04849>>51150000
      DESCRIBEIT         := FALSE;                             <<04844>>51160000
                                                               <<04844>>51170000
   INTEGER                                                     <<04844>>51180000
      RETURNVAL          := 0;                                 <<04844>>51190000
                                                               <<04849>>51200000
   DEFINE                                                      <<04849>>51210000
      GOTLOCK         = RETURNVAL.(0:1) #,                     <<04849>>51220000
      GOTGROUP        = RETURNVAL.(1:1) #,                     <<04849>>51230000
      GOTACCT         = RETURNVAL.(2:1) #;                     <<04849>>51240000
                                                               <<04849>>51250000
                                                               <<04849>>51260000
                                                               <<U.RAO>>51270000
LOGICAL SUBROUTINE CHECKNAME(DELTA);                           <<U.RAO>>51280000
<<GENERAL PURPOSE NAME CHECKER>>                               <<U.RAO>>51290000
VALUE DELTA;INTEGER DELTA;                                     <<U.RAO>>51300000
                                                               <<U.RAO>>51310000
BEGIN                                                          <<U.RAO>>51320000
CHECKNAME := FALSE;                                            <<U.RAO>>51330000
@PARMPTR := @PARMPTR+1;  <<ELIMINATE DELIMITER>>               <<U.RAO>>51340000
ERRPTR := ERRPTR+1;                                            <<U.RAO>>51350000
LENGTH := LENGTH-1;                                            <<U.RAO>>51360000
IF = THEN                                                      <<U.RAO>>51370000
   BEGIN                                                       <<U.RAO>>51380000
   CC := CCL;  <<SET ERROR INDICATION>>                        <<U.RAO>>51390000
   CHECKFILENAME' := NAMEMISSING+DELTA                         <<U.RAO>>51400000
   END                                                         <<U.RAO>>51410000
ELSE IF PARMPTR <> ALPHA THEN                                  <<U.RAO>>51420000
   BEGIN                                                       <<U.RAO>>51430000
   CC := CCL;  <<SET ERROR INDICATION>>                        <<U.RAO>>51440000
   CHECKFILENAME' := EXPECTALPHA+DELTA                         <<U.RAO>>51450000
   END                                                         <<U.RAO>>51460000
ELSE                                                           <<U.RAO>>51470000
   BEGIN                                                       <<U.RAO>>51480000
   MOVE PARMPTR := PARMPTR WHILE ANS, 0;                       <<U.RAO>>51490000
   TEMPLEN := TOS-@PARMPTR;                                    <<U.RAO>>51500000
   IF = THEN                                                   <<U.RAO>>51510000
      BEGIN                                                    <<U.RAO>>51520000
      DEL;                                                     <<U.RAO>>51530000
      CHECKFILENAME' := NAMEMISSING+DELTA;                     <<U.RAO>>51540000
      CC := CCL;  <<SET ERROR INDICATION>>                     <<U.RAO>>51550000
      END                                                      <<U.RAO>>51560000
   ELSE IF TEMPLEN > 8 THEN                                    <<U.RAO>>51570000
      BEGIN                                                    <<U.RAO>>51580000
      DEL;                                                     <<U.RAO>>51590000
      CHECKFILENAME' := NAMETOOLONG+DELTA;                     <<U.RAO>>51600000
      CC := CCL;  <<SET ERROR INDICATION>>                     <<U.RAO>>51610000
      END                                                      <<U.RAO>>51620000
   ELSE  <<NAME OK>>                                           <<U.RAO>>51630000
      BEGIN                                                    <<U.RAO>>51640000
      @PARMPTR := S0;                                          <<U.RAO>>51650000
      ERRPTR := TOS;  <<FIXUP FOR NEXT ROUND>>                 <<U.RAO>>51660000
      CHECKNAME := TRUE;                                       <<U.RAO>>51670000
      END;                                                     <<U.RAO>>51680000
   END;                                                        <<U.RAO>>51690000
END;  <<SUBROUTINE CHECKNAME>>                                 <<U.RAO>>51700000
<< Start of Main Code.                                       >><<04849>>51710000
                                                               <<04849>>51720000
GOTO PARSEIT;                                                  <<04849>>51730000
                                                               <<04849>>51740000
CHK'DESCRIBE'FNAME:                                            <<04849>>51750000
   DESCRIBEIT := TRUE;                                         <<04849>>51760000
                                                               <<04849>>51770000
                                                               <<04849>>51780000
PARSEIT:                                                       <<04849>>51790000
                                                               <<04849>>51800000
ERRPTR := @PARMPTR;                                            <<U.RAO>>51810000
CHECKFILENAME' := 0;                                           <<U.RAO>>51820000
CC := CCE;  <<ASSUME NORMAL FILE NAME>>                        <<U.RAO>>51830000
IF LENGTH = 0 THEN                                             <<U.RAO>>51840000
   BEGIN                                                       <<U.RAO>>51850000
   CC := CCL;                                                  <<U.RAO>>51860000
   CHECKFILENAME' := FILENAMEMISSING                           <<U.RAO>>51870000
   END                                                         <<U.RAO>>51880000
ELSE IF PARMPTR = "$" THEN  <<SYSTEM DEFINED FILE>>            <<U.RAO>>51890000
   BEGIN                                                       <<U.RAO>>51900000
   CC := CCG;  <<SET SYSTEM DEFINED FILE>>                     <<U.RAO>>51910000
   MOVE SYSDEFLIST := PSYSDEFLIST,(PSYSDEFLISTL);              <<U.RAO>>51920000
   CHECKFILENAME' :=  SEARCH(PARMPTR,LENGTH,SYSDEFLIST);       <<U.RAO>>51930000
   IF RESULTSPACE = 0 THEN                                     <<U.RAO>>51940000
      BEGIN                                                    <<U.RAO>>51950000
      CC := CCL;  <<SEARCH FAILED>>                            <<U.RAO>>51960000
      CHECKFILENAME' := UNKNOWNSYSDEF;                         <<U.RAO>>51970000
      END;                                                     <<U.RAO>>51980000
   END                                                         <<U.RAO>>51990000
ELSE                                                           <<U.RAO>>52000000
   BEGIN                                                       <<U.RAO>>52010000
   IF PARMPTR <> "*" THEN  <<NOT BACK REFERENCED FILE>>        <<U.RAO>>52020000
      BEGIN  <<MUST FAKE DELIMITER>>                           <<U.RAO>>52030000
      @PARMPTR := @PARMPTR-1;                                  <<U.RAO>>52040000
      ERRPTR := ERRPTR-1;                                      <<U.RAO>>52050000
      LENGTH := LENGTH+1;                                      <<U.RAO>>52060000
      END                                                      <<U.RAO>>52070000
   ELSE                                                        <<U.RAO>>52080000
      CC := CCG;                                               <<U.RAO>>52090000
   << FIRST CHORE IS TO CHECK FILE NAME>>                      <<U.RAO>>52100000
   IF NOT CHECKNAME(FFNAMEBASE) THEN RETURN;                   <<U.RAO>>52110000
   LENGTH := LENGTH-TEMPLEN;                                   <<U.RAO>>52120000
   IF = THEN GOTO OUTL;  << Entire name okay. >>               <<04849>>52130000
   IF PARMPTR = "/" THEN  <<LOCKWORD?>>                        <<U.RAO>>52140000
      BEGIN                                                    <<U.RAO>>52150000
      IF NOT CHECKNAME(FLWORDBASE) THEN RETURN;  <<BAD LOCKWORD<<U.RAO>>52160000
      GOTLOCK := 1;                                            <<04849>>52170000
      LOCKWORD := TRUE;                                        <<04849>>52180000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>52190000
      IF = THEN GOTO OUTL;                                     <<04849>>52200000
      END;                                                     <<U.RAO>>52210000
   <<CHECK GROUP NAME>>                                        <<U.RAO>>52220000
   IF PARMPTR = "." THEN  <<GROUP NAME>>                       <<U.RAO>>52230000
      BEGIN                                                    <<U.RAO>>52240000
      GPTR := @PARMPTR+1;                                      <<U.RAO>>52250000
      IF NOT CHECKNAME(FGNAMEBASE) THEN RETURN;                <<U.RAO>>52260000
      GOTGROUP := 1;                                           <<04849>>52270000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>52280000
      IF = THEN GOTO OUTL;                                     <<04849>>52290000
      END                                                      <<U.RAO>>52300000
   ELSE  <<SOME OTHER SPECIAL CHARACTER>>                      <<U.RAO>>52310000
      BEGIN                                                    <<U.RAO>>52320000
      CC := CCL;                                               <<U.RAO>>52330000
      IF LOCKWORD THEN CHECKFILENAME' := EXPECTPERIOD          <<U.RAO>>52340000
      ELSE CHECKFILENAME' := XPCTPERIODSLASH;                  <<U.RAO>>52350000
      RETURN                                                   <<U.RAO>>52360000
      END;                                                     <<U.RAO>>52370000
   IF PARMPTR = "." THEN  <<POSSIBLE ACCOUNT NAME>>            <<U.RAO>>52380000
      BEGIN                                                    <<U.RAO>>52390000
      APTR := @PARMPTR+1;                                      <<U.RAO>>52400000
      IF NOT CHECKNAME(FANAMEBASE) THEN RETURN;                <<U.RAO>>52410000
      GOTACCT := 1;                                            <<04849>>52420000
      LENGTH := LENGTH-TEMPLEN;                                <<U.RAO>>52430000
      IF = THEN GOTO OUTL;                                     <<04849>>52440000
      END                                                      <<U.RAO>>52450000
   ELSE  <<SOME OTHER SPECIAL CHARACTER>>                      <<U.RAO>>52460000
      BEGIN                                                    <<U.RAO>>52470000
      CC := CCL;                                               <<U.RAO>>52480000
      CHECKFILENAME' := EXPECTPERIOD;                          <<U.RAO>>52490000
      RETURN                                                   <<U.RAO>>52500000
      END;                                                     <<U.RAO>>52510000
   CHECKFILENAME' := EXTRANEOUSADESG;                          <<U.RAO>>52520000
   CC := CCL;  <<FAILED IF WE GOT TO HERE>>                    <<U.RAO>>52530000
   END;                                                        <<U.RAO>>52540000
                                                               <<04849>>52550000
OUTL:                                                          <<04849>>52560000
                                                               <<04849>>52570000
   IF DESCRIBEIT LAND (CC<>CCL)                                <<04844>>52580000
      THEN RESULTSPACE.(0:8) := RETURNVAL.(0:8);               <<04844>>52590000
   RETURN;                                                     <<04849>>52600000
                                                               <<04849>>52610000
END;  <<CHECKFILENAME'>>                                       <<U.RAO>>52620000
<< Returns values from specified stack marker. >>              <<04193>>52630000
                                                               <<04193>>52640000
PROCEDURE STACKMARK( WHICH, DELQ, STAT, RELP, XREG );          <<04193>>52650000
   VALUE   WHICH;                                              <<04193>>52660000
   INTEGER WHICH, DELQ, STAT, RELP, XREG;                      <<04193>>52670000
   OPTION VARIABLE, UNCALLABLE, PRIVILEGED;                    <<04193>>52680000
BEGIN                                                          <<04193>>52690000
                                                               <<04193>>52700000
<<*********************************************************>>  <<04193>>52710000
<<                                                         >>  <<04193>>52720000
<< This procedure traces back the caller's stack to the    >>  <<04193>>52730000
<< stack marker specified by WHICH--note that the call to  >>  <<04193>>52740000
<< this procedure is not counted; thus, if a procedure     >>  <<04193>>52750000
<< wants the previous stack marker, it should call this    >>  <<04193>>52760000
<< procedure with a value of 1 for WHICH.  This procedure  >>  <<04193>>52770000
<< will return the values stored in the specified marker.  >>  <<04193>>52780000
<<                                                         >>  <<04193>>52790000
<<    Since it is easy to get confused about how many      >>  <<04193>>52800000
<< stack markers back are traveled, please examine the     >>  <<04193>>52810000
<< following example.  Suppose CXLISTF calls CIERR and     >>  <<04193>>52820000
<< CIERR then calls PRINTCICARET; further suppose that     >>  << 8560>>52830000
<< PRINTCICARET wishes the STATUS and RELATIVE-P that      >>  << 8560>>52840000
<< indicates that CIERR was called by CXLISTF (i.e. the    >>  <<04193>>52850000
<< STATUS and RELATIVE-P should point into the system      >>  <<04193>>52860000
<< segment that contains CXLISTF).  While in PRINTCICARET, >>  << 8560>>52870000
<< the stack would look like this:                         >>  <<04193>>52880000
<<                                                         >>  <<04193>>52890000
<<    |                     |                              >>  <<04193>>52900000
<<    |  CXLISTF work area  |                              >>  <<04193>>52910000
<<    |                     |                              >>  <<04193>>52920000
<<    |---------------------|                              >>  <<04193>>52930000
<<    |                     |  Stack marker for CXLISTF.   >>  <<04193>>52940000
<<    |---------------------|                              >>  <<04193>>52950000
<<    |  CIERR work area    |                              >>  <<04193>>52960000
<<    |---------------------|                              >>  <<04193>>52970000
<<    |                     |  Stack marker for CIERR.     >>  <<04193>>52980000
<<    |---------------------|                              >>  <<04193>>52990000
<<    |  PRINTCICARET work  |  <--Q+1                      >>  << 8560>>53000000
<<    |       area          |                              >>  <<04193>>53010000
<<    |                     |                              >>  <<04193>>53020000
<<                                                         >>  <<04193>>53030000
<< While in PRINTCICARET, a call to STACK'MARK( 0, ...);   >>  << 8560>>53040000
<< would return values from the stack marker for CIERR.    >>  <<04193>>53050000
<< Therefore, in this example, PRINTCICARET will need a call >><< 8560>>53060000
<< of the form STACK'MARK( 1, ... ); in order to determine >>  <<04193>>53070000
<< that it was CXLISTF that called CIERR.                  >>  <<04193>>53080000
<<                                                         >>  <<04193>>53090000
<<    If the above example seems wrong and you feel that   >>  <<04193>>53100000
<< we should travel back 2 markers to get the desired      >>  <<04193>>53110000
<< information, please pretend that we are doing zero      >>  <<04193>>53120000
<< origin indexing.                                        >>  <<04193>>53130000
<<                                                         >>  <<04193>>53140000
<<                                                         >>  <<04193>>53150000
<< Parameters:                                             >>  <<04193>>53160000
<<    WHICH:  (required) specified how many stack markers  >>  <<04193>>53170000
<<            back from the caller to travel.              >>  <<04193>>53180000
<<    DELQ:   (optional) if there, gets the delta-Q value  >>  <<04193>>53190000
<<            of the specified marker.                     >>  <<04193>>53200000
<<    STAT:   (optional) if there, gets the status word    >>  <<04193>>53210000
<<            of the specified marker.                     >>  <<04193>>53220000
<<    RELP:   (optional) if there, gets the relative P     >>  <<04193>>53230000
<<            value of the specified marker.               >>  <<04193>>53240000
<<    XREG:   (optional) if there, gets the X register     >>  <<04193>>53250000
<<            value of the specified marker.               >>  <<04193>>53260000
<<                                                         >>  <<04193>>53270000
<< Condition code:  This procedure returns CCE if it was   >>  <<04193>>53280000
<<    able to access the specified marker.  It returns CCL >>  <<04193>>53290000
<<    if WHICH is less than -1 or if the procedure goes    >>  <<04193>>53300000
<<    past the stack's initial-Q value in the search for   >>  <<04193>>53310000
<<    the specified marker.                                >>  <<04193>>53320000
<<                                                         >>  <<04193>>53330000
<<*********************************************************>>  <<04193>>53340000
                                                               <<04193>>53350000
LOGICAL  PMASK  = Q-4;   << Parameter mask for variable    >>  <<04193>>53360000
                         <<    procedure option.           >>  <<04193>>53370000
DEFINE                                                         <<04193>>53380000
   WANTS'XREG  = PMASK.(15:1)#,   << These defines deter-  >>  <<04193>>53390000
   WANTS'RELP  = PMASK.(14:1)#,   << mine which parameters >>  <<04193>>53400000
   WANTS'STAT  = PMASK.(13:1)#,   << were present in the   >>  <<04193>>53410000
   WANTS'DELQ  = PMASK.(12:1)#,   << procedure call.       >>  <<04193>>53420000
   WHICH'MISSING  = ( NOT PMASK.(11:1) )#;                     <<04193>>53430000
                                                               <<04193>>53440000
INTEGER POINTER QINDEX;  << For referencing the markers.   >>  <<04193>>53450000
                                                               <<04193>>53460000
INTEGER I := -1;         << Counts stack markers.          >>  <<04193>>53470000
                                                               <<04193>>53480000
INTEGER INITQ;           << This stack's initial Q value.  >>  <<04193>>53490000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>53500000
INTEGER PXFIXEDLOC;                                            <<06580>>53510000
                                                               <<04193>>53520000
INTEGER IX = X;          << The index register is used in  >>  <<04193>>53530000
                         << the global defines needed to   >>  <<04193>>53540000
                         << determine this stack's INITQ.  >>  <<04193>>53550000
                                                               <<04193>>53560000
                                                               <<04193>>53570000
<< Start of STACKMARK's code.                              >>  <<04193>>53580000
                                                               <<04193>>53590000
<< Initialize.  Assume successful completion.              >>  <<04193>>53600000
   CC := CCE;                                                  <<04193>>53610000
   PXFIXED;                                                    <<06580>>53620000
   INITQ := PXFXQREG;                                          <<06580>>53630000
                                                               <<04193>>53640000
<< Check on WHICH.  If not present or out of bounds, then  >>  <<04193>>53650000
<<    produce an error return.                             >>  <<04193>>53660000
   IF WHICH'MISSING  OR  WHICH < -1 THEN                       <<04193>>53670000
   BEGIN                                                       <<04193>>53680000
      CC := CCL;                                               <<04193>>53690000
      RETURN;                                                  <<04193>>53700000
   END;                                                        <<04193>>53710000
                                                               <<04193>>53720000
<< Starting from STACK'MARKER's Q, trace back WHICH+1      >>  <<04193>>53730000
<<    stack markers if possible.  Recall that WHICH is     >>  <<04193>>53740000
<<    relative to this procedure's caller, thus WHICH+1.   >>  <<04193>>53750000
<<    This is performed because I is initialized to -1.    >>  <<04193>>53760000
   @QINDEX := @DELTAQ;           << STACK'MARKER's marker. >>  <<04193>>53770000
   WHILE @QINDEX <> INITQ  AND  I < WHICH DO                   <<04193>>53780000
   BEGIN                                                       <<04193>>53790000
      @QINDEX := @QINDEX - QINDEX;                             <<04193>>53800000
      I := I + 1;                                              <<04193>>53810000
   END;                                                        <<04193>>53820000
                                                               <<04193>>53830000
<< Check for falling off the stack.                        >>  <<04193>>53840000
   IF @QINDEX = INITQ                                          <<04193>>53850000
      THEN CC := CCL         << Fell off the stack.        >>  <<04193>>53860000
   ELSE                                                        <<04193>>53870000
   BEGIN                                                       <<04193>>53880000
                                                               <<04193>>53890000
   << Found the right stack.  Return the requested values. >>  <<04193>>53900000
      IF WANTS'DELQ  THEN DELQ := QINDEX;                      <<04193>>53910000
      IF WANTS'STAT  THEN STAT := QINDEX(-1);                  <<04193>>53920000
      IF WANTS'RELP  THEN RELP := QINDEX(-2);                  <<04193>>53930000
      IF WANTS'XREG  THEN XREG := QINDEX(-3);                  <<04193>>53940000
                                                               <<04193>>53950000
   END;                                                        <<04193>>53960000
                                                               <<04193>>53970000
END;  << STACKMARK >>                                          <<04193>>53980000
                                                               <<04193>>53990000
                                                               <<04193>>54000000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<U.RAO>>54010000
VALUE FNUM;                                                    <<U.RAO>>54020000
INTEGER FNUM,PARMNUM;                                          <<U.RAO>>54030000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>54040000
<<GENERATES FILESYS ERROR MESSAGE, RETURNS FCHECK #>>          <<U.RAO>>54050000
BEGIN                                                          <<U.RAO>>54060000
FCHECK(FNUM,PARMNUM);                                          <<U.RAO>>54070000
IF NOT (0<=FNUM<=2) THEN                                       <<U.RAO>>54080000
   FCLOSE(FNUM, -1, 0);                                        <<U.RAO>>54090000
IF JOBSESSIONMAIN THEN GENMSG(FSERRORMSGSET, PARMNUM);         <<02.RO>>54100000
END;  <<FERROR'>>                                              <<U.RAO>>54110000
PROCEDURE CXNOTYET EXECUTORHEAD;                                        54120000
   OPTION PRIVILEGED, UNCALLABLE;                                       54130000
   CIERR(ERRNUM:=NOTYETIMPLEMENTED);                                    54140000
$PAGE "SYSTEM INTERNAL ERROR HANDLER"                          <<04193>>54150000
<< Handles generation of System Internal Error messages. >>    <<04193>>54160000
                                                               <<04193>>54170000
PROCEDURE SYSINTERR( ERRN, BACK );                             <<04193>>54180000
   VALUE   ERRN, BACK;                                         <<04193>>54190000
   INTEGER ERRN, BACK;                                         <<04193>>54200000
   OPTION UNCALLABLE, PRIVILEGED;                              <<04193>>54210000
BEGIN                                                          <<04193>>54220000
                                                               <<04193>>54230000
<<*********************************************************>>  <<04193>>54240000
<<                                                         >>  <<04193>>54250000
<< This procedure handles the printing of system internal  >>  <<04193>>54260000
<< errors.  These are error messages for those circum-     >>  <<04193>>54270000
<< stances where a recovery is possible, but we wish to    >>  <<04193>>54280000
<< report the error, anyhow.                               >>  <<04193>>54290000
<<                                                         >>  <<04193>>54300000
<< Parameters:                                             >>  <<04193>>54310000
<<    ERRN:  The message number in the system internal     >>  <<04193>>54320000
<<           error message set.                            >>  <<04193>>54330000
<<    BACK:  If BACK >= -1, then the RELATIVE-P and the    >>  <<04193>>54340000
<<           STATUS value of the indicated stack marker    >>  <<04193>>54350000
<<           are printed.  See the header comment for      >>  <<04193>>54360000
<<           the procedure STACK'MARKER for further        >>  <<04193>>54370000
<<           information on the meaning of this parameter. >>  <<04193>>54380000
<<           Note, however, that this value is relative to >>  <<04193>>54390000
<<           SYSINTERR's caller, thus BACK is incremented  >>  <<04193>>54400000
<<           by one when STACK'MARKER is called.           >>  <<04193>>54410000
<<                                                         >>  <<04193>>54420000
<< Future Enhancements:                                    >>  <<04193>>54430000
<<    In the future, this procedure will be modified to    >>  <<04193>>54440000
<<    also log the occurences of system internal errors.   >>  <<04193>>54450000
<<                                                         >>  <<04193>>54460000
<<*********************************************************>>  <<04193>>54470000
                                                               <<04193>>54480000
INTEGER                                                        <<04193>>54490000
   CALLERSTAT,     << Status register of CIERR caller.>>       <<04193>>54500000
   CALLERSP;       << P offset of CIERR caller.       >>       <<04193>>54510000
                                                               <<04193>>54520000
BYTE ARRAY                                                     <<04193>>54530000
   OUTBUFF(0:21);  << For error msg in bounds viol.   >>       <<04193>>54540000
                                                               <<04193>>54550000
                                                               <<04193>>54560000
                                                               <<04193>>54570000
<< Print the initial error message.                        >>  <<04193>>54580000
   GENMSG( INTRNLERRSET, ERRN, , ,,,,, -2 );                   <<04193>>54590000
                                                               <<04193>>54600000
<< If BACK was specified, print the STATUS and RELATIVE-P  >>  <<04193>>54610000
<<    values of the stack marker indicated.                >>  <<04193>>54620000
   IF BACK >= -1 THEN                                          <<04193>>54630000
   BEGIN                                                       <<04193>>54640000
      STACKMARK( BACK+1, , CALLERSTAT, CALLERSP );             <<04193>>54650000
      IF = THEN     << Was able to find the appropriate >>     <<04193>>54660000
      BEGIN         <<    stack marker.                 >>     <<04193>>54670000
         OUTBUFF := 0;   MOVE OUTBUFF(1) := OUTBUFF, (21);     <<04193>>54680000
         OUTBUFF := "%";                                       <<04193>>54690000
         ASCII( CALLERSTAT, 8, OUTBUFF(1) );                   <<04193>>54700000
         OUTBUFF(11) := "%";                                   <<04193>>54710000
         ASCII( CALLERSP, 8, OUTBUFF(12) );                    <<04193>>54720000
         GENMSG( INTRNLERRSET, STATUS'AND'P, 0,                <<04193>>54730000
                 @OUTBUFF, @OUTBUFF(11), ,,, -2 );             <<04193>>54740000
      END;                                                     <<04193>>54750000
   END;                                                        <<04193>>54760000
                                                               <<04193>>54770000
<< Request that the user send in information so that we    >>  <<04193>>54780000
<<    later examine the cause of the internal error.       >>  <<04193>>54790000
                                                               <<04193>>54800000
   GENMSG( INTRNLERRSET, COPYSCREEN, 0, ,,,,, -2 );            <<04193>>54810000
   RETURN;                                                     <<04193>>54820000
                                                               <<04193>>54830000
END;  << SYSINTERR >>                                          <<04193>>54840000
                                                               <<04193>>54850000
                                                               <<04193>>54860000
PROCEDURE PRINTCICARET(ERRADR);                                << 8560>>54870000
BYTE ARRAY ERRADR;                                             <<01032>>54880000
OPTION UNCALLABLE;                                             << 8560>>54890000
                                                               <<01032>>54900000
BEGIN                                                          <<01032>>54910000
COMMENT                                                        <<01032>>54920000
    THE FOLLOWING ROUTINE PRINTS A CARET UNDER THE ITEM        <<01032>>54930000
    IN ERROR. IF THE COMMAND EXTENDED OVER SEVERAL LINES THEN  <<01032>>54940000
    THE OFFENDING LINE IS PRINTED WITH THE CARET UNDER THE     <<01032>>54950000
    GUILTY CHARACTER, AND A LINE NUMBER RELATIVE TO THE FIRST  <<01032>>54960000
    LINE OF THE COMMAND IS PRINTED OUT.                        <<01032>>54970000
                                                               <<01032>>54980000
    ERRADR - A BYTE POINTER TO THE OFFENDING CHARACTER.        <<01032>>54990000
    BCOMIMAGE - DB RELATIVE ARRAY CONTAINING THE ENTIRE        <<01032>>55000000
                COMMAND TO BE PASSED TO THE CI.                <<01032>>55010000
    LINELENSTACK - A GLOBAL ARRAY CONTAINING THE LENGTHS IN    <<01032>>55020000
                   BYTES OF ORGINAL AND ANY CONSCUTIVE CONTI-  <<01032>>55030000
                   NUATION LINES. THIS ARRAY IS TERMINATED BY  <<01032>>55040000
                   A BINARY ZERO.                              <<01032>>55050000
                                                               <<01032>>55060000
    OPERATION : IF THERE ARE NO CONTINUATION LINES THEN ADJUST <<01032>>55070000
               THE OFFSET WITHIN THE OUTPUT BUFFER AND PRINT   <<01032>>55080000
               IT OUT. OTHERWISE CALCULATE THE OFFSET AND THE  <<01032>>55090000
               LINE NUMBER WHERE THE ERROR OCCURED FORMAT THE  <<01032>>55100000
               LINE NUMBER AND PUT IT TOGETHER WITH THE CONTENT<<01032>>55110000
               OF THE LINE INTO THE OUTPUT BUFFER. IF THE OFFEN<<01032>>55120000
               DING LINE IS THE LAST ONE,DO NOT ECHO IT.       <<01032>>55130000
                                                                        55140000
    ;                                                          <<01032>>55150000
DEFINE LINE'LENGTH = CIS'LINELENSTACK( LINELENSPTR ) #;        << I.A >>55160000
INTEGER OFFSET,LINELENSPTR:=-1,                                <<01032>>55170000
        BYTE'COUNT:=0,LEN:=-1;                                 <<01032>>55180000
ARRAY WBUF(0:CIS'WCOMBUFLEN-1);                                << I.A >>55190000
BYTE ARRAY BBUF(*)=WBUF;                                       <<01032>>55200000
BYTE POINTER BPTR;                                             <<01032>>55210000
                                                               <<01032>>55220000
<< Calculate the caret position and bounds-check. >>           <<04193>>55230000
OFFSET := @ERRADR - @CIS'BCOMIMAGE + 1;                        << I.A >>55240000
IF NOT ( 0 <= OFFSET <= CIS'BCOMBUFLEN ) THEN                  << I.A >>55250000
BEGIN    << Offset not in bounds--CIERR calling error. >>      <<04193>>55260000
                                                               <<04193>>55270000
   SYSINTERR( PRINTCARETERR, 1 );                              <<04193>>55280000
   RETURN;                                                     <<04193>>55290000
                                                               <<04193>>55300000
END;                                                           <<04193>>55310000
                                                               <<04193>>55320000
IF CIS'LINELENSTACK( LINELENSPTR+1 ) <> 0 THEN                 << I.A >>55330000
    BEGIN                                                      <<01032>>55340000
        DO BEGIN                                               <<01032>>55350000
            LINELENSPTR := LINELENSPTR + 1;                    <<01032>>55360000
            BYTE'COUNT := BYTE'COUNT + LINE'LENGTH;            <<01032>>55370000
        END UNTIL BYTE'COUNT >= OFFSET OR LINE'LENGTH = 0;     <<01517>>55380000
        IF LINE'LENGTH <> 0 THEN                               <<01032>>55390000
            BEGIN                                              <<01032>>55400000
               @BPTR := @CIS'BCOMIMAGE(BYTE'COUNT-LINE'LENGTH);<< I.A >>55410000
                BBUF := "(";                                   <<01032>>55420000
                LEN := ASCII(LINELENSPTR,10,BBUF(1));          <<01032>>55430000
                BBUF(LEN + 1) := ")";                          <<01032>>55440000
                MOVE BBUF(LEN+2) := BPTR,(LINE'LENGTH);        <<01032>>55450000
                PRINT(WBUF,-LINE'LENGTH-LEN-2,0);              <<01032>>55460000
                OFFSET := OFFSET - CIS'NUMBLANKS;              << I.A >>55470000
            END;                                               <<01032>>55480000
        OFFSET := OFFSET-(BYTE'COUNT-LINE'LENGTH)+LEN+1;       <<01032>>55490000
    END;                                                       <<01032>>55500000
BBUF := " ";                                                   <<01032>>55510000
MOVE BBUF(1) := BBUF, ( CIS'BCOMBUFLEN-1 );                    << I.A >>55520000
OFFSET := OFFSET + CIS'NUMBLANKS;                              << I.A >>55530000
<<                  >>                                         <<01032>>55540000
BBUF(OFFSET) := "^";                                           <<01032>>55550000
PRINT(WBUF,-OFFSET-1,0);                                       <<01032>>55560000
                                                               <<01032>>55570000
END; << PROCEDURE PRINTCICARET >>                              << 8560>>55580000
PROCEDURE CIERR(ERRNUM,ERRADR,PARMMASK,PARM);                  <<U.RAO>>55590000
VALUE ERRNUM,PARMMASK,PARM;                                    <<U.RAO>>55600000
INTEGER ERRNUM,PARMMASK,PARM;                                  <<U.RAO>>55610000
BYTE ARRAY ERRADR;                                             <<U.RAO>>55620000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                         <<U.RAO>>55630000
BEGIN                                                          <<U.RAO>>55640000
COMMENT                                                        <<U.RAO>>55650000
                                                               <<U.RAO>>55660000
  CAUSES ERROR MESSAGE TO BE PRINTED, HANDLES DETAILS RELATED  <<U.RAO>>55670000
    TO THE CONSEQUENCES OF MAKING AN ERROR.                    <<U.RAO>>55680000
                                                               <<U.RAO>>55690000
  ERRNUM - CIERROR NUMBER.   REQUIRED PARAMETER.   IF NEGATIVE,<<U.RAO>>55700000
    SIMPLY PRINT THE INDICATED MESSAGE AND RETURN.             <<U.RAO>>55710000
  ERRADR - BYTE ADDRESS WHERE PROBLEM DETECTED.  PASSED TO     <<U.RAO>>55720000
    PRINTCICARET.  IF MISSING, DO NOT PRINT CARET.             << 8560>>55730000
  PARMMASK -                                                   <<03.KM>>55740000
    %0000N => PARM IS BYTE ADDR.  IF N<=1, @PARM CONTAINS ONLY <<03.KM>>55750000
              ONE STRING.  IF N=2, @PARM CONTAINS TWO STRINGS. <<03.KM>>55760000
              STRINGS ARE TERMINATED BY NULL (0).              <<03.KM>>55770000
    %10000 => PARM IS INTEGER BY VALUE.                        <<U.RAO>>55780000
    %20000 => PARM IS DOUBLE INTEGER BY REFERENCE.             <<U.RAO>>55790000
    %30000 - %70000  ARE SPARES.                               <<U.RAO>>55800000
       (NOTE: BITS 4-15 ARE RESERVED)                          <<U.RAO>>55810000
    IF PARMMASK IS MISSING, NO PARAMETER WAS PASSED.           <<U.RAO>>55820000
  PARM - ACTUAL PARAMETER AS DESCRIBED UNDER PARMMASK.         <<U.RAO>>55830000
*************************************************************  <<06.RO>>55840000
WARNING:  In JOBs, CIERR attempts to abort the user, if he has <<06.RO>>55850000
not invoked the CONTINUE command and it is not just a warning. <<06.RO>>55860000
In such cases, CIERR does not ever return to the caller.  If   <<06.RO>>55870000
you have cleanup work which must be done before termination,   <<06.RO>>55880000
such as releasing SIRs, it must be done before calling CIERR.  <<06.RO>>55890000
*************************************************************  <<06.RO>>55900000
  ;                                                            <<U.RAO>>55910000
                                                               <<U.RAO>>55920000
DEFINE PFLAG=     VARMASK.(14:1) #,                            <<03.KM>>55930000
       NONSTRING= PARMMASK.(1:3)<>0 #,                         <<03.KM>>55940000
       ONESTRING= PARMMASK.(13:3)<=1 #;                        <<03.KM>>55950000
INTEGER PARM2;                                                 <<03.KM>>55960000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>55970000
INTEGER PCBGLOBLOC,PXFIXEDLOC;                                 <<06580>>55980000
INTEGER COMLEN;                                                <<00617>>55990000
LOGICAL VARMASK=Q-4;  <<OPTION VARIABLE MASK WORD>>            <<U.RAO>>56000000
LOGICAL JUSTPRINT := FALSE;                                    <<U.RAO>>56010000
LOGICAL MODE;   <<RETURNED BY WHO INTRINSIC>>                  <<U.RAO>>56020000
BYTE ARRAY JCWNAME(0:7);  <<WILL HOLD JCW NAME "CIERROR">>     <<U.RAO>>56030000
                                                               <<U.RAO>>56040000
IF NOT JOBSESSIONMAIN THEN RETURN; <<PROGRAMMATIC CALL>>       <<U.RAO>>56050000
PXGLOBAL;                                                      <<06580>>56060000
IF VARMASK.(12:1) AND ERRNUM<0 THEN <<JUST PRINT MSG>>         <<U.RAO>>56070000
   BEGIN                                                       <<U.RAO>>56080000
   ERRNUM := -ERRNUM;                                          <<U.RAO>>56090000
   JUSTPRINT := TRUE;                                          <<U.RAO>>56100000
   END;                                                        <<U.RAO>>56110000
                                                               <<U.RAO>>56120000
<<NOW CLEAN UP TERMINAL STATE>>                                <<U.RAO>>56130000
WHO(MODE);  <<GET DATA ON WHETHER JOB OR SESSION>>             <<U.RAO>>56140000
IF MODE <<INTERACTIVE>> AND MODE.(12:2) <<SESSION>> THEN <<BREA<<U.RAO>>56150000
   <<ASSUME COULD BE IN BREAK, RESET BREAK BITS, CLEAR FLUSH FL<<U.RAO>>56160000
  ATTACHIO(PXG'OUTPUTLDEV,0,0,0,25,0,%320,0,1);                <<06580>>56170000
  <<CLEAR BREAK/IO FLUSH FLAGS, ENABLE WRITE>>                 <<U.RAO>>56180000
SETSERVICE(0);  <<ENABLE BREAK>>                               <<U.RAO>>56190000
                                                               <<U.RAO>>56200000
<< IF UDC AND NOT OPTION LIST AND NOT OPTION NOHELP THEN >>    <<00617>>56210000
<< PRINT THE LINE IN WHICH THE ERROR OCCURED.            >>    <<00617>>56220000
IF CIS'UDCNESTLEVEL <> 0 AND NOT CIS'UDCLISTOPT                << I.A >>56230000
       AND NOT CIS'UDCNOHELPOPT                                << I.A >>56240000
       AND NOT CIS'UDCNOPRINT                                  << I.A >>56250000
                       AND (ERRNUM <> STORE'FAILED)            <<04695>>56260000
                       AND (ERRNUM <> RESTORE'FAILED)                   56270000
                       AND (ERRNUM <> PGMABORT) THEN           <<00733>>56280000
   BEGIN                                                       <<00617>>56290000
   SCAN CIS'BCOMIMAGE UNTIL %6400, 1;                          << I.A >>56300000
   COMLEN := TOS - @CIS'BCOMIMAGE;                             << I.A >>56310000
   PRINT( CIS'WCOMIMAGE, -COMLEN, 0 );                         << I.A >>56320000
   CIS'NUMBLANKS := 0;                                         << I.A >>56330000
   END;                                                        <<00617>>56340000
<<NOW ON WITH THE MESSAGE>>                                    <<U.RAO>>56350000
IF VARMASK.(12:1) THEN   <<MESSAGE NUMBER PRESENT>>            <<U.RAO>>56360000
   BEGIN   <<PUT OUT MESSAGE>>                                 <<U.RAO>>56370000
   MOVE JCWNAME := "CIERROR ";                                 <<U.RAO>>56380000
   TOS := 0;                                                   <<U.RAO>>56390000
   PUTJCW(JCWNAME, ERRNUM, S0);                                <<U.RAO>>56400000
   DEL;                                                        <<U.RAO>>56410000
IF VARMASK.(13:1)   AND                                        << I.A >>56420000
   ( CIS'UDCNESTLEVEL=0 OR NOT CIS'UDCNOHELPOPT )              << I.A >>56430000
      THEN PRINTCICARET(ERRADR);                               << 8560>>56440000
   IF NOT PFLAG THEN GENMSG( CIERRMSGSET, ERRNUM )             << I.A >>56450000
   ELSE IF NONSTRING OR ONESTRING THEN                         <<03.KM>>56460000
      BEGIN                                                    <<03.KM>>56470000
      GENMSG( CIERRMSGSET, ERRNUM, PARMMASK, PARM );           << I.A >>56480000
      END                                                      <<03.KM>>56490000
   ELSE                                                        <<03.KM>>56500000
      BEGIN                                                    <<03.KM>>56510000
      TOS:=PARM;                                               <<03.KM>>56520000
      SCAN * UNTIL 0,1;                                        <<03.KM>>56530000
      PARM2:=TOS+LOGICAL(1);                                   <<03.KM>>56540000
      GENMSG( CIERRMSGSET, ERRNUM, 0, PARM, PARM2 );           << I.A >>56550000
      END;                                                     <<03.KM>>56560000
   END;  <<OF MESSAGE GENERATION STEP>>                        <<U.RAO>>56570000
                                                               <<U.RAO>>56580000
<<FINALLY WE MUST DISPOSE OF THE JOB/SESSION>>                 <<U.RAO>>56590000
IF JUSTPRINT THEN RETURN;                                      <<U.RAO>>56600000
IF CIS'CONTSTATE <> 0 THEN << CONTINUE IN EFFECT, IGNORE ERR >><< I.A >>56610000
   RETURN;                                                     <<08.RO>>56620000
IF CIS'UDCNESTLEVEL <> 0 THEN << PROCESSING A UDC >>           << I.A >>56630000
   BEGIN                                                       <<08.RO>>56640000
   CIS'UDCFATALCIERR := TRUE;  << UDC DAMAGED. >>              << I.A >>56650000
   IF CIS'CONTINUSTATESTK <> 0D THEN << PREV. LEVEL CONTINUE >><< I.A >>56660000
      RETURN;  <<DON'T KILL JOB>>                              <<08.RO>>56670000
   END;                                                        <<08.RO>>56680000
IF MODE.(12:2) = 1 THEN   <<SESSION, DON'T TERMINATE>>         <<08.RO>>56690000
   RETURN;  <<NOTE THAT IF IN UDC, THERE IS NO PENDING >>      <<08.RO>>56700000
            <<CONTINUE, SO WE FLUSH BACK TO REGULAR CI LEVEL>> <<08.RO>>56710000
                                                               <<U.RAO>>56720000
<<FROM HERE ON OUT, THE JOB IS DOWN THE TUBES>>                <<U.RAO>>56730000
GENMSG(CIGENERALMSGSET,JOBFLUSHED);                            <<U.RAO>>56740000
PXFIXED;                                                       <<06580>>56750000
TOS := PXFXQREG-4;                                             <<06580>>56760000
PS0 := 4;  <<FLAG FOR PROCEDURE CLEANUPJOB>>                   <<U.RAO>>56770000
IF PXFXBRKMODE <> 0 THEN FUNBREAK(TRUE);                       <<06580>>56780000
SETJCW(%100000); <<SET ABORT BIT>>                             <<00243>>56790000
TERMINATE;                                                     <<U.RAO>>56800000
END;                                                           <<U.RAO>>56810000
PROCEDURE CYDIRERR'(DIRECRETURN,OKMASK,ERRNUM);                <<U.RAO>>56820000
VALUE DIRECRETURN,OKMASK;                                      <<U.RAO>>56830000
DOUBLE DIRECRETURN;                                            <<U.RAO>>56840000
INTEGER ERRNUM;                                                <<U.RAO>>56850000
LOGICAL OKMASK;                                                <<U.RAO>>56860000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>56870000
<<CONVERTS DIRECRETURN TO CIERROR, RETURNS IT TO>>             <<U.RAO>>56880000
<<ERRNUM, CALLS CIERR>>                                        <<U.RAO>>56890000
BEGIN                                                          <<U.RAO>>56900000
INTEGER DERR1 = DIRECRETURN,                                   <<U.RAO>>56910000
        DERR0 = DIRECRETURN+1;                                 <<U.RAO>>56920000
X := DERR0;                                                    <<U.RAO>>56930000
TOS := OKMASK;                                                 <<U.RAO>>56940000
ASSEMBLE(TBC 0,X);                                             <<U.RAO>>56950000
IF = THEN  SUDDENDEATH(506);  <<DIRECTORY PROBLEM>>            <<U.RAO>>56960000
CASE *(X) OF                                                   <<U.RAO>>56970000
   BEGIN                                                       <<U.RAO>>56980000
   TOS := DIRIOERR;                                            <<U.RAO>>56990000
   TOS := DIRDUPLNAME;                                         <<U.RAO>>57000000
   CASE *(DERR1) OF <<NON EXISTENT ...>>                       <<U.RAO>>57010000
      BEGIN                                                    <<U.RAO>>57020000
      TOS := DIRNOSUCHFILE;                                    <<U.RAO>>57030000
      TOS := DIRNOSUCHGROUP;                                   <<U.RAO>>57040000
      TOS := DIRNOSUCHACCT;                                    <<U.RAO>>57050000
      TOS := DIRNOSUCHUSER;                                    <<U.RAO>>57060000
      TOS := DIRNOSUCHVSD;                                     <<U.RAO>>57070000
      TOS := DIRNOSUCHVSL;                                     <<U.RAO>>57080000
      END;                                                     <<U.RAO>>57090000
   IF DERR1 = 1 THEN TOS := DIRNOSAVEGROUP                     <<U.RAO>>57100000
                ELSE TOS := DIRNOSAVEACCT;                     <<U.RAO>>57110000
   TOS := DIROVERFLOW;                                         <<U.RAO>>57120000
   TOS := DIROVERFLOW;                                         <<U.RAO>>57130000
   TOS := DIROVERFLOW;                                         <<U.RAO>>57140000
   TOS := DIRINUSE;                                            <<U.RAO>>57150000
   IF DERR1 = 1 THEN TOS := DIRGRPFSPACE                       <<U.RAO>>57160000
                ELSE TOS := DIRACCTFSPACE;                     <<U.RAO>>57170000
   END;  <<CASE ON MASTER ERROR TYPE>>                         <<U.RAO>>57180000
ERRNUM := TOS;                                                 <<U.RAO>>57190000
CIERR(ERRNUM);                                                 <<U.RAO>>57200000
END;                                                           <<U.RAO>>57210000
PROCEDURE LOADERROR(ERRNUM);                                   <<U.RAO>>57220000
VALUE ERRNUM;                                                  <<U.RAO>>57230000
INTEGER ERRNUM;                                                <<U.RAO>>57240000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>57250000
<<THIS PROCEDURE PRINTS OUT THE LOADER ERROR MESSAGE AND,>>    <<U.RAO>>57260000
<<OPTIONALLY, THE FILE SYSTEM ERROR MESSAGE ASSOCIATED>>       <<U.RAO>>57270000
BEGIN                                                          <<U.RAO>>57280000
INTEGER FSERRNUM;  <<FILE SYSTEM ERROR NUMBER>>                <<U.RAO>>57290000
IF NOT JOBSESSIONMAIN THEN RETURN;  <<AVOID MESSAGES>>         <<U.RAO>>57300000
IF 50 <= ERRNUM <= 64 THEN    <<FILE ERROR RELATED>>           <<U.RAO>>57310000
   BEGIN                                                       <<U.RAO>>57320000
   FSERRNUM := ERRORGET(1).(8:8);                              <<U.RAO>>57330000
   IF FSERRNUM <> 0 THEN                                       <<U.RAO>>57340000
      GENMSG(FSERRORMSGSET,FSERRNUM);                          <<07.RO>>57350000
   END;                                                        <<U.RAO>>57360000
GENMSG(LOADERRMSGSET,ERRNUM);                                  <<U.RAO>>57370000
END;                                                           <<U.RAO>>57380000
LOGICAL PROCEDURE CREATEERROR;                                 <<U.RAO>>57390000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>57400000
<<IF CREATE ERROR, RETURN TRUE                     >>          <<U.RAO>>57410000
<<ELSE IS LOAD ERROR (DURING CREATE), RETURN FALSE>>           <<U.RAO>>57420000
<<IN ANY CASE, PRINT THE APPROPRIATE ERROR MESSAGE>>           <<U.RAO>>57430000
BEGIN                                                          <<U.RAO>>57440000
INTEGER ERRNUM, FSERRNUM;                                      <<U.RAO>>57450000
IF NOT JOBSESSIONMAIN THEN RETURN;  <<AVOID MESSAGES>>         <<U.RAO>>57460000
CREATEERROR := TRUE;                                           <<U.RAO>>57470000
ERRNUM := ERRORGET (1);                                        <<01244>>57480000
IF ERRNUM = 30 THEN      <<LOAD ERROR ACTUALLY>>               <<U.RAO>>57490000
   BEGIN                                                       <<U.RAO>>57500000
   CREATEERROR := FALSE;                                       <<01244>>57510000
   ERRNUM := ERRORGET (2);                                     <<01426>>57520000
   IF 50 <= ERRNUM <= 64 THEN  <<FURTHER COMPLICATED BY >>     <<U.RAO>>57530000
      BEGIN   <<FILE SYSTEM DETECTED ERROR>>                   <<U.RAO>>57540000
      FSERRNUM := ERRORGET (3).(8:8);                          <<01426>>57550000
      IF FSERRNUM <> 0 THEN                                    <<U.RAO>>57560000
         GENMSG(FSERRORMSGSET,FSERRNUM)                        <<U.RAO>>57570000
      ELSE                                                     <<U.RAO>>57580000
         GENMSG(CIGENERALMSGSET, ENDOFFILEMSG);                <<U.RAO>>57590000
      END;                                                     <<U.RAO>>57600000
   GENMSG(LOADERRMSGSET,ERRNUM);                               <<U.RAO>>57610000
   END                                                         <<U.RAO>>57620000
ELSE                                                           <<U.RAO>>57630000
   GENMSG(CREATEERRMSGSET,ERRNUM);                             <<U.RAO>>57640000
END;   <<CREATEERROR>>                                         <<01452>>57650000
                                                               <<01452>>57660000
PROCEDURE HARD'LOADERR(ERRNUM);                                <<01452>>57670000
   INTEGER ERRNUM;                                             <<01452>>57680000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01452>>57690000
                                                               <<01452>>57700000
COMMENT                                                        <<01452>>57710000
   This procedure can be called to print the LOADER/FILE       <<01452>>57720000
SYSTEM error messages when the error returned from             <<01452>>57730000
CREATEPROCESS is 16.  ERRNUM is set to the LOADER error number.<<01452>>57740000
;                                                              <<01452>>57750000
                                                               <<01452>>57760000
BEGIN                                                          <<01452>>57770000
   INTEGER FSERR;                                              <<01452>>57780000
                                                               <<01452>>57790000
   ERRNUM := ERRORGET(2);  << LOAD ERR >>                      <<01452>>57800000
   IF 50 <= ERRNUM <= 64 THEN                                  <<01452>>57810000
      BEGIN  << ALSO A FILESYSTEM ERROR >>                     <<01452>>57820000
      FSERR := ERRORGET(3).(8:8);                              <<01452>>57830000
      IF FSERR <> 0 THEN                                       <<01452>>57840000
         GENMSG( FSERRORMSGSET, FSERR )                        <<01452>>57850000
      ELSE                                                     <<01452>>57860000
         GENMSG( CIGENERALMSGSET, ENDOFFILEMSG );              <<01452>>57870000
      END;                                                     <<01452>>57880000
   GENMSG( LOADERRMSGSET, ERRNUM );                            <<01452>>57890000
                                                               <<01452>>57900000
END;  << OF HARD'LOADERR >>                                    <<01452>>57910000
                                                               <<01452>>57920000
                                                               <<01452>>57930000
LOGICAL PROCEDURE CREATEPROC'ERR(ERROR,ERRNUM);                <<01452>>57940000
   VALUE ERROR; INTEGER ERROR,ERRNUM;                          <<01452>>57950000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01452>>57960000
                                                               <<01452>>57970000
COMMENT                                                        <<01452>>57980000
   This procedure breaks down the error code returned by       <<01452>>57990000
CREATEPROCESS (which is passed in ERROR) into CIERROR messages.<<01452>>58000000
                                                               <<01452>>58010000
   If ERROR = 16, then a hard loader error has occured.  If    <<01452>>58020000
this is the case, another procedure is called which prints     <<01452>>58030000
the appropriate LOADER/FILE SYSTEM error messages.             <<01452>>58040000
                                                               <<01452>>58050000
   The logical value returned by this procedure tells the      <<01452>>58060000
calling procedure whether a hard loader error has occured.  If <<01452>>58070000
ERROR = 16, then the procedure returns FALSE.  In all other    <<01452>>58080000
cases, the procedure returns TRUE.  ERRNUM is set to the       <<01452>>58090000
appropriate CIERROR number.                                    <<01452>>58100000
;                                                              <<01452>>58110000
                                                               <<01452>>58120000
BEGIN                                                          <<01452>>58130000
   LOGICAL RESULT = CREATEPROC'ERR;                            <<01452>>58140000
                                                               <<01452>>58150000
   RESULT := TRUE;                                             <<01452>>58160000
                                                               <<01452>>58170000
   CASE ERROR OF                                               <<01452>>58180000
      BEGIN                                                    <<01452>>58190000
                                                               <<01452>>58200000
      << 0 = NO ERROR >>                                       <<01452>>58210000
      ;                                                        <<01452>>58220000
                                                               <<01452>>58230000
      << 1 = NO PH CAPABILITY -- SHOULDN'T HAPPEN >>           <<01452>>58240000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>58250000
                                                               <<01452>>58260000
      << 2 = ERROR PARAMETER OMITTED -- SHOULDN'T HAPPEN >>    <<01452>>58270000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>58280000
                                                               <<01452>>58290000
      << 3 = PIN/PROGRAM NAME BAD -- SHOULDN'T HAPPEN >>       <<01452>>58300000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>58310000
                                                               <<01452>>58320000
      << 4 = OUT OF PCB'S >>                                   <<01452>>58330000
      CIERR( ERRNUM := OUTOFPCBS );                            <<01452>>58340000
                                                               <<01452>>58350000
      << 5 = INVALID OPTION -- SHOULDN'T HAPPEN >>             <<01452>>58360000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>58370000
                                                               <<01452>>58380000
      << 6 = UNKNOWN PROGRAM FILE -- CALLER SHOULD HANDLE >>   <<01452>>58390000
      ;                                                        <<01452>>58400000
                                                               <<01452>>58410000
      << 7 = FILE IS NOT A VALID PROGRAM FILE >>               <<01452>>58420000
      CIERR( ERRNUM := INVALIDPROG );                          <<01452>>58430000
                                                               <<01452>>58440000
      << 8 = NO SUCH ENTRY POINT >>                            <<01452>>58450000
      CIERR( ERRNUM := BADENTRYPT );                           <<01452>>58460000
                                                               <<01452>>58470000
   << Errors 9 - 14 are actually warnings and are      >>      <<01452>>58480000
   << returned as negative numbers by CREATEPROCESS.   >>      <<01452>>58490000
   << The caller should ensure that error is positive. >>      <<01452>>58500000
                                                               <<01452>>58510000
      << 9 = PROGRAM FILE STACK SIZE USED >>                   <<01452>>58520000
      CIERR(ERRNUM := -DFLTSTACK);                             <<04787>>58530000
                                                               <<01452>>58540000
      << 10 = PROGRAM FILE DL SIZE USED >>                     <<01452>>58550000
      CIERR(ERRNUM := -DFLTDL);                                <<04787>>58560000
                                                               <<01452>>58570000
      << 11 = PROGRAM FILE MAXDATA USED >>                     <<01452>>58580000
      CIERR(ERRNUM := -DFLTMAXD);                              <<04787>>58590000
                                                               <<01452>>58600000
      << 12 = DLSIZE ROUNDED UP 128 WORDS >>                   <<01452>>58610000
      CIERR(ERRNUM := -DLRNDED);                               <<04787>>58620000
                                                               <<01452>>58630000
      << 13 = CONFIGURATION MAXDATA USED >>                    <<01452>>58640000
      CIERR(ERRNUM := -CONFMAXD);                              <<04787>>58650000
                                                               <<01452>>58660000
      << 14 = MAXDATA ROUNDED UP TO REQUIRED SPACE >>          <<01452>>58670000
      CIERR(ERRNUM := -STKRNDEDUP);                            <<04787>>58680000
                                                               <<01452>>58690000
   << End of warning sublist. >>                               <<01452>>58700000
                                                               <<01452>>58710000
      << 15 = STACK SPACE TOO BIG >>                           <<01452>>58720000
      CIERR( ERRNUM := STACKTOOBIG );                          <<01452>>58730000
                                                               <<01452>>58740000
      << 16 = HARD LOADER ERROR.  In this case, ERRNUM is   >> <<01452>>58750000
      << set to the LOADER error number.  Therefore, it is  >> <<01452>>58760000
      << expected that the calling procedure will call      >> <<01452>>58770000
      << CIERR to print a more general loading error        >> <<01452>>58780000
      << message and to set ERRNUM to this error number.    >> <<01452>>58790000
      BEGIN                                                    <<01452>>58800000
         RESULT := FALSE;  << HARD LOADER ERROR >>             <<01452>>58810000
         HARD'LOADERR(ERRNUM);                                 <<01452>>58820000
      END;                                                     <<01452>>58830000
                                                               <<01452>>58840000
      << 17 = BAD PRIORITY SPECIFIED -- SHOULDN'T HAPPEN >>    <<01452>>58850000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>58860000
                                                               <<01452>>58870000
      << 18 = COULDN'T OPEN $STDIN FOR PROGRAM >>              <<01452>>58880000
      CIERR( ERRNUM := BADSTDIN );                             <<01452>>58890000
                                                               <<01452>>58900000
      << 19 = COULDN'T OPEN $STDLIST FOR PROGRAM >>            <<01452>>58910000
      CIERR( ERRNUM := BADSTDLIST );                           <<01452>>58920000
                                                               <<01452>>58930000
      << 20 = INVALID STRING -- SHOULDN'T HAPPEN >>            <<01452>>58940000
      CIERR( ERRNUM := OTHERCREATERR, ,%10000,ERROR );         <<01452>>58950000
                                                               <<01452>>58960000
      END; << OF CASE STATEMENT >>                             <<01452>>58970000
                                                               <<01452>>58980000
END;  << OF CREATEPROC'ERR >>                                  <<01452>>58990000
      LOGICAL PROCEDURE REQUESTSERVICE;                        <<01452>>59000000
      OPTION PRIVILEGED;                                       <<01.EB>>59010000
      BEGIN                                                             59020000
      ARRAY QARRAY(*) = Q + 0;                                 <<06580>>59030000
      INTEGER PCBGLOBLOC;                                      <<06580>>59040000
      INTEGER LPDT'INDEX; << Index into LPDT/INCLLPDT >>       <<06226>>59050000
      LOGICAL PCBPT;                                           <<06581>>59060000
      PXGLOBAL;                                                <<06580>>59070000
      PCBPT := CURPRC;                                         <<06581>>59080000
      TOS := PROCSTATE.HARDKILLFLAG;                           <<06581>>59090000
      TOS := PROCSTATE.SOFTKILLFLAG;                           <<06581>>59100000
      IF  SPCBPTYPE'= 1 THEN                                   <<06581>>59110000
         BEGIN  <<IN MAIN>>                                             59120000
         TOS := PXG'INPUTLDEV;                                 <<06580>>59130000
         LPDT'INDEX:=TOS*INTEGER(LPDT'ENTRY'SIZE);             <<06579>>59140000
         TOS:=LPDT'BREAK; << Get the Break Bit value >>        <<06226>>59150000
         END                                                            59160000
       ELSE TOS := 0; <<NOT IN MAIN,DON'T CHECK BREAK>>                 59170000
      REQUESTSERVICE:=TOS LOR TOS LOR TOS;                              59180000
      END;<<REQUESTSERVICE>>                                            59190000
      PROCEDURE SETSERVICE(DISP);                                       59200000
      VALUE DISP;                                                       59210000
      LOGICAL DISP;                                                     59220000
      OPTION PRIVILEGED,UNCALLABLE;                                     59230000
      BEGIN                                                             59240000
      INTEGER LPDT'INDEX;                                      <<06226>>59250000
      INTEGER PCBGLOBLOC;                                      <<06580>>59260000
      ARRAY QARRAY(*)=Q+0;                                     <<06580>>59270000
      PXGLOBAL;                                                <<06580>>59280000
         TOS := PXG'INPUTLDEV;                                 <<06580>>59290000
         LPDT'INDEX:=TOS*INTEGER(LPDT'ENTRY'SIZE);             <<06579>>59300000
         DISABLE;                                                       59310000
         LPDT'BREAK:=DISP;                                     <<06226>>59320000
         ENABLE;                                                        59330000
      END;<<SETSERVICE>>                                                59340000
PROCEDURE WELCOMEMES (WDST, FUNNYTERMINAL);                   <<A00.04>>59350000
   VALUE WDST,FUNNYTERMINAL;                                  <<A00.04>>59360000
   INTEGER WDST;  <<WELCOME MESSAGE DATA SEGMENT>>            <<A00.04>>59370000
   LOGICAL FUNNYTERMINAL; <<IF TRUE, INDICATES APL TERMINAL>> <<A00.04>>59380000
   OPTION PRIVILEGED, UNCALLABLE;                             <<A00.04>>59390000
<<PRINTS CURRENT WELCOME MESSAGE, OBTAINED FROM <WDST> -                59400000
   STOPS AT END, OR BREAK.  IF APL TERMINAL, TRANSLATES                 59410000
   CHARACTER SETS>>                                           <<A00.04>>59420000
BEGIN                                                         <<A00.04>>59430000
<< WELCOME MSG DATA SEG STRUCTURE >>                          <<A00.04>>59440000
   INTEGER USECOUNT        = DB+0;  <<0:1 => CURRENT>>        <<A00.04>>59450000
   ARRAY FIRSTLINE (*)     = DB+3;  <<1'ST RECORD>>           <<A00.04>>59460000
<< DB+1 IS THE LENGTH OF THE DATA SEGMENT             >>      <<A00.04>>59470000
<< DB+2.(0:8) IS THE CHARACTER "#"                    >>      <<A00.04>>59480000
<< DB+2.(8:8) IS THE LENGTH OF THE FIRST LINE         >>      <<A00.04>>59490000
<< EACH SUBSEQUENT LINE HAS THE FOLLOWING STRUCTURE:  >>      <<A00.04>>59500000
<<   THEY START ON A WORD BOUNDARY, THE BYTE PRECEEDING>>     <<A00.04>>59510000
<<   IS THE LINE LENGTH IN BYTES, WHICH IS ALWAYS ODD.>>      <<A00.04>>59520000
<<   IF NECESSARY, THE LINE IS PADDED WITH A BLANK.   >>      <<A00.04>>59530000
<< LOCALS >>                                                  <<A00.04>>59540000
   INTEGER POINTER LINEP; <<KEEPS CURRENT POINTER IN DSEG>>   <<A00.04>>59550000
   DEFINE LINELEN =LINEP(-1).(8:8)#; <<LINE LENGTH>>          <<A00.04>>59560000
   INTEGER ARRAY LOCCOPY(0:127); <<LOCAL ARRAY FOR APL TRANS>><<A00.04>>59570000
   INTEGER LINELENAPL;  <<WHEN FUNNYTERMINAL, IS LINE LENGTH>><<A00.04>>59580000
   LOGICAL CRIT'STATE,  << OLD CRITICAL STATE >>               <<02318>>59590000
           OLDSIR;      << OLD SIR STATE      >>               <<02318>>59600000
                                                               <<02318>>59610000
   EQUATE WELCOMESIR = %27;  << WELCOME DST SIR >>             <<02318>>59620000
                                                              <<A00.04>>59630000
<<  >>                                                        <<A00.04>>59640000
   SETSERVICE(0);                                              << 9038>>59650000
   @LINEP := @FIRSTLINE;  <<SETUP LINEP>>                     <<A00.04>>59660000
   EXCHANGEDB(WDST);                                          <<A00.04>>59670000
   << MUST PROTECT THE USECOUNT WORD OF THE WELCOME DATA   >>  <<02318>>59680000
   << SEGMENT SO THAT 1) TWO PROCESSES CANNOT ACCESS THAT  >>  <<02318>>59690000
   << WORD CONCURRENTLY, AND 2) ONCE THE COUNT HAS BEEN    >>  <<02318>>59700000
   << INCREMENTED, THE PROCESS CANNOT BE ABORTED UNTIL THE >>  <<02318>>59710000
   << COUNT HAS BEEN DECREMENTED.  DON'T WANT TO HOLD SIR  >>  <<02318>>59720000
   << WHILE WELCOME MESSAGE PRINTING SO OTHERS CAN LOGON.  >>  <<02318>>59730000
   OLDSIR := GETSIR(WELCOMESIR);                               <<02318>>59740000
   USECOUNT := USECOUNT+1; <<BUMP USER COUNT>>                <<A00.04>>59750000
   CRIT'STATE := SETCRITICAL;  << NO ABORT 'TIL DEC. COUNT >>  <<02318>>59760000
   RELSIR(WELCOMESIR,OLDSIR);                                  <<02318>>59770000
   IF FUNNYTERMINAL THEN  <<BEGIN - APL TRANSLATION REQ'D>>   <<A00.04>>59780000
      BEGIN                                                   <<A00.04>>59790000
      TOS := LINELEN;  <<GET LENGTH OF FIRST LINE>>           <<A00.04>>59800000
      EXCHANGEDB(0);  <<SET BACK TO STACK>>                   <<A00.04>>59810000
      LINELENAPL := TOS;  <<SAVE LENGTH OF FIRST LINE>>       <<A00.04>>59820000
      <<NOW SET UP FOR MOVE FROM DATA SEG>>                   <<A00.04>>59830000
      TOS := @LOCCOPY;                                        <<A00.04>>59840000
      TOS := WDST;                                            <<A00.04>>59850000
      TOS := @LINEP;                                          <<A00.04>>59860000
      FUNNYTERMINAL := FUNNYTERMINAL.(13:2);<<EXTRACT TERMTYPE>>        59870000
      WHILE (LINELENAPL<>255) <<NOT END>>                     <<A00.04>>59880000
            AND (NOT(REQUESTSERVICE)) DO  <<NO BREAK>>        <<A00.04>>59890000
         BEGIN                                                <<A00.04>>59900000
            S2 := @LOCCOPY;                                   <<A00.04>>59910000
            TOS := (LINELENAPL+1)&ASR(1);  <<LENGTH OF MOVE>> <<A00.04>>59920000
            ASSEMBLE(MFDS 1);  <<ONLY POP DEAD COUNT>>        <<A00.04>>59930000
            APLTRANSLATEOUT(LOCCOPY,LINELENAPL,FUNNYTERMINAL);<<A00.04>>59940000
            FWRITE(2,LOCCOPY,-LINELENAPL,0);                  <<A00.04>>59950000
            IF <> THEN  <<FWRITE FAILED FOR SOME REASON>>     <<A00.04>>59960000
               LINELENAPL := 255  <<SET EXIT FLAG>>           <<A00.04>>59970000
            ELSE  <<EVERYTHING OK, GO TO TOP>>                <<A00.04>>59980000
               LINELENAPL := LOCCOPY(LINELENAPL&ASR(1)).(8:8);<<A00.04>>59990000
         END;                                                 <<A00.04>>60000000
         EXCHANGEDB(WDST);                                    <<A00.04>>60010000
      END                                                     <<A00.04>>60020000
   ELSE  <<REGULAR TERMINAL>>                                 <<A00.04>>60030000
      BEGIN                                                   <<A00.04>>60040000
      WHILE (LINELEN<>255)  <<NOT END>>                       <<A00.04>>60050000
            AND (NOT(REQUESTSERVICE)) DO  <<NO BREAK>>        <<A00.04>>60060000
         BEGIN  <<EMIT LINE AND ADVANCE POINTER>>             <<A00.04>>60070000
         FWRITE(2,LINEP,-LINELEN,0);                          <<A00.04>>60080000
         IF <> THEN GOTO LEAVE;                               <<A00.04>>60090000
         @LINEP := @LINEP+((LINELEN+1)&ASR(1));               <<A00.04>>60100000
         END;                                                 <<A00.04>>60110000
      END;                                                    <<A00.04>>60120000
LEAVE:                                                        <<A00.04>>60130000
   OLDSIR := GETSIR(WELCOMESIR);                               <<02318>>60140000
   USECOUNT := USECOUNT-1;  <<ONE LESS USER>>                 <<A00.04>>60150000
   RELSIR(WELCOMESIR,OLDSIR);                                  <<02318>>60160000
   RESETCRITICAL(CRIT'STATE);  << CAN NOW ABORT >>             <<02318>>60170000
   EXCHANGEDB(0);                                             <<A00.04>>60180000
   END;    <<WELCOMMES>>                                      <<A00.04>>60190000
$PAGE       "COMSEARCH - COMMAND DICTIONARY"                   <<08.RO>>60200000
$CONTROL SEGMENT= CIINIT                                                60210000
                                                                        60220000
LOGICAL PROCEDURE COMSEARCH (COMMAND, COMLEN, CAP, ACCESS,     <<U.RAO>>60230000
   EXECPLABEL, CAPERR);                                        <<U.RAO>>60240000
   VALUE COMLEN;                                               <<U.RAO>>60250000
   BYTE ARRAY COMMAND;                                         <<U.RAO>>60260000
   INTEGER COMLEN;                                             <<U.RAO>>60270000
   DOUBLE CAP;                                                 <<U.RAO>>60280000
   INTEGER EXECPLABEL;                                         <<U.RAO>>60290000
   DOUBLE ACCESS;                                              <<U.RAO>>60300000
   INTEGER CAPERR;                                             <<U.RAO>>60310000
   OPTION PRIVILEGED, UNCALLABLE;                              <<U.RAO>>60320000
                                                               <<U.RAO>>60330000
COMMENT:                                                       <<U.RAO>>60340000
   FINDS A COMMAND.                                            <<U.RAO>>60350000
   INPUT PARAMETERS:                                           <<U.RAO>>60360000
      <COMMAND> IS BYTE ARRAY CONTAINING COMMAND NAME.         <<U.RAO>>60370000
      <COMLEN> IS LENGTH OF NAME.                              <<U.RAO>>60380000
   RETURNS:                                                    <<U.RAO>>60390000
<CAP> - Capability mask required to use command.  format is    <<U.RAO>>60400000
   identical to that used in the Directory routines.           <<U.RAO>>60410000
      user attributes & file attributes required               <<U.RAO>>60420000
      0  sm                                                    <<U.RAO>>60430000
      1  am                                                    <<U.RAO>>60440000
      2  al                                                    <<U.RAO>>60450000
      3  gl                                                    <<U.RAO>>60460000
      4  di                                                    <<U.RAO>>60470000
      5  op                                                    <<U.RAO>>60480000
      6  cv                                                    <<U.RAO>>60490000
      7  uv                                                    <<U.RAO>>60500000
      8  LG     (USER LOGGING)                                 <<U.RAO>>60510000
      9  not used                                              <<U.RAO>>60520000
      10  PS  (PROGRAMMATIC CREATION)                          << 8152>>60530000
      11  na                                                   <<06847>>60540000
      12  nm                                                   <<06847>>60550000
      13  cs                                                   <<U.RAO>>60560000
      14  ND                                                   <<U.RAO>>60570000
      15  SF                                                   <<U.RAO>>60580000
      command access restrictions / resource capabilities      <<U.RAO>>60590000
      0  NOT USED                                              <<U.RAO>>60600000
      1  NOT USED                                              <<U.RAO>>60610000
      2  NOT USED                                              <<U.RAO>>60620000
      3  NOT USED                                              <<U.RAO>>60630000
      4  not USED                                              <<U.RAO>>60640000
      5  not USED                                              <<U.RAO>>60650000
      6  NOT USED                                              <<U.RAO>>60660000
      7  ba                                                    <<U.RAO>>60670000
      8  ia                                                    <<U.RAO>>60680000
      9  pm                                                    <<U.RAO>>60690000
      10  NOT USED                                             <<U.RAO>>60700000
      11  not used                                             <<U.RAO>>60710000
      12  mr                                                   <<U.RAO>>60720000
      13  NOT USED                                             <<U.RAO>>60730000
      14  ds                                                   <<U.RAO>>60740000
      15  ph                                                   <<U.RAO>>60750000
<COMSEARCH>  FALSE IMPLIES COMMAND NOT IN DIRECTORY            <<U.RAO>>60760000
<ACCESS> - LIMITATIONS ON USE OF INDIVIDUAL COMMAND.           <<U.RAO>>60770000
     FIRST WORD DEFINED AS FOLLOWS:                            <<00552>>60780000
        10:6 = OPERATOR COMMAND MASK INDEX                     <<00552>>60790000
         10:2 IS THE WORD INDEX                                <<00552>>60800000
         12:4 IS THE BIT INDEX                                 <<00552>>60810000
      SECOND WORD DEFINED AS FOLLOWS:                          <<U.RAO>>60820000
         15:1 = 1  NOT PERMITTED DURING BREAK,                 <<U.RAO>>60830000
         14:1 = 1  NOT PERMITTED PROGRAMMATICALLY,             <<U.RAO>>60840000
         12:2 = 0  NO CAP CHECK REQUIRED.  OTHERWISE:          <<U.RAO>>60850000
              = 1  AND CHECK  (ALL BITS REQUIRED),             <<U.RAO>>60860000
              = 2  OR CHECK (ANY ONE REQUIRED).                <<U.RAO>>60870000
         11:1 = 1  NOT PERMITTED DURING BATCH JOB,             <<U.RAO>>60880000
         10:1 = 1  NOT PERMITTED DURING SESSION.               <<U.RAO>>60890000
         9:1 = 1  ABORTABLE COMMAND                            <<U.RAO>>60900000
         8:1 = 0  NOT PERMITTED WITH APL CHARACTER SET         <<U.RAO>>60910000
         7:1 = 1  execute even if flushing for if command      <<U.RAO>>60920000
         6:1 = 1 NOT PERMITTED IN USER DEFINED COMMAND.        <<U.RAO>>60930000
         5:1 = 1 COMMAND CANNOT BE REDONE WITH REDO.           <<08.RO>>60940000
        4:1 = 1 COMMAND IS AN OPERATOR ONLY COMMAND (USER MUST <<00552>>60950000
                BEEN 'ALLOW'ED ACCESS.                         <<00552>>60960000
         3:1 = 1 COMMAND PERMITTED DURING SPECIAL BREAK                 60970000
<EXECPLABEL> - PLABEL FOR EXECUTOR.                            <<U.RAO>>60980000
<CAPERR> - THE CI ERROR NUMBER TO BE USED IF THE SUBROUTINE    <<U.RAO>>60990000
   PERMITACCESS IN COMMANDINTERP DETECTS A CAPABILITY PROBLEM. <<U.RAO>>61000000
   ;                                                           <<U.RAO>>61010000
COMMENT  *************************************************     <<U.RAO>>61020000
   ***  TO ADD A NEW COMMAND TO THE DIRECTORY  ***********     <<U.RAO>>61030000
   *******************************************************     <<U.RAO>>61040000
STEP 1:  DETERMINE THE CAPABILITIES REQUIRED TO USE THIS NEW   <<U.RAO>>61050000
  COMMAND, SUCH AS SM, AM, AL, UV, BA.  THE COMMENT ABOVE WILL <<U.RAO>>61060000
  HELP YOU FORMAT THIS INFORMATION INTO A DOUBLE WORD.         <<U.RAO>>61070000
  INCIDENTALLY, THIS DOUBLE WORD EXACTLY MATCHES THE USER      <<U.RAO>>61080000
  CAPABILITY ENTRY IN THE DIRECTORY IN ITS PLACEMENT OF BITS.  <<U.RAO>>61090000
  IF YOU ADD A NEW CAPABILITY, YOU MUST MAINTAIN THIS          <<U.RAO>>61100000
  CORRESPONDENCE.                                              <<U.RAO>>61110000
STEP 2:  DECIDE WHEN YOU WISH THIS COMMAND TO BE ILLEGAL.  FOR <<U.RAO>>61120000
  EXAMPLE, YOU MAY NOT WISH TO ALLOW ITS USE IN BATCH, OR      <<U.RAO>>61130000
  PROGRAMMATICALLY, OR YOU MAY WISH IT TO BE BREAKABLE.  YOU   <<U.RAO>>61140000
  MAY ALSO DECIDE WHETHER YOU WISH AN "AND" MATCH ON THE       <<U.RAO>>61150000
  CAPABILITIES DOUBLE WORD OR AND "OR" MATCH.  "OR" IMPLIES    <<U.RAO>>61160000
  ANY ONE OF THE CAPABILIES IS SUFFICIENT, "AND" REQUIRES THAT <<U.RAO>>61170000
  THE USER HAVE ALL THE CAPABILITIES.  THE COMMENT ABOVE WILL  <<U.RAO>>61180000
  HELP YOU IN FORMATTING THE ACCESS RESTRICTIONS DOUBLE WORD.  <<U.RAO>>61190000
  NOTE THAT IF YOU ADD ANY NEW ACCESS RESTRICTIONS, THE SUBROUTINE      61200000
  "PERMIT" IN COMMANDINTERP MUST BE CHANGED TO CHECK THE       <<U.RAO>>61210000
  RESTRICTION.                                                 <<U.RAO>>61220000
STEP 3:  FIND THE APPROPRIATE HASH BUCKET FOR YOUR COMMAND.  IF<<U.RAO>>61230000
  YOU WISH, YOU MAY CALCULATE IT OUT BY HAND.  HOWEVER, THE    <<U.RAO>>61240000
  EASIEST WAY IS TO GET ON A STAND-ALONE MACHINE, SET A        <<U.RAO>>61250000
  BREAKPOINT IN THIS ROUTINE AT THE LABEL NEXTDDEL, ENTER      <<U.RAO>>61260000
  YOUR FULL COMMAND, AND EXAMINE THE INDEX REGISTER WHEN YOU   <<U.RAO>>61270000
  HIT THE BREAKPOINT.  THAT REGISTER WILL CONTAIN THE INDEX OF <<U.RAO>>61280000
  THE HASH BUCKET YOU NEED.                                    <<U.RAO>>61290000
STEP 4:  ADD THE COMMAND TO THE COMMAND DIRECTORY.  USING ONE OF        61300000
  THE COMMANDS ALREADY THERE AS A TEMPLATE, FORMAT AND ENTER YOUR       61310000
  COMMAND IN THE TABLE.  IF THE HASH BUCKET IS CURRENTLY EMPTY,<<U.RAO>>61320000
  THE ENTRY FOR THAT BUCKET IN COMMANDDICT WILL BE 0 AND THE   <<U.RAO>>61330000
  LABEL WILL BE ABSENT.  SIMPLY CREATE THE NECESSARY LABEL AND <<U.RAO>>61340000
  ENTER IT IN COMMANDDICT.  NOTE THE LINKING SCHEME WITHIN THE <<U.RAO>>61350000
  BUCKETS.  A LINK OF 0 TERMINATES A BUCKET.  ALSO NOTE THAT THE        61360000
  COMMAND EXECUTOR MUST BE ADDED TO THE SYSTEM AT THE SAME TIME<<U.RAO>>61370000
  THAT THE MODIFIED PROCEDURE COMSEARCH IS ADDED, SO THAT THE  <<U.RAO>>61380000
  LLBL CAN BE EXECUTED.  OTHERWISE THE CI WILL ABORT.          <<U.RAO>>61390000
;                                                              <<U.RAO>>61400000
                                                               <<U.RAO>>61410000
                                                               <<U.RAO>>61420000
BEGIN                                                          <<U.RAO>>61430000
DEFINE W = :CON#, Y=;LLBL#, Z=;CON#;   <<FOR DICTIONARY>>      <<U.RAO>>61440000
DEFINE   <<CAPABILITY EQUATES>>                                <<U.RAO>>61450000
   NOTB = 0,0,0,1,0#,  << Not allowed in break >>              <<01999>>61460000
   NOTPB = 0,0,0,3,0#,              <<NOT PROG, NOT IN BREAK>> <<U.RAO>>61470000
   OP = %2000,0,0,4,CAPREQ'OP'#,  <<OP CAP, "AND" CHECK>>      <<U.RAO>>61480000
   OPNBR = %2000,0,0,7,CAPREQ'OP'#,  <<AND, NOT IN BRK OR PROG><<U.RAO>>61490000
   OPNOTBRK = %2000,0,0,5,CAPREQ'OP'#, <<OP, NOT IN BRK>>      <<U.RAO>>61500000
   MGR = %100000, 0, 0, 4, CAPREQ'SM'#, <<SM, AND CHECK >>     <<U.RAO>>61510000
   OPBR = %2000,0,0,%104,CAPREQ'OP'#,  <<OP, "AND", BREAKABLE>><<U.RAO>>61520000
   AMGR = %40000, 0, 0, 4, CAPREQ'AM'#, <<AM, AND CHECK>>      <<U.RAO>>61530000
   MGRSA = %140000,0,0,%110,CAPREQSMORAM#,<<OR CHECK, BREAKABLE<<U.RAO>>61540000
   CS = 4,0,0,4,CAPREQ'CS'#,  <<CS, AND CHECK>>                <<U.RAO>>61550000
   OPNOTPB = %2000,0,0,6,CAPREQ'OP'#, <<OP, AND CHECK, NOT PROG<<U.RAO>>61560000
   OPSYSPROG = %102000,0,0,%33,CAPREQSMOROP#,<<NOT JOB/PRG,OR>><<01724>>61570000
   UVCAP = %1400, 0, 0, %12,CAPREQUVORCV#,  <<OR CHK, NOT PROG.<<U.RAO>>61580000
   UVCAPBPROG = %1400,0,0,%110,CAPREQUVORCV#, <<UV,CV,PROG>>   <<U.RAO>>61590000
   CVCAP = %1000, 0, 0, 4, CAPREQ'CV'#,  <<CV, AND CHECK>>     <<U.RAO>>61600000
   IFSTATEMENT = 0,0,0,%402,0#,  <<EVEN IN IF STMT, NOT PROG>> <<U.RAO>>61610000
   OPORSMNB = %102000,0,0,%10,CAPREQSMOROP#, <<OR CHECK>>      <<01724>>61620000
   BREAKABLE = 0,0,0, %100, 0#,  <<ANYTHING, IS BREAKABLE>>    <<U.RAO>>61630000
   USERLOGGING = %102200,0,0,%110,CAPREQ'LG'#,                 <<00596>>61640000
   UNRESTRICTED = 0,0,0,0,0#;  <<ANYTHING, NOT BREAKABLE>>     <<U.RAO>>61650000
   EQUATE HASHVAL = 49;                                        <<U.RAO>>61660000
EQUATE NPOP=%4000;      <<OPERATOR ONLY>>                      <<00552>>61670000
EQUATE NPOPNOTB = %4001;  << Operator only, not in break >>    <<01999>>61680000
EQUATE NPOPAB=%4100; <<OPERATOR COMM., NO RESTRIC, ABORTABLE>> <<00552>>61690000
$PAGE                                                          <<00552>>61700000
<<FOLLOWING EQUATES DEFINE THE MASK BIT FOR EACH OP. COMMAND>> <<00552>>61710000
<< THE FIRST "M'DEVICE" COMMANDS DEFINE THE OPERATOR COMMANDS>><<00552>>61720000
<< DEALING WITH DEVICES                                      >><<00552>>61730000
$INCLUDE INCLAMSK                                              <<06846>>61740000
$PAGE                                                          <<00552>>61750000
DEFINE C'ABORTIO=UNRESTRICTED#,                      <<OP.01>> <<00552>>61760000
       C'ACCEPT=UNRESTRICTED#,                       <<OP.01>> <<00552>>61770000
       C'DOWN=UNRESTRICTED#,                         <<OP.01>> <<00552>>61780000
       C'GIVE=UNRESTRICTED#,                         <<OP.01>> <<00552>>61790000
       C'HEADOFF=UNRESTRICTED#,                      <<OP.01>> <<00552>>61800000
       C'HEADON=UNRESTRICTED#,                       <<OP.01>> <<00552>>61810000
       C'REFUSE=UNRESTRICTED#,                       <<OP.01>> <<00552>>61820000
       C'REPLY=0,0,0,%10000,0#,  <<UNRESTRICTED, OK IN SPECIAL <<00594>>61830000
       C'RESUME=0,0,0,%10022,0#,                               <<00594>>61840000
       C'STARTSPOOL=UNRESTRICTED#,                             <<00552>>61850000
       C'TAKE=UNRESTRICTED#,                         <<OP.01>> <<00552>>61860000
       C'UP=UNRESTRICTED#,                           <<OP.01>> <<00552>>61870000
       << ............................................... >>   <<06847>>61880000
       <<  The following seven network management commands  >> <<06847>>61890000
       <<  require  the NM capability to be executed.     >>   <<06847>>61900000
       << ............................................... >>   <<06847>>61910000
       C'NRJECONTROL = %10, 0, 0, 4, CAPREQ'NM'#,              <<07054>>61920000
       C'SNACONTROL  = %10, 0, 0, 4, CAPREQ'NM'#,              <<07054>>61930000
       C'LINKCONTROL = %10, 0, 0, 4, CAPREQ'NM'#,              <<07054>>61940000
       C'NETCONTROL  = %10, 0, 0, 4, CAPREQ'NM'#,              <<07054>>61950000
       C'RESUMENMLOG = %10, 0, 0, 4, CAPREQ'NM'#,              <<07054>>61960000
       C'SHOWNMLOG   = %10, 0, 0, 4, CAPREQ'NM'#,              <<07054>>61970000
       C'SWITCHNMLOG = %10, 0, 0, 4, CAPREQ'NM'#,              <<07054>>61980000
                                                               <<06847>>61990000
       C'MPLINE=NOTB#,      << Not in break >>                 <<01999>>62000000
       C'DSCONTROL=NOTB#,   << Not in break >>                 <<01999>>62010000
                                                               <<00552>>62020000
       C'ABORTJOB=UNRESTRICTED#,                     <<OP.01>> <<00552>>62030000
       C'ALLOW=0,0,M'ALLOW,NPOPAB,0#,<<         ALLOW>>        <<00552>>62040000
       C'ALTSPOOLFILE=UNRESTRICTED#,                           <<00552>>62050000
       C'ALTSP=C'ALTSPOOLFILE#,                                <<00552>>62060000
       C'ALTJOB=UNRESTRICTED#,                       <<OP.01>> <<00552>>62070000
       C'BREAKJOB=UNRESTRICTED#,                     <<OP.01>> <<00552>>62080000
       C'DELETESPOOLFILE=UNRESTRICTED#,                        <<00552>>62090000
       C'DISALLOW=0,0,M'DISALLOW,NPOPAB,0#,<<         ALLOW>>  <<00552>>62100000
       C'JOBFENCE=0,0,M'JOBFENCE,NPOP,0#,<<           ALLOW>>  <<00552>>62110000
       C'LIMIT=0,0,M'LIMIT,NPOP,0#,<<           ALLOW>>        <<00552>>62120000
       C'STOPSPOOL=UNRESTRICTED#,                              <<00552>>62130000
       C'SUSPENDSPOOL=UNRESTRICTED#,                           <<00552>>62140000
       C'OPENQ = UNRESTRICTED#,                                <<06851>>62150000
       C'SHUTQ = UNRESTRICTED#,                                <<06851>>62160000
       C'OUTFENCE=UNRESTRICTED#,                                        62170000
       C'RECALL=0,0,0,%10000,0#, <<UNRESTRICTED, OK IN SPECIAL <<00594>>62180000
       C'RESUMEJOB=UNRESTRICTED#,                    <<OP.01>> <<00552>>62190000
       C'RESUMESPOOL=UNRESTRICTED#,                            <<00552>>62200000
       C'LISTEQ=BREAKABLE#,                                    << 8246>>62210000
       C'LISTFTEMP=BREAKABLE#,                                 << 8246>>62220000
       C'RESUMESP=C'RESUMESPOOL#,                              <<00552>>62230000
       C'STREAMS=0,0,M'STREAMS,NPOP,0#,<<           ALLOW>>    <<00552>>62240000
       C'CONSOLE=UNRESTRICTED#,                                <<01043>>62250000
       C'WARN=0,0,M'WARN,NPOP,0#,<<           ALLOW>>          <<00552>>62260000
       C'WELCOME=0,0,M'WELCOME,NPOP,0#,<<           ALLOW>>    <<00552>>62270000
       C'MON=0,0,M'MON,NPOP,0#,<<           ALLOW>>            <<00552>>62280000
       C'MOFF=0,0,M'MOFF,NPOP,0#,<<           ALLOW>>          <<00552>>62290000
       C'VMOUNT=0,0,M'VMOUNT,NPOP,0#,<<           ALLOW>>      <<00552>>62300000
       C'LMOUNT=0,0,M'LMOUNT,NPOP,0#,<<           ALLOW>>      <<00552>>62310000
       C'LDISMOUNT=0,0,M'LDISMOUNT,NPOP,0#,<<          ALLOW>> <<00552>>62320000
       C'MRJECNTRL=0,0,M'MRJECNTRL,NPOPNOTB,0#,                <<01999>>62330000
       C'JOBSCRTY=0,0,M'JOBSCRTY,NPOP,0#,                      <<00552>>62340000
       C'LOG=0,0,M'LOG,NPOP,0#,                                <<00601>>62350000
       C'DOWNLOAD=UNRESTRICTED#,                               <<00575>>62360000
       C'MIOENABLE=0,0,M'MIOENABLE,NPOP,0#,<<    ALLOW>>       <<00575>>62370000
       C'MIODISABLE=0,0,M'MIODISABLE,NPOP,0#,<<  ALLOW>>       <<01424>>62380000
       C'FOREIGN=UNRESTRICTED#,                                <<01115>>62390000
       C'IMFCONTROL=0,0,M'IMFCONTROL,NPOPNOTB,0#,              <<06851>>62400000
       C'SHOWCOM=UNRESTRICTED#,                                <<06850>>62410000
       C'STARTCACHE=OPORSMNB#,                                 <<06850>>62420000
       C'STOPCACHE=OPORSMNB#;                                  <<06850>>62430000
                                                               <<00575>>62440000
$PAGE                              <<OP.01>>                   <<00552>>62450000
   TOS := COMLEN;                                              <<U.RAO>>62460000
   IF > THEN                                                   <<U.RAO>>62470000
      BEGIN   <<GET HASH INDEX>>                               <<U.RAO>>62480000
      << HASH VALUE = HASH KEY MOD HASH BASE (49) >>           <<U.RAO>>62490000
      << KEY IS CONSTRUCTED FROM THE LENGTH OF THE COMMAND>>   <<U.RAO>>62500000
      << AND THE FIRST, MIDDLE AND LAST CHARACTERS OF THE>>    <<U.RAO>>62510000
      << NAME.  THAT IS,                                 >>    <<U.RAO>>62520000
      << BYTE 0 = LENGTH, BYTE 1 = FIRST CHARACTER       >>    <<U.RAO>>62530000
      << BYTE 2 = MIDDLE CHAR (ROUND DOWN), BYTE 3 = LAST>>    <<U.RAO>>62540000
      TOS := @COMMAND;                                         <<U.RAO>>62550000
      ASSEMBLE (STBX);                                         <<U.RAO>>62560000
      TOS := LOGICAL (X) & LSL(8) LOR LOGICAL (COMMAND);       <<U.RAO>>62570000
      TOS := LOGICAL (COMMAND (X:=X-1)) LOR                    <<U.RAO>>62580000
            LOGICAL (COMMAND ((X +1) & ASR(1))) & LSL(8);      <<U.RAO>>62590000
      TOS := HASHVAL;                                          <<U.RAO>>62600000
      ASSEMBLE (LDIV, XAX);                                    <<U.RAO>>62610000
      <<XREG NOW HAS HASH INDEX  (REMAINDER)>>                 <<U.RAO>>62620000
      << S-0, S-1 ARE GARBAGE FROM CALCULATION>>               <<U.RAO>>62630000
                                                               <<U.RAO>>62640000
                                                               <<U.RAO>>62650000
   NEXTDDEL:                                                   <<U.RAO>>62660000
      ASSEMBLE ( DDEL;                                         <<U.RAO>>62670000
                                                               <<U.RAO>>62680000
   NEXT:                                                       <<U.RAO>>62690000
      << S-1 = COMLEN, >>                                      <<U.RAO>>62700000
      << S-0 = @COMMAND,  >>                                   <<U.RAO>>62710000
      << X = COMMANDDICT DISPL OF LAST ENTRY.  >>              <<U.RAO>>62720000
                                                               <<U.RAO>>62730000
         LOAD COMMANDDICT, X;          <<P-REL DISPL OF NEXT COMMAND>>  62740000
         BNE NOTEND;   <<SOMETHING IN BUCKET POINTER, LOOK FURTHER>>    62750000
         EXIT 6;  <<BUCKET POINTER EMPTY, NO SUCH COMMAND>>    <<U.RAO>>62760000
NOTEND:                                                        <<U.RAO>>62770000
            ADAX, DDUP;   <<GET OFFSET TO NEXT CANDIDATE IN DIRECTORY>> 62780000
            LRA COMMANDDICT, X;   <<ADDRESS OF BUCKET ENTRY>>  <<U.RAO>>62790000
            INCA;   <<SKIP OVER HASH LINK>>                    <<U.RAO>>62800000
            LSL 1;   <<GET BYTE ADDRESS OF COMMAND NAME IN DIRECTORY>>  62810000
            CAB;  <<PUT LENGTH OF COMMAND NAME ON TOS>>        <<U.RAO>>62820000
            CMPB PB, 1;  <<SEE IF MATCH WITH DIRECTORY NAME>>  <<U.RAO>>62830000
            BNE NEXTDDEL;   <<NO MATCH, TRY AGAIN>>            <<U.RAO>>62840000
            LRA S-1;   <<SUCCESSFUL MATCH, LOOK TO SEE IF DATA><<U.RAO>>62850000
            LSL 1;   <<IS SUBSET OF ACTUAL ENTRY IN DIRECTORY>><<U.RAO>>62860000
            XCH;  <<DONE BY CHECKING NEXT CHARACTER IN DIRECTORY>>      62870000
            LDI 1;   <<IS ALPHABETIC CHARACTER>>               <<U.RAO>>62880000
            MVB PB, 3;                                         <<U.RAO>>62890000
            LSR 8;                                             <<U.RAO>>62900000
            BTST, DEL;                                         <<U.RAO>>62910000
            BE NEXT;                                           <<U.RAO>>62920000
         << FOUND >>                                           <<U.RAO>>62930000
            DEL, INCA;                                         <<U.RAO>>62940000
               ASR 1;                  <<COM WORD LEN (ROUNDED DOWN)>>  62950000
               INCA, ADAX;                                     <<U.RAO>>62960000
               LOAD COMMANDDICT, X;    << LLBL >>              <<U.RAO>>62970000
               XEQ 0;                  << P-LABEL >>           <<U.RAO>>62980000
               INCX;                                           <<U.RAO>>62990000
               LOAD COMMANDDICT, X;    << CAP(0) >>            <<U.RAO>>63000000
               INCX;                                           <<U.RAO>>63010000
               LOAD COMMANDDICT, X;   << CAP(1) >>             <<U.RAO>>63020000
               INCX;                                           <<U.RAO>>63030000
               LOAD COMMANDDICT, X;  << ACCESS(0) >>           <<U.RAO>>63040000
               INCX;                                           <<U.RAO>>63050000
               LOAD COMMANDDICT, X;  << ACCESS(1) >>           <<U.RAO>>63060000
               INCX;                                           <<U.RAO>>63070000
               LOAD COMMANDDICT, X); << CAPERR >>              <<U.RAO>>63080000
               CAPERR := TOS;  <<CAPABILITY ERROR CODE>>       <<U.RAO>>63090000
               ACCESS := TOS;                                  <<U.RAO>>63100000
               CAP := TOS;                                     <<U.RAO>>63110000
               EXECPLABEL := TOS;  <<EXECUTOR PLABEL>>         <<U.RAO>>63120000
               COMSEARCH := TRUE;  <<FOUND LEGAL COMMAND>>     <<U.RAO>>63130000
      END;                                                     <<U.RAO>>63140000
   RETURN;   <<LOGICAL END OF EXECUTABLE CODE>>                <<U.RAO>>63150000
                                                               <<U.RAO>>63160000
<< BUCKET HEADS >>                                                      63170000
                                                                        63180000
COMMANDDICT:  ASSEMBLE (                                                63190000
      CON                                                               63200000
  BUCKET0,BUCKET1,BUCKET2,BUCKET3,BUCKET4,BUCKET5,BUCKET6,     <<06850>>63210000
  BUCKET7 ,BUCKET8 ,BUCKET9 ,BUCKET10,BUCKET11,BUCKET12,BUCKET13,       63220000
                                                               <<01.EB>>63230000
  BUCKET14,BUCKET15,BUCKET16,BUCKET17,BUCKET18,BUCKET19,BUCKET20,       63240000
  BUCKET21,BUCKET22,BUCKET23,BUCKET24,BUCKET25,BUCKET26,BUCKET27,       63250000
  BUCKET28,BUCKET29,BUCKET30,BUCKET31,BUCKET32,BUCKET33,BUCKET34,       63260000
  BUCKET35,BUCKET36,BUCKET37,BUCKET38,BUCKET39,BUCKET40,0       ,       63270000
  BUCKET42,BUCKET43,BUCKET44,BUCKET45,BUCKET46,BUCKET47,BUCKET48;       63280000
                                                                        63290000
<< DICTIONARY ENTRIES                                          <<U.RAO>>63300000
<< 1. P-RELATIVE HASH LINK,                                    <<U.RAO>>63310000
<< 2. COMMAND NAME,                                            <<U.RAO>>63320000
<< 3. LLBL EXECUTOR,                                           <<U.RAO>>63330000
<< 4. CAPABILITY AND ACCESS DATA.  SEE COMMENT ABOVE FOR FORMAT<<U.RAO>>63340000
<<    THE FIRST TWO WORDS ARE THE CAPABILITIES REQUIRED >>     <<U.RAO>>63350000
<<    (RETURNED IN THE DOUBLE <CAP> DEFINED ABOVE) AND  >>     <<U.RAO>>63360000
<<    THE SECOND TWO WORDS ARE THE ACCESS RESTRICTIONS  >>     <<U.RAO>>63370000
<<    (RETURNED IN THE DOUBLE <ACCESS> DEFINED ABOVE).  >>     <<U.RAO>>63380000
<<    IN GENERAL YOU WILL FIND IT MORE CONVENIENT TO    >>     <<U.RAO>>63390000
<<    CREATE A DEFINE FOR THIS FIELD OF THE DICTIONARY. >>     <<U.RAO>>63400000
<<    THE FIFTH WORD IS THE CI ERROR NUMBER TO BE USED IFF     <<U.RAO>>63410000
<<    SUBROUTINE PERMITACCESS IN THE CI ENCOUNTERS A CAPABILITY<<U.RAO>>63420000
<<    ERROR.                                                   <<U.RAO>>63430000
<< NOTE: COMMANDS WHICH ARE BEGINNING SUBSTRINGS OF OTHER      <<U.RAO>>63440000
<<       COMMANDS IN THE SAME BUCKET, MUST APPEAR BEFORE THOSE <<U.RAO>>63450000
<<       COMMANDS IN THE BUCKET CHAIN.                         <<U.RAO>>63460000
<< <X>,<Y> AND <Z> BELOW ARE DEFINES FOR DELIMITERS.           <<U.RAO>>63470000
                                                                        63480000
<< <LOCATION> :CON <HASHLINK> ,"<COMMAND>" ;LLBL <EXEC>   ;CON <DATA>;>>63490000
<<           14            28             43             58    <<U.RAO>>63500000
                                                               <<U.RAO>>63510000
BUCKET0:                                                       <<U.RAO>>63520000
TUNE         W ALTLOG      ,"TUNE"        Y CXTUNE       Z OPORSMNB;    63530000
ALTLOG       W DEBUG'L     ,"ALTLOG"      Y CXALTLOG     Z USERLOGGING; 63540000
DEBUG'L      W EOD         ,"DEBUG"       Y CXDEBUG      Z 0,%100,0,%26,63550000
                                                           CAPREQ'PM';  63560000
EOD          W STREAM      ,"EOD "        Y CXEOD        Z NOTPB       ;63570000
STREAM       W RJE         ,"STREAM"      Y CXSTREAM     Z BREAKABLE   ;63580000
RJE          W SETDUMP'L   ,"RJE "        Y CXRJE        Z NOTPB       ;63590000
SETDUMP'L    W SYSDUMP     ,"SETDUMP "    Y CXSETDUMP    Z UNRESTRICTED;63600000
SYSDUMP      W 0           ,"SYSDUMP "    Y CXSYSDUMP    Z OPNBR       ;63610000
                                                               <<U.RAO>>63620000
BUCKET1:                                                       <<DS0.0>>63630000
DISASSOCIATE W ABORTJOB ,"DISASSOCIATE" Y CXDISASSOCIATE Z UNRESTRICTED;63640000
ABORTJOB     W REDO        ,"ABORTJOB"    Y CXABORTJOB   Z C'ABORTJOB;  63650000
REDO         W RFA         ,"REDO"        Y CXREDO             <<01455>>63660000
                                          Z 0,0,0,%3102,0;     <<01455>>63670000
RFA          W 0           ,"RFA "        Y CXRFAD      Z 0,0,0,%2400,0;63680000
                                                               <<DS0.0>>63690000
BUCKET2:                                                       <<06850>>63700000
STARTCACHE   W OPENQ       ,"STARTCACHE"  Y CXSTARTCACHE       <<06851>>63710000
                                          Z C'STARTCACHE;      <<06850>>63720000
                                                               <<06850>>63730000
OPENQ        W 0           ,"OPENQ"       Y CXOPENQ            <<06851>>63740000
                                          Z C'OPENQ;           <<06851>>63750000
                                                           <<00815>>    63760000
BUCKET3:                                                       <<U.RAO>>63770000
PASCALGO     W DISALLOW    ,"PASCALGO"    Y CXPASCALGO         <<02844>>63780000
                                          Z NOTPB;             <<02844>>63790000
DISALLOW     W SHOWIN      ,"DISALLOW"    Y CXDISALLOW   Z C'DISALLOW;  63800000
<<SPOOL        W SHOWIN      ,"SPOOL"       Y CXSPOOL      Z C'SPOOL;>> 63810000
SHOWIN       W NEWACCT     ,"SHOWIN"      Y CXSHOWIN     Z BREAKABLE   ;63820000
NEWACCT      W CLINE       ,"NEWACCT "    Y CXNEWACCT    Z MGR         ;63830000
CLINE        W 0           ,"CLINE "      Y CXCLINE      Z CS          ;63840000
                                                               <<U.RAO>>63850000
BUCKET4:                                                       <<U.RAO>>63860000
FOREIGN      W REPLY       ,"FOREIGN"     Y CXFOREIGN    Z C'FOREIGN;   63870000
REPLY        W ELSE'       ,"REPLY"       Y CXREPLY      Z C'REPLY;     63880000
ELSE'        W FREERIN     ,"ELSE"        Y CXELSE       Z IFSTATEMENT; 63890000
                                                               <<U.RAO>>63900000
FREERIN      W SHOWLOG     ,"FREERIN "    Y CXFREERIN    Z NOTPB       ;63910000
SHOWLOG      W 0           ,"SHOWLOG "    Y CXSHOWLOG    Z OPBR        ;63920000
                                                               <<U.RAO>>63930000
BUCKET5:                                                       <<U.RAO>>63940000
TELLOP       W 0           ,"TELLOP"      Y CXTELLOP     Z UNRESTRICTED;63950000
                                                               <<U.RAO>>63960000
BUCKET6:                                                       <<U.RAO>>63970000
                                                               <<00506>>63980000
LISTLOG      W EOJ         ,"LISTLOG "    Y CXLISTLOG    Z USERLOGGING; 63990000
EOJ          W BASICGO     ,"EOJ "        Y CXEOJ        Z 0,0,0,%42,0; 64000000
BASICGO      W BASICPREP   ,"BASICGO "    Y CXBASICGO    Z NOTPB       ;64010000
BASICPREP    W PASCAL      ,"BASICPREP"   Y CXBASICPREP        <<02844>>64020000
                                          Z NOTPB;             <<02844>>64030000
PASCAL       W 0           ,"PASCAL"      Y CXPASCAL           <<02844>>64040000
                                          Z NOTPB;             <<02844>>64050000
                                                               <<U.RAO>>64060000
BUCKET7:                                                       <<U.RAO>>64070000
LDISMOUNT    W VMOUNT      ,"LDISMOUNT"   Y CXLDISMOUNT  Z C'LDISMOUNT; 64080000
VMOUNT       W HELP        ,"VMOUNT"      Y CXVMOUNT     Z C'VMOUNT;    64090000
HELP         W 0           ,"HELP"        Y CXHELP       Z BREAKABLE   ;64100000
                                                               <<01.EB>>64110000
BUCKET8:                                                       <<U.RAO>>64120000
LISTEQ       W ALLOW       ,"LISTEQ"      Y CXLISTEQ           << 8246>>64130000
                                          Z C'LISTEQ;          << 8246>>64140000
ALLOW        W SHOWQ       ,"ALLOW"       Y CXALLOW            << 8946>>64150000
                                          Z C'ALLOW;           << 8199>>64160000
SHOWQ        W JOBPRI      ,"SHOWQ"       Y CXSHOWQ      Z OPBR;        64170000
JOBPRI       W 0           ,"JOBPRI"      Y CXJOBPRI     Z OP; <<U.RAO>>64180000
                                                               <<U.RAO>>64190000
BUCKET9:                                                       <<U.RAO>>64200000
PURGE        W PURGEUSER   ,"PURGE "      Y CXPURGE      Z UNRESTRICTED;64210000
PURGEUSER    W 0           ,"PURGEUSER "  Y CXPURGEUSER  Z AMGR        ;64220000
                                                               <<U.RAO>>64230000
BUCKET10:                                                      <<U.RAO>>64240000
IMFMGR       W SHOWCOM     ,"IMFMGR"      Y CX3270MGR          <<02845>>64250000
                                          Z NOTPB;             <<02845>>64260000
SHOWCOM      W LISTVS      ,"SHOWCOM"     Y CXSHOWCOM    Z C'SHOWCOM;   64270000
LISTVS       W 0           ,"LISTVS"      Y CXLISTVS     Z UVCAPBPROG  ;64280000
                                                                        64290000
BUCKET11:                                                               64300000
                                                               <<01436>>64310000
RESUMENMLOG  W MRJECONTROL ,"RESUMENMLOG"  Y CXRESUMENMLOG     <<06847>>64320000
                                           Z C'RESUMENMLOG;    <<06847>>64330000
MRJECONTROL  W RPGPREP     ,"MRJECONTROL" Y CXMRJECONTROL Z C'MRJECNTRL;64340000
                                                               <<01436>>64350000
RPGPREP      W PURGEACCT   ,"RPGPREP "    Y CXRPGPREP    Z NOTPB       ;64360000
PURGEACCT    W PURGEVSET   ,"PURGEACCT "  Y CXPURGEACCT  Z MGR         ;64370000
PURGEVSET    W FCOPY       ,"PURGEVSET "  Y CXPURGEVSET        <<01453>>64380000
                                          Z CVCAP;             <<01453>>64390000
FCOPY        W 0           ,"FCOPY "      Y CXFCOPY            <<01453>>64400000
                                          Z NOTPB;             <<01453>>64410000
                                                                        64420000
BUCKET12:                                                               64430000
PREPRUN      W QUANTUM'L   ,"PREPRUN "    Y CXPREPRUN    Z NOTPB       ;64440000
QUANTUM'L    W 0           ,"QUANTUM "    Y CXQUANTUM    Z OP          ;64450000
                                                                        64460000
BUCKET13:                                                               64470000
COBOLIIPREP  W ALLOCATE     ,"COBOLIIPREP" Y CXCOBOLIIPREP     <<06131>>64480000
                                           Z NOTPB;            <<06131>>64490000
ALLOCATE     W  0           ,"ALLOCATE"    Y CXALLOCATE   Z OP << 9027>>64500000
                                                                        64510000
BUCKET14:                                                               64520000
OUTFENCE     W NRJE        ,"OUTFENCE"    Y CXOUTFENCE   Z C'OUTFENCE;  64530000
NRJE         W STREAMS     ,"NRJE"        Y CXNRJE       Z NOTPB     ;  64540000
STREAMS      W HELLO       ,"STREAMS"     Y CXSTREAMS    Z C'STREAMS;   64550000
HELLO        W LISTACCT    ,"HELLO "      Y CXHELLO     Z 0,%200,0,%133,64560000
                                                           CAPREQ'IA';  64570000
LISTACCT     W 0           ,"LISTACCT"    Y CXLISTACCT   Z MGRSA       ;64580000
                                                                        64590000
BUCKET15:                                                               64600000
FORTGO       W JOB         ,"FORTGO"      Y CXFORTGO     Z NOTPB       ;64610000
JOB          W GETRIN      ,"JOB "        Y CXJOB       Z 0,%400,0,%113,64620000
                                                           CAPREQ'BA';  64630000
GETRIN       W DSTAT       ,"GETRIN"      Y CXGETRIN     Z UNRESTRICTED;64640000
DSTAT        W 0           ,"DSTAT "      Y CXDSTAT      Z UNRESTRICTED;64650000
                                                                        64660000
BUCKET16:                                                               64670000
RESUMESPOOL  W TAKE        ,"RESUMESPOOL" Y CXRESUMESPOOL Z C'RESUMESP; 64680000
TAKE         W SETJCW'L    ,"TAKE"        Y CXTAKE       Z C'TAKE;      64690000
SETJCW'L     W PREP        ,"SETJCW"      Y CXSETJCW     Z UNRESTRICTED;64700000
PREP         W SAVE        ,"PREP"        Y CXPREP       Z NOTPB       ;64710000
SAVE         W 0           ,"SAVE"        Y CXSAVE       Z 1,0,0,4,     64720000
                                                           CAPREQ'SF';  64730000
                                                                        64740000
BUCKET17:                                                               64750000
LOG          W SHOWOUT     ,"LOG"        Y CXLOG         Z C'LOG;       64760000
SHOWOUT      W 0           ,"SHOWOUT "    Y CXSHOWOUT    Z BREAKABLE   ;64770000
                                                                        64780000
BUCKET18:                                                               64790000
PTAPE        W SWITCHNMLOG ,"PTAPE"        Y CXPTAPE           <<06847>>64800000
                                           Z 0,0,0,%20,0;      <<06847>>64810000
SWITCHNMLOG  W 0           ,"SWITCHNMLOG"  Y CXSWITCHNMLOG     <<06847>>64820000
                                           Z C'SWITCHNMLOG;    <<06847>>64830000
                                                                        64840000
BUCKET19:                                                               64850000
SHOWNMLOG    W JOBSECURITY ,"SHOWNMLOG"    Y CXSHOWNMLOG       <<06847>>64860000
                                           Z C'SHOWNMLOG;      <<06847>>64870000
JOBSECURITY  W SHOWDEV     ,"JOBSECURITY" Y CXJOBSECURITY Z C'JOBSCRTY; 64880000
SHOWDEV      W RPG        ,"SHOWDEV "     Y CXSHOWDEV    Z BREAKABLE   ;64890000
RPG          W 0          ,"RPG "         Y CXRPG        Z NOTPB       ;64900000
                                                                        64910000
BUCKET20:                                                               64920000
SHOWJCW      W PARTBACKUP     ,"SHOWJCW "    Y CXSHOWJCW    Z BREAKABLE;64930000
PARTBACKUP   W ALTUSER      ,"PARTBACKUP"   Y CXPARTBACKUP Z OPNBR ;    64940000
                                                               <<U.RAO>>64950000
ALTUSER      W VINIT       ,"ALTUSER "    Y CXALTUSER    Z AMGR        ;64960000
VINIT        W 0           ,"VINIT "      Y CXVINIT      Z OPSYSPROG   ;64970000
                                                                        64980000
BUCKET21:                                                               64990000
WELCOME      W ASSOCIATE   ,"WELCOME"     Y CXWELCOME    Z C'WELCOME;   65000000
ASSOCIATE    W SECURE      ,"ASSOCIATE"   Y CXASSOCIATE Z UNRESTRICTED; 65010000
SECURE       W 0           ,"SECURE"      Y CXSECURE     Z UNRESTRICTED;65020000
                                                                        65030000
BUCKET22:                                                               65040000
                                                               <<01177>>65050000
DSCONTROL    W LMOUNT      ,"DSCONTROL"   Y CXDSCONTROL        << 8946>>65060000
                                          Z C'DSCONTROL;       << 8199>>65070000
LMOUNT       W ALTJOB      ,"LMOUNT"      Y CXLMOUNT     Z C'LMOUNT;    65080000
ALTJOB       W FORTRAN     ,"ALTJOB"      Y CXALTJOB     Z C'ALTJOB;    65090000
FORTRAN      W SPLGO       ,"FORTRAN "    Y CXFORTRAN    Z NOTPB       ;65100000
SPLGO        W RESETDUMP'L ,"SPLGO "      Y CXSPLGO      Z NOTPB       ;65110000
RESETDUMP'L  W DSCOPY      ,"RESETDUMP"   Y CXRESETDUMP        <<01452>>65120000
                                          Z UNRESTRICTED;      <<01452>>65130000
DSCOPY       W 0           ,"DSCOPY"      Y CXDSCOPY           <<01452>>65140000
                                          Z NOTPB;             <<01452>>65150000
                                                                        65160000
BUCKET23:                                                               65170000
IMF          W BREAKJOB    ,"IMF "        Y CX3270             <<02845>>65180000
                                          Z NOTPB;             <<02845>>65190000
BREAKJOB     W RENAME      ,"BREAKJOB"    Y CXBREAKJOB   Z C'BREAKJOB;  65200000
RENAME       W 0           ,"RENAME"      Y CXRENAME     Z UNRESTRICTED;65210000
                                                                        65220000
BUCKET24:                                                               65230000
LISTFTEMP    W LIMIT       ,"LISTFTEMP"   Y CXLISTFTEMP        << 8246>>65240000
                                          Z C'LISTFTEMP;       << 8246>>65250000
LIMIT        W WARN        ,"LIMIT"       Y CXLIMIT      Z C'LIMIT;     65260000
WARN         W ALTSEC      ,"WARN"        Y CXWARN       Z C'WARN;      65270000
ALTSEC       W 0           ,"ALTSEC"      Y CXALTSEC     Z UNRESTRICTED;65280000
                                                                        65290000
BUCKET25:                                                               65300000
SHUTQ        W APL         ,"SHUTQ"       Y CXSHUTQ            <<06851>>65310000
                                          Z C'SHUTQ;           <<06851>>65320000
APL          W NEWUSER     ,"APL "        Y CXAPL        Z NOTPB       ;65330000
NEWUSER      W 0           ,"NEWUSER "    Y CXNEWUSER    Z AMGR        ;65340000
                                                                        65350000
BUCKET26:                                                               65360000
MIOENABLE    W RELEASE     ,"MIOENABLE"   Y CXMIOENABLE  Z C'MIOENABLE; 65370000
RELEASE      W SHOWTIME    ,"RELEASE "    Y CXRELEASE    Z BREAKABLE   ;65380000
SHOWTIME     W RESETACCT   ,"SHOWTIME"    Y CXSHOWTIME   Z BREAKABLE   ;65390000
RESETACCT    W 0           ,"RESETACCT "  Y CXRESETACCT  Z MGR         ;65400000
                                                                        65410000
BUCKET27:                                                               65420000
LISTF        W CONTINUE    ,"LISTF "      Y CXLISTF      Z BREAKABLE   ;65430000
CONTINUE     W 0           ,"CONTINUE"    Y CXCONTINUE   Z 0,0,0,%2,0;  65440000
                                                                        65450000
BUCKET28:                                                               65460000
BUILD        W 0           ,"BUILD "      Y CXBUILD      Z UNRESTRICTED;65470000
                                                                        65480000
BUCKET29:                                                               65490000
A3270        W RESUMEJOB   ,"IMF "        Y CX3270     Z NOTPB;<<06851>>65500000
RESUMEJOB    W SEGMENTER'L ,"RESUMEJOB"   Y CXRESUMEJOB  Z C'RESUMEJOB; 65510000
SEGMENTER'L  W COMMENTL    ,"SEGMENTER"   Y CXSEGMENTER  Z NOTPB;       65520000
COMMENTL     W COBOLIIGO   ,"COMMENT "    Y CXCOMMENT          <<06131>>65530000
                                          Z UNRESTRICTED;      <<06131>>65540000
COBOLIIGO    W 0           ,"COBOLIIGO"   Y CXCOBOLIIGO        <<06131>>65550000
                                          Z NOTPB;             <<06131>>65560000
                                                                        65570000
BUCKET30:                                                               65580000
ALTSPOOLFILE W STOPSPOOL   ,"ALTSPOOLFILE" Y CXALTSPOOLFILE Z C'ALTSP;  65590000
STOPSPOOL    W RECALL      ,"STOPSPOOL"    Y CXSTOPSPOOL  Z C'STOPSPOOL;65600000
RECALL       W REMOTE      ,"RECALL"      Y CXRECALL     Z C'RECALL;    65610000
REMOTE       W COBOLPREP   ,"REMOTE"      Y CXREMOTED    Z UNRESTRICTED;65620000
COBOLPREP    W 0           ,"COBOLPREP "  Y CXCOBOLPREP  Z NOTPB       ;65630000
                                                                        65640000
BUCKET31:                                                               65650000
CONSOLE      W HEADOFF     ,"CONSOLE"     Y CXCONSOLE    Z C'CONSOLE;   65660000
HEADOFF      W HEADON      ,"HEADOFF"     Y CXHEADOFF    Z C'HEADOFF;   65670000
HEADON       W COBOL       ,"HEADON"      Y CXHEADON     Z C'HEADON;    65680000
COBOL        W 0           ,"COBOL "      Y CXCOBOL      Z NOTPB       ;65690000
                                                                        65700000
BUCKET32:                                                               65710000
SNACONTROL   W RUN         ,"SNACONTROL"   Y CXSNACONTROL      <<06847>>65720000
                                           Z C'SNACONTROL;     <<06847>>65730000
RUN          W SETCOM      ,"RUN"         Y CXRUN        Z NOTPB;       65740000
SETCOM       W RESET       ,"SET"         Y CXSET        Z UNRESTRICTED;65750000
RESET        W SPEED       ,"RESET "      Y CXRESET      Z UNRESTRICTED;65760000
SPEED        W VSUSER      ,"SPEED "      Y CXSPEED            <<01724>>65770000
                                          Z 0,0,0,%20,0;       <<01724>>65780000
VSUSER       W 0           ,"VSUSER"      Y CXVSUSER     Z UVCAP       ;65790000
                                                                        65800000
                                                                        65810000
BUCKET33:                                                               65820000
DOWNLOAD     W ABORTIO     ,"DOWNLOAD"    Y CXDOWNLOAD   Z C'DOWNLOAD;  65830000
ABORTIO      W SETMSG      ,"ABORTIO"     Y CXABORTIO    Z C'ABORTIO;   65840000
SETMSG       W DISMOUNTC   ,"SETMSG"      Y CXSETMSG     Z UNRESTRICTED;65850000
DISMOUNTC    W ALTVSET     ,"DISMOUNT"    Y CXDISMOUNT   Z UVCAP       ;65860000
ALTVSET      W 0           ,"ALTVSET"     Y CXALTVSET    Z CVCAP       ;65870000
                                                                        65880000
BUCKET34:                                                               65890000
NRJECONTROL  W ACCEPT      ,"NRJECONTROL"  Y CXNRJECONTROL2    <<06847>>65900000
                                           Z C'NRJECONTROL;    <<06847>>65910000
ACCEPT       W DOWN        ,"ACCEPT"      Y CXACCEPT     Z C'ACCEPT;    65920000
DOWN         W GIVE        ,"DOWN"        Y CXDOWN       Z C'DOWN;      65930000
GIVE         W DSLINE      ,"GIVE"        Y CXGIVE       Z C'GIVE;      65940000
DSLINE       W SPLPREP     ,"DSLINE"      Y CXDSLINED    Z UNRESTRICTED;65950000
SPLPREP      W TELL        ,"SPLPREP "    Y CXSPLPREP    Z NOTPB       ;65960000
TELL         W RESUMELOG   ,"TELL"        Y CXTELL       Z UNRESTRICTED;65970000
RESUMELOG    W CACHECONTROL,"RESUMELOG "  Y CXRESUMELOG  Z OPBR        ;65980000
CACHECONTROL W DEALLOCATE  ,"CACHECONTROL" Y CXCACHECONTROL             65990000
                                           Z OPORSMNB;                  66000000
DEALLOCATE   W 0           ,"DEALLOCATE"  Y CXDEALLOCATE Z OP; << 9027>>66010000
                                                                        66020000
BUCKET35:                                                               66030000
SHOWLOGSTAT W FULLBACKUP,"SHOWLOGSTATUS "Y CXSHOWLOGSTATUS Z 0,0,0,%2,0;66040000
                                                               <<00506>>66050000
FULLBACKUP W LISTGROUP,"FULLBACKUP" Y CXFULLBACKUP Z OPNBR;             66060000
LISTGROUP    W 0           ,"LISTGROUP "  Y CXLISTGROUP  Z MGRSA       ;66070000
                                                                        66080000
BUCKET36:                                                               66090000
DELETESPOOLFILE W SUSPENDSPOOL,                                <<00552>>66100000
             "DELETESPOOLFILE" Y CXDELETESPOOLFILE Z C'DELETESPOOLFILE; 66110000
SUSPENDSPOOL W IF'         ,                                   <<00552>>66120000
             "SUSPENDSPOOL"    Y CXSUSPENDSPOOL Z C'SUSPENDSPOOL;       66130000
IF'          W LISTUSER    ,"IF"          Y CXIF         Z IFSTATEMENT; 66140000
                                                               <<U.RAO>>66150000
LISTUSER     W 0           ,"LISTUSER"    Y CXLISTUSER   Z MGRSA       ;66160000
                                                                        66170000
BUCKET37:                                                               66180000
LINKCONTROL  W FORTPREP    ,"LINKCONTROL"  Y CXLINKCONTROL     <<06847>>66190000
                                           Z C'LINKCONTROL;    <<06847>>66200000
FORTPREP     W DATA        ,"FORTPREP"    Y CXFORTPREP   Z NOTPB       ;66210000
DATA         W PURGEGROUP  ,"DATA"        Y CXDATA       Z NOTPB       ;66220000
PURGEGROUP   W MOUNTC      ,"PURGEGROUP"  Y CXPURGEGROUP Z AMGR        ;66230000
MOUNTC       W 0           ,"MOUNT "      Y CXMOUNT      Z UVCAP       ;66240000
                                                                        66250000
BUCKET38:                                                               66260000
STARTSPOOL   W ABORT       ,                                            66270000
              "STARTSPOOL"     Y CXSTARTSPOOL   Z C'STARTSPOOL;         66280000
ABORT        W CRESET      ,"ABORT "      Y CXABORT      Z 0,0,0,%22,0 ;66290000
CRESET       W NEWVSET     ,"CRESET"      Y CXCRESET     Z UNRESTRICTED;66300000
NEWVSET      W 0           ,"NEWVSET"     Y CXNEWVSET    Z CVCAP       ;66310000
                                                                        66320000
BUCKET39:                                                               66330000
SHOWALLOW    W SHOWCATALOG ,"SHOWALLOW"   Y CXSHOWALLOW  Z BREAKABLE   ;66340000
SHOWCATALOG  W BASIC       ,"SHOWCATALOG " Y CXSHOWCATALOG Z 0D,%102D,0;66350000
BASIC        W DISCRPS     ,"BASIC"       Y CXBASIC      Z NOTPB;       66360000
DISCRPS      W 0           ,"DISCRPS"     Y CXDISCRPS    Z UNRESTRICTED;66370000
                                                              <<MRJE>>  66380000
BUCKET40:                                                     <<MRJE>>  66390000
MIODISABLE   W UP          ,"MIODISABLE"  Y CXMIODISABLE Z C'MIODISABLE;66400000
UP           W MRJE        ,"UP"          Y CXUP         Z C'UP;        66410000
MRJE         W GETLOG      ,"MRJE"        Y CXMRJE       Z NOTPB    ;   66420000
GETLOG       W COBOLII     ,"GETLOG"      Y CXGETLOG           <<06131>>66430000
                                          Z USERLOGGING;       <<06131>>66440000
COBOLII      W 0           ,"COBOLII"     Y CXCOBOLII          <<06131>>66450000
                                          Z NOTPB;             <<06131>>66460000
                                                              <<MRJE>>  66470000
                                                                        66480000
BUCKET42:                                                               66490000
BYE          W RPGGO       ,"BYE "        Y CXBYE        Z 0,0,0,%123,0;66500000
RPGGO        W ALTGROUP    ,"RPGGO "      Y CXRPGGO      Z NOTPB       ;66510000
ALTGROUP     W 0           ,"ALTGROUP"    Y CXALTGROUP   Z AMGR        ;66520000
                                                                        66530000
BUCKET43:                                                               66540000
SHOWME       W PASCALPREP  ,"SHOWME"      Y CXSHOWME           << 8946>>66550000
                                          Z BREAKABLE;         << 8199>>66560000
PASCALPREP   W STOPCACHE   ,"PASCALPREP"  Y CXPASCALPREP       <<06850>>66570000
                                          Z NOTPB;             <<06850>>66580000
STOPCACHE    W SHOWCACHE   ,"STOPCACHE"   Y CXSTOPCACHE        <<06850>>66590000
                                          Z C'STOPCACHE;       <<06850>>66600000
SHOWCACHE    W 0           ,"SHOWCACHE"   Y CXSHOWCACHE        <<06850>>66610000
                                          Z UNRESTRICTED;      <<06850>>66620000
                                                               <<U.RAO>>66630000
BUCKET44:                                                               66640000
SETCATALOG   W EDITOR      ,"SETCATALOG"  Y CXSETCATALOG Z 0,0,0,2,0   ;66650000
EDITOR       W RESTORE     ,"EDITOR"      Y CXEDITOR     Z NOTPB       ;66660000
RESTORE      W ENDIF       ,"RESTORE "    Y CXRESTORENEW                66670000
                                          Z NOTB;                       66680000
ENDIF        W 0           ,"ENDIF "      Y CXENDIF      Z IFSTATEMENT; 66690000
                                                               <<U.RAO>>66700000
                                                                        66710000
BUCKET45:                                                               66720000
                                                               <<01208>>66730000
MPLINE       W STORE       ,"MPLINE"      Y CXMPLINE     Z C'MPLINE;    66740000
                                                               <<01208>>66750000
STORE        W REPORT      ,"STORE "      Y CXSTORENEW         <<04695>>66760000
                                          Z NOTB;              <<04695>>66770000
REPORT       W SWITCHLOG   ,"REPORT"      Y CXREPORT     Z BREAKABLE   ;66780000
SWITCHLOG    W 0           ,"SWITCHLOG "  Y CXSWITCHLOG  Z OPBR        ;66790000
                                                                        66800000
BUCKET46:                                                               66810000
MOFF         W JOBFENCE    ,"MOFF"        Y CXMOFF       Z C'MOFF;      66820000
JOBFENCE     W COBOLGO'L   ,"JOBFENCE"    Y CXJOBFENCE   Z C'JOBFENCE;  66830000
COBOLGO'L    W 0           ,"COBOLGO "    Y CXCOBOLGO    Z NOTPB       ;66840000
                                                                        66850000
BUCKET47:                                                               66860000
IMFCONTROL   W A3270CONTROL,"IMFCONTROL"  Y CX3270CONTROL      <<02845>>66870000
                                          Z C'IMFCONTROL;      <<06851>>66880000
A3270CONTROL W MON         ,"IMFCONTROL" Y CX3270CONTROL       <<06851>>66890000
                                           Z C'IMFCONTROL;     <<06851>>66900000
MON          W REFUSE      ,"MON"         Y CXMON        Z C'MON;       66910000
REFUSE       W SPL         ,"REFUSE"      Y CXREFUSE     Z C'REFUSE;    66920000
SPL          W RESUME      ,"SPL "        Y CXSPL        Z NOTPB       ;66930000
RESUME       W BASICOMP    ,"RESUME"      Y CXRESUME     Z C'RESUME;    66940000
BASICOMP     W NEWGROUP    ,"BASICOMP"    Y CXBASICOMP   Z NOTPB       ;66950000
NEWGROUP     W ALTACCT     ,"NEWGROUP"    Y CXNEWGROUP   Z AMGR        ;66960000
ALTACCT      W 0           ,"ALTACCT "    Y CXALTACCT    Z MGR         ;66970000
                                                                        66980000
BUCKET48:                                                               66990000
RELLOG       W FILE        ,"RELLOG"      Y CXRELLOG     Z USERLOGGING; 67000000
                                                               <<00506>>67010000
FILE         W STARTSESS'  ,"FILE"        Y CXFILE             << 8152>>67020000
                                          Z UNRESTRICTED;      << 8152>>67030000
STARTSESS'   W SHOWJOB     ,"STARTSESS"   Y CXSTARTSESS        << 8152>>67040000
                                          Z %40,0,0,%10,7009;  << 8152>>67050000
SHOWJOB      W 0           ,"SHOWJOB "    Y CXSHOWJOB    Z BREAKABLE   ;67060000
   );                                                          <<U.RAO>>67070000
END    <<COMSEARCH>>;                                          <<U.RAO>>67080000
$PAGE "COMMANDINTERP - MAIN BODY OF CI"                        <<08.RO>>67090000
PROCEDURE COMMANDINTERP(EXPCODE);                              <<02.EB>>67100000
   VALUE EXPCODE;                                              <<02.EB>>67110000
   LOGICAL EXPCODE;                                            <<02.EB>>67120000
   OPTION UNCALLABLE;                                          <<02.EB>>67130000
BEGIN                                                                   67140000
      ENTRY                                                    <<U.RAO>>67150000
          UDCCI,  <<REENTRY POINT FOR UDC'S>>                  <<03.RO>>67160000
          COMMAND',  <<ENTRY FOR COMMAND INTRINSIC>>           <<03.RO>>67170000
          SYSBREAK;  <<ENTRY FOR TERMINAL BREAK FUNCTION>>     <<03.RO>>67180000
                                                               <<01.PV>>67190000
      DOUBLE                                                   <<01.PV>>67200000
          ACCESS,  <<ACCESS RESTRICTIONS FROM COMSEARCH>>      <<U.RAO>>67210000
          CAP;   <<EXEC CAPABILITY FROM COMSEARCH>>            <<03.RO>>67220000
                                                               <<01.PV>>67230000
      LOGICAL                                                  <<01.PV>>67240000
          CAP0 = CAP,                                          <<01.PV>>67250000
          CAP1 = CAP0+1,                                       <<01.PV>>67260000
         ACCESS0=ACCESS,   <<10:6 =OPERATOR COMMAND INDEX>>    <<00552>>67270000
          ACCESS1 = ACCESS+1,  <<ACCESS RESTRICTIONS>>         <<U.RAO>>67280000
          PROGCALL := FALSE,  <<PROGRAMMATICALLY INVOKED>>     <<03.RO>>67290000
         SPECIAL'BREAK:=FALSE, <<ENTERED THRU RIT BREAK FLAG>> <<00594>>67300000
          STAT2 = Q-5,  <<FOR PROGRAMMATIC CALL STATUS RTN>>   <<03.RO>>67310000
          PROMPT := ": ",   <<PROMPT FOR SESSION>>             <<03.RO>>67320000
          CONTFLG := FALSE,  <<EXPECTING CONTINUATION RECORD>> <<03.RO>>67330000
          JOBFLG,  <<PROCESSING "JOB" COMMAND, NO ECHO>>       <<03.RO>>67340000
          EXECPLABEL,  <<PLABEL OF COMMAND EXECUTOR TO CALL>>  <<03.RO>>67350000
          <<  The following two logicals are used   >>         <<04952>>67360000
          <<  Locally in ECHO                       >>         <<04952>>67370000
          SEQUENCED := FALSE, <<  true if numbered  >>         <<04952>>67380000
          COMPACTED := FALSE, <<  true if things slid  >>      <<04952>>67390000
          NONABORTABLE; <<COMMAND CAN BE BROKEN WITH BREAK>>   <<03.RO>>67400000
                                                               <<01.PV>>67410000
      ARRAY                                                    <<01.PV>>67420000
          WMESNO(0:15);   <<ANSWER HOLDER FOR ABORT QUESTION>> <<U.RAO>>67430000
                                                               <<01.PV>>67440000
      INTEGER ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                <<06846>>67450000
      INTEGER ARRAY ALLOWMASK(*) = JITALLOWMASK;               <<06846>>67460000
                                 <<OP.01>>                              67470000
      LOGICAL PCBPT;                                           <<06581>>67480000
      INTEGER                                                  <<01.PV>>67490000
          JITDSTN, << JIT data seq number >>                   <<06846>>67500000
          ERRNUM,  <<ERROR NUMBER RETURNED FROM EXECUTOR>>     <<03.RO>>67510000
          PARMNUM, <<PARAMETER INDEX FROM EXECUTOR>>           <<03.RO>>67520000
          LENGTH,  <<LENGTH OF THE RECORD JUST READ.>>         <<03.RO>>67530000
          COMLEN,  <<LENGTH OF THE CURRENT COMMAND NAME>>      <<03.RO>>67540000
          LEFT,  <<SPACE LEFT IN THE INPUT BUFFER>>            <<03.RO>>67550000
          CAPCHECKERR,  <<CIERR IF CAPABILITY CHECK FAILED>>   <<03.RO>>67560000
          SEQBITADR,  << Address in JMAT of sequence flag>>    <<06584>>67570000
          BYTE'INDEX, << INDEX INTO TEMP ARRAY FOR ECHO  >>    <<04212>>67580000
          TEMP'COMLENGTH,<< TEMP COMMAND STRING LENGTHY>>      <<04212>>67590000
          TEMP'BYTE'INDX,<<SAVES BYTE INDX TO LOCKWORD START>> <<04212>>67600000
          LEN'STRING'LEFT,<<LENGTH OF STRING AFTER LOCKWORD>>  <<04212>>67610000
          WHOLELENGTH, <<SAVES WHOLE STRING LENGTH>>           <<04212>>67620000
          TEMP'COUNT,<<FIGURED COUNT OF CHARS COMPACTED>>      <<04212>>67630000
          NCHAR; <<NUMBER OF CHARACTERS READ FOR ABORT REPLY>> <<03.RO>>67640000
                                                               <<01.PV>>67650000
      POINTER                                                  <<01.PV>>67660000
          ERRPARM = Q-9,  <<ERRNUM FROM COMMAND INTRINSIC>>    <<03.RO>>67670000
          PARMPARM = Q-8, <<PARMNUM FROM COMMAND INTRINSIC>>   <<03.RO>>67680000
          JFLAGS,  <<JOB FLAGS FROM PXGLOB>>                   <<03.RO>>67690000
          PXGLOB;  <<DB RELATIVE POINTER TO PXGLOB>>           <<03.RO>>67700000
      INTEGER IOERRCOUNT;  <<COUNT OF READ ERRORS ENCOUNTERED>><<03.RO>>67710000
      EQUATE IOERRLIMIT = 3;  <<BEFORE TERMINATING SESSION>>   <<03.RO>>67720000
      LOGICAL UDCEXECED := FALSE;  <<FLAG BETWEEN CI & UDC>>   <<03.EB>>67730000
INTEGER LINELENSPTR;  <<STACK POINTER INTO LINE LENGTH STACK>> <<U.RAO>>67740000
      BYTE POINTER                                             <<03.RO>>67750000
          COMARRAY = Q-10,  <<COMMAND STRING FROM COMMAND>>    <<03.RO>>67760000
                         <<INTRINSIC.  POINTS TO COMMAND NAME>><<03.RO>>67770000
          PNTR,  <<CURRENT END OF INPUT BUFFER (SEE GETIMAGE)>><<03.RO>>67780000
           TEMP'PNTR,<<POINTS TO START IF ECHO TEMP ARRAY>>    <<04212>>67790000
           B'POINTER, << POINTS TO WHERE SLASH IS FOUND>>      <<04212>>67800000
          PARMSP;  <<START OF COMMAND PARAMETERS>>             <<03.RO>>67810000
      LOGICAL                                                  <<00257>>67820000
          LCOMARRAY = COMARRAY;<<USED TO GET ADDR OF COMARRAY>><<00257>>67830000
      EQUATE                                                   <<00257>>67840000
          CR'CR = %6415;                                       <<00257>>67850000
      BYTE ARRAY MESNO(*) = WMESNO;   <<FOR MESSAGES>>         <<U.RAO>>67860000
       <<  The following three variables are used in ECHO  >>  <<04952>>67870000
       BYTE SAVEECHOBYTE;                                      <<04212>>67880000
       BYTE TEMP'BYTE;                                         <<04952>>67890000
       BYTE ARRAY TEMP'COMIMAGE (0:CIS'BCOMBUFLEN);            << I.A >>67900000
ARRAY QARRAY(*) = Q + 0;                                       <<06580>>67910000
INTEGER PCBGLOBLOC,PXFIXEDLOC;                                 <<06580>>67920000
INTEGER LPDT'INDEX; << Indexes LPDT per INCLLPDT file >>       <<06226>>67930000
DEFINE    <<FOR ACCESS RESTRICTIONS>>                          <<U.RAO>>67940000
   OPCOMMANDWRD=ACCESS0.(9:3)#, << ALLOW MASK WORD INDEX >>    <<06846>>67950000
   OPCOMMANDINX=ACCESS0.(12:4)#, <<ALLOW MASK BIT INDEX>>      <<00552>>67960000
   ANOTINBREAK = ACCESS1#,  <<NOT ALLOWED IN BREAK>>           <<U.RAO>>67970000
   ANOTINPROG = ACCESS1.(14:1)#, <<NOT ALLOWED PROGRAMMATICALLY<<U.RAO>>67980000
   CAPCHECK = ACCESS1.(12:2)<>0#, <<CAP CHECK REQUIRED>>       <<U.RAO>>67990000
   ANDCAPCHECK = ACCESS1.(12:2)=1#,  <<DO "AND" CHECK>>        <<U.RAO>>68000000
   ORCAPCHECK = ACCESS1.(12:2)=2#,  <<DO "OR" CHECK>>          <<U.RAO>>68010000
   ANOTINJOB = ACCESS1.(11:1)#,  <<NOT ALLOWED IN BATCH>>      <<U.RAO>>68020000
   ANOTINSESSION = ACCESS1.(10:1)#, <<NOT ALLOWED IN SESSION>> <<U.RAO>>68030000
   ACANBREAK = ACCESS1.(9:1)#,  <<CAN BREAK COMMAND LISTING>>  <<U.RAO>>68040000
   ACAN'TWITHAPL = ACCESS1.(8:1)#,  <<CAN'T USE WITH APL>>     <<U.RAO>>68050000
   AEXECEVENINIF = ACCESS1.(7:1)#,  <<DON'T FLUSH IN IF>>      <<U.RAO>>68060000
   ANOTINUDC = ACCESS1.(6:1)#, <<NOT ALLOWED IN USER DEF CMD>> <<08.RO>>68070000
    SPECIALBREAK'COM=ACCESS1.(3:1)#,   <<COMMAND OK IN SPECIAL <<00594>>68080000
   OPCOMMAND=ACCESS1.(4:1)#,    <<USER MUST HAVE BEEN ALLOWED>><<00552>>68090000
   ANOTREDOABLE = ACCESS1.(5:1)#;  <<CAN'T REDO>>              <<08.RO>>68100000
                                                               <<04710>>68110000
DEFINE          << Bit in PCB(0) indicating SIR holding.   >>  <<04710>>68120000
   HASSIR = (3:1) #;                                           <<04710>>68130000
                                                               <<04710>>68140000
EQUATE JOBFLAG = 2,                                            <<U.RAO>>68150000
       SESSIONFLAG = 1;  <<JOB/SESSION FIELD IN JOB NUMBERS>>  <<U.RAO>>68160000
      EQUATE PROMPTL=-1;  <<PROMPT LENGTH IS ONE BYTE>>        <<03.RO>>68170000
      DEFINE CCC=STAT2.(6:2)#,  <<FOR COMMAND INTRINSIC>>      <<03.RO>>68180000
      DUPLF=JFLAGS.(PXGFDUP)#,   <<DUPLICATIVE FLAG>>          <<03.RO>>68190000
      INTERACTF=JFLAGS.(PXGFINTER)#;   <<INTERACTIVE FLAG>>    <<03.RO>>68200000
      DEFINE INSTANTLOGON =  <<FOR ONE COMMAND LOGONS>>        <<03.RO>>68210000
         TOS := 0;                                             <<02.EB>>68220000
         TOS := @S0; << TARGET >>                              <<02.EB>>68230000
         TOS := JMATDST;                                       <<02.EB>>68240000
         << Push offset to Funny Terminal bits in JMAT entry >><<06584>>68250000
         TOS := PXG'JMATINX * JMATENTRYSIZE                    <<06584>>68260000
                                        + JMATFTBITSOFF;       <<06584>>68270000
         TOS := 1;  << One word from JMAT entry >>             <<06584>>68280000
         ASSEMBLE(MFDS 4);                                     <<02.EB>>68290000
         TOS := TOS.JMATFTBITSEXT;                             <<06584>>68300000
         PASSEDCOMMAND := TOS&LSL(1)#;                         <<U.RAO>>68310000
      LOGICAL PASSEDCOMMAND:=0;  <<STATUS WORD FOR PASSED COM><<A00.04>>68320000
      DEFINE FUNNYTERMINAL=PASSEDCOMMAND.(15:1)#,<<APL TERMINAL<A00.04>>68330000
             COMMANDPASSED=PASSEDCOMMAND.(0:1)#, <<ONE SEEN>> <<A00.04>>68340000
             COMMANDEXECED=PASSEDCOMMAND.(1:1)#, <<ONE DONE>> <<A00.04>>68350000
             APLTERMTYPE  =PASSEDCOMMAND.(13:2)#;             <<A00.04>>68360000
DOUBLE OLDSEQNUM := 0D,  <<LAST VALID SEQUENCE NUMBER>>        <<01.RO>>68370000
       NEWSEQNUM;   <<CANDIDATE SEQUENCE NUMBER>>              <<01.RO>>68380000
INTEGER                                                        <<00419>>68390000
   STDLISTLENB,                                                <<00419>>68400000
   STDLISTLENW;                                                <<00419>>68410000
POINTER                                                        <<00419>>68420000
   PRINTPOS;   << USED IN SUBR. ECHO >>                        <<00419>>68430000
LOGICAL                                                        <<00540>>68440000
   OLDCRITICAL,                                                <<04169>>68450000
   DUMMY,                                                      <<01455>>68460000
   LOCKWORD'SLASH := %6457,  <<CARRIAGE RETURN,SLASH>>         <<04212>>68470000
   HARDEOF'THEN'BRK := FALSE; <<HIT BRK AFTER :EOF:>>          <<00540>>68480000
                                                               <<00835>>68490000
<< SAVE AREA FOR UDC AND IF NESTING GLOBALS DURING BREAK >>    <<00835>>68500000
LOGICAL                                                        <<00835>>68510000
   SAVE'UDC3,                                                  <<00835>>68520000
   SAVE'UDC4,                                                  <<00835>>68530000
   SAVE'IFNESTING,                                             <<00835>>68540000
   SAVE'IFSKIP,                                                <<00835>>68550000
   SAVE'ELSESEEN;                                              <<00835>>68560000
DOUBLE                                                         <<00835>>68570000
   SAVE'CONTINUSTATESTK;                                       <<00835>>68580000
                                                               <<00835>>68590000
                                                               << 8958>>68600000
LOGICAL                                                        << 8958>>68610000
   COMMDST,   << INITIAL DST number >>                         << 8958>>68620000
   FOS'TAPE;  << TRUE if startup from HP FOS TAPE >>           << 8958>>68630000
EQUATE                                                         << 8958>>68640000
   SYSSET          = 1,                                        << 8958>>68650000
   AUTOINSTALL'MSG = 2000,                                     << 8958>>68660000
   COMMDSTLOC      = %122,                                     << 8958>>68670000
   SYSEXTPTR       = %377;                                     << 8958>>68680000
                                                               <<01.RO>>68690000
POINTER                                                        << 8958>>68700000
   SYS'GLOB'EXT = SYSEXTPTR;                                   << 8958>>68710000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<01.RO>>68720000
                                                               <<01.RO>>68730000
                                                                        68740000
<<                 *********************                   >>  <<U.RAO>>68750000
<<                 *   ABORTREFUSED    *                   >>  <<U.RAO>>68760000
<<                 *********************                   >>  <<U.RAO>>68770000
                                                               <<U.RAO>>68780000
LOGICAL SUBROUTINE ABORTREFUSED (COMLEN);                               68790000
   VALUE COMLEN;                                                        68800000
   INTEGER COMLEN;    <<LENGTH OF COMMAND (IN COMIMAGE) 2 B SAVED>>     68810000
                                                                        68820000
<< CALLED WHEN PROGRAM-ABORTING COMMAND DETECTED (INCL EOF).            68830000
   IF NOT IN BREAK MODE, THEN RETURNS FALSE.                            68840000
   IF IN BREAK MODE, THEN                                               68850000
      IF USER CONFIRMS "ABORT?", THEN                                   68860000
         SAVE COMLEN (IN PENDINGCOMLEN),                                68870000
         ABORT PROGRAM, AND                                             68880000
         (PROCEDURE) EXIT TO BREAK CODE (PSEUDO INT ROUTINE).           68890000
      IF USER DECLINES "ABORT?", THEN                                   68900000
         WARNING ("NOT VALID IN BREAK") EMITTED, AND                    68910000
         TRUE RETURNED TO CALLER.    >>                                 68920000
                                                                        68930000
BEGIN                                                                   68940000
   PXFIXED;                                                    <<06580>>68950000
   IF PXFXBRKMODE = 0  THEN                                    <<06580>>68960000
      ABORTREFUSED := FALSE    << NOT EVEN IN BREAK MODE >>             68970000
   ELSE                                                                 68980000
      IF SPECIAL'BREAK THEN <<IGNORE EOF'S IN SPECIAL BREAK>>  <<00594>>68990000
      BEGIN                                                    <<00594>>69000000
         << Breaks like during a :STORE, :RESTORE, etc. >>     <<06226>>69010000
         CIERR(ERRNUM:=SPECIALCOM);                            <<00594>>69020000
         ABORTREFUSED:=TRUE;                                   <<00594>>69030000
         FRESETEOF;                                            <<00594>>69040000
         PXGLOBAL;                                             <<06580>>69050000
         LPDT'INDEX := PXG'INPUTLDEV * LPDT'ENTRY'SIZE;        <<06580>>69060000
         LPDT'EOF'TYPE:=LPDT'NO'EOF;                           <<06226>>69070000
      END                                                      <<00594>>69080000
      ELSE                                                     <<00594>>69090000
ASK:  BEGIN    << BREAK MODE: ASK USER FOR ABORT >>                     69100000
      GENMSG(CIGENERALMSGSET,ABORTQ,,,,,,,,,,,%100000);        <<U.RAO>>69110000
      PXGLOBAL;                                                <<06580>>69120000
      TOS :=ATTACHIO(PXG'INPUTLDEV,0,0,                        <<06580>>69130000
            @WMESNO, 0, -4, 5, 0, 1);                                   69140000
      ASSEMBLE (NEG, XCH);    <<FIX COUNT & CHECK COMPLETION>>          69150000
      ASSEMBLE(DUP); << duplicate attachio status >>           <<02849>>69160000
      IF TOS.(13:3) <> 1 THEN << i/o error >>                  <<02849>>69170000
         BEGIN                                                 <<02849>>69180000
         IF TOS.(9:7) <> %173 THEN << broken read OK. (DS) >>  <<02849>>69190000
            BEGIN                                              <<02849>>69200000
            FUNBREAK(TRUE);                                    <<02849>>69210000
            TERMINATE;                                         <<02849>>69220000
            END;                                               <<02849>>69230000
         END                                                   <<02849>>69240000
      ELSE                                                     <<02849>>69250000
         DEL;                                                  <<02849>>69260000
      NCHAR := TOS;                                                     69270000
      MOVE MESNO := MESNO WHILE AS;    <<UPSHIFT>>                      69280000
      IF (NCHAR = 3) AND (MESNO = "YES") THEN                           69290000
         BEGIN    <<ABORT REQUESTED>>                                   69300000
         PXFIXED;                                              <<06580>>69310000
         PXFXBRKMODE := 0;                                     <<06580>>69320000
         CIS'PENDINGCOMLEN := COMLEN;                          << I.A >>69330000
         FUNBREAK(TRUE);                                                69340000
         ABORTPROG;                                                     69350000
         CIS'UDCEXITBREAK := TRUE;                             << I.A >>69360000
         ABORTREFUSED := TRUE;                                 <<03.EB>>69370000
         RETURN;                                               <<03.EB>>69380000
         END;                                                           69390000
      IF (NCHAR <> 2) OR (MESNO <> "NO") THEN                           69400000
         BEGIN    << RESPONSE WAS NEITHER "YES" NOR "NO" >>             69410000
         CIERR(ERRNUM := -BRKINVLDRESP);                       <<04787>>69420000
         <<FIX UP BREAK FLAGS BEFORE TRYING AGAIN>>            <<04.RO>>69430000
         PXGLOBAL;                                             <<06580>>69440000
         ATTACHIO(PXG'INPUTLDEV,0,0,0,28,0,0,0,1);<<QUIESE>>   <<06580>>69450000
         SETSERVICE(TRUE);                                     <<04.RO>>69460000
         ATTACHIO(PXG'OUTPUTLDEV,0,0,0,                        <<06580>>69470000
               25,0,%320,0,1);   <<CLEAR FLUSH FLAGS>>         <<04.RO>>69480000
         GOTO ASK;    <<AND TRY AGAIN>>                                 69490000
         END;                                                           69500000
      << USER DECLINED "ABORT?" >>                                      69510000
      CIERR(ERRNUM := -NOTINBREAK);                            <<04787>>69520000
      ABORTREFUSED := TRUE;                                             69530000
      END;                                                              69540000
   END;    <<ABORTREFUSED>>                                             69550000
                                                                        69560000
<<                 *********************                   >>  <<U.RAO>>69570000
<<                 *       ECHO        *                   >>  <<U.RAO>>69580000
<<                 *********************                   >>  <<U.RAO>>69590000
                                                               <<U.RAO>>69600000
SUBROUTINE ECHO(LEN);                                                   69610000
<<  LEN is actually length(command) - 1  >>                    <<04952>>69620000
VALUE LEN;                                                              69630000
INTEGER LEN;                                                            69640000
<<If STDIN and STDLIST are DUPLICATIVE, don't echo line>>      <<03.RO>>69650000
BEGIN                                                                   69660000
PXGLOBAL;                                                      <<06580>>69670000
IF NOT PXG'DUPLICATIVE THEN                                    <<06580>>69680000
   BEGIN                                                       <<00419>>69690000
WHOLELENGTH := LEN;  <<  Save the command length  >>           <<04952>>69700000
@TEMP'PNTR := @TEMP'COMIMAGE; <<BYTE PTR TO STRING START>>     <<04212>>69710000
TEMP'COMIMAGE :=" "; <<BLANK OUT TEMP BUFFER>>                 <<04212>>69720000
MOVE TEMP'COMIMAGE(1):= TEMP'COMIMAGE,(CIS'BCOMBUFLEN-1);      << I.A >>69730000
MOVE TEMP'COMIMAGE:= PNTR,(LEN+1); <<PUT CMND FROM BCOMIMAGE>> <<04212>>69740000
    << COMMAND MOVED TO TEMPORARY BUFFER >>                    <<04212>>69750000
COMPACTED := SEQUENCED := FALSE;<< Init. flags  >>             <<04952>>69760000
                                                               <<04952>>69770000
<<  ..........................................  >>             <<04952>>69780000
<< If the command is sequenced then we must be  >>             <<04952>>69790000
<< careful not to move the sequence number when >>             <<04952>>69800000
<< we compress away a lockword.  Therefore we   >>             <<04952>>69810000
<< chop off the number by subtracting its length>>             <<04952>>69820000
<< from LEN.  We are also forced                >>             <<04952>>69830000
<< to chop off the CR at the end of the command.>>             <<04952>>69840000
<< So, since we need a CR to terminate our SCAN >>             <<04952>>69850000
<< we replace the FIRST digit of the sequence   >>             <<04952>>69860000
<< number with a CR and save that digit         >>             <<04952>>69870000
<< for later replacement.                       >>             <<04952>>69880000
<< ............................................ >>             <<04952>>69890000
                                                               <<04952>>69900000
IF CIS'SEQUENCED AND LEN > 8 THEN                              << I.A >>69910000
     BEGIN                                                     <<04212>>69920000
                                                               <<04952>>69930000
     NEWSEQNUM := DBINARY(TEMP'PNTR(LEN-8),8);                 <<04952>>69940000
     IF = THEN BEGIN <<VALID NUMBER >>                         <<04212>>69950000
            LEN := LEN-8;<<truncate seq. # and CR >>           <<04952>>69960000
            SEQUENCED := TRUE;<<flag that we are seq.>>        <<04952>>69970000
            SAVEECHOBYTE:= TEMP'PNTR(LEN);<<SAVE BYTE BEFORE SE<<04212>>69980000
            TEMP'PNTR(LEN) := %15;<< PUT IN CARRIAGE RETURN >> <<04212>>69990000
            END                                                <<04212>>70000000
                                                               <<04952>>70010000
     END;                                                      <<04212>>70020000
TOS := @TEMP'COMIMAGE; <<SET UP FOR SCAN FOR SLASH >>          <<04212>>70030000
                                                               <<04212>>70040000
REPEATSCAN:                                                    <<04212>>70050000
     SCAN * UNTIL LOCKWORD'SLASH,1;                            <<04212>>70060000
     IF CARRY THEN <<NO/NO MORE LOCKWORDS FOUND>>              <<04212>>70070000
         BEGIN                                                 <<04212>>70080000
         DEL;                                                  <<04212>>70090000
         IF COMPACTED THEN                                     <<04952>>70100000
         BEGIN                                                 <<04952>>70110000
             << .............................. >>              <<04952>>70120000
             << We are here in the event that  >>              <<04952>>70130000
             << at least one lockword has been >>              <<04952>>70140000
             << found and a compaction has     >>              <<04952>>70150000
             << been done.  Some garbage will  >>              <<04952>>70160000
             << be left at the end of the      >>              <<04952>>70170000
             << command string which must be   >>              <<04952>>70180000
             << blanked out.                   >>              <<04952>>70190000
             << .............................. >>              <<04952>>70200000
                                                               <<04952>>70210000
             TEMP'COUNT := WHOLELENGTH - LEN;<< Junk left >>   <<04952>>70220000
             IF SEQUENCED THEN TEMP'COUNT := TEMP'COUNT-8;     <<04952>>70230000
             MOVE TEMP'PNTR(LEN) := " ";                       <<04212>>70240000
          MOVE TEMP'PNTR(LEN+1):=TEMP'PNTR(LEN),(TEMP'COUNT-1);<<04212>>70250000
             END;<<BLANKS RESIDUAL AFTER LOCKWORD COMPRESSION D<<04212>>70260000
             <<  drop through to PRINTCOMMAND  >>              <<04952>>70270000
         END                                                   <<04212>>70280000
                                                               <<04952>>70290000
     << ...................................... >>              <<04952>>70300000
     <<  A slash has been found. A lockword    >>              <<04952>>70310000
     <<  may follow.  If it does we compact    >>              <<04952>>70320000
     <<  else we look again (repeat scan).     >>              <<04952>>70330000
     <<  A lockword must:                      >>              <<04952>>70340000
     <<    (a) Begin with an ALPHA character   >>              <<04952>>70350000
     <<    (b) Be <= 8 characters in length    >>              <<04952>>70360000
     <<    (c) Be delimited by a ".", ",", ";" >>              <<04952>>70370000
     <<          or a CR.                      >>              <<04952>>70380000
     <<  ....................................  >>              <<04952>>70390000
                                                               <<04952>>70400000
     ELSE                                                      <<04212>>70410000
        BEGIN                                                  <<04212>>70420000
        @B'POINTER := TOS;                                     <<04212>>70430000
        BYTE'INDEX:= LOGICAL(@B'POINTER - @TEMP'COMIMAGE) + 1; <<04212>>70440000
        <<  BYTE'INDEX now points 1 char. past "/">>           <<04952>>70450000
        IF TEMP'PNTR(BYTE'INDEX) <> ALPHA THEN                 <<04952>>70460000
        BEGIN   <<  Not a lockword, bye...  >>                 <<04952>>70470000
         TOS := @B'POINTER+1; << set up scan  >>               <<04952>>70480000
         GOTO REPEATSCAN;                                      <<04952>>70490000
        END                                                    <<04952>>70500000
       ELSE                                                    <<04952>>70510000
       BEGIN  <<Looks like a valid lockword >>                 <<04952>>70520000
        TEMP'BYTE'INDX:= BYTE'INDEX; << SAVE BYTE INDEX>>      <<04212>>70530000
        WHILE TEMP'PNTR(BYTE'INDEX) <> SPECIAL                 <<04212>>70540000
            DO BEGIN                                           <<04212>>70550000
            BYTE'INDEX:= BYTE'INDEX + 1;                       <<04212>>70560000
            END;                                               <<04212>>70570000
       END;                                                    <<04952>>70580000
        <<  Check length and delimiters  >>                    <<04952>>70590000
        <<  to see if we have a lockword >>                    <<04952>>70600000
        <<  TEMP'BYTE holds the delimiter>>                    <<04952>>70610000
        TEMP'BYTE := TEMP'PNTR(BYTE'INDEX);                    <<04952>>70620000
        IF BYTE'INDEX - TEMP'BYTE'INDX > 8                     <<04952>>70630000
        OR                                                     <<04952>>70640000
          (TEMP'BYTE <> "."   LAND                             <<04952>>70650000
           TEMP'BYTE <> ","   LAND                             <<04952>>70660000
           TEMP'BYTE <> ";"   LAND                             <<04952>>70670000
           TEMP'BYTE <> " "   LAND                             <<04952>>70680000
           TEMP'BYTE <> %15)                                   <<04952>>70690000
        THEN BEGIN  <<  Not a lockword  >>                     <<04952>>70700000
           TOS := @B'POINTER+1;  << Reset for scan >>          <<04952>>70710000
           GOTO REPEATSCAN;                                    <<04952>>70720000
        END                                                    <<04952>>70730000
                                                               <<04952>>70740000
        ELSE BEGIN   << assume a lockword and compact >>       <<04952>>70750000
            LEN'STRING'LEFT := LEN-BYTE'INDEX+1;               <<04952>>70760000
            MOVE TEMP'PNTR(TEMP'BYTE'INDX) :=                  <<04212>>70770000
                TEMP'PNTR(BYTE'INDEX),(LEN'STRING'LEFT);       <<04212>>70780000
            LEN := LEN- (BYTE'INDEX-TEMP'BYTE'INDX);           <<04212>>70790000
     <<           NEW STRING LENGTH COMPUTED           >>      <<04212>>70800000
            TOS := @B'POINTER +1; <<POINT AT BYTE AFTER SLASH>><<04212>>70810000
            COMPACTED := TRUE; << remember me  >>              <<04952>>70820000
            GOTO REPEATSCAN;                                   <<04212>>70830000
        END;                                                   <<04952>>70840000
                                                               <<04952>>70850000
     END;                                                      <<04212>>70860000
                                                               <<04212>>70870000
PRINTCOMMAND:                                                  <<04212>>70880000
   IF WHOLELENGTH > LEN THEN                                   <<04212>>70890000
       BEGIN                                                   <<04212>>70900000
       LEN := WHOLELENGTH;                                     <<04212>>70910000
       IF SEQUENCED THEN <<  replace saved byte  >>            <<04952>>70920000
       TEMP'PNTR(LEN-8) := SAVEECHOBYTE;                       <<04952>>70930000
       END;                                                    <<04212>>70940000
   @PRINTPOS := @TEMP'PNTR&LSR(1);<< PNTR=START OF TEMPBUFFER <<04212>>70950000
   IF LEN > STDLISTLENB THEN                                   <<00419>>70960000
      DO BEGIN   << BREAK LINE INTO PRINTABLE PIECES >>        <<00419>>70970000
         PRINT(PRINTPOS,STDLISTLENW,0);                        <<00419>>70980000
         IF > THEN CIERR(ERRNUM := ERRSTDLISTEOF)              <<04787>>70990000
         ELSE IF < THEN CIERR(ERRNUM := ERRSTDLISTIO);         <<04787>>71000000
         LEN := LEN-STDLISTLENB;                               <<00419>>71010000
         @PRINTPOS := @PRINTPOS+STDLISTLENW;                   <<00419>>71020000
         END                                                   <<00419>>71030000
      UNTIL LEN <= STDLISTLENB;                                <<00419>>71040000
   PRINT(PRINTPOS,-LEN,0);                                     <<00419>>71050000
   IF > THEN CIERR(ERRNUM := ERRSTDLISTEOF)                    <<04787>>71060000
   ELSE IF < THEN CIERR(ERRNUM := ERRSTDLISTIO);               <<04787>>71070000
   END;                                                        <<00419>>71080000
END;<<ECHO>>                                                            71090000
                                                               <<00607>>71100000
<<               **************************                >>  <<00607>>71110000
<<               *  CLEAN'TERMINAL'STATE  *                >>  <<00607>>71120000
<<               **************************                >>  <<00607>>71130000
                                                               <<00607>>71140000
SUBROUTINE CLEAN'TERMINAL'STATE (PROMPTUSER);                  <<00607>>71150000
   VALUE PROMPTUSER;                                           <<00607>>71160000
   LOGICAL PROMPTUSER;                                         <<00607>>71170000
BEGIN                                                          <<00607>>71180000
COMMENT:                                                       <<00607>>71190000
   THIS SUBROUTINE DISALLOWS BREAK, CLEARS THE FLUSH           <<00607>>71200000
   FLAG TO ALLOW READ/WRITE TO TERMINAL, AND PRINTS            <<00607>>71210000
   ":" IF PROMPTUSER IS TRUE.;                                 <<00607>>71220000
PXGLOBAL;                                                      <<06580>>71230000
ATTACHIO(PXG'INPUTLDEV,0,0,0,28,0,0,0,1);                      <<06580>>71240000
<<QUIESCE I/O TO WAIT UNTIL ALL OTHER I/O IS COMPLETED>>       <<00607>>71250000
<<BEFORE BREAK IS DISALLOWED ON $STDIN                >>       <<00607>>71260000
SETSERVICE(TRUE); <<DON'T ALLOW BREAK>>                        <<00607>>71270000
IF PROMPTUSER THEN                                             <<00607>>71280000
   ATTACHIO(PXG'OUTPUTLDEV,0,0,@PROMPT,25,PROMPTL,             <<06580>>71290000
            %320,0,1)  <<WRITE OUT PROMPT>>                    <<00607>>71300000
ELSE  <<NO PROMPT--BUT CLEAR FLUSH>>                           <<00607>>71310000
  ATTACHIO(PXG'OUTPUTLDEV,0,0,0,25,0,%320,0,1);                <<06580>>71320000
END;<<CLEAN'TERMINAL'STATE>>                                   <<00607>>71330000
<<                 *********************                   >>  <<U.RAO>>71340000
<<                 *     GETIMAGE      *                   >>  <<U.RAO>>71350000
<<                 *********************                   >>  <<U.RAO>>71360000
                                                               <<U.RAO>>71370000
SUBROUTINE GETIMAGE;                                                    71380000
<<This subroutine is responsible for getting the next command>><<03.RO>>71390000
<<image from the user, except for UDC's and the COMMAND >>     <<03.RO>>71400000
<<intrinsic.  When it returns a completed command image will>> <<03.RO>>71410000
<<be found in the COMIMAGE buffer.  The subroutine is primarily<<03.RO>>71420000
<<a giant loop which reads and processes each record until>>   <<03.RO>>71430000
<<it decides that there are no more continuation records to>>  <<03.RO>>71440000
<<be read.>>                                                   <<03.RO>>71450000
<<The first part of the loop (before label HAVECOMMAND) is>>   <<03.RO>>71460000
<<involved with the I/O aspects of getting the record.>>       <<03.RO>>71470000
<<First, if STDIN is a terminal, it quiesces the terminal,>>   <<03.RO>>71480000
<<clears the BREAK bits, then prompts the user.>>              <<03.RO>>71490000
<<Second it manages a stack called LINELENSTACK.  This stack>> <<03.RO>>71500000
<<holds the processed lengths of each of the lines read.  >>   <<03.RO>>71510000
<<This information is used when CIERR calculates where in >>   <<03.RO>>71520000
<<world to put a caret.  This is an imperfect mechanism since>><<03.RO>>71530000
<<it requires a lot of coordination between the executors and>><<03.RO>>71540000
<<CIERR.  It should be replaced with a better one.  >>         <<03.RO>>71550000
<<Third a READ is issued against STDIN.  This read is followed><<03.RO>>71560000
<<by a lot of code to handle I/O errors and EOF's.  Not very>> <<03.RO>>71570000
<<interesting stuff.  One thing to note, however, is that>>    <<03.RO>>71580000
<<with terminals we usually try to continue.  In some cases>>  <<03.RO>>71590000
<<this will cause the CI to loop until it finally gets aborted><<03.RO>>71600000
<<from elsewhere or for some other reason.>>                   <<03.RO>>71610000
<<The second part of the command (after HAVECOMMAND) we process<<03.RO>>71620000
<<the read record into what will later be passed to the >>     <<03.RO>>71630000
<<command executor.  In particular it deletes leading and>>    <<03.RO>>71640000
<<trailing blanks, handles sequence numbers, checks for the>>  <<03.RO>>71650000
<<leading colon, checks the current length of the command>>    <<03.RO>>71660000
<<for a fit with our buffer and several other fairly obvious>> <<03.RO>>71670000
<<tasks.  Finally the subroutine returns to the outer block>>  <<03.RO>>71680000
<<of the procedure.  One other related thing to be aware of>>  <<03.RO>>71690000
<<is the fact that sometimes the first record of the command>> <<03.RO>>71700000
<<has been pre-read.  In particular this occurs if a user>>    <<03.RO>>71710000
<<program was reading data from STDIN in a job.  In this>>     <<03.RO>>71720000
<<case the CI tries to flush all remaining user data until>>   <<03.RO>>71730000
<<it finds an MPE command (leading colon) to execute.>>        <<03.RO>>71740000
<<The procedure doing the flush (CISUBSYSFINISH) then >>       <<03.RO>>71750000
<<stuffs the MPE command it stopped on into COMIMAGE and >>    <<03.RO>>71760000
<<leaves the length in PENDINGCOMLEN.  Obviously then we>>     <<03.RO>>71770000
<<must branch around the code which does the read the first>>  <<03.RO>>71780000
<<time through.  Hence HAVECOMMAND.  >>                        <<03.RO>>71790000
<<There are also some scattered flags for UDC for handling>>   <<03.RO>>71800000
<<REDO and error message generation on UDC's.>>                <<03.RO>>71810000
BEGIN                                                                   71820000
PXGLOBAL;                                                      <<06580>>71830000
IOERRCOUNT := 0;  << Gets "IOERRLIMIT" tries this cmd. >>      <<04709>>71840000
NEXTCOM:                                                                71850000
      @PNTR := @CIS'BCOMIMAGE;                                 << I.A >>71860000
      COMMENT:                                                 <<00287>>71870000
         INITIALIZE "SPACE LEFT" TO NUM OF ALLOWED CHAR+1,     <<00287>>71880000
         IN ORDER TO CATCH 'COMMAND TOO LONG';                 <<00287>>71890000
      LEFT := CIS'BCOMBUFLEN - 1;                              << I.A >>71900000
      CIS'UDCIMAGEADJUST := FALSE;                             << I.A >>71910000
      CONTFLG := JOBFLG := FALSE;                              <<03.RO>>71920000
   << CHECK FOR ENTIRE COM (BREAK) OR PARTIAL COM (FLUSH) PENDING>>     71930000
      LENGTH := CIS'PENDINGCOMLEN; << READ COMMAND LENGTH >>   << I.A >>71940000
      IF > THEN                                                         71950000
         BEGIN    <<SOMETHING PENDING>>                                 71960000
         CIS'PENDINGCOMLEN := 0;  << CLEAR ALREADY READ FLAG >><< I.A >>71970000
         IF COMMANDPASSED THEN COMMANDEXECED:=TRUE; <<IMAGED>>          71980000
         LINELENSPTR := 0;  << INITIALIZE FOR (CMD) LOGONS >>  <<00240>>71990000
         <<DISABLE BREAK & CLEAR FLUSH FLAG>>                  <<00607>>72000000
         IF PXG'INTERACTIVE THEN CLEAN'TERMINAL'STATE(FALSE);  <<06580>>72010000
         GOTO HAVECOMMAND;                                              72020000
         END;                                                           72030000
      LINELENSPTR := -1;   <<INITIALIZE STACK POINTER>>        <<U.RAO>>72040000
      DO                                                                72050000
         BEGIN                                                          72060000
         IF PXG'INTERACTIVE THEN                               <<06580>>72070000
           BEGIN                                                        72080000
           <<DISABLE BREAK,CLEAR FLUSH,WRITE PROMPT IF NEC.>>  <<00607>>72090000
           LPDT'INDEX:=PXG'INPUTLDEV * LPDT'ENTRY'SIZE;        <<06580>>72100000
           IF INTEGER(LPDT'EOF'TYPE) =LPDT'NO'EOF THEN         <<06226>>72110000
              CLEAN'TERMINAL'STATE(TRUE) <<WRITE PROMPT>>      <<00607>>72120000
           ELSE  <<NO PROMPT>>                                 <<00607>>72130000
              CLEAN'TERMINAL'STATE(FALSE);                     <<00607>>72140000
           END;                                                         72150000
           <<PREPARE TO UPDATE LINELENGTH STACK>>              <<U.RAO>>72160000
           LINELENSPTR := LINELENSPTR+1;                       <<U.RAO>>72170000
    IF LINELENSPTR > CIS'MAXCONTLINES THEN                     << I.A >>72180000
    BEGIN                                                      <<01032>>72190000
        CIERR(ERRNUM := COMTOOMANYLINES);                      <<04787>>72200000
        GO TO NEXTCOM;                                         <<01032>>72210000
    END;                                                       <<01032>>72220000
            IF LINELENSPTR <> 0                                << I.A >>72230000
               THEN CIS'UDCIMAGEADJUST                         << I.A >>72240000
                      := TRUE;                                 << I.A >>72250000
            TOS := 0;                                                   72260000
            TOS := @PNTR & ASR(1);     <<STACK < 16K>>                  72270000
            LENGTH := READ (*, -LEFT);                                  72280000
            IF <> THEN                                                  72290000
               BEGIN    << ERROR OR EOF >>                              72300000
            IF < THEN   <<IO ERROR ON STDIN>>                  <<U.RAO>>72310000
               BEGIN                                           <<U.RAO>>72320000
               CIERR(ERRNUM := ERRSTDINIO);                    <<04787>>72330000
               IF (IOERRCOUNT:=IOERRCOUNT+1) > IOERRLIMIT THEN <<03.RO>>72340000
                  BEGIN                                        <<03.RO>>72350000
                  SETSERVICE(FALSE);                           <<03.RO>>72360000
                  TERMINATE;                                   <<03.RO>>72370000
                  END;  <<TOO MANY IO ERRORS ON READ FROM STDIN<<03.RO>>72380000
               GO TO NEXTCOM;                                  <<U.RAO>>72390000
               END;                                            <<U.RAO>>72400000
               << EOF: PHYSICAL OR JOB-DELIMITING COMMAND >>            72410000
                IF HARDEOF'THEN'BRK THEN                       <<00540>>72420000
                   BEGIN                                       <<00540>>72430000
                   COMMENT:                                    <<00540>>72440000
                      HIT BREAK AFTER :EOF:. IGNORE BREAK      <<00540>>72450000
                      AND END SESSION;                         <<00540>>72460000
                PXFIXED;                                       <<06580>>72470000
                PXFXBRKMODE := 0;                              <<06580>>72480000
                   CIS'PENDINGCOMLEN := 0;                     << I.A >>72490000
                   FUNBREAK(TRUE);                             <<00540>>72500000
                   ABORTPROG;                                  <<00540>>72510000
                   CIS'UDCEXITBREAK := TRUE;                   << I.A >>72520000
                   GO NEXT;                                    <<00540>>72530000
                   END;                                        <<00540>>72540000
               IF NOT (CONTFLG) THEN                                    72550000
                  BEGIN    <<NO PARTIAL COMMAND: "PURE EOF">>           72560000
                  IF ABORTREFUSED (0) THEN                              72570000
                     BEGIN    << ABORT REFUSED IN BREAK >>              72580000
                     IF CIS'UDCEXITBREAK THEN GO NEXT;         << I.A >>72590000
                     FRESETEOF;    <<CLEAR FSYS' EOF STUFF>>            72600000
                     LEFT := PXG'INPUTLDEV;                    <<06580>>72610000
                     << CHECK FOR BACKSPACED COMMAND & CLEAR >>         72620000
                    LPDT'INDEX:=LEFT*INTEGER(LPDT'ENTRY'SIZE); <<06579>>72630000
                    IF NOT                                     <<06226>>72640000
                     (LOGICAL((INTEGER(LPDT'EOF'TYPE))MOD 2))  <<06226>>72650000
                     THEN                                      <<06226>>72660000
                     << other EOF's:  :HELLO, :JOB, :DATA >>   <<06226>>72670000
                        ATTACHIO (LEFT,0,0,0,0,0,0,0,1)                 72680000
                     ELSE                                               72690000
                     << EOF's: Hardware, :EOD, :BYE, :EOJ >>   <<06226>>72700000
                        << JUST CLEAR LPDT EOF INDICATOR >>             72710000
                     LPDT'EOF'TYPE:=LPDT'NO'EOF;               <<06226>>72720000
                     GOTO NEXTCOM;    <<CONTINUE SESSION>>              72730000
                     END;                                               72740000
                  <<NOT IN BREAK MODE (INCL ALL BATCH)>>                72750000
                  PXGLOBAL;                                    <<06580>>72760000
                  LPDT'INDEX := PXG'INPUTLDEV* LPDT'ENTRY'SIZE;<<06580>>72770000
                  IF PXG'JOBTYPE=2 AND                         <<06580>>72780000
                  LPDT'EOF'TYPE=LPDT'EOJ THEN                  <<06226>>72790000
                    BEGIN <<EOJ READ IN JOB MODE>>                      72800000
                    MOVE PNTR := ":EOJ";                                72810000
                    PNTR(4) :=%15;                             <<04690>>72820000
                    ECHO(5);                                   <<04690>>72830000
                    END;                                                72840000
                  SETSERVICE(FALSE);<<CLEAR BREAK BIT IN LPDT>>         72850000
                  TERMINATE;    <<EOF TERMINATES DIRECTLY>>             72860000
                  END;                                                  72870000
               LENGTH := 0;    <<EOF AS CONTINUED COMMAND DELIM>>       72880000
               END;                                                     72890000
               IOERRCOUNT := 0;  <<SINCE SUCCESSFUL READ>>     <<03.RO>>72900000
HAVECOMMAND:                                                            72910000
            PNTR(LENGTH) := %15;  <<TERMINATOR>>               <<01.RO>>72920000
            CIS'NUMBLANKS := 0; << no. blanks in last line >>  << I.A >>72930000
            IF NOT (PXG'INTERACTIVE) AND NOT(CONTFLG) THEN     <<06580>>72940000
               BEGIN                                           <<01.RO>>72950000
               <<NEXT FIND CMD NAME, SINCE MIGHT BE JOB CMD.>> <<01.RO>>72960000
               <<IF SO, DON'T WANT TO ECHO>>                   <<01.RO>>72970000
               SCAN PNTR(1) WHILE %6440,1;<<SKIP BLANKS TO NAME<<01.RO>>72980000
               ASSEMBLE(DUP);                                  <<01.RO>>72990000
               MOVE BPS0 := BPS0 WHILE AS,1;                   <<01.RO>>73000000
               ASSEMBLE(SUB);  <<NEG OF COMMAND NAME LENGTH>>  <<01.RO>>73010000
               IF TOS = -3 THEN   <<LENGTH IS RIGHT FOR :JOB>> <<01.RO>>73020000
                  IF *="JOB" THEN                              <<01.RO>>73030000
                     JOBFLG := TRUE   <<DON'T ECHO>>           <<01.RO>>73040000
                  ELSE                                         <<01.RO>>73050000
               ELSE DEL;  <<POP POINTER TO COMMAND NAME>>      <<01.RO>>73060000
               END;                                            <<01.RO>>73070000
            IF NOT JOBFLG THEN   <<NOT IN MIDDLE OF JOB CMD>>  <<01.RO>>73080000
               ECHO(LENGTH);                                   <<01.RO>>73090000
            IF CIS'SEQUENCED AND LENGTH > 8 THEN               << I.A >>73100000
               BEGIN  <<HANDLE SEQUENCE NUMBER>>               <<01.RO>>73110000
               LENGTH := LENGTH-8;  <<DELETE SEQUENCE NUMBER>> <<01.RO>>73120000
               NEWSEQNUM := DBINARY(PNTR(LENGTH), 8);          <<01.RO>>73130000
               IF = THEN   <<VALID NUMBER>>                    <<01.RO>>73140000
                  IF NEWSEQNUM >= OLDSEQNUM THEN  <<IN SEQUENCE<<01.RO>>73150000
                     OLDSEQNUM := NEWSEQNUM                    <<01.RO>>73160000
                  ELSE <<OUT OF SEQUENCE>>                     <<01.RO>>73170000
                   CIERR(ERRNUM:=-BADSEQUENCEORDR,PNTR(LENGTH))<<04787>>73180000
               ELSE  <<NON-NUMERIC, CHECK FOR BLANKS>>         <<01.RO>>73190000
                  IF PNTR(LENGTH) <> "        " THEN           <<01.RO>>73200000
                     BEGIN                                     <<01.RO>>73210000
                   CIERR(ERRNUM:=-BADSEQUENCENUM,PNTR(LENGTH));<<04787>>73220000
                     LENGTH := LENGTH+8;                       <<01.RO>>73230000
                     END;                                      <<01.RO>>73240000
               PNTR(LENGTH) := %15;  <<TRAILING CR>>           <<01.RO>>73250000
               END;                                            <<01.RO>>73260000
            IF (LENGTH > 0) AND (PNTR (LENGTH -1) = " ") THEN  <<00581>>73270000
               BEGIN    <<STRIP TRAILING BALNKS>>              <<01.RO>>73280000
               TOS := @PNTR (X);                               <<01.RO>>73290000
               ASSEMBLE (DUP, DECA);                           <<01.RO>>73300000
               TOS := -X;                                      <<01.RO>>73310000
               ASSEMBLE (CMPB 0);                              <<01.RO>>73320000
               LENGTH := -TOS;                                 <<01.RO>>73330000
               DDEL;                                           <<01.RO>>73340000
               PNTR(LENGTH) := %15;  <<TRAILING CR>>           <<00581>>73350000
               END;                                            <<01.RO>>73360000
          PXGLOBAL;                                            <<06580>>73370000
          IF NOT PXG'INTERACTIVE THEN << IS JOB >>             <<06580>>73380000
            BEGIN  <<USER MUST PROVIDE LEADING COLON>>         <<01.RO>>73390000
            IF PNTR <> ":" THEN                                <<01.RO>>73400000
                       <<COLON MISSING, MIGHT BE DATA, NOT CMD><<01.RO>>73410000
               IF CIS'IFSKIP THEN <<NOT PARSING ANYHOW>>       << I.A >>73420000
                  GO TO NEXTCOM   <<IGNORE>>                   <<07.RO>>73430000
               ELSE  <<FATAL ERROR>>                           <<07.RO>>73440000
                  BEGIN                                        <<00255>>73450000
                  CIERR(ERRNUM := NOCOLON, CIS'BCOMIMAGE);     <<04787>>73460000
                  GO TO NEXTCOM; <<IN CASE OF PREV :CONTINUE>> <<00255>>73470000
                  END;                                         <<00255>>73480000
            IF LENGTH=1 AND NOT CONTFLG THEN <<NULL COMMAND>>  <<U.RAO>>73490000
               GO TO NEXTCOM;  <<TRY AGAIN>>                   <<U.RAO>>73500000
            PNTR := " ";  <<WIPE OUT COLON>>                   <<U.RAO>>73510000
            CIS'NUMBLANKS := -1;                               << I.A >>73520000
            END                                                <<U.RAO>>73530000
         ELSE  <<IN SESSION JUST CHECK FOR BLANK COMMAND>>     <<U.RAO>>73540000
            IF (LENGTH=0) AND NOT CONTFLG THEN                 <<U.RAO>>73550000
               GO TO NEXTCOM;  <<ZERO LENGTH READ>>            <<U.RAO>>73560000
         <<NOW DELETE ANY LEADING BLANKS>>                     <<U.RAO>>73570000
         IF PNTR=" " THEN                                      <<U.RAO>>73580000
            BEGIN   <<AT LEAST ONE THERE>>                     <<U.RAO>>73590000
            TOS := @PNTR;                                      <<U.RAO>>73600000
            SCAN PNTR WHILE %6440,1;  <<SCAN UNTIL NOT BLANK>> <<U.RAO>>73610000
            ASSEMBLE(DDUP, SUB);  <<NEG # OF BLANKS TO DELETE>><<U.RAO>>73620000
            CIS'NUMBLANKS := -S0 + CIS'NUMBLANKS;              << I.A >>73630000
            LENGTH := TOS+LENGTH;  <<ACTUAL LENGTH OF COMMAND>><<U.RAO>>73640000
            MOVE * := *, (LENGTH);                             <<U.RAO>>73650000
            PNTR(LENGTH) := %15;  <<MARK END OF COMMAND>>      <<U.RAO>>73660000
            CIS'UDCIMAGEADJUST := TRUE;                        << I.A >>73670000
            END;                                               <<U.RAO>>73680000
         IF LENGTH >= LEFT THEN  << CMMD TOO LONG FOR BUFFER >><< I.A >>73690000
            BEGIN                                              <<U.RAO>>73700000
            CIERR(ERRNUM := COMMAND'GT'BUFFER,                 <<04787>>73710000
                  CIS'BCOMIMAGE( CIS'BCOMBUFLEN-LEFT ), %10000,<< I.A >>73720000
                  CIS'MAXCOMLEN    );                          << I.A >>73730000
            GO TO NEXTCOM;                                     <<U.RAO>>73740000
            END;                                               <<U.RAO>>73750000
         << IGNORE LINE IF: 1) NOT A CONTINUATION LINE AND >>  <<01309>>73760000
         <<                 2) ONLY CHARACTER IS A "&".    >>  <<01309>>73770000
         IF (NOT CONTFLG) AND                                  <<01309>>73780000
            (LENGTH=1) AND (PNTR="&") THEN                     <<01309>>73790000
            GO TO NEXTCOM;                                     <<01309>>73800000
         IF NOT CONTFLG THEN                                   <<U.RAO>>73810000
            BEGIN   <<IDENTIFY COMMAND>>                       <<U.RAO>>73820000
            IF PNTR = ALPHA                                    <<00184>>73830000
              THEN MOVE PNTR := PNTR WHILE AS,0                <<00184>>73840000
              ELSE MOVE PNTR := PNTR WHILE ANS,0;              <<00184>>73850000
            @PARMSP := TOS;                                    <<U.RAO>>73860000
            COMLEN := TOS-@PNTR;                               <<U.RAO>>73870000
            END;                                               <<U.RAO>>73880000
         @PNTR := @PNTR+LENGTH;                                <<U.RAO>>73890000
         IF PNTR(-1)="&" THEN   <<WILL EXPECT CONTINUATION>>   <<U.RAO>>73900000
            BEGIN                                              <<U.RAO>>73910000
            CONTFLG := TRUE;                                   <<U.RAO>>73920000
            PNTR(-1) := " ";  <<WIPE OUT "&">>                 <<U.RAO>>73930000
            END                                                <<U.RAO>>73940000
         ELSE  <<NO CONTINUATION EXPECTED>>                    <<U.RAO>>73950000
            CONTFLG := FALSE;                                  <<U.RAO>>73960000
         IF LOGICAL(@PNTR) THEN  <<ON ODD BYTE BOUNDARY>>      <<U.RAO>>73970000
            BEGIN  <<ADJUST TO WORD BOUNDARY>>                 <<U.RAO>>73980000
            PNTR := " ";                                       <<U.RAO>>73990000
            @PNTR := @PNTR+1;                                  <<U.RAO>>74000000
            LENGTH := LENGTH+1;                                <<U.RAO>>74010000
            END;                                               <<U.RAO>>74020000
      CIS'LINELENSTACK(LINELENSPTR) := LENGTH;                 << I.A >>74030000
         LEFT := LEFT-LENGTH;                                  <<U.RAO>>74040000
         END                                                   <<U.RAO>>74050000
      UNTIL NOT CONTFLG;  <<UNTIL NO MORE CONTINUATIONS>>      <<U.RAO>>74060000
   PNTR := %15;  <<MARK END WITH CR>>                          <<U.RAO>>74070000
   CIS'LINELENSTACK(LINELENSPTR) := 0;  << TERMINATOR >>       << I.A >>74080000
END   <<GETIMAGE>>;                                                     74090000
<<                 *********************                   >>  <<U.RAO>>74100000
<<                 *   PERMITACCESS    *                   >>  <<U.RAO>>74110000
<<                 *********************                   >>  <<U.RAO>>74120000
                                                               <<U.RAO>>74130000
LOGICAL SUBROUTINE PERMITACCESS;                               <<U.RAO>>74140000
BEGIN                                                          <<U.RAO>>74150000
<<THIS SUBROUTINE PROCESSES THE ACCESS MASK PASSED BACK>>      <<U.RAO>>74160000
<<BY COMSEARCH.  TO SEE THE EXPLICIT ASSIGNMENT OF BITS>>      <<U.RAO>>74170000
<<TO RESTRICTIONS AND CAPABILITIES, SEE THE COMMENT TO>>       <<U.RAO>>74180000
<<THAT PROCEDURE.  THIS SUBROUTINE DOES NOTHING OF GREAT>>     <<U.RAO>>74190000
<<DIFFICULTY.  NOTE THAT IT IS ASSUMED THAT THE CALLER>>       <<U.RAO>>74200000
<<WILL COPE WITH ANY DIFFICULTIES ASSOCIATED WITH HANDLING>>   <<U.RAO>>74210000
<<PROGRAMMATIC CALLS, SUCH AS RETURNING ERROR CODES.>>         <<U.RAO>>74220000
PXGLOBAL;                                                      <<06580>>74230000
IF NOT PROGCALL AND CIS'IFSKIP AND NOT AEXECEVENINIF THEN      << I.A >>74240000
   RETURN;  <<FLUSH, IN NON-EXECUTING BLOCK OF IF COMMAND>>    <<U.RAO>>74250000
IF ACANBREAK THEN <<SET FLAG, SO OUTER BLOCK CAN INITIALIZE>>  <<U.RAO>>74260000
   NONABORTABLE := FALSE  <<ITSELF TO HOLD OFF BREAK>>         <<U.RAO>>74270000
ELSE  <<CAN'T BE BROKEN>>                                      <<U.RAO>>74280000
   NONABORTABLE := TRUE;  <<SORRY FOR THE DOUBLE NEGATIVES>>   <<U.RAO>>74290000
<< THE CHECK FOR NOT REDOABLE HAS BEEN REMOVED FROM >>         <<01455>>74300000
<< PERMITACCESS AND MOVED TO XEQIT.                 >>         <<01455>>74310000
IF PROGCALL AND ANOTINPROG THEN                                <<U.RAO>>74320000
   BEGIN  <<CAN'T BE USED PROGRAMMATICALLY>>                   <<U.RAO>>74330000
   ERRNUM := ERRNOTPROGRAMAT;                                  <<U.RAO>>74340000
   RETURN                                                      <<U.RAO>>74350000
   END;                                                        <<U.RAO>>74360000
IF ANOTINBREAK THEN  <<CHECK TO SEE IF USER IN BREAK>>         << 8880>>74370000
   BEGIN                                                       << 8880>>74380000
   TOS := 0;  <<RETURN SPACE FOR ABORTREFUSED>>                << 8880>>74390000
   SCAN CIS'BCOMIMAGE UNTIL %6415,1;  << GET WHOLE CMMD LEN >> << 8880>>74400000
   TOS := TOS - @CIS'BCOMIMAGE;  << COMMAND LENGTH >>          << 8880>>74410000
   IF ABORTREFUSED(*) THEN                                     << 8880>>74420000
      BEGIN                                                    << 8880>>74430000
      IF CIS'UDCNESTLEVEL <> 0 THEN                            << 8880>>74440000
         CIS'UDCFATALCIERR  := TRUE;                           << 8880>>74450000
      RETURN;  <<ABORT REFUSED IN BREAK MODE>>                 << 8880>>74460000
      END;                                                     << 8880>>74470000
   END;                                                        << 8880>>74480000
IF UDCEXECED AND ANOTINUDC THEN                                <<01455>>74490000
   BEGIN  << NOT ALLOWED IN UDC >>                             <<01455>>74500000
   CIERR( ERRNUM:=NOTINUDC, CIS'BCOMIMAGE );                   << I.A >>74510000
   RETURN                                                      <<01455>>74520000
   END;                                                        <<01455>>74530000
IF ANOTINJOB AND PXG'JOBTYPE = JOBFLAG THEN                    <<06580>>74540000
   BEGIN  <<NOT ALLOWED IN JOB>>                               <<U.RAO>>74550000
   CIERR( ERRNUM:=NOTINJOB, CIS'BCOMIMAGE );                   << I.A >>74560000
   RETURN                                                      <<U.RAO>>74570000
   END;                                                        <<U.RAO>>74580000
IF ANOTINSESSION AND PXG'JOBTYPE = SESSIONFLAG THEN            <<06580>>74590000
   BEGIN  <<NOT ALLOWED IN SESSION>>                           <<U.RAO>>74600000
   CIERR( ERRNUM:=NOTINSESSION, CIS'BCOMIMAGE );               << I.A >>74610000
   RETURN                                                      <<U.RAO>>74620000
   END;                                                        <<U.RAO>>74630000
IF FUNNYTERMINAL AND ACAN'TWITHAPL THEN                        <<U.RAO>>74640000
   BEGIN                                                       <<U.RAO>>74650000
   CIERR( ERRNUM:=APLTERM, CIS'BCOMIMAGE(1) );                 << I.A >>74660000
   RETURN                                                      <<U.RAO>>74670000
   END;                                                        <<U.RAO>>74680000
IF CAPCHECK THEN                                               <<U.RAO>>74690000
   BEGIN                                                       <<U.RAO>>74700000
   <<STRATEGY IS TO LOAD USER'S CAP LIST, USE REQUESTED>>      <<U.RAO>>74710000
   <<COMPARISON, SEND USER'S ERROR MESSAGE AS SUPPLIED IN>>    <<U.RAO>>74720000
   <<COMSEARCH.>>                                              <<U.RAO>>74730000
   TOS := CAP0 LAND PXG'USERATTRIBUTES;                        <<06580>>74740000
   PXFIXED;                                                    <<06580>>74750000
   TOS := CAP1 LAND PXFXCAP;                                   <<06580>>74760000
   IF ORCAPCHECK AND TOS=0D OR ANDCAPCHECK AND TOS<>CAP THEN  <<U.RAO>> 74770000
      BEGIN                                                    <<U.RAO>>74780000
      CIERR( ERRNUM:=CAPCHECKERR, CIS'BCOMIMAGE );             << I.A >>74790000
      RETURN                                                   <<U.RAO>>74800000
      END;                                                     <<U.RAO>>74810000
   END;                                                        <<U.RAO>>74820000
IF OPCOMMAND AND NOT MASTEROP THEN                             <<00552>>74830000
BEGIN                                                          <<00552>>74840000
   JITDSTN:=PXG'JITDST;                                        <<06846>>74850000
   MOVEFROMDSEG(@JITARR,JITDSTN,0,JIT'ENTRY'SIZE);             <<06846>>74860000
   IF (ALLOWMASK(OPCOMMANDWRD)&LSL(OPCOMMANDINX))>=0 THEN      <<00552>>74870000
   BEGIN                                                       <<00552>>74880000
      CIERR( ERRNUM:=OPCOMNOTALLOW, CIS'BCOMIMAGE );           << I.A >>74890000
      RETURN;                                                  <<00552>>74900000
   END;                                                        <<00552>>74910000
END;                                                           <<00552>>74920000
   IF SPECIAL'BREAK AND NOT SPECIALBREAK'COM THEN              <<00594>>74930000
   BEGIN                                                       <<00594>>74940000
      CIERR( ERRNUM:=SPECIALCOM, CIS'BCOMIMAGE );              << I.A >>74950000
      RETURN;                                                  <<00594>>74960000
   END; <<COMMAND NOT ALLOWED DURING SPECIAL BREAK>>           <<00594>>74970000
PERMITACCESS := TRUE;                                          <<U.RAO>>74980000
END;  <<SUBROUTINE PERMITACCESS>>                              <<U.RAO>>74990000
                                                                        75000000
<<                 *********************                   >>  <<U.RAO>>75010000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>75020000
<<                 *********************                   >>  <<U.RAO>>75030000
                                                               <<U.RAO>>75040000
                                                               <<03.RO>>75050000
<<The main body of the procedure is really split up into>>     <<03.RO>>75060000
<<two pieces, a part which fires up the job/session and>>      <<03.RO>>75070000
<<a part which iterates, getting commands and sending>>        <<03.RO>>75080000
<<them to the appropriate executor.   Most of the first>>      <<03.RO>>75090000
<<part is done by procedure INITJSMP in NURSERY.>>             <<03.RO>>75100000
<<As a sidelight, it should be noted that this is where the>>  <<03.RO>>75110000
<<WELCOME message is sent to the user.>>                       <<03.RO>>75120000
<<The bulk of the work is done by the second part of the main>><<03.RO>>75130000
<<body.  There are five major sections.  The first four are>>  <<03.RO>>75140000
<<all involved with making sure we get the command image from>><<03.RO>>75150000
<<the right place.  The last one is concerned with trying to>> <<03.RO>>75160000
<<execute the command that was found.  Therefore we will deal>><<03.RO>>75170000
<<with the last section, XEQIT, first.  This block must do >>  <<03.RO>>75180000
<<three things.  First, it calls procedure COMSEARCH to>>      <<03.RO>>75190000
<<decide if this is a valid MPE command.  It is decided>>      <<03.RO>>75200000
<<elsewhere if this is a UDC, so we don't worry about it here.><<03.RO>>75210000
<<Assuming it to be a valid command, we call the executor,>>   <<03.RO>>75220000
<<the plabel of which was returned by COMSEARCH.  >>           <<03.RO>>75230000
<<Finally we must decide where to go next.  If we entered>>    <<03.RO>>75240000
<<from the COMMAND intrinsic we return to the user.  If we>>   <<03.RO>>75250000
<<entered from UDC then we return there.  Otherwise we must>>  <<03.RO>>75260000
<<go back to the user for another command.  The entry >>       <<03.RO>>75270000
<<UDCCI is called from UDC to process the putative MPE>>       <<03.RO>>75280000
<<command found in the UDC being processed.  The primary>>     <<03.RO>>75290000
<<item of interest here is that it provides for the >>         <<03.RO>>75300000
<<possibility that the command being processed is actually>>   <<03.RO>>75310000
<<another UDC (nested).  The entry COMMAND' is the entry>>     <<03.RO>>75320000
<<from the COMMAND intrinsic.  It's primary function is >>     <<03.RO>>75330000
<<to set some flags indicating that we were actually called>>  <<03.RO>>75340000
<<programmatically.  The entry SYSBREAK is called whenever>>   <<03.RO>>75350000
<<the system decides that BREAK has been hit (either the key>> <<03.RO>>75360000
<<or the intrinsic CAUSEBREAK).  Note that it runs on the>>    <<03.RO>>75370000
<<CI stack, not the users stack.  COMMAND' runs on the >>      <<03.RO>>75380000
<<user's stack.  Label NEXT is branched to as the "normal" >>  <<03.RO>>75390000
<<place whenever we are doing the normal CI thing.>>           <<03.RO>>75400000
<<It has three claims to fame.  First it is the code>>         <<03.RO>>75410000
<<which handles the decay of a :CONTINUE.  >>                  <<03.RO>>75420000
<<Second it is the origination of the call to UDC.>>           <<03.RO>>75430000
<<Third it is the only place where GETIMAGE is called.>>       <<03.RO>>75440000
                                                               <<03.RO>>75450000
PXGLOBAL;                                                      <<06580>>75460000
PUSH(STATUS);                                                  <<02.EB>>75470000
TOS.(2:1) := 0; << TURN OFF TRAPS >>                           <<02.EB>>75480000
SET(STATUS);                                                   <<02.EB>>75490000
CIS'UDCSPACE:= 0;   MOVE CIS'UDCSPACE(1) := CIS'UDCSPACE,(4);  << I.A >>75500000
INITJSMP(EXPCODE);                                             <<02.EB>>75510000
CIS'IFNESTING := CIS'IFSKIP := CIS'ELSESEEN := 0;              << I.A >>75520000
CIS'CIFLAGS := CIS'PENDINGCOMLEN := 0;                         << I.A >>75530000
CIS'CONTINUSTATESTK := 0D;                                     << I.A >>75540000
CIS'LINELENSTACK := 0;                                         << I.A >>75550000
MOVE CIS'LINELENSTACK(1)                                       << I.A >>75560000
   := CIS'LINELENSTACK, (CIS'MAXCONTLINES);                    << I.A >>75570000
CIS'NUMBLANKS := 0;                                            << I.A >>75580000
SPECIAL'BREAK:=FALSE;                                          <<00594>>75590000
IOERRCOUNT := 0;  <<INITIALIZE IO ERROR COUNTER>>              <<03.RO>>75600000
@CIS'BCOMIMAGE := @CIS'WCOMIMAGE&LSL(1); << INIT POINTER >>    << I.A >>75610000
@CIS'BLASTCOMIMAGE := @CIS'LASTCOMIMAGE&LSL(1);                << I.A >>75620000
CIS'BCOMIMAGE := CIS'BLASTCOMIMAGE := %15; <<FOR INITIAL REDO>><< I.A >>75630000
                                                               <<06.EB>>75640000
   << PREVENT BREAK IN EVENT OF (RUN)USER.ACCT OR A >>         <<08.EB>>75650000
   << OPTION LOGON UDC THAT RUNS A PROGRAM          >>         <<08.EB>>75660000
                                                               <<00850>>75670000
   << HANDLE (CMD)USER.ACCT LOGON & APL CHAR SET >>            <<00850>>75680000
PXGLOBAL;                                                      <<06580>>75690000
INSTANTLOGON;                                                  <<00850>>75700000
IF APLTERMTYPE <> 0 THEN                                       <<00850>>75710000
BEGIN                                                          <<00850>>75720000
   COMMANDPASSED := TRUE;                                      <<00850>>75730000
   IF APLTERMTYPE <> 1 THEN  <<NON-ASCII CHARACTERS>>          <<00850>>75740000
      FUNNYTERMINAL := TRUE                                    <<00850>>75750000
   ELSE   <<ASCII TERMINAL, JUST A SPECIAL LOGON>>             <<00850>>75760000
      APLTERMTYPE := 0;  <<CLEAR.  HENCEFORTH THIS>>           <<00850>>75770000
   <<FIELD JUST INDICATES WHICH APL TERMINAL IS IN USE>>       <<00850>>75780000
END;                                                           <<00850>>75790000
                                                               << 8958>>75800000
<< Print the WELCOME message if  1.  Startup not from FOS  >>  << 8958>>75810000
<<                               2.  The message exists    >>  << 8958>>75820000
<< Get the INITIAL communication DST.  If it is non-zero, >>   << 8958>>75830000
<< then we have a first logon via progen.  If the DST     >>   << 8958>>75840000
<< location is non-zero (the communication DST exists)    >>   << 8958>>75850000
<< get the FOS'TAPE word (1=boot was from HP FOS, 0=      >>   << 8958>>75860000
<< other).  IF FOS'TAPE = 1, then don't print any WELCOME >>   << 8958>>75870000
<< message, and print the auto installer message after    >>   << 8958>>75880000
<< UDC's are initialized.   Zero out the INITIAL          >>   << 8958>>75890000
<< communication DST after FOS'TAPE is retrieved and      >>   << 8958>>75900000
<< release the DST.                                       >>   << 8958>>75910000
                                                               << 8958>>75920000
FOS'TAPE := 0;                                                 << 8958>>75930000
COMMDST := SYS'GLOB'EXT( COMMDSTLOC );                         << 8958>>75940000
IF COMMDST <> 0                                                << 8958>>75950000
   THEN BEGIN     << 1st loggon by operator or manager >>      << 8958>>75960000
        TOS := @FOS'TAPE;                                      << 8958>>75970000
        TOS := COMMDST;                                        << 8958>>75980000
        TOS := 4;                                              << 8958>>75990000
        TOS := 1;                                              << 8958>>76000000
        ASSEMBLE( MFDS 4 );                                    << 8958>>76010000
        SYS'GLOB'EXT( COMMDSTLOC ) := 0;                       << 8958>>76020000
        RELDATASEG( COMMDST );                                 << 8958>>76030000
        END;                                                   << 8958>>76040000
                                                               << 8958>>76050000
IF FOS'TAPE = 0                                                << 8958>>76060000
   THEN BEGIN     << Not a boot logon >>                       << 8958>>76070000
        X := ABSOLUTE( WELCOMEDST );                           << 8958>>76080000
        IF >                                                   << 8958>>76090000
           THEN WELCOMEMES( X, PASSEDCOMMAND );                << 8958>>76100000
        END;  << Printing welcome message >>                   << 8958>>76110000
                                                               << 8958>>76120000
                                                               << 8958>>76130000
                                                               <<00850>>76140000
                                                               <<02848>>76150000
IF GET'DSDEVICE(PXG'INPUTLDEV)=3 THEN                          <<06580>>76160000
                                                               <<02848>>76170000
      << Job/session $STDIN device is a DS pseudo terminal,  >><<02848>>76180000
      << so this is a slave session.  Perform the appropriate>><<02848>>76190000
      << DS initialization by calling the CXRFA procedure    >><<02848>>76200000
      << (in the DSSEG4 segment) with a fake "RFA" command.  >><<02848>>76210000
                                                               <<02848>>76220000
   BEGIN                                                       <<02848>>76230000
   CIS'WCOMIMAGE(0) := "RF";                                   << I.A >>76240000
   CIS'WCOMIMAGE(1) := "A ";                                   << I.A >>76250000
   CIS'WCOMIMAGE(2) := %27;                                    << I.A >>76260000
   CXRFAD(CIS'BCOMIMAGE(3) <<after RFA parsed>>                << I.A >>76270000
         , ERRNUM, PARMNUM);                                   << I.A >>76280000
   END;                                                        <<02848>>76290000
IF PXG'INTERACTIVE THEN << INDICATES SESSION >>                <<06580>>76300000
BEGIN                                                          <<08.EB>>76310000
   ATTACHIO(PXG'INPUTLDEV,0,0,0,28,0,0,0,1);                   <<06580>>76320000
     <<QUIESCE I/O BEFORE BREAK DISALLOWED>>                   <<08.EB>>76330000
   SETSERVICE(TRUE);  <<DISABLE CI BREAK>>                     <<08.EB>>76340000
   ATTACHIO(PXG'OUTPUTLDEV,0,0,0,25,0,%320,0,1);               <<06580>>76350000
     <<CLEAR BREAK FLAGS IN LDT IF SET>>                       <<08.EB>>76360000
END;                                                           <<08.EB>>76370000
TOS:=ABSOLUTE(SYSUDCFLAG);  <<GET SYSTEM LEVEL UDC FLAG>>      <<00416>>76380000
PXFIXED;                                                       <<06580>>76390000
TOS := TOS LOR PXFXUSERUDC LOR PXFXACCTUDC;                    <<06580>>76400000
IF TOS THEN INITUDC(FALSE); <<INIT UDC'S IF THEY EXIST>>       <<00416>>76410000
                                                               << 8958>>76420000
<< Print the auto installer message if boot from HP FOS  >>    << 8958>>76430000
IF FOS'TAPE = 1      << Still 1st time boot logon >>           << 8958>>76440000
   THEN GENMSG( SYSSET, AUTOINSTALL'MSG );                     << 8958>>76450000
                                                               <<00416>>76460000
   << PXGLOB MUST BE SET AFTER INITUDC. PXFILE EXPANSION >>    <<06.EB>>76470000
PXGLOBAL;                                                      <<06580>>76480000
                                                               <<11.EB>>76490000
   << TURN BREAK OFF AGAIN IN CASE BREAK OCCURRED          >>  <<11.EB>>76500000
   << DURING LOGON UDC.                                    >>  <<11.EB>>76510000
IF CIS'UDC0 <> 0 AND PXG'INTERACTIVE THEN                      <<06580>>76520000
BEGIN                                                          <<11.EB>>76530000
   ATTACHIO(PXG'INPUTLDEV,0,0,0,28,0,0,0,1);                   <<06580>>76540000
     <<QUIESCE I/O BEFORE BREAK DISALLOWED>>                   <<11.EB>>76550000
   ATTACHIO(PXG'OUTPUTLDEV,0,0,0,25,0,%320,0,1);               <<06580>>76560000
     <<CLEAR BREAK FLAGS IN LDT IF SET>>                       <<11.EB>>76570000
END;                                                           <<11.EB>>76580000
                                                               <<02.EB>>76590000
<<NEXT SET A FLAG WHICH INDICATES IF SEQUENCED RECORDS ARE>>   <<01.RO>>76600000
<<EXPECTED.  THIS COMES FROM THE JMAT, SET BY SPOOLING, AND>>  <<01.RO>>76610000
<<CAUSES THE LAST 8 BYTES TO BE STRIPPED FROM EACH JOB RECORD>><<01.RO>>76620000
<<BEFORE INTERPRETATION.  THIS IS ONLY VALID FOR JOBS.>>       <<01.RO>>76630000
IF NOT PXG'INTERACTIVE THEN                                    <<06580>>76640000
   BEGIN                                                       <<01.RO>>76650000
   TOS := 0;  <<RETURN SPACE FOR MOVE FROM JMAT>>              <<01.RO>>76660000
   << Get offset into JMAT entry of the sequence bit >>        <<06584>>76670000
   SEQBITADR:= PXG'JMATINX * JMATENTRYSIZE                     <<06584>>76680000
                                       + JMATSEQBITOFF;        <<06584>>76690000
   MOVEFROMDSEG(@S0, JMATDST, SEQBITADR, 1);                   <<06584>>76700000
   TOS := TOS.JMATSEQBITEXT;  <<EXTRACT FLAG FROM JMAT WORD>>  <<06584>>76710000
   CIS'SEQUENCED := TOS;  << STORE FLAG IN CI STACK >>         << I.A >>76720000
   END;                                                        <<01.RO>>76730000
                                                               <<01.RO>>76740000
      @CIS'BCOMIMAGE := @CIS'WCOMIMAGE&LSL(1);                 << I.A >>76750000
      IF COMMANDPASSED THEN  <<FAKE OUT CI GETIMAGE ROUTINE>> <<A00.04>>76760000
         BEGIN <<SEE PROCEDURE CIFINISH IN SUBSYSTEM SECTION>><<A00.04>>76770000
         IF NOT CILOGTABLE(1, PXG'JMATINX * JMATENTRYSIZE,     <<06584>>76780000
            LENGTH, CIS'WCOMIMAGE) THEN SUDDENDEATH(509);      <<06584>>76790000
         CIS'PENDINGCOMLEN := LENGTH.(2:14); <<PASSED COMD>>   << I.A >>76800000
         IF = THEN TERMINATE;  <<NO COMMAND PASSED>>          <<A00.04>>76810000
         END;                                                 <<A00.04>>76820000
<< GET RECORD SIZE OF STDLIST FOR USE IN SUBR. ECHO >>         <<00419>>76830000
FGETINFO(2,,,,STDLISTLENB);                                    <<00419>>76840000
STDLISTLENB := -STDLISTLENB;  << CONVERT LEN FROM - TO + >>    <<00419>>76850000
<< CONVERT LENGTH TO EVEN NUMBER <= ACTUAL LENGTH >>           <<00419>>76860000
STDLISTLENB.(15:1) := 0;                                       <<00419>>76870000
STDLISTLENW := STDLISTLENB/2;                                  <<00419>>76880000
      GO TO NEXT;                                                       76890000
                                                                        76900000
                                                                        76910000
<<             **********************               >>         <<U.RAO>>76920000
<<             *   ENTRY UDCCI      *               >>         <<U.RAO>>76930000
<<             **********************               >>         <<U.RAO>>76940000
                                                               <<U.RAO>>76950000
UDCCI:                                                         <<03.EB>>76960000
   PCBPT := CURPRC;                                            <<06581>>76970000
   IF RESABORTINFO.RITBRKFLAG = 1 THEN << SPECIAL BREAK >>     <<06581>>76980000
   BEGIN                                                       <<00831>>76990000
      SPECIAL'BREAK:=TRUE;                                     <<00831>>77000000
      SETSERVICE(0);  <<CLEAR BREAK IN LPDT, NOT REAL BREAK>>  <<00831>>77010000
   END                                                         <<00831>>77020000
   ELSE SPECIAL'BREAK:=FALSE;                                  <<00831>>77030000
      CIS'UDCFATALCIERR := FALSE;  << STOP FLUSHING UDC >>     << I.A >>77040000
      CIS'UDCBREAKDETECTED := FALSE;                           << I.A >>77050000
      CIS'UDCFLUSH := FALSE;                                   << I.A >>77060000
      TOS := 0; << FOR ZSIZE RETURN >>                         <<03.EB>>77070000
      PUSH(S);                                                 <<03.EB>>77080000
      TOS := S0 - (INTEGER( CIS'UDC1 )); << TOTAL UDC STACK >> << I.A >>77090000
      IF > THEN                                                <<03.EB>>77100000
      BEGIN << NEED MORE >>                                    <<03.EB>>77110000
         TOS := TOS + TOS; << NEEDS FOR ANOTHER CALL >>        <<03.EB>>77120000
         TOS := ZSIZE(*);                                      <<03.EB>>77130000
         IF > THEN                                             <<03.EB>>77140000
         BEGIN                                                 <<03.EB>>77150000
            CIERR(ERRNUM := UDCSTACKOVRFLOW);                  <<04787>>77160000
            RETURN;                                            <<03.EB>>77170000
         END;                                                  <<03.EB>>77180000
         PUSH(S);  CIS'UDC1 := TOS;  << SAVE CURRENT S AGAIN >><< I.A >>77190000
         DEL;<<TRICK:USED TO MAKE S SAME AS WHEN S PUSHED>>    <<03.EB>>77200000
      END                                                      <<03.EB>>77210000
      ELSE ASSEMBLE(DDEL); << POP 0 & SIZE >>                  <<03.EB>>77220000
      IF CIS'CONTSTATE >= 1 THEN << CONTINUE IN EFFECT >>      << I.A >>77230000
         IF = THEN  <<JUST SAW IT>>                            <<08.RO>>77240000
            CIS'CONTSTATE := 2                                 << I.A >>77250000
         ELSE  <<JUST EXECUTED NON-:CONTINUE, >>               <<08.RO>>77260000
            CIS'CONTSTATE := 0;  << CLEAR THE CONDITION >>     << I.A >>77270000
      << IF RFA CALLED FROM WITHIN UDC BODY BYPASS IT >>       <<01100>>77280000
      IF CIS'BCOMIMAGE <> "RFA " THEN                          << I.A >>77290000
         IF UDC( CIS'BCOMIMAGE, EXPCODE ) THEN                 << I.A >>77300000
            RETURN; << UDC NEST ? >>                           <<01100>>77310000
      UDCEXECED := TRUE;                                       <<03.EB>>77320000
      PXGLOBAL;                                                <<06580>>77330000
      IF PXG'INTERACTIVE THEN << INDICATES SESSION >>          <<06580>>77340000
      BEGIN                                                    <<00451>>77350000
         ATTACHIO(PXG'INPUTLDEV,0,0,0,28,0,0,0,1);             <<06580>>77360000
           <<QUIESCE I/O BEFORE BREAK DISALLOWED>>             <<00451>>77370000
         SETSERVICE(TRUE);  <<DISABLE CI BREAK>>               <<00451>>77380000
         ATTACHIO(PXG'OUTPUTLDEV,0,0,0,25,0,%320,0,1);         <<06580>>77390000
           <<CLEAR BREAK FLUSH FLAG IN DIT IF SET>>            <<00451>>77400000
      END;                                                     <<00451>>77410000
      TOS := 0; <<RETURN SPACE FOR COMSEARCH>>                 <<U.RAO>>77420000
      TOS := @CIS'BCOMIMAGE;                                   << I.A >>77430000
      ASSEMBLE(DUP,DDUP);                                      <<03.EB>>77440000
      IF BPS0 = ALPHA                                          <<00184>>77450000
        THEN MOVE * := * WHILE AS,0                            <<00184>>77460000
        ELSE MOVE * := * WHILE ANS,0;                          <<00184>>77470000
      @PARMSP := TOS; << PARM PTR >>                           <<03.EB>>77480000
      ASSEMBLE(XCH,SUB); << LENGTH >>                          <<03.EB>>77490000
      GO XEQIT;                                                <<03.EB>>77500000
                                                               <<03.EB>>77510000
                                                               <<03.EB>>77520000
<<             **********************               >>         <<U.RAO>>77530000
<<             *   ENTRY COMMAND'   *               >>         <<U.RAO>>77540000
<<             **********************               >>         <<U.RAO>>77550000
                                                               <<U.RAO>>77560000
COMMAND':                                                               77570000
      SPECIAL'BREAK:=FALSE;                                    <<00594>>77580000
      PROGCALL := TRUE;                                                 77590000
    PXGLOBAL;                                                  <<06580>>77600000
    << CHECK FOR CR AT END OF COMMAND IMAGE >>                 <<00257>>77610000
      TOS := @COMARRAY;      << SAVE VALUE >>                  <<00257>>77620000
      ASSEMBLE(DUP);                                           <<00257>>77630000
      << NOTE: COMARRAY IS LOCATED AT Q-10 AND IS THE >>       <<00257>>77640000
      << FIRST PARAMETER STACKED FROM THE 'COMMAND' CALL >>    <<00257>>77650000
      @COMARRAY := CR'CR;  << STOPPER IN CASE OF MISSING CR >> <<00257>>77660000
      SCAN * UNTIL CR'CR,1; << GET BYTE ADDR OF CR >>          <<00257>>77670000
      << CHECK IF SCAN STOP ADDR = STOPPER ADDR >>             <<00257>>77680000
      IF TOS = @LCOMARRAY&LSL(1) THEN                          <<00257>>77690000
         BEGIN                                                 <<00257>>77700000
         ERRPARM := ERRMISSINGCR;                              <<00257>>77710000
         CCC := CCG;                                           <<00257>>77720000
         RETURN 0;                                             <<00257>>77730000
         END;                                                  <<00257>>77740000
      @COMARRAY := TOS;      << RESTORE VALUE >>               <<00257>>77750000
      TOS := 0;  <<RETURN SPACE FOR COMSEARCH>>                <<U.RAO>>77760000
      TOS := @COMARRAY;                                                 77770000
      ASSEMBLE(DUP,DDUP);                                               77780000
      MOVE * := * WHILE AS, 0;                                          77790000
      @PARMSP := TOS;                                                   77800000
      ASSEMBLE(XCH,SUB);                                                77810000
      GO TO XEQIT;                                                      77820000
                                                                        77830000
                                                                        77840000
<<             **********************               >>         <<U.RAO>>77850000
<<             *   ENTRY SYSBREAK   *               >>         <<U.RAO>>77860000
<<             **********************               >>         <<U.RAO>>77870000
                                                               <<U.RAO>>77880000
SYSBREAK:                                                               77890000
   COMMENT:  IF A SON PROCESS HAS ENABLED BREAK IN  A          <<00851>>77900000
      NOBREAK UDC, IGNORE BREAK AND RETURN--TEMPORARY KLUDGE   <<01279>>77910000
      DOES NOT HANDLE DS--SHOULD BE FIXED;                     <<01279>>77920000
   OLDCRITICAL := SETCRITICAL;                                 <<04169>>77930000
   IF CIS'UDCNOBREAKOPT THEN                                   << I.A >>77940000
      BEGIN                                                    <<00851>>77950000
      FBREAK;                                                  <<01279>>77960000
      CLEAN'TERMINAL'STATE(FALSE); << CLEAR FLUSH FLAGS >>     <<00851>>77970000
      FCONTROL(1,DISABLEBREAK,DUMMY);                          <<01455>>77980000
      FUNBREAK (FALSE);                                        <<01279>>77990000
      RESETCRITICAL(OLDCRITICAL);                              <<04169>>78000000
      RETURN 0;                                                <<00851>>78010000
      END;                                                     <<00851>>78020000
   PCBPT := CURPRC;                                            <<06581>>78030000
   IF RESABORTINFO.RITBRKFLAG = 1 THEN << SPECIAL BREAK >>     <<06581>>78040000
   BEGIN                                                       <<00594>>78050000
      SPECIAL'BREAK:=TRUE;                                     <<00594>>78060000
      SETSERVICE(0); <<CLEAR BREAK FLAG IN LPDT...NOT REAL BREA<<00594>>78070000
   END                                                         <<00594>>78080000
   ELSE SPECIAL'BREAK:=FALSE;                                  <<00594>>78090000
   PXFIXED;                                                    <<06580>>78100000
   PXFXBRKMODE := -1;                                          <<06580>>78110000
   PXGLOBAL;                                                   <<06580>>78120000
      FBREAK;                                                           78130000
      RESETCRITICAL(OLDCRITICAL);                              <<04169>>78140000
      LPDT'INDEX := PXG'INPUTLDEV * LPDT'ENTRY'SIZE;           <<06580>>78150000
      IF LPDT'EOF'TYPE = LPDT'HARDWARE'EOF THEN                <<06226>>78160000
         HARDEOF'THEN'BRK:=TRUE; <<BREAK HIT AFTER :EOF:>>     <<00540>>78170000
                                                               <<00835>>78180000
      << SAVE UDC AND IF NESTING GLOBALS >>                    <<00835>>78190000
      SAVE'UDC3            := CIS'UDC3;                        << I.A >>78200000
      SAVE'UDC4            := CIS'UDC4;                        << I.A >>78210000
      SAVE'IFNESTING       := CIS'IFNESTING;                   << I.A >>78220000
      SAVE'IFSKIP          := CIS'IFSKIP;                      << I.A >>78230000
      SAVE'ELSESEEN        := CIS'ELSESEEN;                    << I.A >>78240000
      SAVE'CONTINUSTATESTK := CIS'CONTINUSTATESTK;             << I.A >>78250000
                                                               <<00835>>78260000
      << RESET UDC AND IF NESTING GLOBALS FOR BREAK >>         <<00835>>78270000
      CIS'UDC3 := CIS'UDC4 := CIS'IFNESTING                    << I.A >>78280000
               := CIS'IFSKIP := CIS'ELSESEEN    := 0;          << I.A >>78290000
      CIS'CONTINUSTATESTK := 0D;                               << I.A >>78300000
                                                                        78310000
<<             **********************               >>         <<U.RAO>>78320000
<<             *      NEXT          *               >>         <<U.RAO>>78330000
<<             **********************               >>         <<U.RAO>>78340000
                                                               <<U.RAO>>78350000
NEXT:                                                                   78360000
   IF COMMANDEXECED THEN TERMINATE; <<HAVE DONE PASSED COMMAND<<A00.04>>78370000
   IF UDCEXECED THEN RETURN; << UDC CALL >>                    <<03.EB>>78380000
   IF CIS'UDCEXITBREAK THEN                                    << I.A >>78390000
   BEGIN << ABORT FLAG SET >>                                           78400000
      CIS'UDCEXITBREAK := FALSE;                               << I.A >>78410000
      IF SPECIAL'BREAK THEN SETSERVICE(0);                     <<00835>>78420000
                                                               <<00835>>78430000
      << RESTORE UDC AND IF NESTING GLOBALS TO SAVED VALUES >> <<00835>>78440000
      CIS'UDC3             := SAVE'UDC3;                       << I.A >>78450000
      CIS'UDC4             := SAVE'UDC4;                       << I.A >>78460000
      CIS'IFNESTING        := SAVE'IFNESTING;                  << I.A >>78470000
      CIS'IFSKIP           := SAVE'IFSKIP;                     << I.A >>78480000
      CIS'ELSESEEN         := SAVE'ELSESEEN;                   << I.A >>78490000
      CIS'CONTINUSTATESTK  := SAVE'CONTINUSTATESTK;            << I.A >>78500000
                                                               <<00835>>78510000
      RETURN 0;                                                         78520000
   END;                                                                 78530000
   PUSH(S);                                                    <<03.EB>>78540000
   CIS'UDC1 := TOS;    << SAVE CURRENT "S" >>                  << I.A >>78550000
   IF CIS'CONTSTATE >= 1 THEN << CONTINUE IN EFFECT  >>        << I.A >>78560000
      IF = THEN                                                <<U.RAO>>78570000
         CIS'CONTSTATE := 2   << CONTINUE JUST READ  >>        << I.A >>78580000
      ELSE  <<JUST EXECUTED NON-:CONTINUE>>                    <<U.RAO>>78590000
         CIS'CONTSTATE := 0;  << CLEAR CONTINUE FLAG >>        << I.A >>78600000
   GETIMAGE;                                                            78610000
   << BYPASS UDC SEARCH IF COMMAND NAME IS RFA >>              <<01100>>78620000
   IF CIS'UDC0 <> 0 AND CIS'BCOMIMAGE <> "RFA " THEN           << I.A >>78630000
      IF UDC( CIS'BCOMIMAGE, 0 ) THEN                          << I.A >>78640000
         GO NEXT;                                              <<01100>>78650000
   TOS := 0;  <<RETURN SPACE FOR COMSEARCH>>                   <<U.RAO>>78660000
   TOS := @CIS'BCOMIMAGE;  << ADDRESS OF COMMAND NAME >>       << I.A >>78670000
   TOS := COMLEN;                                                       78680000
                                                                        78690000
                                                                        78700000
<<             **********************               >>         <<U.RAO>>78710000
<<             *      XEQIT         *               >>         <<U.RAO>>78720000
<<             **********************               >>         <<U.RAO>>78730000
                                                               <<U.RAO>>78740000
XEQIT:                                                                  78750000
   ERRNUM := 0;                                                <<U.RAO>>78760000
   PARMNUM := APLTERMTYPE;  <<0 UNLESS (APL) COMMAND>>         <<U.RAO>>78770000
   DUMMY := COMSEARCH(*,*,CAP,ACCESS,EXECPLABEL,CAPCHECKERR);  <<01455>>78780000
                                                               <<01455>>78790000
   << IF REDO ALLOWED, MOVE IMAGE INTO REDO BUFFER. >>         <<01455>>78800000
   IF NOT PROGCALL AND NOT UDCEXECED AND                       <<01455>>78810000
      NOT ( DUMMY LAND ANOTREDOABLE ) THEN                     <<01455>>78820000
      MOVE CIS'LASTCOMIMAGE                                    << I.A >>78830000
               := CIS'WCOMIMAGE, (CIS'WCOMBUFLEN);             << I.A >>78840000
                                                               <<01455>>78850000
   IF NOT DUMMY THEN     << UNKNOWN COMMAND >>                 <<01455>>78860000
      IF PROGCALL THEN                                         <<U.RAO>>78870000
         BEGIN   <<NO SUCH COMMAND AND PROGRAMMATIC>>          <<U.RAO>>78880000
         CCC := CCL;                                           <<U.RAO>>78890000
         ERRPARM := ERRUNDEF;                                  <<U.RAO>>78900000
         END                                                   <<U.RAO>>78910000
      ELSE                                                     <<U.RAO>>78920000
         BEGIN                                                 <<00856>>78930000
         IF NOT CIS'IFSKIP THEN                                << I.A >>78940000
            CIERR(ERRNUM := ERRUNDEF, CIS'BCOMIMAGE)           <<04787>>78950000
         END                                                   <<00856>>78960000
   ELSE  <<IS VALID COMMAND, TRY TO EXECUTE IT>>               <<U.RAO>>78970000
      IF PERMITACCESS THEN                                     <<U.RAO>>78980000
         BEGIN  <<LEGAL FOR THIS USER, IN THIS CASE>>          <<U.RAO>>78990000
         TOS := @PARMSP;                                       <<U.RAO>>79000000
         TOS := @ERRNUM;                                       <<U.RAO>>79010000
         TOS := @PARMNUM;                                      <<U.RAO>>79020000
         TOS := EXECPLABEL;                                    <<U.RAO>>79030000
         SETSERVICE(NONABORTABLE);  <<SET BREAK STATUS>>       <<U.RAO>>79040000
         ASSEMBLE(PCAL 0);                                     <<U.RAO>>79050000
                                                               <<04710>>79060000
      << Check here if the CI is left holding a SIR.  This >>  <<04710>>79070000
      << should never be the case.  Note that this check   >>  <<04710>>79080000
      << is encoded in a low level to minimize the         >>  <<04710>>79090000
      << disturbance to the stack (in case we want to      >>  <<04710>>79100000
      << crash).  What is being done, here, is to get the  >>  <<04710>>79110000
      << address of the first word of the CI's PCB entry   >>  <<04710>>79120000
      << by using the CPCB pointer in low core.  This word >>  <<04710>>79130000
      << contains the HASSIR pointer.                      >>  <<04710>>79140000
         PCBPT := CURPRC;                                      <<06581>>79150000
         IF RESABORTINFO.HASSIRFLAG <> 0                       <<06581>>79160000
            THEN SUDDENDEATH(315);                             <<04710>>79170000
                                                               <<04710>>79180000
         IF NOT PROGCALL AND NOT NONABORTABLE AND              <<U.RAO>>79190000
            CIS'UDCNESTLEVEL <> 0 AND REQUESTSERVICE THEN      << I.A >>79200000
            CIS'UDCBREAKDETECTED := TRUE;                      << I.A >>79210000
         IF PROGCALL THEN  <<MUST SET CONDITION CODE>>         <<U.RAO>>79220000
            IF ERRNUM = 0 THEN                                 <<00525>>79230000
               CCC := CCE   <<SUCCESSFUL COMMAND>>             <<U.RAO>>79240000
            ELSE   <<COMMAND FAILED, RETURN CODES>>            <<U.RAO>>79250000
               BEGIN                                           <<U.RAO>>79260000
               ERRPARM := ERRNUM;                              <<U.RAO>>79270000
               PARMPARM := PARMNUM;                            <<U.RAO>>79280000
               IF ERRNUM > 0 THEN                              <<04942>>79290000
                  CCC := CCG                                   <<04942>>79300000
               ELSE                                            <<04942>>79310000
                  CCC := CCE;                                  <<04942>>79320000
               END;                                            <<U.RAO>>79330000
         END                                                   <<U.RAO>>79340000
      ELSE   <<PERMITACCESS FAILED>>                           <<U.RAO>>79350000
         IF PROGCALL THEN                                      <<U.RAO>>79360000
            BEGIN                                              <<U.RAO>>79370000
            ERRPARM := ERRNUM;                                 <<U.RAO>>79380000
            CCC := CCG;                                        <<U.RAO>>79390000
            END;                                               <<U.RAO>>79400000
IF PROGCALL THEN RETURN 0;   <<NO PARAMETERS>>                 <<U.RAO>>79410000
GO TO NEXT;     <<LOOP>>                                       <<U.RAO>>79420000
END  <<COMMANDINTERP>>;                                                 79430000
PROCEDURE HELP; OPTION EXTERNAL;                               <<03.EB>>79440000
PROCEDURE COMMAND(COMIMAGE,ERROR,PARM);                                 79450000
   BYTE ARRAY COMIMAGE;                                                 79460000
   INTEGER ERROR,PARM;                                                  79470000
BEGIN                                                                   79480000
   ERRORON;                                                             79490000
   CHEK([10/68,6/3],3,%53D);                                            79500000
   ERROR := PARM := 0;  <<INITIALIZE RETURN VALUES>>          <<A01.01>>79510000
   COMMAND'(*);                                                         79520000
   ERROREXIT([10/68,6/3],0,0);                                          79530000
END;    <<COMMAND>>                                                     79540000
$CONTROL SEGMENT=MAIN                                                   79550000
END.                                                                    79560000
