$CONTROL USLINIT,CODE,MAP                                      <<01549>>00010000
<< CIFILES of the Command Interpreter.  Module 5A >>           <<04848>>00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$THIRTY                                                                 00028000
$TITLE "IMS"                                                            00030000
<<*************************************************************<<U.RAO>>00032000
<<*****************  Command Interpreter IMS  *****************<<U.RAO>>00034000
<<*************************************************************<<U.RAO>>00036000
<<                                                             <<U.RAO>>00038000
<<*************************************************************<<U.RAO>>00040000
<<************************  OVERVIEW  *************************<<U.RAO>>00042000
<<*************************************************************<<U.RAO>>00044000
<<                                                             <<U.RAO>>00046000
<<WHO:                                                         <<U.RAO>>00048000
<<   Larry Birenbaum designed the basic structures of the      <<U.RAO>>00050000
<<Command Interpreter for VERSION A of MPE.  Work was begun in <<U.RAO>>00052000
<<1970 or 1971.                                                <<U.RAO>>00054000
<<   Bob Olson substantially redesigned the parsers of the     <<U.RAO>>00056000
<<Command Interpreter for VERSION B of MPE II.  Work was begun <<U.RAO>>00058000
<<in November 1976 and completed in late 1977.  The basic      <<U.RAO>>00060000
<<algorithms for executing the commands remained essentially   <<U.RAO>>00062000
<<the same even though the parsers were rewritten.  Several    <<U.RAO>>00064000
<<new commands were added at this time, as were User Defined   <<U.RAO>>00066000
<<Commands.                                                    <<U.RAO>>00068000
<<   Other people who have added commands or modified existing <<U.RAO>>00070000
<<commands for MPE IIB are Ron Hoyt and Bob Vannucci (Private  <<U.RAO>>00072000
<<Volumes, including modification of the accounting commands   <<U.RAO>>00074000
<<and STORE/RESTORE), Neal Mack (Transaction Logging user      <<U.RAO>>00076000
<<commands), Mike Philben (revision of DS commands), Ed Basart <<U.RAO>>00078000
<<(revision of HELLO, JOB, and DATA and the addition of User   <<U.RAO>>00080000
<<Defined Commands), and Bob Gerstmeyer (CLINE command).       <<U.RAO>>00082000
<<                                                             <<U.RAO>>00084000
<<WHERE:                                                       <<U.RAO>>00086000
<<   Pieces of the Command Interpreter are scattered all over  <<U.RAO>>00088000
<<the system.  This module contains the bulk of the executors. <<U.RAO>>00090000
<<The spooling commands (SHOWJOB, SHOWOUT, STREAM, and SHOWIN) <<U.RAO>>00092000
<<may be found in the SPOOLCOMS module.  The DS commands       <<U.RAO>>00094000
<<(RFA, DSLINE, REMOTE) will be found in the DS code.  STORE   <<U.RAO>>00096000
<<and RESTORE have a module of their own.  The bulk of the work<<U.RAO>>00098000
<<for User Defined Commands is done in a module called UDC.    <<U.RAO>>00100000
<<HELP resides in module HELPUSER.  JOB, HELLO and DATA are    <<U.RAO>>00102000
<<parsed by code in module NURSERY.  In general, it is better  <<U.RAO>>00104000
<<to put the executors in the same module as the routines which<<U.RAO>>00106000
<<do the work.  This will reduce confusion and simplify        <<U.RAO>>00108000
<<maintenance.  There is no inherent benefit to accumulating   <<U.RAO>>00110000
<<executors in common segments, assuming that there is         <<U.RAO>>00112000
<<non-trivial work to do.                                      <<U.RAO>>00114000
<<                                                             <<U.RAO>>00116000
<<WHY:                                                         <<U.RAO>>00118000
<<   The purpose served by the Command Interpreter is to       <<U.RAO>>00120000
<<provide the user access to the operating system functions    <<U.RAO>>00122000
<<without requiring him/her to go through the irritation of    <<U.RAO>>00124000
<<writing a program to do so.  There are three primary function<<U.RAO>>00126000
<<provided by the commands.  Most important is the ability to  <<U.RAO>>00128000
<<execute programs, evidenced by the RUN command and the variou<<U.RAO>>00130000
<<compiler commands.  Second is the ability to manage one's    <<U.RAO>>00132000
<<resources, such as files.  Finally there are a large number o<<U.RAO>>00134000
<<utility functions, primarily for status checking.  When a new<<U.RAO>>00136000
<<capability is added to the system, the user should be given  <<U.RAO>>00138000
<<commands which allow him to manipulate the capability and to <<U.RAO>>00140000
<<determine the status of the new resource created by the      <<U.RAO>>00142000
<<capability.                                                  <<U.RAO>>00144000
<<                                                             <<U.RAO>>00146000
$PAGE                                                                   00148000
<<*************************************************************<<U.RAO>>00150000
<<****************  ADDING A COMMAND TO THE CI  ***************<<U.RAO>>00152000
<<*************************************************************<<U.RAO>>00154000
<<                                                             <<U.RAO>>00156000
<<Step 1:  Designing the command.                              <<U.RAO>>00158000
<<   A reasonable and parseable command syntax is one of the   <<U.RAO>>00160000
<<important parts of designing a good command.  Your goal is   <<U.RAO>>00162000
<<to minimize user irritation when using the command.  Always  <<U.RAO>>00164000
<<remember that for most users the problem for which they are  <<U.RAO>>00166000
<<using a computer is probably solved within an application    <<U.RAO>>00168000
<<program of some sort and the Command Interpreter in general  <<U.RAO>>00170000
<<and your command in particular are necessary annoyances.     <<U.RAO>>00172000
<<You must strive to limit that annoyance to the unavoidable.  <<U.RAO>>00174000
<<   Unfortunately, there are a wide variety of ways in which  <<U.RAO>>00176000
<<you can annoy people.  Some of the solutions are mutually    <<U.RAO>>00178000
<<incompatible.  The following is a list of the issues you     <<U.RAO>>00180000
<<should consider.                                             <<U.RAO>>00182000
<<   1)  Verbose versus terse command names                    <<U.RAO>>00184000
<<       In general it is desireable to have command names     <<U.RAO>>00186000
<<       which accurately reflect the function of the          <<U.RAO>>00188000
<<       command.  The tradeoff is that verbose command        <<U.RAO>>00190000
<<       names which describe the command are easier to        <<U.RAO>>00192000
<<       pick out in documentation whereas terse names are     <<U.RAO>>00194000
<<       easier to type.  Thus the deciding factor should      <<U.RAO>>00196000
<<       be how often the user will use the command.  A        <<U.RAO>>00198000
<<       side consideration is that the use of archaic         <<U.RAO>>00200000
<<       English or bizarre abbreviations will work a          <<U.RAO>>00202000
<<       hardship on our users who are not native English      <<U.RAO>>00204000
<<       speakers.                                             <<U.RAO>>00206000
<<   2)  Keyword versus positional parameters                  <<U.RAO>>00208000
<<       Positional parameters can be dangerous, especially    <<U.RAO>>00210000
<<       when the parameters can be similar data types.        <<U.RAO>>00212000
<<       For example, a positional string of numbers can       <<U.RAO>>00214000
<<       result in erroneous operation due to the accidental   <<U.RAO>>00216000
<<       omission of a delimiter.  Keyworded parameters        <<U.RAO>>00218000
<<       can be very verbose, especially on complex commands.  <<U.RAO>>00220000
<<       They can also work a hardship when a user uses a      <<U.RAO>>00222000
<<       particular command heavily, since it drastically      <<U.RAO>>00224000
<<       enlarges the amount of typing.  This last objection   <<U.RAO>>00226000
<<       can be gotten around through the agency of User       <<U.RAO>>00228000
<<       Defined Commands.  Another major objection to         <<U.RAO>>00230000
<<       keywords is that it requires several different        <<U.RAO>>00232000
<<       delimiters, often leading to typing errors and        <<U.RAO>>00234000
<<       mental confusion.                                     <<U.RAO>>00236000
<<   3)  Delimiters & other special characters                 <<U.RAO>>00238000
<<       The typical delimiters in commands are commas to      <<U.RAO>>00240000
<<       separate positional parameters and semicolons to      <<U.RAO>>00242000
<<       separate keywords.  The file command shows this       <<U.RAO>>00244000
<<       in full generality.  Periods are sometimes            <<U.RAO>>00246000
<<       terminators (as in the LABEL option on the FILE       <<U.RAO>>00248000
<<       command) and sometimes separators, as in the logon    <<U.RAO>>00250000
<<       user ID and file names.  Blanks are tough to deal     <<U.RAO>>00252000
<<       with and should be avoided as delimiters.             <<U.RAO>>00254000
<<       Non-printing characters should be avoided at all      <<U.RAO>>00256000
<<       costs.  All commands will be terminated with a        <<U.RAO>>00258000
<<       carriage return when passed to the command parser.    <<U.RAO>>00260000
<<   4)  Hardware/software peculiarities                       <<U.RAO>>00262000
<<       Too frequently the command syntax reflects some       <<U.RAO>>00264000
<<       strange and unpleasant aspect of the mechanism        <<U.RAO>>00266000
<<       underlying the command.  We should not require the    <<U.RAO>>00268000
<<       user to be cognizant of our design problems.  To      <<U.RAO>>00270000
<<       do so violates the principle of lowering the          <<U.RAO>>00272000
<<       annoyance factor.                                     <<U.RAO>>00274000
<<   5)  Extensibility                                         <<U.RAO>>00276000
<<       No matter how well your command does its job, one     <<U.RAO>>00278000
<<       of these days someone will want to modify or          <<U.RAO>>00280000
<<       extend it.  In particular, one should be careful      <<U.RAO>>00282000
<<       about the use of delimiters in ways other than the    <<U.RAO>>00284000
<<       "traditional" way.  For example, periods, commas,     <<U.RAO>>00286000
<<       semicolons and others have fairly standardized        <<U.RAO>>00288000
<<       meanings, and to use them in a different way reduces  <<U.RAO>>00290000
<<       the options of your successor to extend your command. <<U.RAO>>00292000
<<       Another related issue is that listing formats should  <<U.RAO>>00294000
<<       be extensible.                                        <<U.RAO>>00296000
<<   6)  Defaults                                              <<U.RAO>>00298000
<<       Defaults are vital, dangerous and difficult to choose.<<U.RAO>>00300000
<<       The design goal is that the command should be simple  <<U.RAO>>00302000
<<       for simple minded users.  This implies restraint in   <<U.RAO>>00304000
<<       the use of defaults which vary depending on some other<<U.RAO>>00306000
<<       parameter to the command.  Too smart defaults can be  <<U.RAO>>00308000
<<       just as bad as no defaults, since many users will     <<U.RAO>>00310000
<<       use the command defensively to avoid surprises from   <<U.RAO>>00312000
<<       the default mechanism.  Good luck.                    <<U.RAO>>00314000
<<   7)  Ambiguity                                             <<U.RAO>>00316000
<<       Careful design will avoid the need for lookahead to   <<U.RAO>>00318000
<<       resolve abiguous situations.  Lookahead should be     <<U.RAO>>00320000
<<       avoided if at all possible, as it results in          <<U.RAO>>00322000
<<       much code with complicated data structures.           <<U.RAO>>00324000
<<   8)  Computerese                                           <<U.RAO>>00326000
<<       Keywords should be couched in English, not computerese<<U.RAO>>00328000
<<                                                             <<U.RAO>>00330000
<<In summary, the user of your command will probably not be a  <<U.RAO>>00332000
<<computer professional and probably will be annoyed at the nee<<U.RAO>>00334000
<<to use your command at all.  Simplicity, understandability an<<U.RAO>>00336000
<<regularity are the keys to good command syntax.              <<U.RAO>>00338000
<<                                                             <<U.RAO>>00340000
<<Step 2: Code the Executor.                                   <<U.RAO>>00342000
<<   For the most part this is quite straightforward.  Most of <<U.RAO>>00344000
<<the existing executors can be used as models.  There are a fe<<U.RAO>>00346000
<<good concepts to keep in mind, however.                      <<U.RAO>>00348000
<<   Generating good error messages is just as important as    <<U.RAO>>00350000
<<executing the command.  The whole error message issue is deal<<U.RAO>>00352000
<<with below.                                                  <<U.RAO>>00354000
<<   The code of the command should be easily extensible.  This<<U.RAO>>00356000
<<implies the use of a simple parsing scheme with very obvious <<U.RAO>>00358000
<<techniques.  Probably more often than any other part of the  <<U.RAO>>00360000
<<system, the CI is modified by people who have no proprietary <<U.RAO>>00362000
<<interest in it.  In the interests of reliability and         <<U.RAO>>00364000
<<maintainability, it is desireable to start with as clean code<<U.RAO>>00366000
<<as possible.  Unfortunately, no universal parsing scheme has <<U.RAO>>00368000
<<yet been developed for the CI.                               <<U.RAO>>00370000
<<   A trap to avoid is called the "parse a little, execute a  <<U.RAO>>00372000
<<little" syndrome.  It results in the need to back out of a   <<U.RAO>>00374000
<<situation when an error is detected further down stream.  A  <<U.RAO>>00376000
<<secondary problem is that it tends to result in the          <<U.RAO>>00378000
<<partial destruction of the context of the error.  A command  <<U.RAO>>00380000
<<should be parsed completely before being executed at all.    <<U.RAO>>00382000
<<   Don't worry about having particularly efficient code.  The<<U.RAO>>00384000
<<CI's execution time is trivial compared to the time it takes <<U.RAO>>00386000
<<for the user to recover from a poorly designed error message <<U.RAO>>00388000
<<or even from a poorly designed syntax.  The customer always  <<U.RAO>>00390000
<<comes first.                                                 <<U.RAO>>00392000
<<   The use of global storage is discouraged.  Most important <<U.RAO>>00394000
<<is the fact that there are some performance consequences     <<U.RAO>>00396000
<<related to the need to constantly enlarge the CI's stack.    <<U.RAO>>00398000
<<If you find you do need global storage, be sure to initialize<<U.RAO>>00400000
<<it in procedure COMMANDINTERP, as the CI is procreated and   <<U.RAO>>00402000
<<thus has no global initialization capability.  Be careful    <<U.RAO>>00404000
<<about where you put new globals.  Certain other modules such <<U.RAO>>00406000
<<as UDC know about the CI global space.                       <<U.RAO>>00408000
<<   In general, the execution part of the command should simpl<<U.RAO>>00410000
<<be a call to the appropriate user callable intrinsic.  The   <<U.RAO>>00412000
<<CI usually should not provide the user any special services  <<U.RAO>>00414000
<<that are not available programmatically.  In this way we avoi<<U.RAO>>00416000
<<such undesireable situations as users getting their accountin<<U.RAO>>00418000
<<information through a call to the REPORT command and setting <<U.RAO>>00420000
<<up their files through a call to the FILE command through the<<U.RAO>>00422000
<<COMMAND intrinsic.  See the SETJCW command for an example of <<U.RAO>>00424000
<<this.                                                        <<U.RAO>>00426000
<<   EXCHANGEDB is to be avoided if at all possible, even if   <<U.RAO>>00428000
<<you have to do data segment moves iteratively.  The speed cos<<U.RAO>>00430000
<<is nothing compared to the cost of the crash which is        <<U.RAO>>00432000
<<inevitable when doing split stack operations.  All of the CI <<U.RAO>>00434000
<<utility routines assume no split stack operation.            <<U.RAO>>00436000
<<   Similarly there is rarely any valid reason for accessing  <<U.RAO>>00438000
<<system primitives directly from the CI.  The CI should be a  <<U.RAO>>00440000
<<very high level module.  It rarely has any business rooting  <<U.RAO>>00442000
<<around in some system table.  This principle unfortunately ha<<U.RAO>>00444000
<<been rather imperfectly adhered to.                          <<U.RAO>>00446000
<<   These almost random thoughts about writing executors hardl<<U.RAO>>00448000
<<provide a good framework for writing code.  Cursory          <<U.RAO>>00450000
<<examination of some of the executors currently in the module <<U.RAO>>00452000
<<probably will give you a better idea of the tricks of the    <<U.RAO>>00454000
<<trade.  A few ideas stand out.                               <<U.RAO>>00456000
<<                                                             <<U.RAO>>00458000
<<      Code assuming someone else will be changing it.        <<U.RAO>>00460000
<<                                                             <<U.RAO>>00462000
<<      Code for good error messages, not speed.               <<U.RAO>>00464000
<<                                                             <<U.RAO>>00466000
<<      It is far better to detect a problem at the            <<U.RAO>>00468000
<<      time the command is put in than when it is             <<U.RAO>>00470000
<<      executed.  That is, at parse time as opposed           <<U.RAO>>00472000
<<      to execution time.                                     <<U.RAO>>00474000
<<                                                             <<U.RAO>>00476000
<<      Cleverness will get you in trouble, usually for        <<U.RAO>>00478000
<<      no good reason.                                        <<U.RAO>>00480000
<<                                                             <<U.RAO>>00482000
<<Step 3:  Add the command to the Command Interpreter.         <<U.RAO>>00484000
<<   Other than physically adding the executor to the system,  <<U.RAO>>00486000
<<the only task is to add the command name to the list in      <<U.RAO>>00488000
<<procedure COMSEARCH.  This procedure is called for each      <<U.RAO>>00490000
<<command to determine if it is one of the ones known to the   <<U.RAO>>00492000
<<system.  The mechanics of this process are described in that <<U.RAO>>00494000
<<procedure.  If the executor is physically outside the CI     <<U.RAO>>00496000
<<module, don't forget to add the OPTION EXTERNAL declaration. <<U.RAO>>00498000
<<Congratulations.  Now all you need to do is make sure it     <<U.RAO>>00500000
<<works.                                                       <<U.RAO>>00502000
<<                                                             <<U.RAO>>00504000
$PAGE                                                                   00506000
<<*************************************************************<<U.RAO>>00508000
<<**************  ERROR MESSAGES FROM THE CI  **************** <<U.RAO>>00510000
<<*************************************************************<<U.RAO>>00512000
<<                                                             <<U.RAO>>00514000
<<Philosophical aspects:                                       <<U.RAO>>00516000
<<     The essential goal of an error message from the CI is to<<U.RAO>>00518000
<<help the user quickly recover from his problem.  In general, <<U.RAO>>00520000
<<a good error message should indicate:                        <<U.RAO>>00522000
<<    1)  What the CI did not like.  On syntax errors this     <<U.RAO>>00524000
<<        typically is done with a caret underneath where the  <<U.RAO>>00526000
<<        problem was detected.  If the caret isn't sufficient <<U.RAO>>00528000
<<        to identify the problem then some of the text of the <<U.RAO>>00530000
<<        message should further elaborate.  On semantic errors<<U.RAO>>00532000
<<        this usually is done with the text of the message.   <<U.RAO>>00534000
<<    2)  How to recover.  This usually will take the form of  <<U.RAO>>00536000
<<        telling the user what the valid input might be.  For <<U.RAO>>00538000
<<        example, on an invalid record type in the :FILE      <<U.RAO>>00540000
<<        command, the CI will put out a message something like<<U.RAO>>00542000
<<        EXPECTED RECORD TYPE TO BE F, V OR U.                <<U.RAO>>00544000
<<        This serves to identify to the user very quickly what<<U.RAO>>00546000
<<        the valid syntax is and thus how to get on with his  <<U.RAO>>00548000
<<        business.  Sometimes it is hard to figure out what th<<U.RAO>>00550000
<<        user had in mind.  For example, it isn't really      <<U.RAO>>00552000
<<        possible to second guess the user on an unknown      <<U.RAO>>00554000
<<        command name.  In these relatively rare cases, it is <<U.RAO>>00556000
<<        sufficient to tell the user just what was wrong.     <<U.RAO>>00558000
<<        In general, if it is a syntax error of any sort, it  <<U.RAO>>00560000
<<        is possible to give a good error message outlining   <<U.RAO>>00562000
<<        what was expected.  A cop-out on this is really      <<U.RAO>>00564000
<<        sloppy workmanship.                                  <<U.RAO>>00566000
<<    3)  In many cases it is desireable to tell the user what <<U.RAO>>00568000
<<        was done about the error.  This is particularly true <<U.RAO>>00570000
<<        in the case of warnings, where the user may be left  <<U.RAO>>00572000
<<        wondering whether some default was taken.  For exampl<<U.RAO>>00574000
<<        in the accounting structure commands we ignore many  <<U.RAO>>00576000
<<        errors.  In each case it is necessary to tell the use<<U.RAO>>00578000
<<        what default we took so that he can then do an ALTxxx<<U.RAO>>00580000
<<        to fix up the particular error, if necessary.  Of    <<U.RAO>>00582000
<<        course, in each case we try to pick a reasonable     <<U.RAO>>00584000
<<        default so that he doesn't have to do any recovery.  <<U.RAO>>00586000
<<                                                             <<U.RAO>>00588000
<<In any case, messages should be very specific.  Given the    <<U.RAO>>00590000
<<very simple mechanism for generating error and warning       <<U.RAO>>00592000
<<messages, there is no acceptable excuse for generic messages.<<U.RAO>>00594000
<<Examples:                                                    <<U.RAO>>00596000
<<   "INVALID NUMBER" is unacceptable.  Such messages should be<<U.RAO>>00598000
<<of the form "EXPECTED <item> TO BE BETWEEN <n1> AND <n2>."   <<U.RAO>>00600000
<<This message should be used only once in the CI.             <<U.RAO>>00602000
<<   "UNKNOWN KEYWORD" is unacceptable.  The proper form is    <<U.RAO>>00604000
<<"EXPECTED ONE OF <item1>, <item2>....".                      <<U.RAO>>00606000
<<   In general, "<item>", "<n1>" and so forth should not be   <<U.RAO>>00608000
<<passed to CIERR as parameters but rather be embedded as part <<U.RAO>>00610000
<<of the error message.  The reason for this is that you will  <<U.RAO>>00612000
<<need to give a fuller description of the error in the Error  <<U.RAO>>00614000
<<Messages part of the MPE manual.  It is awkward at best and  <<U.RAO>>00616000
<<embarrassing at worst to have to tell the manual writer "Well<<U.RAO>>00618000
<<it could be this, or it could be that, or even this third    <<U.RAO>>00620000
<<thing."  The one exception is where truly dynamic information<<U.RAO>>00622000
<<is involved.  Examples might include configuration data and  <<U.RAO>>00624000
<<user supplied information like file names.>>                 <<U.RAO>>00626000
<<   In most cases, redundantly specified parameters should    <<U.RAO>>00628000
<<result not in a fatal error but in a warning.  If a value is <<U.RAO>>00630000
<<associated with the redundant keyword then the message should<<U.RAO>>00632000
<<specify that the last value found was used.                  <<U.RAO>>00634000
<<   Similarly unacceptable messages are                       <<U.RAO>>00636000
<<   "INSUFFICIENT PARAMETERS" - what is missing?              <<U.RAO>>00638000
<<   "INSUFFICIENT CAPABILITY" should say what capability is   <<U.RAO>>00640000
<<missing.                                                     <<U.RAO>>00642000
<<   "INSUFFICIENT RESOURCES" should say what resources are    <<U.RAO>>00644000
<<lacking.                                                     <<U.RAO>>00646000
<<And so forth for all messages.                               <<U.RAO>>00648000
<<                                                             <<U.RAO>>00650000
<<Mechanical aspects of adding error messages:                 <<U.RAO>>00652000
<<                                                             <<U.RAO>>00654000
<<1)  Numbering                                                <<U.RAO>>00656000
<<    The number chosen for a message is largely irrelevant.  I<<U.RAO>>00658000
<<    is nice, however, if it is near the other messages       <<U.RAO>>00660000
<<    associated with the same command.  Be sure to declare it <<U.RAO>>00662000
<<    as an equate in the CI globals (or SPOOLCOMS or whatever)<<U.RAO>>00664000
<<    Note that the message should be tagged as to whether it i<<U.RAO>>00666000
<<    a CIERR or CIWARN or whatever.  Put it in message set 2. <<U.RAO>>00668000
<<2)  Generation                                               <<U.RAO>>00670000
<<    There is a procedure called CIERR which is responsible fo<<U.RAO>>00672000
<<    processing related to the handling of errors.  In        <<U.RAO>>00674000
<<    particular this procedure decides whether to print the   <<U.RAO>>00676000
<<    message, abort the job, and other related cleanup        <<U.RAO>>00678000
<<    problems.  Note that it always returns to the caller if  <<U.RAO>>00680000
<<    the job is not aborted.  It is the responsibility of the <<U.RAO>>00682000
<<    caller to assure that the job is clean enough to be      <<U.RAO>>00684000
<<    aborted at the time of the call.  CIERR cannot be called <<U.RAO>>00686000
<<    in split stack mode.  See the listing of CIERR for the   <<U.RAO>>00688000
<<    details of the call.                                     <<U.RAO>>00690000
<<3)  Errors detected by other parts of the system.            <<U.RAO>>00692000
<<    Errors such as file system errors, loader errors, DS     <<U.RAO>>00694000
<<    runtime errors and private volume errors are really of   <<U.RAO>>00696000
<<    little meaning in the context of the CI.  Accordingly,   <<U.RAO>>00698000
<<    when such errors are detected, several messages may be   <<U.RAO>>00700000
<<    displayed.  This is done through the agency of routines  <<U.RAO>>00702000
<<    like FERROR', CYDIRERR', LOADERROR, and CREATEERROR.     <<U.RAO>>00704000
<<    The development of such routines is encouraged whenever  <<U.RAO>>00706000
<<    message sets outside the CI error message set is         <<U.RAO>>00708000
<<    involved.  When such a message is output, the CI should  <<U.RAO>>00710000
<<    also print a message translating the error into the      <<U.RAO>>00712000
<<    context of the command which failed.  For example, when  <<U.RAO>>00714000
<<    a purge fails for an unusual reason, we print the file   <<U.RAO>>00716000
<<    system error message as well as a message saying that the<<U.RAO>>00718000
<<    purge was not done.                                      <<U.RAO>>00720000
<<4)  General purpose parsing routines                         <<U.RAO>>00722000
<<    Some parses, such as file names, are done so often that  <<U.RAO>>00724000
<<    generalized routines exist.  Usually these will be found <<U.RAO>>00726000
<<    in the neighborhood of the error handling routines.      <<U.RAO>>00728000
<<5)  Programmatically callable commands                       <<U.RAO>>00730000
<<    For errors in programmatically callable commands you must<<U.RAO>>00732000
<<    also return the error number to the caller of the COMMAND<<U.RAO>>00734000
<<    intrinsic.  This is done by returning the number through <<U.RAO>>00736000
<<    the ERRNUM parameter to all executors.  Also it is       <<U.RAO>>00738000
<<    required that you return the parameter number in the     <<U.RAO>>00740000
<<    PARMNUM parameter.  Parameter number is roughly defined  <<U.RAO>>00742000
<<    as one for each entity such as a keyword or value past   <<U.RAO>>00744000
<<    the command name.  In other words, 1 is the first        <<U.RAO>>00746000
<<    parameter past the command name, 2 might be the value to <<U.RAO>>00748000
<<    be associated with the keyword which was parameter 1.    <<U.RAO>>00750000
<<                                                             <<U.RAO>>00752000
<<   Error message generation is one of the most important     <<U.RAO>>00754000
<<tasks to be performed by the Command Interpreter.  The best  <<U.RAO>>00756000
<<error messages are generated when the coder tries to envision<<U.RAO>>00758000
<<the user's perception of the error.  For example, in many    <<U.RAO>>00760000
<<cases it seems to the user that it was obvious what he meant <<U.RAO>>00762000
<<even though it was not expressed in correct form.  This      <<U.RAO>>00764000
<<includes redundantly specified keywords like NOCCTL in the   <<U.RAO>>00766000
<<file command.  The user does not think highly of a command   <<U.RAO>>00768000
<<parser which gives him an error message on something like tha<<U.RAO>>00770000
<<which is obviously non-fatal.  The key to success with error <<U.RAO>>00772000
<<messages is to identify errors in the user's frame of        <<U.RAO>>00774000
<<reference, not the system programmer's.                      <<U.RAO>>00776000
<<                                                             <<U.RAO>>00778000
$TITLE "GLOBAL DECLARATIONS"                                            00780000
$PAGE "GLOBAL DECLARATIONS"                                             00782000
$CONTROL MAIN=COMMAND'INTERP                                   <<06.EB>>00784000
BEGIN                                                                   00786000
      <<MISCELLANEOUS DECLARATIONS >>                                   00788000
      INTEGER                                                           00790000
      DELTAQ=Q-0,                                                       00792000
      S0=S-0,                                                           00794000
      S4=S-4,                                                           00796000
      XREG = X,                                                         00798000
      X=X;                                                              00800000
                                                                        00802000
      LOGICAL                                                           00804000
      LS0=S-0,                                                          00806000
      STATUS=Q-1;                                                       00808000
                                                                        00810000
      DOUBLE                                                            00812000
      DS1=S-1,                                                          00814000
      DS3=S-3;                                                 << I.A >>00816000
                                                                        00818000
      BYTE POINTER                                                      00820000
      BPS0=S-0,                                                         00822000
      BPS1=S-1;                                                         00824000
                                                                        00826000
      INTEGER POINTER                                                   00828000
      PS0=S-0;                                                 << I.A >>00830000
                                                                        00832000
      DOUBLE POINTER                                                    00834000
      DPS1 = S-1;                                              <<U.RAO>>00836000
                                                                        00838000
      INTEGER ARRAY ARRDB0(*)=DB+0;                                     00840000
      INTEGER ARRAY ARRDB2(*)=DB+2;                                     00842000
      INTEGER ARRAY ARRDB3(*)=DB+3;                                     00844000
      INTEGER ARRAY ARRDB5(*)=DB+5;                                     00846000
      INTEGER ARRAY ARRDB6(*)=DB+6;                                     00848000
      INTEGER ARRAY ARRQ0(*)=Q-0;                                       00850000
      INTEGER ARRAY ARRS7(*)=S-7;                                       00852000
$INCLUDE INCLCIS                                               << I.A >>00854000
$PAGE "GLOBAL DECLARATIONS"                                    << I.A >>00856000
                                                               <<09.EB>>00858000
      <<EQUATES USED THROUGHOUT>>                                       00860000
                                                                        00862000
      EQUATE                                                            00864000
      << SERIES 33 CPU NUMBER RETURNED FROM 'THISCPU' >>       <<00492>>00866000
      <<CONDITION CODES>>                                               00868000
      CCE=2,                                                            00870000
      CCL=1,                                                            00872000
      CCG=0,                                                            00874000
      <<CI MESSAGE SET NUMBERS>>                               <<U.RAO>>00876000
      CIERRMSGSET=2,                                           <<U.RAO>>00878000
      CIGENERALMSGSET=7,                                       <<U.RAO>>00880000
      PVERRMSGSET = 15,                                        <<RH.PV>>00882000
   <<EQUATES FOR GENERAL MESSAGES (NOT ERROR MESSAGES)>>       <<U.RAO>>00884000
   ENDOFPROG       = 50,  <<END OF PROGRAM MESSAGE>>           <<U.RAO>>00886000
   << END OF PREPARE = 51, >>                                  <<U.RAO>>00888000
   << END OF SUBSYSTEM = 52, >>                                <<U.RAO>>00890000
   << END OF COMPILE = 53, >>                                  <<U.RAO>>00892000
   << END OF REMOTE PROGRAM = 54>>                             <<U.RAO>>00894000
   <<JCW = WARN, MSG 56>>                                      <<U.RAO>>00896000
   <<JCW = FATAL, MSG 57>>                                     <<U.RAO>>00898000
   <<JCW = SYSTEM, MSG 58>>                                    <<U.RAO>>00900000
   <<DS MESSAGE, MSG 59>>                                      <<U.RAO>>00902000
   <<DS MESSAGE, MSG 60>>                                      <<U.RAO>>00904000
      <<ERROR EQUATES REFER TO C.I. ERROR NUMBER>>                      00906000
                                                                        00908000
                                                                        00910000
                                                                        00912000
      <<COMMAND RELATED ERRORS>>                                        00914000
   PARAMTOOBIG     =  14,  <<PARAMETER EXCEEDS 255 CHARS>>     <<01709>>00916000
   <<FILE AND BUILD COMMANDS>>                                 <<U.RAO>>00918000
   FDESGNOLOCK     = 199  ,  <<No lockword in formal desgn.>>  <<04848>>00920000
   BLD2MP          = 200  ,  <<MORE THAN 30 PARMS TO BUILD>>   <<U.RAO>>00922000
   BLDREQFILENAME  = 201  ,  <<NAME IS REQUIRED PARM>>         <<U.RAO>>00924000
   FILEFCODEDEFALT = 202  ,  <<FILE CODE MISSING - 0 DEFAULT>> <<U.RAO>>00926000
   FILE2MP         = 203  ,  <<MORE THAN 30 PARMS TO BUILD>>   <<U.RAO>>00928000
   FILEREQFDESIG   = 204  ,  <<REQUIRES FORMAL DESIGNATOR>>    <<U.RAO>>00930000
   FILEFDSGNOBACK  = 205  ,  <<FDESIG MAY NOT BE BACKREF>>     <<U.RAO>>00932000
   FILEFDSGNOSYS   = 206  ,  <<FDESIG MAY NOT BE SYSDEF FILE>> <<U.RAO>>00934000
   FILEREQSOMEPARM = 207  ,  <<NEEDS AT LEAST 2 PARMS>>        <<U.RAO>>00936000
   FILEADESIGBR2MP = 208  ,  <<BACK REF MAY NOT HAVE PARMS>>   <<U.RAO>>00938000
   FILEBREFMISADES = 209  ,  <<UNABLE TO FIND BACK REF'D FILE>><<U.RAO>>00940000
   FILEADESNULL2MP = 210  ,  <<$NULL ADES CANNOT HAVE PARMS>>  <<U.RAO>>00942000
   FILEDOMAINSYSDF = 211  ,  <<CANNOT SPEC FILE DOMAIN>>       <<U.RAO>>00944000
   FILEXPCTDOMAIN  = 212  ,  <<EXPECTED A FILE DOMAIN>>        <<U.RAO>>00946000
   FILEINVLDDOMAIN = 213  ,  <<UNKNOWN DOMAIN TYPE>>           <<U.RAO>>00948000
   FILEXSTRTPARMCR = 214  ,  <<EXPECTED START OF PARMS>>       <<U.RAO>>00950000
   FILEEXTRANDELIM = 215  ,  <<EXTRANEOUS PARM DELIMITER>>     <<U.RAO>>00952000
   FILECONTXTBLD   = 216  ,  <<NOT APPROPRIATE FOR BUILD>>     <<U.RAO>>00954000
   FILECONTXTSYSDF = 217  ,  <<NOT APPROPRIATE FOR SYSDEF FILE><<U.RAO>>00956000
   FILECONTXTOLD   = 218  ,  <<NOT APPROPRIATE FOR OLD FILE>>  <<U.RAO>>00958000
   FILECONTXTNEW   = 219  ,  <<NOT APPROPRIATE FOR NEW FILE>>  <<U.RAO>>00960000
   FILEUNKNOWNKEY  = 220  ,  <<UNKNOWN KEYWORD FOR COMMAND>>   <<U.RAO>>00962000
   FILENOCCTLCCTL  = 221  ,  <<CCTL OVERRIDES NOCCTL>>         <<U.RAO>>00964000
   FILECCTLNOCCTL  = 222  ,  <<NOCCTL OVERRIDES CCTL>>         <<U.RAO>>00966000
   FILEDELTEMP     = 223  ,  <<TEMP OVERRIDES DEL>>            <<U.RAO>>00968000
   FILESAVETEMP    = 224  ,  <<TEMP OVERRIDES SAVE>>           <<U.RAO>>00970000
   FILEDELSAVE     = 225  ,  <<SAVE OVERRIDES DEL>>            <<U.RAO>>00972000
   FILETEMPSAVE    = 226  ,  <<SAVE OVERRIDES TEMP>>           <<U.RAO>>00974000
   FILETEMPDEL     = 227  ,  <<DEL OVERRIDES TEMP>>            <<U.RAO>>00976000
   FILESAVEDEL     = 228  ,  <<DEL OVERRIDES SAVE>>            <<U.RAO>>00978000
   FILEEXCLSHARE   = 229  ,  <<SHR OVERRIDES EXCLUSIVE>>       <<U.RAO>>00980000
   FILEEXCLEAR     = 231  ,  <<EAR OVERRIDES EXC>>             <<U.RAO>>00982000
   FILESHAREEAR    = 232  ,  <<EAR OVERRIDES SHARE>>           <<U.RAO>>00984000
   FILEEAREXCL     = 233  ,  <<EXC OVERRIDES EAR>>             <<U.RAO>>00986000
   FILESHAREEXCL   = 234  ,  <<EXC OVERRIDES SHARE>>           <<U.RAO>>00988000
   FILEBUFNOBUF    = 235  ,  <<NOBUF OVERRIDES BUF>>           <<U.RAO>>00990000
   FILENOMRMR      = 236  ,  <<MR OVERRIDES NOMR>>             <<U.RAO>>00992000
   FILEMRNOMR      = 237  ,  <<NOMR OVERRIDES MR>>             <<U.RAO>>00994000
   FILENOMULTIMULTI= 238  ,  <<MULTI OVERRIDES NOMULTI>>       <<U.RAO>>00996000
   FILEMULTINOMULTI= 239  ,  <<NOMULTI OVERRIDES MULTI>>       <<U.RAO>>00998000
   FILENOWAITWAIT  = 240 ,  <<WAIT OVERRIDES NOWAIT>>          <<U.RAO>>01000000
   FILEWAITNOWAIT  = 241 ,  <<NOWAIT OVERRIDES WAIT>>          <<U.RAO>>01002000
   FILENOXPCTSPARM = 242 ,  <<NO SUBPARMS FOR THIS KEY>>       <<U.RAO>>01004000
   FILEREQEQSIGN   = 243 ,  <<EXPECTED EQUALS SIGN>>           <<U.RAO>>01006000
   FILEACCESSREDND = 244 ,  <<ACCESS REDUNDANTLY SPECIFIED>>   <<U.RAO>>01008000
   FILEACCREQVALUE = 245 ,  <<ACCESS TYPE REQUIRED>>           <<U.RAO>>01010000
   FILEACCINVALID  = 246 ,  <<UNKNOWN ACCESS TYPE>>            <<U.RAO>>01012000
   FILEACCXTRNPARM = 247 ,  <<EXTRANEOUS PARM TO ACCESS>>      <<U.RAO>>01014000
   FILENOBUFBUF    = 248 ,  <<BUF OVERRIDES NOBUF>>            <<U.RAO>>01016000
   FILEBUFOVERRIDE = 249 ,  <<BUF OVERRIDES PREVIOUS BUF>>     <<U.RAO>>01018000
   FILEINVLDBUFNUM = 250 ,  <<INVALID NUMBER OF BUFFERS>>      <<U.RAO>>01020000
   FILEBUFXTRANDEL = 251 ,  <<EXTRANEOUS PARM TO BUF>>         <<U.RAO>>01022000
   FILEFCODEREDUND = 252 ,  <<FILE CODE OVERRIDES PREVIOUS>>   <<U.RAO>>01024000
   FILEUNKFCODE    = 253 ,  <<UNKNOWN FILE CODE>>              <<U.RAO>>01026000
   FILEFCODEVALUE  = 254 ,  <<FILE CODE MUST BE A POSITIVE INT><<U.RAO>>01028000
   FILECODEXTRNDEL = 255 ,  <<EXTRANEOUS PARM TO CODE>>        <<U.RAO>>01030000
   FILEDEVOVERRIDE = 256 ,  <<OVERRIDES PREVIOUS DEV>>         <<U.RAO>>01032000
   FILESYSDEFDEV   = 257 ,  <<SYSDEF FILE DEV FORCED>>         <<U.RAO>>01034000
   FILEDSNAME2LONG = 259 ,  <<DS NAME > 8 CHARACTERS>>         <<U.RAO>>01036000
   FILEDEVNAME2LNG = 260 ,  <<DEVICE NAME > 8 CHARACTERS>>     <<U.RAO>>01038000
   FILEOUTPRINOT   = 261 ,  <<OUTPRI LEGAL ONLY FOR OUTPUT FILES>>      01040000
   FILEOUTPRIINVLD = 262 ,  <<UNACCEPTABLE OUTPRI>>            <<U.RAO>>01042000
   FILENUMCOPINVLD = 263 ,  <<UNACCEPTABLE NUMBER OF COPIES>>  <<U.RAO>>01044000
   FILEDEVXPARMS   = 264 ,  <<UNKNOWN SUBPARAMETER>>           <<U.RAO>>01046000
   FILEDISCOVERIDE = 265 ,  <<OVERRIDE PREVIOUS DISC PARM>>    <<U.RAO>>01048000
   FILEFILESIZE    = 266 ,  <<ILLEGAL NUMBER OF RECORDS>>      <<U.RAO>>01050000
   FILEEXTENTSPROB = 267 ,  <<ILLEGAL NUMBER OF EXTENTS>>      <<U.RAO>>01052000
   FILEINITALLOCBD = 268 ,  <<UNACCEPTABLE INIT ALLOCATION>>   <<U.RAO>>01054000
   FILEDISCXPARMS  = 269 ,  <<UNKNOWN DISC SUBPARAMETER>>      <<U.RAO>>01056000
   FILERECOVERRIDE = 270 ,  <<OVERRIDE PREVIOUS REC =  >>      <<U.RAO>>01058000
   FILEBADRECSIZE  = 271 ,  <<DISALLOW RECSIZE OF 0>>          <<U.RAO>>01060000
   FILEBADBLOCKING = 272 ,  <<ILLEGAL BLOCK FACTOR>>           <<U.RAO>>01062000
   FILEUNKRECFMT   = 273 ,  <<UNKNOWN RECORD FORMAT>>          <<U.RAO>>01064000
   FILEASCIIINVALD = 274 ,  <<NEITHER ASCII NOR BINARY>>       <<U.RAO>>01066000
   FILERECXTRANPRM = 275 ,  <<UNKNOWN PARM TO REC PARM>>       <<U.RAO>>01068000
   FEQTABFULLXPLCT = 276 ,  <<FILE EQUATE TABLE FULL>>         <<U.RAO>>01070000
   BLDDOMAINNOT    = 277 ,  <<DOMAIN NOT ALLOWED ON BUILD>>    <<U.RAO>>01072000
   BLDNOTADES      = 278 ,  <<ACTUAL DESIGNATOR NOT ALLOWED ON BUILD>>  01074000
   BLDFAILED       = 279 ,  <<BUILD OF FILE FAILED>>           <<U.RAO>>01076000
   FILEXPINVMONTH  = 280 ,  <<BAD NO. FOR MONTH>>              <<U.RAO>>01078000
   FILEXPNOSLASHMD = 281 ,  <<NO SLASH BETWEEN MONTH & DAY>>   <<U.RAO>>01080000
   FILEXPINVDAY    = 282 ,  <<INVALID NO. FOR DAY OF MONTH>>   <<U.RAO>>01082000
   FILEXPDAYZERO   = 283 ,  <<00 FOR MONTH, NOT FOR DAY>>      <<U.RAO>>01084000
   FILEXPNOSLASHDY = 284 ,  <<NO SLASH BETWEEN DAY & YEAR>>    <<U.RAO>>01086000
   FILEXPNONZERO   = 285 ,  <<IF MONTH, DAY = 00, NOT YEAR>>   <<U.RAO>>01088000
   FILEXPXTRNDATA  = 286 ,  <<EXTRANEOUS PARM TO EXP DATE>>    <<U.RAO>>01090000
   FILEREDUNDLABEL = 287 ,  <<LABEL REDUNDANTLY SPECIFIED>>    <<U.RAO>>01092000
   FILEVOLID2LONG  = 288 ,  <<VOLID > 6 CHARACTERS>>           <<U.RAO>>01094000
   FILEVOLIDSPECAL = 289 ,  <<EMBEDDED SPECIAL IN VOLID>>      <<U.RAO>>01096000
   FILEINVVOLTYPE  = 290 ,  <<BAD VOLUME TYPE>>                <<U.RAO>>01098000
   FILEXPINVSEQ    = 291 ,  <<INVALID SEQUENCE FIELD>>         <<U.RAO>>01100000
   FILEXTRNLABEL   = 292 ,  <<EXTRANEOUS PARM TO LABEL>>       <<U.RAO>>01102000
   FILEFORMOVERRID = 293 ,  <<REDUNDANTLY SPECIFIED FORMS MSG>><<U.RAO>>01104000
   FILEFMSNOPERIOD = 294 ,  <<NO PERIOD ON FORMS MESSAGE>>     <<U.RAO>>01106000
   FILEFMSTOOLONG  = 295 ,  <<TRUNCATED TO 49 CHARACTERS>>     <<U.RAO>>01108000
   FILELABELNOLABEL= 296 ,  <<LABEL OVERRIDEN BY NOLABEL>>     <<U.RAO>>01110000
   FILENOLOCKLOCK  = 297 ,  <<NOLOCK OVERRIDES LOCK>>          <<U.RAO>>01112000
   FILELOCKNOLOCK  = 298 ,  <<LOCK OVERRIDES NOLOCK>>          <<U.RAO>>01114000
   BLDUNKNOWNKEY   = 299 ,  <<UNKNOWN KEYWORD TO BUILD>>       <<U.RAO>>01116000
   BLDNOSYSFILES   = 300,  <<ONLY $NEWPASS TO :BUILD>>         <<U.RAO>>01118000
   FILEINVALDEVNAME= 301,  <<INVALID DEV NAME>>                <<00579>>01120000
   CIRCULARFEQ     = 304,  <<CIRCULAR FILE EQUATIONS>>         <<00834>>01122000
   FILEADESSYS     = 305,  <<ENVIRONMENT NOT SYSFILE>>         <<01549>>01124000
   FILEENVOVERRIDE = 306,  <<OVERRIDE PREVIOUS ENV PARAMETER>> <<01549>>01126000
   FILEENVXPARMS   = 307,  <<ENV HAS NO SUBPARAMETERS>>        <<01549>>01128000
   FILEOUTQOVERRIDE= 308,  <<OVERRIDE PREVIOUS OUTQ PARM>>     <<01549>>01130000
   OUTQNAMEALPHNUM = 309,  <<OUTQ NAME NOT ALPHANUMERIC>>      <<01549>>01132000
   OUTQNAME2LNG    = 310,  <<OUTQ NAME > 8 CHARACTERS>>        <<01549>>01134000
   OUTQNAMENOTALPH = 311,  <<OUTQ NAME BEGINS WITH ALPHA>>     <<01549>>01136000
   FILEOUTQXPARMS  = 312,  <<OUTQ HAS NO SUBPARAMETERS>>       <<01549>>01138000
   FILESHARESEMI   = 313,  <<SEMI OVERRIDES SHR>>              <<01549>>01140000
   FILEEXCLSEMI    = 314,  <<SEMI OVERRIDES EXC>>              <<01549>>01142000
   FILENOCOPYCOPY  = 315,  <<COPY OVERRIDES NOCOPY>>           <<01549>>01144000
   FILECOPYNOCOPY  = 316,  <<NOCOPY OVERRIDES COPY>>           <<01549>>01146000
   FILENOMULTGMULT = 317,  <<GMULTI OVERRIDES NOMULTI>>        <<01549>>01148000
   FILEMULTIGMULTI = 318,  <<GMULTI OVERRIDES MULTI>>          <<01549>>01150000
   FILEGMULTIMULTI = 319,  <<MULTI OVERRIDES GMULTI>>          <<01549>>01152000
   FILEGMULTNOMULT = 320,  <<NOMULTI OVERRIDES GMULTI>>        <<01549>>01154000
   FILERIOSTD      = 321,  <<STD OVERRIDES RIO>>               <<01549>>01156000
   FILEMSGSTD      = 322,  <<STD OVERRIDES MSG>>               <<01549>>01158000
   FILECIRSTD      = 323,  <<STD OVERRIDES CIR>>               <<01549>>01160000
   FILESTDRIO      = 324,  <<RIO OVERRIDES STD>>               <<01549>>01162000
   FILEMSGRIO      = 325,  <<RIO OVERRIDES MSG>>               <<01549>>01164000
   FILECIRRIO      = 326,  <<RIO OVERRIDES CIR>>               <<01549>>01166000
   FILESTDMSG      = 327,  <<MSG OVERRIDES STD>>               <<01549>>01168000
   FILERIOMSG      = 328,  <<MSG OVERRIDES RIO>>               <<01549>>01170000
   FILECIRMSG      = 329,  <<MSG OVERRIDES CIR>>               <<01549>>01172000
   FILESTDCIR      = 330,  <<CIR OVERRIDES STD>>               <<01549>>01174000
   FILERIOCIR      = 331,  <<CIR OVERRIDES RIO>>               <<01549>>01176000
   FILEMSGCIR      = 332,  <<CIR OVERRIDES MSG>>               <<01549>>01178000
   FILECONTENV     = 333,  <<BACK REF. FILE CONTAINS ENV.>>    <<02554>>01180000
   FILEDENSOVERRID = 334,  <<OVERRIDE PREVIOUS DENS PARM>>     <<02569>>01182000
   FILEDENSXPARM   = 335,  <<EXTRANEOUS PARM TO DENS>>         <<02569>>01184000
   FILEDENSINVAL   = 336,  <<DENS PARM NOT VALID>>             <<02569>>01186000
   FILEMISSQUOTE   = 337,  << MISSING QUOTE ON VOLID >>        <<02663>>01188000
   FILENONPRINTCHAR= 338,  << VOLID HAS NON PRINT CHARS >>     <<02663>>01190000
   FILECOMMASEMINOK= 339,  << VOLID CAN'T HAVE COMMA,SEMI >>   <<02663>>01192000
   FILEVIRTUALDEV  = 342,  << virtual device not allowed >>    <<04171>>01194000
   FILEINVLDCLASPEC= 343,  << invalid device class >>          <<04171>>01196000
   FILEUNKNOWNDEV  = 344,  << unknown device class >>          <<04171>>01198000
   FILEDONTKNOWLDEV= 345,  << unknown logical device >>        <<04171>>01200000
                                                                        01202000
<< SECURE COMMAND>>                                            <<U.RAO>>01204000
   NOTCREATOR      = 351,  <<NOT CREATOR OF FILE>>             <<U.RAO>>01206000
   DISCIOERR       = 353, <<DISC IO ERROR WHEN ACCESSING FILE L<<U.RAO>>01208000
   SECURE2MP       = 354, <<ONLY FILE NAME ALLOWED>>           <<U.RAO>>01210000
   SECURENOTENUF   = 355, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>01212000
   GETFLABOPEN     = 356,  <<OPEN FAILED IN GETFLABEL>>        <<04.RO>>01214000
<< RESET AND CRESET COMMANDS>>                                 <<U.RAO>>01216000
   RESETPARMERR    = 360,                                      <<U.RAO>>01218000
   CRESETPARMERR   = 361,                                      <<U.RAO>>01220000
   FEQNOTFOUND     = 362, <<FILE EQUATE NOT FOUND>>            <<U.RAO>>01222000
<< RENAME COMMAND>>                                            <<U.RAO>>01224000
   RENAME2MP       = 370,                                      <<U.RAO>>01226000
   RENAMEEXPECTTEMP= 371,                                      <<U.RAO>>01228000
   RENAMEOLDFFSERR = 372,  <<RENAME OLD FILE ERROR>>           <<U.RAO>>01230000
   RENAMEFAILED    = 373,  <<CALL TO FRENAME FAILED>>          <<U.RAO>>01232000
   RENAMECLSFAILED = 374,  <<CLOSE OF RENAMED FILE FAILED>>    <<U.RAO>>01234000
   RENAMEREQOLDNAME= 375  ,  <<EXPECTED OLD FILE NAME>>        <<U.RAO>>01236000
   RENAMEREQNEWNAME= 376  ,  <<EXPECTED NEW FILE NAME>>        <<U.RAO>>01238000
<< PURGE COMMAND>>                                             <<U.RAO>>01240000
   PURGE2MP        = 380,                                      <<U.RAO>>01242000
   PURGEREQFNAME   = 381,                                      <<U.RAO>>01244000
   PURGEEXPECTTEMP = 382,                                      <<U.RAO>>01246000
   PURGEFNOTFOUND  = 383,                                      <<U.RAO>>01248000
   PURGEFOPENFAILD = 384,  <<OPEN OF FILE TO BE PURGED FAILED>><<U.RAO>>01250000
   PURGECLOSEFAILD = 385,  <<UNABLE TO PURGE FILE>>            <<U.RAO>>01252000
   PURGESEMICOLON  = 386  ,  <<FOUND ";", EXPECTED ",">>       <<U.RAO>>01254000
<< SAVE COMMAND >>                                             <<U.RAO>>01256000
   SAVE2MP         = 390,                                      <<U.RAO>>01258000
   SAVEREQFNAME    = 391,                                      <<U.RAO>>01260000
   SAVEEXPECTOLDPASS=392,                                      <<U.RAO>>01262000
   SAVEOPENOLDPASS = 393,  <<UNABLE TO OPEN $OLDPASS>>         <<U.RAO>>01264000
   SAVECLOSOLDPASS = 394,  <<UNABLE TO CLOSE $OLDPASS>>        <<U.RAO>>01266000
   SAVETEMPOPEN    = 395,  <<UNABLE TO OPEN TEMP FILE>>        <<U.RAO>>01268000
   SAVETEMPCLOSE   = 396,  <<UNABLE TO SAVE TEMP FILE>>        <<U.RAO>>01270000
   SAVESEMICOLON   = 397  ,  <<FOUND ";", EXPECTED ",">>       <<U.RAO>>01272000
   SAVETEMPFAIL    = 398,   <<COULDN'T OPEN STEMPFILE>>        <<04784>>01274000
<< RELEASE COMMAND >>                                          <<U.RAO>>01276000
   RELEASE2MP      = 400, <<ONLY FILE NAME ALLOWED>>           <<U.RAO>>01278000
   RELEASENOTENUF  = 401, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>01280000
<< ALTSEC COMMAND >>                                           <<U.RAO>>01282000
   ALTSECNOTENUF   = 410, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>01284000
   ALTSEC2MP       = 411, <<EXTRANEOUS DATA ON ALTSEC COMMAND>><<U.RAO>>01286000
<< LISTF COMMAND >>                                            <<U.RAO>>01288000
   LISTFBADLEVEL    = 420, <<BAD LEVEL # IN LISTF>>            <<U.RAO>>01290000
   LISTFSMCAP       = 422, <<NEED SM CAPABILITY>>              <<U.RAO>>01292000
   LISTFAMCAP       = 423, <<NEED AM CAPABILITY>>              <<U.RAO>>01294000
   LISTFEXPECTFILE  = 424, <<EXPECTED FILE NAME>>              <<U.RAO>>01296000
   LISTFFSERR       = 425, <<LISTF FILE SYS ERROR>>            <<U.RAO>>01298000
   LISTFEXTRANEOUS = 426,  <<UNIDENTIFIED FILESET NAME>>       <<U.RAO>>01300000
   LISTF2MP        = 427,  <<2 MANY PARMS TO LISTF>>           <<U.RAO>>01302000
   LISTFFLABIOERR  = 428,  <<IO ERROR READING FILE LABEL>>     <<U.RAO>>01304000
   LISTFHVSNOTMTD  = 429,  <<HOME VOLUME SET NOT MOUNTED>>     <<RV.PV>>01306000
   LISTFSTOPPED    = 430,                                      <<03.KM>>01308000
   NOXXXLISTED     = 431,                                      <<03.KM>>01310000
   NOFILESLISTED   = NOXXXLISTED,                              <<03.KM>>01312000
<< FILE ACCESS MASK ERRORS (PROCEDURE FORMACCESS, MOSTLY)>>    <<U.RAO>>01314000
   ACCESSEXPECTLPAREN= 500, <<EXPECTED LEADING "(">>           <<U.RAO>>01316000
   ACCESSEXPECTRPAREN=501,<<EXPECTED TRAILING ")">>            <<U.RAO>>01318000
   ACCESSUNKNOWNFMODE=502,<<EXPECTED FILE ACCESS MODE TYPE>>   <<U.RAO>>01320000
   ACCESSUNKNOWNGMODE=503,<<DITTO FOR GROUP>>                  <<U.RAO>>01322000
   ACCESSUNKNOWNAMODE=504,<<DITTO FOR ACCOUNT>>                <<U.RAO>>01324000
   ACCESSFSNOTPERMIT=505, <<SAVE NOT PERMITTED FOR FILE>>      <<U.RAO>>01326000
   ACCESSASNOTPERMIT=506, <<SAVE NOT PERMITTED FOR ACCOUNT>>   <<U.RAO>>01328000
   ACCESSEXPECTCOLON=507, << (X:XX), DIDN'T FIND COLON>>       <<U.RAO>>01330000
   ACCESSUNKNOWNFUSER=508,<<UNKNOWN FILE USER TYPE>>           <<U.RAO>>01332000
   ACCESSUNKNOWNGUSER=509,<<UNKNOWN GROUP USER TYPE>>          <<U.RAO>>01334000
   ACCESSUNKNOWNAUSER=510,<<UNKNOWN ACCOUNT USER TYPE>>        <<U.RAO>>01336000
   ACCESSCRNOTPERMIT=511, <<CREATOR NOT PERMITTED IN GROUP>>   <<U.RAO>>01338000
   ACCESSUSNOTPERMIT=512, <<NOT PERMITTED AT ACCOUNT LEVEL>>   <<U.RAO>>01340000
   ACCESSRREDUND   = 513, <<READ REDUNDANTLY SPECIFIED>>       <<U.RAO>>01342000
   ACCESSAREDUND   = 514, <<APPEND REDUNDANTLY SPECIFIED>>     <<U.RAO>>01344000
   ACCESSWREDUND   = 515, <<WRITE  "               "   >>      <<U.RAO>>01346000
   ACCESSLREDUND   = 516, <<LOCK      "            "   >>      <<U.RAO>>01348000
   ACCESSXREDUND   = 517, <<EXECUTE   "            "   >>      <<U.RAO>>01350000
   ACCESSSREDUND   = 518, <<SAVE      "            "   >>      <<U.RAO>>01352000
   ACCESSREDUNDMODE= 519, <<REDUNDANT IN THIS LIST>>           <<U.RAO>>01354000
<< FILE NAME ERRORS>>                                          <<U.RAO>>01356000
   FILEEXPECTALPHA = 530  ,                                    <<U.RAO>>01358000
   FFNAMEBASE=FILEEXPECTALPHA-1,                               <<U.RAO>>01360000
   FILENAMEMISSING = 531  ,                                    <<U.RAO>>01362000
   FILENAMETOOLONG = 532  ,                                    <<U.RAO>>01364000
   FILEMISSINGDELIM= 535,                                     <<00.GEN>>01366000
   FILENOGENNAME   = 536,                                     <<00.GEN>>01368000
<< GROUP NAME ERRORS >>                                        <<U.RAO>>01370000
   GRPEXPECTALPHA  = 540  ,                                    <<U.RAO>>01372000
   FGNAMEBASE=GRPEXPECTALPHA-1,                                <<U.RAO>>01374000
<< ACCOUNT NAME ERRORS >>                                      <<U.RAO>>01376000
   ACCTEXPECTALPHA = 550  ,                                    <<U.RAO>>01378000
   FANAMEBASE=ACCTEXPECTALPHA-1,                               <<U.RAO>>01380000
<< LOCKWORD NAME ERRORS >>                                     <<U.RAO>>01382000
   LWDEXPECTALPHA  = 560  ,                                    <<U.RAO>>01384000
   FLWORDBASE=LWDEXPECTALPHA-1,                                <<U.RAO>>01386000
<< VOLUME SET DEFINITION NAME ERRORS >>                        <<U.RAO>>01388000
   VSDEXPECTALPHA  = 570  ,                                    <<U.RAO>>01390000
   VSDNAMEBASE     = VSDEXPECTALPHA-1,                         <<U.RAO>>01392000
   VSDNOLOCKWORD   = 579,                                     <<00.GEN>>01394000
<< MISCELLANEOUS NAMING ERRORS >>                              <<U.RAO>>01396000
<< USER NAME ERRORS >>                                         <<U.RAO>>01398000
   USEREXPECTALPHA = 590,                                      <<U.RAO>>01400000
   USERNAMEBASE    = USEREXPECTALPHA-1,                        <<U.RAO>>01402000
<< PREPRUN, PREP, RUN COMMANDS >>                              <<U.RAO>>01404000
   ERRNOPROGF      = 600  ,  <<NO PROGRAM FILE SPECIFIED>>     <<U.RAO>>01406000
   ERRNOUSLF       = 601  ,  <<NO USL FILE SPECIFIED>>         <<U.RAO>>01408000
   ERRNOPORUF      = 602  ,  <<NEITHER SPECIFIED>>             <<U.RAO>>01410000
   ERRNOPREPTARGET = 603  ,  <<NO PROGRAM FILE SPECIFIED>>     <<U.RAO>>01412000
   CMAXPCTSEMIORCR = 604  ,  <<FOUND COMMA, NEEDED ; OR CR>>   <<U.RAO>>01414000
   EQXPCTSEMIORCR  = 605  ,  <<FOUND =, NEEDED ; OR CR>>       <<U.RAO>>01416000
   EXTRNDELIMIGNRD = 606  ,  <<IGNORED EXTRANEOUS DELIMITER>>  <<U.RAO>>01418000
   CONTXTRUNNOTPRP = 607  ,  <<ALLOWED IN RUN, NOT PREP>>      <<U.RAO>>01420000
   CONTXTPRPNOTRUN = 608  ,  <<ALLOWED IN PREP, NOT RUN>>      <<U.RAO>>01422000
   UNKNOWNKEYPREP  = 609  ,                                    <<U.RAO>>01424000
   UNKNOWNKEYRUN   = 610  ,                                    <<U.RAO>>01426000
   UNKNOWNKEYPRPRN = 611  ,                                    <<U.RAO>>01428000
   REQEQUALSIGN    = 612  ,  <<NEED EQUALS SIGN>>              <<U.RAO>>01430000
   INVALIDLIB      = 613  ,  <<NEED ONE OF S,P, OR G>>         <<U.RAO>>01432000
   INVALIDMAXDATA  = 614  ,                                    <<U.RAO>>01434000
   INVALIDPARM     = 615  ,                                    <<U.RAO>>01436000
   INVALIDSTAKSIZE = 616  ,                                    <<U.RAO>>01438000
   INVALIDDLSIZE   = 617  ,                                    <<U.RAO>>01440000
   MISSINGCAP      = 618  ,  <<A SYNTAX PROBLEM WITH CAPABILITY<<U.RAO>>01442000
   UNKNOWNCAP      = 619  ,  <<NOT RECOGNIZED CAPABILITY>>     <<U.RAO>>01444000
   WARNDUPLKEY     = 620  ,  <<A WARNING ONLY>>                <<U.RAO>>01446000
   SEGMENTERERROR  = 621  ,  <<SEGMENTER RETURN TO CXPREPRUN>> <<U.RAO>>01448000
   NOSUCHPROGFILE  = 622  ,  <<THE CREATE FAILED.>>            <<U.RAO>>01450000
   DEFVAL          = 623,  <<DEFAULT MAXDATA TAKEN>>           <<U.RAO>>01452000
   PRPRNNOLOAD     = 625,  <<UNABLE TO LOAD PROGRAM>>          <<U.RAO>>01454000
   INVALIDPROGFILE = 626,   <<INVALID PROGRAM FILE>>           <<U.RAO>>01456000
   ERRENTRYTOOBIG  = 627,  <<ENTRY POINT NAME > 15 CHAR LONG>> <<U.RAO>>01458000
   INVALIDPATCH    = 628,                                      <<00629>>01460000
<< OTHER SUBSYSTEM ERRORS (BASIC, SPL, RJE, ETC. >>            <<U.RAO>>01462000
   ERR2MPLISTONLY  = 640,                                      <<U.RAO>>01464000
   SUBSNOTFOUND    = 641,                                      <<U.RAO>>01466000
   SUBS2MP         = 642,                                      <<U.RAO>>01468000
   COMPFAILEDNOPRP = 643,                                      <<U.RAO>>01470000
   PREPFAILEDNORUN = 644,                                      <<U.RAO>>01472000
   BASICCREATEERR  = 648,  <<UNABLE TO CREATE BASIC INTERP.>>  <<U.RAO>>01474000
   BASICLOADERR    = 649,  <<UNABLE TO LOAD BASIC INTERPRETER>><<U.RAO>>01476000
   SUBSYSCREATEERR = 650,  <<UNABLE TO CREATE SUBSYSTEM>>      <<U.RAO>>01478000
   SUBSYSLOADERR   = 651,  <<UNABLE TO LOAD SUBSYSTEM>>        <<U.RAO>>01480000
   COMPILEDCREATE  = 654,  <<UNABLE TO CREATE USER PROG>>      <<U.RAO>>01482000
   COMPILEDLOAD    = 655,   <<UNABLE TO LOAD USER PROG>>       <<U.RAO>>01484000
   FEQTABFULL      = 656,  <<FILE EQUATE TABLE FULL>>          <<U.RAO>>01486000
   TOOMANYFEQBREF  = 657,  <<TOO MANY BACK REF'S>>             <<U.RAO>>01488000
   APLXPCTJUSTWS   = 659,  <<TOO MANY PARMS TO APL COMMAND>>   <<02.RO>>01490000
   SUBSNOTCREATE   = 660,  <<CREATEPROCESS FAILED ON SUBSYS.>> <<01452>>01492000
   INFOOVERIDE     = 661,  <<MULTIPLE INFO PARMS >>            <<02844>>01494000
   UNKNWNKWRD      = 662,  << UNKNOWN KEYWORD >>               <<02844>>01496000
<< ADDITIONAL ERRORS FOR :RUN COMMAND >>                       <<01200>>01498000
   INVALIDSTDIN    = 680,  <<INCORRECT STDIN SPECIFICATION>>   <<01200>>01500000
   INVALIDSTDLIST  = 681,  <<INCORRECT STDLIST SPECIFICATION>> <<01200>>01502000
   EXPCTQUOTE      = 682,  <<EXPECTED ' OR " TO START STRING>> <<01200>>01504000
   EXPCTCLOSEQUOTE = 683,  <<EXPECTED ' OR " TO END STRING>>   <<01200>>01506000
                           << TO TRAP INTERNAL PROBLEMS.>>     <<01452>>01508000
   XPCTSEMIORCR    = 687,  <<EXPECTED ; OR CR>>                <<01709>>01510000
   STRINGTOOBIG    = 688,  <<INFO STRING > 255 CHARS>>         <<01709>>01512000
   INVALIDSYSDEFFL = 689, <<INVALID SYSTEM DEFINED FILE >>     <<02324>>01514000
   IMPIABA         = 690,                                      <<02369>>01516000
   BOTHFPMAPNOFPMAP= 691, <<BOTH FPMAP/NOFPMAP SPECIFIED>>     <<04103>>01518000
<<ORGANIZATIONAL MANAGEMENT COMMAND ERROR MESSAGES>>           <<U.RAO>>01520000
   ERRABTERM       = 976, <<ABNORMAL PROGRAM TERMINATION>>     <<U.RAO>>01522000
   REQFORMALFDESIG = 984,                                      <<U.RAO>>01524000
   PGMABORT        = 989,  <<PROGRAM ABORTED BY USER>>         <<U.RAO>>01526000
<< 1000'S RESERVED FOR STORE/RESTORE >>                        <<U.RAO>>01528000
<< 1100'S RESERVED FOR PRIVATE VOLUMES MESSAGES >>             <<U.RAO>>01530000
   <<1126-1135 RESERVED FOR IMPLICITMNT ERRORS>>               <<03.KM>>01532000
   IM'MNTERR       = 1126,   <<MOUNT ERROR RECORDED IN DST>>   <<03.KM>>01534000
<< 1200'S RESERVED FOR USER LOGGING >>                         <<U.RAO>>01536000
<< 1300'S RESERVED FOR DS >>                                   <<U.RAO>>01538000
<< 1400'S RESERVED FOR STARTDEVICE (HELLO, JOB, DATA)>>        <<U.RAO>>01540000
<< 1500 - 1529 RESERVED FOR SHOWJOB >>                         <<U.RAO>>01542000
<< 1530 - 1579 RESERVED FOR SHOWIN AND SHOWOUT >>              <<U.RAO>>01544000
<< 1580 - 1589 RESERVED FOR SHOWDEV >>                         <<U.RAO>>01546000
<< 1590 - 1609 RESERVED FOR STREAM >>                          <<U.RAO>>01548000
<< TELL COMMAND >>                                             <<U.RAO>>01550000
<< SHOWQ COMMAND >>                                            <<U.RAO>>01552000
   WARNXPARMSIGNORED=1670, <<COMMAND HAS NO PARMS, PARMS IGNORE<<U.RAO>>01554000
<< SETMSG COMMAND >>                                           <<U.RAO>>01556000
   SETMSGPARMPROB  = 1675, <<MISSING OR UNKNOWN PARM>>         <<U.RAO>>01558000
   SETMSGEXTRAPARM = 1676, <<TOO MANY PARMS TO SETMSG>>        <<U.RAO>>01560000
<< SETDUMP COMMAND >>                                          <<U.RAO>>01562000
   SETDUMPUNKNOWN  = 1680, <<UNKNOWN OPTION TO SETDUMP>>       <<U.RAO>>01564000
   SETDUMP2MP      = 1681, <<MORE THAN 4 PARMS TO SETDUMP>>    <<U.RAO>>01566000
<< CLINE COMMAND >>                                            <<U.RAO>>01568000
   ERRLNOTFOUND    = 1764, <<CLINE EQUATION NOT FOUND>>        <<U.RAO>>01570000
<< 1900 - 1999 RESERVED FOR USER DEFINED COMMANDS (UDC) >>     <<09.EB>>01572000
<< 3000-4000 ARE RESERVED FOR OPERATOR COMMANDS>>              <<00552>>01574000
                                                               <<00552>>01576000
<< IML/3000 ERROR MESSAGES >>                                  <<02845>>01578000
   TOOMANYPARMS    = 3820, << TOO MANY PARMS FOR IML CMND >>   <<02845>>01580000
   EXPECTSEMIC     = 3821, << EXPECT SEMICOLON DELIM >>        <<02845>>01582000
   UNKNOWNKEY      = 3822, << INVALID KEYWORD >>               <<02845>>01584000
   REDNDENH        = 3823, << ENHANCE REDUNDANTLY SPECD. >>    <<02845>>01586000
   EXPCTEQUAL      = 3824, << EXPECTED EQUAL AS DELMITER >>    <<02845>>01588000
   ILLVALENH       = 3825, << ILLEGAL VALUE FOR ENHANCE >>     <<02845>>01590000
   REDNDFMT        = 3826, << FORMAT REDUNDANTLY SPECD. >>     <<02845>>01592000
   ILLVALFMT       = 3827, << ILLEGAL VALUE FOR FORMAT >>      <<02845>>01594000
   REDNDPRI        = 3828, << PRI. REDUNDANTLY SPECD. >>       <<02845>>01596000
   ILLVALPRI       = 3829, << ILLEGAL VALUE FOR PRI. >>        <<02845>>01598000
<< SET COMMAND ERROR MESSAGES >>                               <<04786>>01600000
   NONALPHA        = 4400, << EXPECTS ALPHANUMERIC PARM >>     <<04786>>01602000
   INVALID'PARM    = 4401, << INVALID PARAMETER         >>     <<04786>>01604000
   NO'EQUALS       = 4402, << EXPECTED AN EQUAL SIGN    >>     <<04786>>01606000
   BAD'OPTION      = 4403, << UNKNOWN OPTION GIVEN      >>     <<04786>>01608000
   ALREADY         = 4404, << OPTION ALREADY IN EFFECT  >>     <<04786>>01610000
   NOT'SPOOLED     = 4405, << $STDLIST NOT SPOOLED      >>     <<04786>>01612000
   UNEXP'DELIM     = 4406, << EXTRANEOUS CHARACTERS     >>     <<04786>>01614000
                                                               <<04786>>01616000
                                                               <<03.EB>>01618000
      <<FILE SYSTEM DEFINITIONS >>                                      01620000
                                                                        01622000
      FLSECURE=22,                                                      01624000
      FLSECMATRIX=10,                                                   01626000
                                                                        01628000
      <<DST ENTRIES USED THROUGHOUT>>                                   01630000
                                                                        01632000
      JMATDST=25,                                                       01634000
                                                               <<00851>>01636000
      <<Definitions for finding the PLABEL for SHOWCOM>>                01638000
                                                                        01640000
      << FCONTROL DEFINITIONS >>                               <<00851>>01642000
                                                               <<00851>>01644000
      TIMEOUT      = 4,                                        <<00851>>01646000
      DISABLEBREAK = 14,                                       <<00851>>01648000
      ENABLEBREAK  = 15,                                       <<00851>>01650000
                                                                        01652000
     <<TABLE LENGTHS USED THROUGHOUT>>                                  01654000
                                                                        01656000
     JMATLEN=26,                                                        01658000
                                                                        01660000
      <<SIRS USED THROUGHOUT>>                                          01662000
                                                                        01664000
     FILESIR=37,                                                        01666000
                                                                        01668000
      <<WORDS/FLAGS>>                                                   01670000
                                                                        01672000
      COLDLOADID=%1075,                                                 01674000
      PXGWFLAGS = 6,                                                    01676000
      PXGWJDT = 5,                                                      01678000
      PXGWJIT = 6,                                                      01680000
      PCBSIZE = 16;                                            << I.A >>01682000
                                                                        01684000
      <<DEFINES USED THROUGHOUT>>                                       01686000
                                                                        01688000
      <<CODE DEFINITIONS>>                                              01690000
                                                                        01692000
      DEFINE                                                            01694000
      CC = STATUS . (6:2)#,                                             01696000
      LBPARMDECS=ARRAY LPARM (*) = PARMS;                               01698000
                 BYTE ARRAY BPARM (*) = PARMS #,                        01700000
      NEXTLINE=ASSEMBLE (ZERO,DZRO);                           <<01881>>01702000
               PRINT (*, *, *)#,                               <<01881>>01704000
                                                               <<01709>>01706000
      SETXPXGLOB=PUSH (DL);                                             01708000
                 X := TOS -PS0 (-1)#,                                   01710000
      SETJIT=PUSH(DL);                                                  01712000
             TOS:=ARRDB6(TOS-PS0(-1)).(6:10)#,                          01714000
<<        DEF'MOVEFROMDSEG          >>                         <<U.RAO>>01716000
<< To use, declare SUBROUTINE DEF'MOVEFROMDSEG >>              <<U.RAO>>01718000
   DEF'MOVEFROMDSEG =                                          <<U.RAO>>01720000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                  <<U.RAO>>01722000
         VALUE TARGET,DSTN,OFFSET,COUNT;                       <<U.RAO>>01724000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                     <<U.RAO>>01726000
      BEGIN                                                    <<U.RAO>>01728000
         X := TOS; << SAVE RETURN ADDRESS >>                   <<U.RAO>>01730000
         ASSEMBLE(MFDS 0);                                     <<U.RAO>>01732000
         TOS := X; << RESTORE RETURN ADDRESS >>                <<U.RAO>>01734000
      END #,                                                   <<U.RAO>>01736000
                                                               <<U.RAO>>01738000
<<        DEF'MOVETODSEG            >>                         <<U.RAO>>01740000
<< To use, declare SUBROUTINE DEF'MOVETODSEG >>                <<U.RAO>>01742000
   DEF'MOVETODSEG =                                            <<U.RAO>>01744000
      MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                    <<U.RAO>>01746000
         VALUE DSTN,OFFSET,SOURCE,COUNT;                       <<U.RAO>>01748000
         LOGICAL DSTN,OFFSET,SOURCE,COUNT;                     <<U.RAO>>01750000
      BEGIN                                                    <<U.RAO>>01752000
         X := TOS;                                             <<U.RAO>>01754000
         ASSEMBLE(MTDS 0);                                     <<U.RAO>>01756000
         TOS := X;                                             <<U.RAO>>01758000
      END #,                                                   <<U.RAO>>01760000
                                                               <<U.RAO>>01762000
                                                                        01764000
      << FIELDS/FLAGS>>                                                 01766000
                                                                        01768000
      PXGFINTER = 5:1 #,                                                01770000
                                                                        01772000
<<TEST FOR INTERACTIVE USER.  LEAVES TRUE ON TOS IF>>          <<02.RO>>01774000
<<USER WAS INTERACTIVE.  GETS IT FROM PXGLOB>>                 <<02.RO>>01776000
                                                               <<02.RO>>01778000
INTERACTIVETEST =   SETXPXGLOB+PXGWFLAGS;                      <<02.RO>>01780000
                    TOS := ARRDB0(X).(PXGFINTER)#,             <<02.RO>>01782000
                                                               <<02.RO>>01784000
<<DELIMITER ARRAY DECLARATIONS>>                               <<U.RAO>>01786000
                                                               <<U.RAO>>01788000
SEMICR  = [8/";",8/%15]#,                                      <<U.RAO>>01790000
COMMASEMICR = [8/",",8/";",8/%15,8/0]D#,                       <<U.RAO>>01792000
                                                               <<U.RAO>>01794000
      <<EXECUTOR PROCEDURE HEADING>>                                    01796000
                                                                        01798000
      EXECUTORHEAD =                                                    01800000
      (PARMSP,ERRNUM,PARMNUM);                                          01802000
      BYTE ARRAY PARMSP;                                                01804000
      INTEGER ERRNUM,PARMNUM #,                                         01806000
                                                                        01808000
      SMCAP = LOGICAL(ARRDB2(X).(0:1))#,                       <<U.RAO>>01810000
      AMCAP = LOGICAL(ARRDB2(X).(1:1))#;                       << I.A >>01812000
                                                                        01814000
                                                              <<00.GEN>>01816000
                                                              <<00.GEN>>01818000
<<  P R O D U C E P A R M S   D E F I N I T I O N S  >>       <<00.GEN>>01820000
                                                              <<00.GEN>>01822000
DEFINE D'INX=      DPPRESULT #,        <<"PPRESULT" FMT>>     <<00.GEN>>01824000
       D'INX1=     PPRESULT #,                                <<00.GEN>>01826000
       D'INX2=     PPRESULT(1) #,                             <<04.GEN>>01828000
       D'TYPE=     PPRESULT(2) #,                             <<00.GEN>>01830000
       D'FNAME=    PPRESULT(3) #,                             <<00.GEN>>01832000
       D'GNAME=    PPRESULT(7) #,                             <<00.GEN>>01834000
       D'ANAME=    PPRESULT(11) #,                            <<00.GEN>>01836000
       D'LOCKWORD= PPRESULT(15) #,                            <<00.GEN>>01838000
       G'FNAME=    PPRESULT(19) #,                            <<00.GEN>>01840000
       G'GNAME=    PPRESULT(23) #,                            <<00.GEN>>01842000
       G'ANAME=    PPRESULT(27) #;                             << I.A >>01844000
                                                               <<01.PV>>01846000
                                                               <<01.PV>>01848000
<<  D I R E C T O R Y   E N T R Y   D E F I N I T I O N S  >>  <<01.PV>>01850000
EQUATE                                                         <<01.PV>>01852000
   NAMESIZE        = 4,                  <<UNPACKED REP>>      <<01.PV>>01854000
                   <<ENTRY EQUATES>>                           <<01.PV>>01856000
                                                               <<01.PV>>01858000
                                                               <<01.PV>>01860000
<< ACCOUNT ENTRY >>                                            <<01.PV>>01862000
   ANAME           = 0,                  <<NAME>>              <<01.PV>>01864000
   AGIPNTR         = ANAME+NAMESIZE,     <<GROUP INDEX PNTR>>  <<01.PV>>01866000
   AUIPNTR         = AGIPNTR+1,          <<USER INDEX PNTR>>   <<01.PV>>01868000
   ACAP            = AUIPNTR+1,          <<CAPABILITY>>        <<01.PV>>01870000
   ALATTR          = ACAP+2,                                   <<01.PV>>01872000
   APASS           = ALATTR+2,                                 <<01.PV>>01874000
   ADFSCOUNT       = APASS+NAMESIZE,     <<DISC FILE SPACE>>   <<01.PV>>01876000
   ADFSLIMIT       = ADFSCOUNT+2,                              <<01.PV>>01878000
   ACPUCOUNT       = ADFSLIMIT+2,        <<CPU TIME>>          <<01.PV>>01880000
   ACPULIMIT       = ACPUCOUNT+2,                              <<01.PV>>01882000
   ACONTIMECOUNT   = ACPULIMIT+2,        <<CONNECT TIME>>      <<01.PV>>01884000
   ACONTIMELIMIT   = ACONTIMECOUNT+2,                          <<01.PV>>01886000
   ASECW           = ACONTIMELIMIT+2,                          <<01.PV>>01888000
   AMAXJOBW        = ASECW+1,            <<MAX. JOB PRIORITY>> <<01.PV>>01890000
   ASPARE1         = AMAXJOBW+1,                               <<RV.PV>>01892000
   ASPARE2         = ASPARE1 +1,                               <<RV.PV>>01894000
   ASIZE           = ASPARE2 +1,                               <<RV.PV>>01896000
                                                               <<01.PV>>01898000
<<GROUP ENTRY>>                                                <<01.PV>>01900000
   GNAME           = 0,                  <<NAME>>              <<01.PV>>01902000
   GFIPNTR         = GNAME+NAMESIZE,     <<FILE INDEX>>        <<01.PV>>01904000
   GPASS           = GFIPNTR+1,          <<PASSWORD>>          <<01.PV>>01906000
   GDFSCOUNT       = GPASS+NAMESIZE,     <<DISC FILE SPACE>>   <<01.PV>>01908000
   GDFSLIMIT       = GDFSCOUNT+2,                              <<01.PV>>01910000
   GCPUCOUNT       = GDFSLIMIT+2,        <<CPU TIME>>          <<01.PV>>01912000
   GCPULIMIT       = GCPUCOUNT+2,                              <<01.PV>>01914000
   GCONTIMECOUNT   = GCPULIMIT+2,                              <<01.PV>>01916000
   GCONTIMELIMIT   = GCONTIMECOUNT+2,                          <<01.PV>>01918000
   GSEC            = GCONTIMELIMIT+2,                          <<01.PV>>01920000
   GCAP            = GSEC +2,                                  <<01.PV>>01922000
   GLINKAGE        = GCAP+1,                                   <<01.PV>>01924000
   GVSDIPNTR       = GLINKAGE+1,         <<VS DEF INDEX PNTR>> <<01.PV>>01926000
   GHVSNAME        = GVSDIPNTR+1,        <<HOME VS NAME>>      <<01.PV>>01928000
   GHVSANAME       = GHVSNAME,           << "   "  ACCT NAME>> <<01.PV>>01930000
   GHVSGNAME       = GHVSANAME+NAMESIZE, << "   "  GRP  NAME>> <<01.PV>>01932000
   GHVSVSNAME      = GHVSGNAME+NAMESIZE, << "   "  VS   NAME>> <<01.PV>>01934000
   GSAVEFIPNTR     = GHVSVSNAME+NAMESIZE,                      <<13.PV>>01936000
   GMOUNTREFCNTR   = GSAVEFIPNTR+1,                            <<13.PV>>01938000
   GSPARE          = GMOUNTREFCNTR+1,                          <<13.PV>>01940000
   GSIZE           = GSPARE +1;                                <<01.PV>>01942000
<<GLINKAGE DEFINITIONS>>                                       <<01.PV>>01944000
DEFINE                                                         <<01.PV>>01946000
   PVF             = 0:1 #,                                    <<01.PV>>01948000
   MVTABXF         = 8:8 #;                                    <<01.PV>>01950000
DEFINE                                                         <<10.KM>>01952000
   PVMVTABXF= 4:4 #;                   <<PVINFO FIELD>>        <<10.KM>>01954000
EQUATE                                                         <<01.PV>>01956000
<<ENTRY TYPES>>                                                <<01.PV>>01958000
   GROUPLEVEL      = 1,                                        <<01.PV>>01960000
   ACCOUNTLEVEL    = 2,                                        <<01.PV>>01962000
   USERLEVEL       = 3,                                        <<01.PV>>01964000
   VSDEFLEVEL      = 4;                                        <<RV.PV>>01966000
                                                               <<01.PV>>01968000
<<DIRECTORY SEARCH TYPE WORD DEFINITIONS>>                     <<01.PV>>01970000
DEFINE                                                         <<01.PV>>01972000
   STARTLEVELF     = 13:3 #,                                   <<01.PV>>01974000
   ALLFLAG         =  9:1 #,                                   <<01.PV>>01976000
   ENDLEVELFX      =  9:4 #,                                   <<01.PV>>01978000
   TOLEVELF        =  6:3 #,                                   <<01.PV>>01980000
   HITFLAG         =  5:1 #;                                   <<01.PV>>01982000
EQUATE                                                         <<01.PV>>01984000
   ALLXXX          = %(2)1000,                                 <<04.PV>>01986000
   ALLACCTS        = ALLXXX + ACCOUNTLEVEL,                    <<04.PV>>01988000
   ALLGROUPS       = ALLXXX + GROUPLEVEL,                      <<04.PV>>01990000
   ALLUSERS        = ALLXXX + USERLEVEL,                       <<04.PV>>01992000
   PPR'LEN         = 31 +    << "ppresult" size >>             <<04178>>01994000
                     ASIZE+1+<< account entry size >>          <<04178>>01996000
                     GSIZE+1,<< group entry size   >>          <<04178>>01998000
   SYSL'PARMLEN    = 35 + PPR'LEN,<< "syslist" parm >>         <<04178>>02000000
   SYSL'PPRINX     = SYSL'PARMLEN - PPR'LEN,                   <<04178>>02002000
   SAVEBUFFINDEX = SYSL'PPRINX + 31;                           <<04178>>02004000
                                                               <<03.KM>>02006000
<<DIRECTORY SEARCH STATES (RETURNED BY RECIP)>>                <<03.KM>>02008000
EQUATE GOTSIR=          1,                                     <<03.KM>>02010000
       NEXTSON=         0,                                     <<03.KM>>02012000
       NEXTBROTHER=     2,                                     <<03.KM>>02014000
       NEXTUNCLE=       NEXTBROTHER,   <<NOT IMPLEMENTED>>     <<03.KM>>02016000
       REVISIT=         %100000,                               <<03.KM>>02018000
       ABORTSCAN=       4,                                     <<03.KM>>02020000
       NEXTSON'SIR=     NEXTSON+GOTSIR,                        <<03.KM>>02022000
       NEXTBROTHER'SIR= NEXTBROTHER+GOTSIR,                    <<03.KM>>02024000
       NEXTUNCLE'SIR=   NEXTUNCLE+GOTSIR,                      <<03.KM>>02026000
       ABORTSCAN'SIR=   ABORTSCAN+GOTSIR;                      << I.A >>02028000
$PAGE   "EXTERNAL DECLARATIONS"                                         02030000
                                                               << I.A >>02032000
<< EXTERNAL/FORWARD MPE INTRINSICS >>                          << I.A >>02034000
                                                               << I.A >>02036000
   PROCEDURE DATE'LINE(STRING);                                <<0U.EB>>02038000
      BYTE ARRAY STRING; OPTION EXTERNAL;                      <<0U.EB>>02040000
                                                               <<0U.EB>>02042000
                                                               <<00.EB>>02044000
INTRINSIC SETJCW,GETJCW,FCONTROL;                              <<00851>>02046000
   LOGICAL PROCEDURE BINARY (STRING, LENGTH);                           02048000
   VALUE LENGTH;                                                        02050000
   BYTE ARRAY STRING;                                                   02052000
   INTEGER LENGTH;                                                      02054000
   OPTION EXTERNAL;                                                     02056000
                                                                        02058000
   INTEGER PROCEDURE EXCHANGEDB(DSTNO);                                 02060000
   VALUE DSTNO;                                                         02062000
   INTEGER DSTNO;                                                       02064000
   OPTION EXTERNAL;                                                     02066000
                                                                        02068000
   DOUBLE PROCEDURE DBINARY(STRING,LENGTH);                             02070000
   VALUE LENGTH;                                                        02072000
   BYTE ARRAY STRING;  INTEGER LENGTH;                                  02074000
   OPTION EXTERNAL;                                                     02076000
                                                                        02078000
   INTEGER PROCEDURE ASCII (WORD, BASE, STRING);                        02080000
   VALUE WORD, BASE;                                                    02082000
   LOGICAL WORD;                                                        02084000
   INTEGER BASE;                                                        02086000
   BYTE ARRAY STRING;                                                   02088000
   OPTION EXTERNAL;                                                     02090000
                                                                        02092000
   INTEGER PROCEDURE DASCII(WORD,BASE,STRING);                          02094000
   VALUE WORD,BASE;                                                     02096000
   DOUBLE WORD;                                                         02098000
   INTEGER BASE;                                                        02100000
   BYTE ARRAY STRING;                                                   02102000
   OPTION EXTERNAL;                                                     02104000
                                                                        02106000
   PROCEDURE PRINT (STRING, LENGTH, TYPE);                              02108000
   VALUE LENGTH, TYPE;                                                  02110000
   ARRAY STRING;                                                        02112000
   INTEGER LENGTH;                                                      02114000
   LOGICAL TYPE;                                                        02116000
   OPTION EXTERNAL;                                                     02118000
                                                                        02120000
   INTEGER PROCEDURE SEARCH (TARGET, LENGTH, DICT, DEFN);               02122000
   VALUE LENGTH;                                                        02124000
   BYTE ARRAY TARGET, DICT;                                             02126000
   INTEGER LENGTH;                                                      02128000
   BYTE POINTER DEFN;                                                   02130000
   OPTION EXTERNAL, VARIABLE;                                           02132000
                                                               <<01.01>>02134000
   INTEGER PROCEDURE MYCOMMAND                                          02136000
   (COMIMAGE,DELIMS,MAXPARMS,NUMPARMS,PARMS,DICT,DEFN);                 02138000
   VALUE MAXPARMS;                                                      02140000
   BYTE ARRAY COMIMAGE,DELIMS,DICT;                                     02142000
   INTEGER MAXPARMS, NUMPARMS;                                          02144000
   DOUBLE ARRAY PARMS;                                                  02146000
   BYTE POINTER DEFN;                                                   02148000
   OPTION VARIABLE,EXTERNAL;                                            02150000
                                                                        02152000
   PROCEDURE WHO(MODE,CAP,LATTR,USERN,GROUPN,ACCTN,HOMEN,TERMNUM);      02154000
   LOGICAL MODE;                                                        02156000
   DOUBLE CAP,LATTR;                                                    02158000
   BYTE ARRAY USERN,GROUPN,ACCTN,HOMEN;                                 02160000
   LOGICAL TERMNUM;                                                     02162000
   OPTION VARIABLE,EXTERNAL;                                            02164000
                                                                        02166000
   LOGICAL PROCEDURE PARSE'DENSITY(PARM,PARMLEN,DEN'VALUE);    <<02569>>02168000
   VALUE PARMLEN;                                              <<02569>>02170000
   INTEGER DEN'VALUE,PARMLEN;                                  <<02569>>02172000
   BYTE ARRAY PARM;                                            <<02569>>02174000
   OPTION EXTERNAL;                                            <<02569>>02176000
                                                               <<02569>>02178000
   INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS, AOPTIONS, RECSIZE, 02180000
   DEVICE, FORMMSG, RECMODE, BLOCKFACTOR, NUMBUFFERS, FILESIZE,         02182000
   NUMEXTENTS, INITALLOC, FILECODE);                                    02184000
   VALUE FOPTIONS, AOPTIONS, RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, 02186000
   FILESIZE, NUMEXTENTS, INITALLOC, FILECODE;                           02188000
   BYTE ARRAY FILEDESIGNATOR,  DEVICE, FORMMSG;                         02190000
   LOGICAL FOPTIONS, AOPTIONS;                                          02192000
   INTEGER RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, NUMEXTENTS,       02194000
   INITALLOC, FILECODE;                                                 02196000
   DOUBLE FILESIZE;                                                     02198000
   OPTION VARIABLE, EXTERNAL;                                           02200000
                                                               <<00098>>02202000
   INTEGER PROCEDURE DFOPEN                                    <<00200>>02204000
     (FNAME,FOPS,AOPS,RECSIZE,DEV,FORMMSG,NUMLABS,BLKFACT,     <<00200>>02206000
      NUMBUFS,FSIZE,NUMEXTS,INITEXTS,FCODE);                   <<00200>>02208000
     VALUE FOPS,AOPS,RECSIZE,NUMLABS,BLKFACT,NUMBUFS,FSIZE,    <<00200>>02210000
           NUMEXTS,INITEXTS,FCODE;                             <<00200>>02212000
     BYTE ARRAY FNAME,DEV,FORMMSG;                             <<00200>>02214000
     LOGICAL FOPS,AOPS;                                        <<00200>>02216000
     INTEGER RECSIZE,NUMLABS,BLKFACT,NUMBUFS,NUMEXTS,INITEXTS, <<00200>>02218000
             FCODE;                                            <<00200>>02220000
     DOUBLE FSIZE; OPTION VARIABLE,EXTERNAL;                   <<00200>>02222000
                                                                        02224000
   PROCEDURE FCLOSE (FILENUM, DISPOSITION, SECCODE);                    02226000
   VALUE FILENUM, DISPOSITION, SECCODE;                                 02228000
   INTEGER FILENUM, DISPOSITION, SECCODE;                               02230000
   OPTION EXTERNAL;                                                     02232000
                                                                        02234000
   INTEGER PROCEDURE FREAD (FNUM, BUF, COUNT);                          02236000
      VALUE FNUM, COUNT;                                                02238000
      INTEGER FNUM, COUNT;                                              02240000
      ARRAY BUF;                                                        02242000
      OPTION EXTERNAL;                                                  02244000
                                                                        02246000
   PROCEDURE FWRITE(FNUM,TARGET,COUNT,CONT);                            02248000
   VALUE FNUM,COUNT,CONT;                                               02250000
   INTEGER FNUM,COUNT,CONT;                                             02252000
   ARRAY TARGET;                                                        02254000
   OPTION EXTERNAL;                                                     02256000
                                                                        02258000
   PROCEDURE FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);             02260000
   VALUE FILENUM;                                                       02262000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              02264000
   DOUBLE BLKNUM;                                                       02266000
   OPTION VARIABLE,EXTERNAL;                                            02268000
                                                                        02270000
   PROCEDURE FGETINFO                                                   02272000
   (FNUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,DEVTYPE,LDNUM,HDADDR,       02274000
    FILECODE,RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,BLKSIZE,EXTSIZE,       02276000
    NUMEXTENTS,USERLABELS,CREATORID,LABADDR);                           02278000
   VALUE FNUM;                                                          02280000
   INTEGER FNUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,USERLABELS; 02282000
   BYTE ARRAY FILENAME,CREATORID;                                       02284000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      02286000
   DOUBLE RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,LABADDR;                  02288000
   OPTION VARIABLE,EXTERNAL;                                            02290000
                                                                        02292000
INTEGER PROCEDURE FLABIO (LDEV,ADDR,FUNC,FLAB);                         02294000
    VALUE   LDEV,FUNC,ADDR;                                             02296000
    INTEGER LDEV,FUNC;                                                  02298000
    LOGICAL ARRAY FLAB;                                                 02300000
    DOUBLE ADDR;                                                        02302000
    OPTION EXTERNAL;                                                    02304000
                                                                        02306000
   PROCEDURE FRENAME(FILENUM,FNAME);                                    02308000
   VALUE FILENUM;                                                       02310000
   INTEGER FILENUM;                                                     02312000
   BYTE ARRAY FNAME;                                                    02314000
   OPTION EXTERNAL;                                                     02316000
                                                                        02318000
   PROCEDURE SEGMENTER                                                  02320000
   (PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6,           <<00629>>02322000
    STR1,STR2,FNAME1,FNAME2);                                  <<00629>>02324000
   VALUE COMMAND,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;                <<00629>>02326000
   INTEGER PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;    <<00629>>02328000
   BYTE ARRAY STR1,STR2,FNAME1,FNAME2;                                  02330000
   OPTION VARIABLE, EXTERNAL;                                           02332000
                                                                        02334000
   PROCEDURE CREATEPROCESS (ERROR,PIN,PROGNAME,OPTNUMS,OPTS);  <<01200>>02336000
   INTEGER ERROR,PIN;                                          <<01200>>02338000
   BYTE ARRAY PROGNAME;                                        <<01200>>02340000
   INTEGER ARRAY OPTNUMS;                                      <<01200>>02342000
   LOGICAL ARRAY OPTS;                                         <<01200>>02344000
   OPTION VARIABLE, EXTERNAL;                                  <<01200>>02346000
                                                               <<01200>>02348000
   PROCEDURE CREATE(PROGNAME,ENTRYNAME,PIN,PARM,FLAGS,                  02350000
   STACK,DL,MAXDATA,PRI,RANK);                                          02352000
   VALUE PARM,STACK,DL,PRI,FLAGS,MAXDATA,RANK;                          02354000
   LOGICAL PIN,PARM,FLAGS,PRI;                                          02356000
   INTEGER STACK,DL,MAXDATA,RANK;                                       02358000
   BYTE ARRAY PROGNAME, ENTRYNAME;                                      02360000
   OPTION EXTERNAL, VARIABLE;                                           02362000
                                                                        02364000
   PROCEDURE AWAKE(PCBPT,N,WTFLG);                                      02366000
   VALUE PCBPT,N,WTFLG;                                                 02368000
   INTEGER PCBPT,N,WTFLG;                                               02370000
   OPTION EXTERNAL;                                                     02372000
                                                               <<02318>>02374000
LOGICAL PROCEDURE SETCRITICAL;                                 <<02318>>02376000
OPTION EXTERNAL;                                               <<02318>>02378000
                                                                        02380000
   LOGICAL PROCEDURE CALENDAR;                                          02382000
   OPTION EXTERNAL;                                                     02384000
                                                                        02386000
   DOUBLE PROCEDURE CLOCK;                                              02388000
   OPTION EXTERNAL;                                                     02390000
                                                                        02392000
   LOGICAL PROCEDURE GETSIR (N);                                        02394000
   VALUE N;                                                             02396000
   LOGICAL N;                                                           02398000
   OPTION EXTERNAL;                                                     02400000
                                                                        02402000
   PROCEDURE RELSIR (N,T);                                              02404000
   VALUE N, T;                                                          02406000
   LOGICAL N, T;                                                        02408000
   OPTION EXTERNAL;                                                     02410000
                                                                        02412000
   DOUBLE PROCEDURE DIRECSCAN (TYPE,LINKAGE'INDEXP,ANAME,      <<38.PV>>02414000
                               GUNAME,FNAME,RECIP,LDN,MVTABX); <<38.PV>>02416000
   VALUE TYPE,LINKAGE'INDEXP,MVTABX;                           <<38.PV>>02418000
   INTEGER TYPE,MVTABX;                                        <<38.PV>>02420000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>02422000
   ARRAY ANAME,GUNAME,FNAME,LDN;                                        02424000
   INTEGER PROCEDURE RECIP;                                             02426000
   OPTION EXTERNAL,VARIABLE;                                   <<35.PV>>02428000
                                                                        02430000
   INTEGER PROCEDURE ADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO);                02432000
   VALUE SIZE,TNO;                                                      02434000
   INTEGER SIZE,TNO;                                                    02436000
   BYTE ARRAY N1,N2,N3;                                                 02438000
   INTEGER ARRAY INFO;                                                  02440000
   OPTION EXTERNAL;                                                     02442000
                                                                        02444000
   INTEGER PROCEDURE XADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO,XN1,XN2,XN3);   02446000
   VALUE SIZE,TNO;                                                      02448000
   INTEGER SIZE,TNO;                                                    02450000
   BYTE ARRAY N1,N2,N3,XN1,XN2,XN3;                                     02452000
   INTEGER ARRAY INFO;                                                  02454000
   OPTION EXTERNAL;                                                     02456000
                                                                        02458000
   INTEGER PROCEDURE XREMJTENTRY(N1,N2,N3,TNO);                         02460000
   VALUE TNO;                                                           02462000
   INTEGER TNO;                                                         02464000
   BYTE ARRAY N1,N2,N3;                                                 02466000
   OPTION EXTERNAL;                                                     02468000
                                                                        02470000
   LOGICAL PROCEDURE LOCKJIR;                                           02472000
   OPTION EXTERNAL;                                                     02474000
                                                                        02476000
   PROCEDURE UNLOCKJIR (A);                                             02478000
   VALUE A;                                                             02480000
   INTEGER A;                                                           02482000
   OPTION EXTERNAL;                                                     02484000
                                                                        02486000
   DOUBLE PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);02488000
   VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     02490000
   INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                   02492000
   OPTION EXTERNAL;                                                     02494000
                                                                        02496000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<0U.EB>>02498000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>02500000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<0U.EB>>02502000
      DST,IOTYPE;                                              <<0U.EB>>02504000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<0U.EB>>02506000
      DST,IOTYPE;                                              <<0U.EB>>02508000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>02510000
                                                               <<U.RAO>>02512000
   PROCEDURE ERRORON;                                                   02514000
   OPTION EXTERNAL;                                                     02516000
                                                                        02518000
   PROCEDURE ERROREXIT(INTRINEXIT,ERRBYTES,PARAM);                      02520000
   VALUE INTRINEXIT,ERRBYTES,PARAM;                                     02522000
   LOGICAL INTRINEXIT,ERRBYTES,PARAM;                                   02524000
   OPTION EXTERNAL;                                                     02526000
                                                                        02528000
INTEGER PROCEDURE FORMNAME(TYPE,TARGET,BA1,BA2,BA3,BA4);       <<02.EB>>02530000
   VALUE TYPE; INTEGER TYPE;                                   <<02.EB>>02532000
   BYTE ARRAY TARGET,BA1,BA2,BA3,BA4; OPTION EXTERNAL;         <<02.EB>>02534000
                                                               <<02.EB>>02536000
INTEGER PROCEDURE GETDEVINFO(DEVICE,DEVINFO);                  <<00579>>02538000
   BYTE ARRAY DEVICE;                                          <<00579>>02540000
   INTEGER ARRAY DEVINFO;                                      <<00579>>02542000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<00579>>02544000
                                                               <<00579>>02546000
INTEGER PROCEDURE GET'DSDEVICE( LDEV );                        <<02848>>02548000
   VALUE   LDEV;                                               <<02848>>02550000
   INTEGER LDEV;                                               <<02848>>02552000
   OPTION  PRIVILEGED, UNCALLABLE, EXTERNAL;                   <<02848>>02554000
                                                               <<02848>>02556000
PROCEDURE DISMOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,            <<00211>>02558000
                    MVTABX,SOME'OTHER'PIN);                    <<00211>>02560000
   VALUE MVTABX,SOME'OTHER'PIN;                                <<00211>>02562000
   INTEGER REQTYPE,MVTABX,SOME'OTHER'PIN;                      <<00211>>02564000
   BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                          <<RH.PV>>02566000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>02568000
                                                               <<RH.PV>>02570000
INTEGER PROCEDURE LUN (VTABINX,MVTABX);                        <<RV.PV>>02572000
    VALUE   VTABINX,MVTABX;                                    <<RV.PV>>02574000
    INTEGER VTABINX,MVTABX;                                    <<RV.PV>>02576000
    OPTION EXTERNAL;                                           <<RV.PV>>02578000
                                                               <<RV.PV>>02580000
PROCEDURE INITUDC( SHOW, COMFN );                              <<03737>>02582000
   VALUE    SHOW, COMFN;                                       <<03737>>02584000
   LOGICAL  SHOW;                                              <<03737>>02586000
   INTEGER  COMFN;                                             <<03737>>02588000
   OPTION   VARIABLE, EXTERNAL;                                <<03737>>02590000
PROCEDURE QUALIFYFILENAME(OLDFNAME,NEWFNAME);                  <<03.EB>>02592000
   BYTE ARRAY OLDFNAME,NEWFNAME; OPTION EXTERNAL;              <<03.EB>>02594000
                                                               <<03.EB>>02596000
PROCEDURE CRUNCH(N1,N2,N3,DEST,NWORDS);                        <<02554>>02598000
   INTEGER NWORDS;                                             <<02554>>02600000
   INTEGER ARRAY DEST;                                         <<02554>>02602000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>02604000
   OPTION EXTERNAL;                                            <<02554>>02606000
INTEGER PROCEDURE XRETJTENTRY(N1,N2,N3,SIZE,INFO);             <<02554>>02608000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>02610000
   INTEGER SIZE;                                               <<02554>>02612000
   INTEGER ARRAY INFO;                                         <<02554>>02614000
   OPTION EXTERNAL;                                            <<02554>>02616000
   INTEGER PROCEDURE CYIMPLCTFILE'(LHS,RHS,LENR);              <<U.RAO>>02618000
   VALUE LENR;                                                 <<U.RAO>>02620000
   INTEGER LENR;                                               <<U.RAO>>02622000
   BYTE ARRAY LHS, RHS;                                        <<U.RAO>>02624000
   OPTION PRIVILEGED, UNCALLABLE, FORWARD;                     <<U.RAO>>02626000
                                                               <<U.RAO>>02628000
   PROCEDURE DELIMPFILE(PARM,FNAME);                                    02630000
   VALUE PARM;                                                          02632000
   LOGICAL PARM;                                                        02634000
   BYTE ARRAY FNAME;                                                    02636000
   OPTION PRIVILEGED, UNCALLABLE, FORWARD;                              02638000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<U.RAO>>02640000
VALUE FNUM;                                                    <<U.RAO>>02642000
INTEGER FNUM,PARMNUM;                                          <<U.RAO>>02644000
OPTION PRIVILEGED, UNCALLABLE,EXTERNAL;                        << I.A >>02646000
                                                                        02648000
   PROCEDURE CIERR(ERRNUM,ERRADR,PARMMASK,PARM);               <<U.RAO>>02650000
   VALUE ERRNUM,PARMMASK,PARM;                                 <<U.RAO>>02652000
   INTEGER ERRNUM,PARMMASK,PARM;                               <<U.RAO>>02654000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>02656000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE,EXTERNAL;             << I.A >>02658000
                                                               <<U.RAO>>02660000
   INTEGER PROCEDURE SYSLIST (ELEMENT, LEVEL, PARMS, SIRS);             02662000
   VALUE LEVEL, PARMS, SIRS;                                            02664000
   ARRAY ELEMENT;                                                       02666000
   INTEGER LEVEL, PARMS;                                                02668000
   DOUBLE SIRS;                                                         02670000
   OPTION EXTERNAL, PRIVILEGED, UNCALLABLE;                    << I.A >>02672000
                                                                        02674000
PROCEDURE CYDIRERR'(DIRECRETURN,OKMASK,ERRNUM);                <<U.RAO>>02676000
VALUE DIRECRETURN,OKMASK;                                      <<U.RAO>>02678000
DOUBLE DIRECRETURN;                                            <<U.RAO>>02680000
INTEGER ERRNUM;                                                <<U.RAO>>02682000
LOGICAL OKMASK;                                                <<U.RAO>>02684000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         << I.A >>02686000
                                                                        02688000
   PROCEDURE GET'FILECODE(FILECODE,MNEMONIC,MNEMONIC'LENGTH);  <<01454>>02690000
   INTEGER FILECODE,MNEMONIC'LENGTH;                           <<01454>>02692000
   BYTE ARRAY MNEMONIC;                                        <<01454>>02694000
   OPTION UNCALLABLE,PRIVILEGED,FORWARD;                       <<01454>>02696000
                                                               <<01454>>02698000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>02700000
VALUE PDEF; DOUBLE PDEF;                                       <<U.RAO>>02702000
LOGICAL GPTR,APTR,ERRPTR;                                      <<U.RAO>>02704000
OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                       << I.A >>02706000
                                                               <<U.RAO>>02708000
<< CHK'DESCRIBE'FNAME is an entry point to CHECKFILENAME'. >>  <<04848>>02710000
INTEGER PROCEDURE CHK'DESCRIBE'FNAME( P, G, A, E );            <<04848>>02712000
VALUE P;  DOUBLE P;                                            <<04848>>02714000
LOGICAL G, A, E;                                               <<04848>>02716000
OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                       <<04848>>02718000
                                                               <<04848>>02720000
LOGICAL PROCEDURE CIBADFILENAME(ERRNUM,PARM);                  <<U.RAO>>02722000
VALUE PARM;                                                    <<U.RAO>>02724000
INTEGER ERRNUM;                                                <<U.RAO>>02726000
DOUBLE PARM;                                                   <<U.RAO>>02728000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         << I.A >>02730000
                                                               <<U.RAO>>02732000
INTEGER PROCEDURE CHECKHOMEACCT(PPRESULT);                     <<U.RAO>>02734000
INTEGER ARRAY PPRESULT;                                        <<U.RAO>>02736000
OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                       << I.A >>02738000
                                                                        02740000
PROCEDURE RESET'TERMINALMODE;                                  <<00851>>02742000
OPTION UNCALLABLE,FORWARD;                                     <<00851>>02744000
LOGICAL PROCEDURE CREATEERROR;                                 <<U.RAO>>02746000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         << I.A >>02748000
                                                               <<U.RAO>>02750000
   INTEGER PROCEDURE GETFLABEL(FILEREF,LEN,FLABEL,FLDN,                 02752000
   FADDR,FNUM,SIRINFO);                                        <<04.RO>>02754000
   VALUE LEN;                                                           02756000
   INTEGER LEN,FLDN;                                                    02758000
   INTEGER FNUM;                                               <<04.RO>>02760000
   ARRAY FLABEL;                                                        02762000
   BYTE ARRAY FILEREF;                                                  02764000
   DOUBLE FADDR,SIRINFO;                                                02766000
   OPTION FORWARD,VARIABLE,PRIVILEGED,UNCALLABLE;                       02768000
                                                                        02770000
   PROCEDURE RESETDUMP;                                                 02772000
   OPTION FORWARD,PRIVILEGED;                                           02774000
                                                                        02776000
   PROCEDURE SETDUMP(FLAGS);                                            02778000
   VALUE FLAGS;                                                         02780000
   LOGICAL FLAGS;                                                       02782000
   OPTION PRIVILEGED,FORWARD;                                           02784000
                                                                        02786000
   LOGICAL PROCEDURE REQUESTSERVICE;                                    02788000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      << I.A >>02790000
                                                                        02792000
   LOGICAL PROCEDURE CREATEPROC'ERR(ERROR,ERRNUM);             <<01452>>02794000
   VALUE ERROR; INTEGER ERROR,ERRNUM;                          <<01452>>02796000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      << I.A >>02798000
                                                               <<01452>>02800000
LOGICAL PROCEDURE CISUBSYSFINISH(MESSGTYPE,ERRNUM,PARMNUM);    <<01452>>02802000
   VALUE MESSGTYPE;                                            <<01452>>02804000
   INTEGER MESSGTYPE,ERRNUM,PARMNUM;                           <<01452>>02806000
   OPTION UNCALLABLE,PRIVILEGED,FORWARD;                       <<01452>>02808000
                                                                        02810000
LOGICAL PROCEDURE JOBSESSIONMAIN; OPTION EXTERNAL;             << I.A >>02812000
                                                               <<14.EB>>02814000
LOGICAL PROCEDURE IMPLICITMNT(GROUP,ACCT,MOUNTDST,PV'ERROR);   << I.A >>02816000
  ARRAY GROUP,ACCT;                                            << I.A >>02818000
  INTEGER MOUNTDST,PV'ERROR;                                   << I.A >>02820000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>02822000
         EXTERNAL;                                             << I.A >>02824000
                                                               << I.A >>02826000
$PAGE    "FILE AND BUILD COMMAND EXECUTORS"                             02828000
$CONTROL   SEGMENT  =  CIFILEB                                          02830000
                                                                        02832000
LOGICAL PROCEDURE CHECKEXPDATE(ERRNUM, FIELDLEN, DATASOURCE,   <<U.RAO>>02834000
    DATATARGET);                                               <<U.RAO>>02836000
VALUE FIELDLEN;                                                <<U.RAO>>02838000
INTEGER ERRNUM, FIELDLEN;                                      <<U.RAO>>02840000
BYTE ARRAY DATASOURCE, DATATARGET;                             <<U.RAO>>02842000
OPTION INTERNAL;                                               <<04.RO>>02844000
<<This procedure checks the expiration date field for labeled>><<U.RAO>>02846000
<<tapes.  The format for this field is MM/DD/YY.  They may all><<U.RAO>>02848000
<<be zero.  The procedure calls CIERR directly.  ERRNUM is the><<U.RAO>>02850000
<<usual CI error parameter.  FIELDLEN is the length of the >>  <<U.RAO>>02852000
<<expiration date field as determined in the FILE command by>> <<U.RAO>>02854000
<<MYCOMMAND.  It is used to check for extraneous data.  >>     <<U.RAO>>02856000
<<DATASOURCE and DATATARGET are just what they seem.    >>     <<U.RAO>>02858000
BEGIN                                                          <<U.RAO>>02860000
INTEGER MONTH;                                                 <<U.RAO>>02862000
INTEGER DAY;                                                   <<U.RAO>>02864000
INTEGER YEAR;                                                  <<U.RAO>>02866000
INTEGER NUMLEN;  <<LENGTH OF THE INDIVIDUAL DATA FIELD>>       <<U.RAO>>02868000
INTEGER MAXDAYS;  <<USED TO COPE WITH LEAP YEAR COMPLICATIONS>><<U.RAO>>02870000
BYTE POINTER SOURCEPTR;   <<CURRENT LOCATION IN SOURCE>>       <<U.RAO>>02872000
INTEGER ARRAY MONTHARR(0:1) = PB :=    <<DAYS OF EACH MONTH>>  <<U.RAO>>02874000
   0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31;          <<U.RAO>>02876000
SUBROUTINE GETTOKEN(TARGET);                                   <<U.RAO>>02878000
INTEGER TARGET;                                                <<U.RAO>>02880000
<<FINDS AND COMPUTES EACH PART OF THE DATE FIELD>>             <<U.RAO>>02882000
BEGIN                                                          <<U.RAO>>02884000
SCAN SOURCEPTR WHILE [8/%15,8/" "],1;                          <<U.RAO>>02886000
@SOURCEPTR := TOS;                                             <<U.RAO>>02888000
MOVE SOURCEPTR := SOURCEPTR WHILE N,1;                         <<U.RAO>>02890000
NUMLEN := TOS-@SOURCEPTR;                                      <<U.RAO>>02892000
TARGET := BINARY(SOURCEPTR, NUMLEN);  <<CONVERT TO BINARY>>    <<U.RAO>>02894000
END;                                                           <<U.RAO>>02896000
@SOURCEPTR := @DATASOURCE;                                     <<U.RAO>>02898000
MOVE DATATARGET := "00/00/0";  <<INITIALIZE RETURN SPACE>>     <<U.RAO>>02900000
GETTOKEN(MONTH);   <<COMPUTE MONTH VALUE>>                     <<U.RAO>>02902000
IF NOT(1<=NUMLEN<=2) OR NOT(0<=MONTH<=12) THEN   <<INVALID MONT<<U.RAO>>02904000
   CIERR(ERRNUM := FILEXPINVMONTH, SOURCEPTR)                  <<U.RAO>>02906000
ELSE                                                           <<U.RAO>>02908000
   BEGIN   <<MONTH CHECKED OUT OK, DO DAY>>                    <<U.RAO>>02910000
   ASCII(MONTH, -10, DATATARGET(1));  <<PUT IN RESULT FIELD>>  <<U.RAO>>02912000
   SCAN SOURCEPTR(NUMLEN) WHILE [8/%15,8/" "],1;               <<U.RAO>>02914000
   IF BPS0 <> "/" THEN                                         <<U.RAO>>02916000
      CIERR(ERRNUM := FILEXPNOSLASHMD, BPS0)                   <<U.RAO>>02918000
   ELSE   <<FOUND SLASH, LOOK FOR DAY>>                        <<U.RAO>>02920000
      BEGIN                                                    <<U.RAO>>02922000
      @SOURCEPTR := TOS+1;                                     <<U.RAO>>02924000
      GETTOKEN(DAY);                                           <<U.RAO>>02926000
      IF MONTH=0 AND DAY<>0 THEN  <<00/00/00 BAD>>             <<U.RAO>>02928000
         CIERR(ERRNUM := FILEXPDAYZERO, SOURCEPTR)             <<U.RAO>>02930000
      ELSE IF NOT(1<=NUMLEN<=2) THEN                           <<00617>>02932000
         CIERR(ERRNUM := FILEXPINVDAY,SOURCEPTR,%10000,MAXDAYS)<<U.RAO>>02934000
      ELSE   <<DAY CHECKED OUT>>                               <<U.RAO>>02936000
         BEGIN                                                 <<U.RAO>>02938000
         ASCII(DAY, -10, DATATARGET(4));                       <<U.RAO>>02940000
         SCAN SOURCEPTR(NUMLEN) WHILE [8/%15,8/" "],1;         <<U.RAO>>02942000
         IF BPS0 <> "/" THEN                                   <<U.RAO>>02944000
            CIERR(ERRNUM := FILEXPNOSLASHDY, BPS0)             <<U.RAO>>02946000
         ELSE                                                  <<U.RAO>>02948000
            BEGIN                                              <<U.RAO>>02950000
            @SOURCEPTR := TOS+1;                               <<U.RAO>>02952000
            GETTOKEN(YEAR);                                    <<U.RAO>>02954000
            MAXDAYS:=MONTHARR(MONTH) + <<LEAP YEAR CORRECTION>><<00617>>02956000
               (IF YEAR MOD 4 = 0 AND MONTH=2 THEN 1 ELSE 0);  <<00617>>02958000
            IF MONTH <> 0 AND NOT(1<=DAY<=MAXDAYS) THEN        <<00617>>02960000
               CIERR(ERRNUM:=FILEXPINVDAY,,%10000,MAXDAYS)     <<00617>>02962000
            ELSE                                               <<00617>>02964000
            IF MONTH=0 AND YEAR<>0 THEN  <<EXPECTED 00/00/00>> <<U.RAO>>02966000
               CIERR(ERRNUM := FILEXPNONZERO, SOURCEPTR)       <<U.RAO>>02968000
            ELSE                                               <<U.RAO>>02970000
               IF @SOURCEPTR(NUMLEN)-@DATASOURCE <> FIELDLEN THEN       02972000
                  CIERR(ERRNUM := FILEXPXTRNDATA, SOURCEPTR(NUMLEN))    02974000
            ELSE   <<ALL CHECKED OUT, DO IT>>                  <<U.RAO>>02976000
               BEGIN                                           <<U.RAO>>02978000
               ASCII(YEAR, -10, DATATARGET(7));                <<U.RAO>>02980000
               CHECKEXPDATE := TRUE;                           <<U.RAO>>02982000
               END;                                            <<U.RAO>>02984000
            END;                                               <<U.RAO>>02986000
         END;                                                  <<U.RAO>>02988000
      END;                                                     <<U.RAO>>02990000
   END;                                                        <<U.RAO>>02992000
END;   <<PROCEDURE CHECKEXPDATE>>                              <<U.RAO>>02994000
PROCEDURE CXFILE EXECUTORHEAD;                                 <<U.RAO>>02996000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>02998000
BEGIN                                                          <<U.RAO>>03000000
BYTE ARRAY PKEYLIST (0:1) = PB :=                              <<U.RAO>>03002000
   << FLAGS-BYTE (FOLLOWING WORD) = DISALLOW NEW/OLD/SYS($)/BUIL>>      03004000
   6,3, "DEV", 0,                                              <<U.RAO>>03006000
   7,4, "DISC", 6,                                             <<U.RAO>>03008000
   6,3, "REC", 0,                                              <<U.RAO>>03010000
   7,4, "CODE", 2,                                             <<U.RAO>>03012000
   7,4, "CCTL", 0,                                             <<U.RAO>>03014000
   9,6, "NOCCTL", 0,                                           <<U.RAO>>03016000
   7,4, "TEMP", 2,                                             <<U.RAO>>03018000
   7,4, "SAVE", 3,                                             <<U.RAO>>03020000
   6,3, "DEL", 3,                                              <<U.RAO>>03022000
   6,3, "ACC", 1,                                              <<U.RAO>>03024000
   6,3, "SHR", 1,                                              <<U.RAO>>03026000
   6,3, "EAR", 1,                                              <<U.RAO>>03028000
   7,4, "SEMI", 1,                                             <<01549>>03030000
   6,3, "EXC", 1,                                              <<U.RAO>>03032000
   6,3, "BUF", 1,                                              <<U.RAO>>03034000
   8,5, "NOBUF", 1,                                            <<U.RAO>>03036000
   7,4, "COPY", 1,                                             <<01549>>03038000
   9,6, "NOCOPY", 1,                                           <<01549>>03040000
   5,2, "MR", 1,                                               <<U.RAO>>03042000
   7,4, "NOMR", 1,                                             <<U.RAO>>03044000
   9,6, "GMULTI", 1,                                           <<01549>>03046000
   8,5, "MULTI", 1,                                            <<U.RAO>>03048000
   10,7, "NOMULTI", 1,                                         <<U.RAO>>03050000
   10,7, "NOLABEL", 3,                                         <<U.RAO>>03052000
   8,5, "FORMS", 1,                                            <<U.RAO>>03054000
   8,5, "LABEL", 3,                                            <<U.RAO>>03056000
   7,4, "LOCK", 1,                                             <<U.RAO>>03058000
   9,6, "NOLOCK", 1,                                           <<U.RAO>>03060000
   7,4, "WAIT", 1,                                             <<U.RAO>>03062000
   9,6, "NOWAIT", 1,                                           <<U.RAO>>03064000
   6,3, "STD", 3,                                              <<01724>>03066000
   6,3, "RIO",2,                                               <<00634>>03068000
   8,5, "NORIO",2,                                             <<00634>>03070000
   6,3,"ENV",1,                                                <<01549>>03072000
   7,4,"OUTQ", 1,                                              <<01549>>03074000
   6,3, "MSG", 2,                                              <<01549>>03076000
   6,3, "CIR", 2,                                              <<01549>>03078000
   6,3, "DEN", 3,                                              <<02569>>03080000
   0;                                                          <<U.RAO>>03082000
EQUATE PKEYLISTL = 272;                                        <<02569>>03084000
BYTE ARRAY KEYLIST (0:PKEYLISTL-1);                            <<U.RAO>>03086000
BYTE ARRAY PACCTYPES(0:1) = PB :=                              <<U.RAO>>03088000
   4,2, "IN",                                                  <<U.RAO>>03090000
   5,3, "OUT",                                                 <<U.RAO>>03092000
   9,7, "OUTKEEP",                                             <<U.RAO>>03094000
   8,6, "APPEND",                                              <<U.RAO>>03096000
   7,5, "INOUT",                                               <<U.RAO>>03098000
   8,6, "UPDATE",                                              <<U.RAO>>03100000
   0;                                                          <<U.RAO>>03102000
EQUATE ACCTYPEL = 42;                                          <<U.RAO>>03104000
BYTE ARRAY ACCTYPES(0:ACCTYPEL-1);                             <<U.RAO>>03106000
ENTRY CXBUILD, PARSE'FILE'EQ;                                  <<01200>>03108000
LABEL STARTPARSE;          << COMMOM CODE TO BOTH ENTRY PTS >> <<01200>>03110000
                                                               <<U.RAO>>03112000
<<VARIABLES FOR THE PARSE>>                                    <<U.RAO>>03114000
LOGICAL BUILDFLAG := FALSE;                                    <<U.RAO>>03116000
INTEGER NUMPARMS;                                              <<U.RAO>>03118000
EQUATE MAXPARMS = 32;                                          <<01549>>03120000
BYTE POINTER PARMPTR;  <<POINTER TO CURRENT PARAMETER>>        <<U.RAO>>03122000
INTEGER PARMLEN;  <<LENGTH OF CURRENT PARAMETER>>              <<U.RAO>>03124000
BYTE SAVEDELIM;                                                <<02053>>03126000
INTEGER NEXTDELIM;  <<DELIMITER FOLLOWING CURRENT PARAMETER>>  <<U.RAO>>03128000
DOUBLE DELIMS := [8/",",8/"=",8/";",8/%15]D;                   <<01117>>03130000
BYTE ARRAY BDELIMS (*) = DELIMS;                               <<01117>>03132000
DEFINE DELIMTYPE = (13:3)#;                                    <<U.RAO>>03134000
EQUATE COMMA = 0,  <<EQUATES FOR INDEX IN DELIMITER ARRAY>>    <<U.RAO>>03136000
       EQUALS = 1,                                             <<U.RAO>>03138000
       SEMICOLON = 2,                                          <<U.RAO>>03140000
       CR = 3;                                                 <<U.RAO>>03142000
INTEGER COMTYPE;  <<HOLDS TYPE OF COMMAND WHILE IN PROCKEY>>   <<U.RAO>>03144000
EQUATE BUILD = 0,  <<EQUATES FOR VALUES OF COMTYPE>>           <<U.RAO>>03146000
       SYSDEF = 1,                                             <<U.RAO>>03148000
       OLD = 2,                                                <<U.RAO>>03150000
       NEW = 3;                                                <<U.RAO>>03152000
LOGICAL GPNTR := 0,   <<HOLD BYTE POINTERS TO APPROPRIATE ENTRY<<U.RAO>>03154000
        APNTR := 0,                                            <<U.RAO>>03156000
        GPNTR2 := 0,                                           <<U.RAO>>03158000
        APNTR2 := 0,                                           <<U.RAO>>03160000
        APNTRENV := 0,   <<"ENV=FILENAME">>                    <<01549>>03162000
        GPNTRENV := 0,                                         <<01549>>03164000
        ERRPNTR := 0;                                          <<U.RAO>>03166000
BYTE POINTER GROUP = GPNTR,                                    <<U.RAO>>03168000
             ACCT = APNTR,                                     <<U.RAO>>03170000
             GROUP2 = GPNTR2,                                  <<U.RAO>>03172000
             ACCT2 = APNTR2,                                   <<U.RAO>>03174000
             GROUPENV = GPNTRENV,                              <<02554>>03176000
             ACCTENV  = APNTRENV,                              <<02554>>03178000
             ERRADR = ERRPNTR;                                 <<U.RAO>>03180000
                                                               <<U.RAO>>03182000
<<VARIABLES FOR THE EXECUTION PHASE>>                          <<U.RAO>>03184000
BYTE POINTER DICTPTR;  <<DICTIONARY POINTER FOR SEARCH INTRINSIC>>      03186000
ARRAY WENTRY(0:71);   <<HOLDS PROTOTYPE ENTRY FOR JDT>>        <<U.RAO>>03188000
BYTE ARRAY BENTRY(*)=WENTRY;                                   <<U.RAO>>03190000
INTEGER ARRAY                                                  <<02554>>03192000
   FILE'ENTRY(0:71),      << HOLDS FILE ENTRY FROM JDT >>      <<02554>>03194000
   DEST(0:14);            << HOLDS OUTPUT OF CRUNCH    >>      <<02554>>03196000
INTEGER                                                        <<02554>>03198000
   SIZE,                  << FOR CRUNCH CALL           >>      <<02554>>03200000
   INDEX;                 << GENERAL LOOP VARIABLE     >>      <<02554>>03202000
BYTE ARRAY                                                     <<02554>>03204000
   BFILE'ENTRY(*) = FILE'ENTRY;                                <<02554>>03206000
INTEGER NEXTENTRYX := 6;  <<USED IN SETTING UP WENTRY>>        <<U.RAO>>03208000
BYTE BLANK := " ";                                             <<U.RAO>>03210000
                                                               <<U.RAO>>03212000
<<DATA VARIABLES>>                                             <<U.RAO>>03214000
BYTE ARRAY FORMSMSG(0:73);                                     <<U.RAO>>03216000
BYTE ARRAY TAPELABEL(*)=FORMSMSG(49);                          <<U.RAO>>03218000
BYTE ARRAY SAVEDCOMIMAGE(0:CIS'BCOMBUFLEN - 1);                << I.A >>03220000
INTEGER FORMSMSGLEN := 0;                                      <<U.RAO>>03222000
INTEGER TAPELABELLEN := 0;                                     <<U.RAO>>03224000
EQUATE                                                         <<04171>>03226000
   MAXDEVLEN      = 44, << when this changes, change the one in<<04171>>03228000
                        << FOPEN  segment FILESYS6A.           <<04171>>03230000
   MAXDEVCLASSLEN = 8;  << maximum device class name >>        <<04171>>03232000
INTEGER DEVLEN := 0;                                           <<U.RAO>>03234000
DOUBLE DISC := "DISC";                                         <<U.RAO>>03236000
BYTE POINTER DEV := @DISC;                                     <<U.RAO>>03238000
INTEGER ARRAY DEVINFO(0:8);                                    <<04171>>03240000
BYTE POINTER BPTR;                                             <<01117>>03242000
DEFINE                                                         <<04171>>03244000
   FLUSH'COMMAND =                                             <<04171>>03246000
      BEGIN                                                    <<04171>>03248000
         PARSE'ERR(ERRNUM,BPTR);                               <<04171>>03250000
         RETURN;                                               <<04171>>03252000
      END;#;                                                   <<04171>>03254000
LOGICAL FOPTIONS := 0;                                         <<U.RAO>>03256000
LOGICAL AOPTIONS := 0;                                         <<U.RAO>>03258000
LOGICAL FLAGS1 := 0;  <<PROTOTYPE PARAMETER PRESENT MASK>>     <<U.RAO>>03260000
LOGICAL FLAGS2 := 0;  <<WORD 2 OF FLAGS>>                      <<U.RAO>>03262000
EQUATE DELETE = 4,   <<EQUATES FOR DISPOSITION PARAMETERS>>    <<U.RAO>>03264000
       TEMP = 2,                                               <<U.RAO>>03266000
       SAVE = 1;                                               <<U.RAO>>03268000
EQUATE STD = 0,  <<EQUATES FOR FILE TYPE>>                     <<01549>>03270000
       RIO = 2,                                                <<01549>>03272000
       CIR = 4,                                                <<01549>>03274000
       MSG = 6;                                                <<01549>>03276000
EQUATE NOMULTI     = 0,  <<EQUATES FOR MULTIACCESS>>           <<01549>>03278000
       LOCALMULTI  = 1,                                        <<01549>>03280000
       GLOBALMULTI = 2;                                        <<01549>>03282000
INTEGER DISPOSITION := SAVE;  <<DISPOSITION OF FILE AT CLOSE>> <<U.RAO>>03284000
INTEGER RECSIZE := 0;                                          <<U.RAO>>03286000
INTEGER BLOCKFACTOR := 0;                                      <<U.RAO>>03288000
DOUBLE FILESIZE := 0D;                                         <<U.RAO>>03290000
INTEGER NUMEXTENTS := 0;                                       <<U.RAO>>03292000
INTEGER INITALLOC := 0;                                        <<U.RAO>>03294000
INTEGER OUTPRI := 0;                                           <<U.RAO>>03296000
INTEGER NUMCOPIES := 0;                                        <<U.RAO>>03298000
INTEGER FILECODE := 0;                                         <<U.RAO>>03300000
INTEGER NUMBUFFERS := 0;                                       <<U.RAO>>03302000
EQUATE EXCLUSIVE     = 1,                                      << I.A >>03304000
       EXCLUSIVEREAD = 2,                                      <<U.RAO>>03306000
       SHARE         = 3;                                      <<U.RAO>>03308000
LOGICAL PARSE'ONLY;          << TRUE IF ONLY DOING PARSE >>    <<01200>>03310000
LOGICAL STOP;                                                  <<02663>>03312000
<< Variables for FOPEN device parameter keywords >>            <<02569>>03314000
BYTE POINTER                                                   <<01851>>03316000
   DENS,                                                       <<02569>>03318000
   OUTQ,                                                       <<01851>>03320000
   ENV;                                                        <<01851>>03322000
INTEGER                                                        <<01851>>03324000
   DUMMY,          << Dummy for procedure call >>              <<02569>>03326000
   DENSLEN := 0,                                               <<02569>>03328000
   ENVLEN := 0,                                                <<01851>>03330000
   OUTQLEN := 0,                                               <<01851>>03332000
   KEYS'LEN := 0;  << Total length of device parms >>          <<02569>>03334000
LOGICAL FLAGS3 := FALSE;                                       <<01549>>03336000
DEFINE                                                         <<01549>>03338000
   FLAGDENS = FLAGS3.(12:1)#,                                  <<02569>>03340000
   FLAGADEV = FLAGS3.(15:1)#,                                  <<01549>>03342000
   FLAGENV = FLAGS3.(14:1)#,                                   <<01549>>03344000
   FLAGOUTQ = FLAGS3.(13:1)#;                                  <<01549>>03346000
INTEGER                                                        <<04843>>03348000
   ERRLOC;     << Local error number copy. >>                  <<04843>>03350000
                                                               <<04843>>03352000
                                                               <<U.RAO>>03354000
                                                               <<02569>>03356000
<< The PARMS array (and its equivalences) MUST be the last >>  <<02569>>03358000
<< Q-relative variable defined in the procedure because it >>  <<02569>>03360000
<< is a direct array.  Otherwise, the procedure will run   >>  <<02569>>03362000
<< out of Primary Q space. >>                                  <<02569>>03364000
                                                               <<02569>>03366000
DOUBLE ARRAY PARMS(0:MAXPARMS) = Q;                            <<02569>>03368000
BYTE POINTER FORMALDES = PARMS;                                <<02569>>03370000
BYTE POINTER ACTUALDES = PARMS + 2;                            <<02569>>03372000
BYTE ACTUALDESLEN = PARMS + 3;                                 <<02569>>03374000
                                                               <<02569>>03376000
<<FOPTIONS DEFINES>>                                           <<U.RAO>>03378000
DEFINE                                                         <<U.RAO>>03380000
   FILETYPE    = (2:3) #,                                      <<01549>>03382000
   TAPELABELF  = (6:1)#,                                       <<U.RAO>>03384000
   CCTL        = (7:1)#,                                       <<U.RAO>>03386000
   RECORDFMT   = (8:2)#,                                       <<U.RAO>>03388000
   DEFAULTDES  = (10:3)#,                                      <<U.RAO>>03390000
   ASCIIBINARY = (13:1)#,                                      <<U.RAO>>03392000
   DOMAIN      = (14:2)#;                                      <<U.RAO>>03394000
                                                               <<U.RAO>>03396000
<<AOPTIONS DEFINES>>                                           <<U.RAO>>03398000
DEFINE                                                         <<U.RAO>>03400000
   COPY        = (3:1)#,                                       <<01549>>03402000
   NOWAIT      = (4:1)#,                                       <<U.RAO>>03404000
   MULTIACCESS = (5:2)#,                                       <<01549>>03406000
   NOBUF       = (7:1)#,                                       <<U.RAO>>03408000
   EXCLACCESS  = (8:2)#,                                       <<U.RAO>>03410000
   LOCKING     = (10:1)#,                                      <<U.RAO>>03412000
   MULTIRECORD = (11:1)#,                                      <<U.RAO>>03414000
   ACCESSTYPE  = (12:4)#;                                      <<U.RAO>>03416000
                                                               <<U.RAO>>03418000
<<PARAMETER BIT MASK DEFINES - SEE JDT DESCRIPTION>>           <<U.RAO>>03420000
DEFINE                                                         <<U.RAO>>03422000
   FLAGANAME       = FLAGS1.(15:1)#,                           <<U.RAO>>03424000
   FLAGDEV         = FLAGS1.(14:1)#,                           <<U.RAO>>03426000
   FLAGDOMAIN      = FLAGS1.(13:1)#,                           <<U.RAO>>03428000
   FLAGASCII       = FLAGS1.(12:1)#,                           <<U.RAO>>03430000
   FLAGDEFDESIG    = FLAGS1.(11:1)#,                           <<U.RAO>>03432000
   FLAGRECFMT      = FLAGS1.(10:1)#,                           <<U.RAO>>03434000
   FLAGCCTL        = FLAGS1.(9:1)#,                            <<U.RAO>>03436000
   FLAGCOPY        = FLAGS1.(8:1) #,                           <<01549>>03438000
   FLAGACCESSTYPE  = FLAGS1.(7:1)#,                            <<U.RAO>>03440000
   FLAGMULTIREC    = FLAGS1.(6:1)#,                            <<U.RAO>>03442000
   FLAGEXCLUSIVE   = FLAGS1.(5:1)#,                            <<U.RAO>>03444000
   FLAGBUFINHIBIT  = FLAGS1.(4:1)#,                            <<U.RAO>>03446000
   FLAGNUMBUFS     = FLAGS1.(3:1)#,                            <<U.RAO>>03448000
   FLAGDISP        = FLAGS1.(2:1)#,                            <<U.RAO>>03450000
   FLAGRECSIZE     = FLAGS1.(1:1)#,                            <<U.RAO>>03452000
   FLAGBLOCKFACTOR = FLAGS1.(0:1)#,                            <<U.RAO>>03454000
   FLAGINITALLOC   = FLAGS2.(15:1)#,                           <<U.RAO>>03456000
   FLAGNUMEXTS     = FLAGS2.(14:1)#,                           <<U.RAO>>03458000
   FLAGFILESIZE    = FLAGS2.(13:1)#,                           <<U.RAO>>03460000
   FLAGFILECODE    = FLAGS2.(12:1)#,                           <<U.RAO>>03462000
   FLAGOUTPRI      = FLAGS2.(11:1)#,                           <<U.RAO>>03464000
   FLAGNUMCOPIES   = FLAGS2.(10:1)#,                           <<U.RAO>>03466000
   FLAGMULTIACCESS = FLAGS2.(9:1)#,                            <<U.RAO>>03468000
   FLAGWAIT        = FLAGS2.(8:1)#,                            <<U.RAO>>03470000
   FLAGDYNLOCKING = FLAGS2.(7:1)#,                             <<U.RAO>>03472000
   FLAGFORMS      = FLAGS2.(2:1)#,                             <<U.RAO>>03474000
   FLAGLABELEDTAPE= FLAGS2.(1:1)#,                             <<U.RAO>>03476000
   FLAGFTYPE      = FLAGS2.(0:1)#;                             <<01549>>03478000
<< JDT FILE ENTRY DEFINES - SEE JDT DESCRIPTION >>             <<02554>>03480000
DEFINE                                                         <<02554>>03482000
   FORMAL'DES'LEN        = FILE'ENTRY.(8:8)#,                  <<02554>>03484000
   FORMAL'DES'NAME       = BFILE'ENTRY(2)#,                    <<02554>>03486000
   ACTUAL'DES'LEN        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>03488000
                                       3).(0:8)#,              <<02554>>03490000
   DEVICE'DES'LEN        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>03492000
                                       3).(8:8)#,              <<02554>>03494000
   DEVICE'DES'NAME       = BFILE'ENTRY(FORMAL'DES'LEN * 2 +    <<02554>>03496000
                                      ACTUAL'DES'LEN +         <<02554>>03498000
                                       8)#,                    <<02554>>03500000
   DEVICE'PRESENT        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>03502000
                                       1).(14:1)#;             <<02554>>03504000
                                                               <<U.RAO>>03506000
                                                               <<04848>>03508000
DEFINE      << Lockword found by CHK'DESCRIBE'FNAME. >>        <<04848>>03510000
   GOTLOCK     = ( ERRLOC.(0:1) = 1 ) #;                       <<04843>>03512000
                                                               <<04843>>03514000
                                                               <<01200>>03516000
<<                 *********************                   >>  <<01200>>03518000
<<                 *     PARSE'ERR     *                   >>  <<01200>>03520000
<<                 *********************                   >>  <<01200>>03522000
                                                               <<01200>>03524000
SUBROUTINE PARSE'ERR (ERROR, ERRADR);                          <<01200>>03526000
 VALUE ERROR;                                                  <<01200>>03528000
  INTEGER ERROR;                                               <<01200>>03530000
  BYTE ARRAY ERRADR;                                           <<01200>>03532000
<< SUBROUTINE TO HANDLE ERRORS ENCOUNTERED DURING FILE      >> <<01200>>03534000
<< EQUATION PARSING.  IF A SPECIAL PARSE IS IN PROGRESS     >> <<01200>>03536000
<< (I.E. PARSE'ONLY = TRUE) THEN SIMPLY SET THE ERROR       >> <<01200>>03538000
<< RETURN.  IF A CI COMMAND IS BEING EXECUTED (I.E. :FILE   >> <<01200>>03540000
<< :BUILD) THEN CALL CIERR.                                 >> <<01200>>03542000
BEGIN                                                          <<01200>>03544000
ERRNUM := ERROR;                                               <<04843>>03546000
IF NOT PARSE'ONLY THEN                                         <<01200>>03548000
  CIERR (ERROR, ERRADR);                                       <<01200>>03550000
END << PARSE'ERR >>;                                           <<01200>>03552000
                                                               <<U.RAO>>03554000
<<                 *********************                   >>  <<U.RAO>>03556000
<<                 *      GETNEXT      *                   >>  <<U.RAO>>03558000
<<                 *********************                   >>  <<U.RAO>>03560000
                                                               <<U.RAO>>03562000
SUBROUTINE GETNEXT;                                            <<U.RAO>>03564000
<<THIS SUBROUTINE EXTRACTS THE NEXT PARAMETER FROM PARMS>>     <<U.RAO>>03566000
<<AND DECOMPOSES THE MYCOMMAND RETURNED ENTRY.  IT ALSO CHECKS><<U.RAO>>03568000
<<FOR THE TOO MANY PARAMETERS CASE.  >>                        <<U.RAO>>03570000
BEGIN                                                          <<U.RAO>>03572000
TOS := PARMS(PARMNUM);  <<GET NEXT ENTRY>>                     <<U.RAO>>03574000
NEXTDELIM := S0.DELIMTYPE;  <<GET TRAILING DELIMITER>>         <<U.RAO>>03576000
PARMLEN := TOS&LSR(8);  <<LENGTH OF ENTRY>>                    <<U.RAO>>03578000
@PARMPTR := TOS;  <<FIRST WORD OF MYCOMMAND ENTRY>>            <<U.RAO>>03580000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>03582000
IF PARMNUM > MAXPARMS THEN  <<TOO MANY PARAMETERS>>            <<U.RAO>>03584000
   BEGIN                                                       <<U.RAO>>03586000
   IF BUILDFLAG THEN                                           <<U.RAO>>03588000
      PARSE'ERR(ERRNUM := BLD2MP,PARMPTR)                      <<01200>>03590000
   ELSE                                                        <<U.RAO>>03592000
      PARSE'ERR(ERRNUM := FILE2MP,PARMPTR);                    <<01200>>03594000
   ASSEMBLE(EXIT 3);  <<BAIL OUT OF CXFILE>>                   <<U.RAO>>03596000
   END;                                                        <<U.RAO>>03598000
END;  <<SUBROUTINE GETNEXT>>                                   <<U.RAO>>03600000
                                                               <<U.RAO>>03602000
<<                 *********************                   >>  <<U.RAO>>03604000
<<                 *    CHECKFDESIG    *                   >>  <<U.RAO>>03606000
<<                 *********************                   >>  <<U.RAO>>03608000
                                                               <<U.RAO>>03610000
LOGICAL SUBROUTINE CHECKFDESIG;                                <<U.RAO>>03612000
BEGIN                                                          <<U.RAO>>03614000
<<NOTE:  A FORMAL FILE DESIGNATOR MUST HAVE THE SAME FORMAT>>  <<U.RAO>>03616000
<<AS AN ACTUAL FILE DESIGNATOR, BUT IT MAY NOT BE A SYSTEM>>   <<U.RAO>>03618000
<<DEFINED FILE OR A BACK REFERENCED FILE.>>                    <<U.RAO>>03620000
CHECKFDESIG := FALSE;                                          <<U.RAO>>03622000
GETNEXT;  <<EXPLODE PARMS ENTRY FOR FILE NAME>>                <<U.RAO>>03624000
ERRLOC := CHK'DESCRIBE'FNAME(PARMS&LSR(8),GPNTR,APNTR,ERRPNTR);<<04843>>03626000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>03628000
   PARSE'ERR( ERRLOC, ERRADR )                                 <<04843>>03630000
ELSE IF > THEN  <<NOT STANDARD FILE NAME>>                     <<U.RAO>>03632000
   IF ERRLOC.(8:8) = 0 THEN  << Back-ref'd file. >>            <<04843>>03634000
      PARSE'ERR(ERRNUM := FILEFDSGNOBACK, FORMALDES)           <<01200>>03636000
   ELSE                                                        <<U.RAO>>03638000
      PARSE'ERR(ERRNUM := FILEFDSGNOSYS, FORMALDES)            <<01200>>03640000
ELSE  <<OK - REGULAR FORMAL DESIGNATOR>>                       <<U.RAO>>03642000
   BEGIN                                                       <<U.RAO>>03644000
   IF GOTLOCK THEN                                             <<04848>>03646000
   BEGIN                                                       <<04848>>03648000
      PARSE'ERR( ERRNUM := FDESGNOLOCK, FORMALDES );           <<04848>>03650000
      RETURN;                                                  <<04848>>03652000
   END;                                                        <<04848>>03654000
   CHECKFDESIG := TRUE;                                        <<U.RAO>>03656000
   IF GPNTR = 0 THEN GPNTR := @BLANK;                          <<U.RAO>>03658000
   IF APNTR = 0 THEN APNTR := @BLANK;                          <<U.RAO>>03660000
   END                                                         <<U.RAO>>03662000
END;                                                           <<U.RAO>>03664000
                                                               <<U.RAO>>03666000
<<                 *********************                   >>  <<U.RAO>>03668000
<<                 *  BLDCHECKFDESIG   *                   >>  <<U.RAO>>03670000
<<                 *********************                   >>  <<U.RAO>>03672000
                                                               <<U.RAO>>03674000
LOGICAL SUBROUTINE BLDCHECKFDESIG;                             <<U.RAO>>03676000
BEGIN                                                          <<U.RAO>>03678000
<<NOTE:  A FORMAL FILE DESIGNATOR MUST HAVE THE SAME FORMAT>>  <<U.RAO>>03680000
<<AS AN ACTUAL FILE DESIGNATOR, BUT IT MAY NOT BE A SYSTEM>>   <<U.RAO>>03682000
<<DEFINED FILE>>                                               <<U.RAO>>03684000
BLDCHECKFDESIG := FALSE;                                       <<U.RAO>>03686000
GETNEXT;  <<EXPLODE PARMS ENTRY FOR FILE NAME>>                <<U.RAO>>03688000
ERRNUM := CHECKFILENAME'(PARMS&LSR(8),GPNTR,APNTR,ERRPNTR);    <<U.RAO>>03690000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>03692000
   PARSE'ERR(ERRNUM,ERRADR)                                    <<01200>>03694000
ELSE IF > AND ERRNUM<>0 AND ERRNUM<>2 THEN  <<NOT STD FILE NAME<<U.RAO>>03696000
   PARSE'ERR(ERRNUM := BLDNOSYSFILES, FORMALDES)               <<01200>>03698000
ELSE IF ERRNUM=2 THEN   <<IS $NEWPASS, ALLOW>>                 <<U.RAO>>03700000
   BEGIN                                                       <<00449>>03702000
   BLDCHECKFDESIG := TRUE;                                     <<00449>>03704000
   ERRNUM := 0;                                                <<00449>>03706000
   END                                                         <<00449>>03708000
ELSE  <<OK - REGULAR FORMAL DESIGNATOR>>                       <<U.RAO>>03710000
   BEGIN                                                       <<U.RAO>>03712000
   BLDCHECKFDESIG := TRUE;                                     <<U.RAO>>03714000
   IF GPNTR = 0 THEN GPNTR := @BLANK;                          <<U.RAO>>03716000
   IF APNTR = 0 THEN APNTR := @BLANK;                          <<U.RAO>>03718000
   END                                                         <<U.RAO>>03720000
END;                                                           <<U.RAO>>03722000
                                                               <<U.RAO>>03724000
<<                 *********************                   >>  <<U.RAO>>03726000
<<                 *   CHECKADESIG     *                   >>  <<U.RAO>>03728000
<<                 *********************                   >>  <<U.RAO>>03730000
                                                               <<U.RAO>>03732000
LOGICAL SUBROUTINE CHECKADESIG;                                <<U.RAO>>03734000
<<CHECK FORM OF ACTUAL DESIGNATOR.  MAY BE ANY SORT OF FILE NAM<<U.RAO>>03736000
<<IF IT IS A BACK REFERENCED FILE, WE GO AHEAD AND DO THE FILE <<U.RAO>>03738000
<<EQUATE NOW, SINCE IT SHOULD NOT HAVE ANY PARAMETERS.>>       <<U.RAO>>03740000
BEGIN                                                          <<U.RAO>>03742000
GETNEXT;                                                       <<U.RAO>>03744000
CHECKADESIG := TRUE;                                           <<U.RAO>>03746000
ERRLOC := CHK'DESCRIBE'FNAME( PARMS(1)&LSR(8), GPNTR2,         <<04843>>03748000
                              APNTR2, ERRPNTR           );     <<04848>>03750000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>03752000
   BEGIN                                                       <<U.RAO>>03754000
   PARSE'ERR( ERRLOC, ERRADR );                                <<04843>>03758000
   CHECKADESIG := FALSE                                        <<U.RAO>>03760000
   END                                                         <<U.RAO>>03762000
ELSE IF = THEN  <<ORDINARY ACTUAL FILE DESIGNATOR>>            <<U.RAO>>03764000
   BEGIN                                                       <<U.RAO>>03766000
   FLAGANAME := TRUE                                           <<U.RAO>>03770000
   END                                                         <<U.RAO>>03772000
ELSE IF > AND (ERRLOC.(8:8) <> 0) THEN                         <<04843>>03774000
   BEGIN  <<SYSTEM DEFINED FILE NAME>>                         <<U.RAO>>03776000
   FOPTIONS.DEFAULTDES := ERRLOC.(8:8);                        <<04843>>03778000
   IF (FOPTIONS.DEFAULTDES=6) AND (NUMPARMS>PARMNUM) THEN  <<PARMS>>    03780000
      BEGIN  <<WITH $NULL, WHICH IS ILLEGAL>>                  <<U.RAO>>03782000
      CHECKADESIG := FALSE;                                    <<U.RAO>>03784000
      GETNEXT;                                                 <<U.RAO>>03786000
      PARSE'ERR(ERRNUM := FILEADESNULL2MP, PARMPTR);           <<01200>>03788000
      END;                                                     <<U.RAO>>03790000
   FLAGDEFDESIG := TRUE;                                       <<U.RAO>>03792000
   END                                                         <<U.RAO>>03794000
ELSE   <<MUST BE BACK REFERENCED FILE>>                        <<U.RAO>>03796000
   BEGIN                                                       <<U.RAO>>03798000
   <<THIS IS THE END OF THE LINE FOR A BACK REFERENCE.  EITHER><<U.RAO>>03800000
   <<WE WILL DETECT AN ERROR AND REPORT IT OR WE WILL INSERT THE>>      03802000
   <<ENTRY INTO THE JOB DIRECTORY TABLE (JDT).>>               <<U.RAO>>03804000
   IF GOTLOCK THEN                                             <<04848>>03806000
   BEGIN                                                       <<04848>>03808000
      PARSE'ERR( ERRNUM := FDESGNOLOCK, ACTUALDES );           <<04848>>03810000
      CHECKADESIG := FALSE;                                    <<04848>>03812000
      RETURN;                                                  <<04848>>03814000
   END;                                                        <<04848>>03816000
   CHECKADESIG := FALSE;                                       <<U.RAO>>03818000
   IF NUMPARMS > 2 THEN  <<TOO MANY PARAMETERS>>               <<U.RAO>>03820000
      BEGIN                                                    <<U.RAO>>03822000
      GETNEXT;  <<TO FORCE PARMPTR TO THE OFFENDING ITEM>>     <<U.RAO>>03824000
      PARSE'ERR(ERRNUM := FILEADESIGBR2MP, PARMPTR)            <<01200>>03826000
      END                                                      <<U.RAO>>03828000
   ELSE                                                        <<U.RAO>>03830000
      BEGIN                                                    <<U.RAO>>03832000
      <<CREATE ENTRY, ATTEMPT TO INSERT IT>>                   <<U.RAO>>03834000
      IF GPNTR2 = 0 THEN GPNTR2 := @BLANK;                     <<U.RAO>>03836000
      IF APNTR2 = 0 THEN APNTR2 := @BLANK;                     <<U.RAO>>03838000
      @ACTUALDES := @ACTUALDES+1;  <<MOVE PAST "*">>           <<U.RAO>>03840000
      ACTUALDESLEN := ACTUALDESLEN-1;                          <<U.RAO>>03842000
      PARMNUM := 0;  <<CLEAN UP RETURN PARAMETER>>             <<U.RAO>>03844000
      <<NOW FORMAT WENTRY>>                                    <<U.RAO>>03846000
      WENTRY := 1;   <<SET PMASK - NAME ONLY PARM PRESENT>>    <<U.RAO>>03848000
      WENTRY(1) := %1000;  <<SET PMASK WORD 2 - POINTER WENTRY><<U.RAO>>03850000
      BENTRY(4) := ACTUALDESLEN;                               <<U.RAO>>03852000
      BENTRY(5):=0;  <<CLEAR DEVLEN>>                          <<00080>>03854000
      MOVE BENTRY(6) := ACTUALDES,(ACTUALDESLEN);              <<U.RAO>>03856000
      NEXTENTRYX := (ACTUALDESLEN+29)&LSR(1); <<LENGTH IN WORDS<<U.RAO>>03858000
      IF PARSE'ONLY THEN                                       <<01200>>03860000
         BEGIN                                                 <<01200>>03862000
         << COPY LOCAL TABLE ENTRY OVER STRING PASSED TO   >>  <<01200>>03864000
         << PARSE'FILE'EQ.  THIS RETURNS THE PARSED FILE   >>  <<01200>>03866000
         << EQUATION INFO TO THE CALLER.                   >>  <<01200>>03868000
         MOVE PARMSP := BENTRY, (ACTUALDESLEN+8);              <<01200>>03870000
         END                                                   <<01200>>03872000
      ELSE                                                     <<01200>>03874000
      CASE XADDJTENTRY(FORMALDES,GROUP,ACCT,-3,NEXTENTRYX,WENTRY,       03876000
               ACTUALDES,GROUP2,ACCT2) OF                      <<U.RAO>>03878000
         BEGIN                                                 <<U.RAO>>03880000
            ;  <<0 - NO PROBLEM>>                              <<U.RAO>>03882000
            CIERR(ERRNUM := FEQTABFULLXPLCT);                  <<U.RAO>>03884000
            ;  <<DUPLICATE NAME CAN'T HAPPEN>>                 <<U.RAO>>03886000
            BEGIN  <<ACTUAL DESIGNATOR NOT FOUND>>             <<U.RAO>>03888000
               QUALIFYFILENAME(ACTUALDES,BENTRY);              <<U.RAO>>03890000
               CIERR(ERRNUM := FILEBREFMISADES,,0,@BENTRY);    <<U.RAO>>03892000
            END;                                               <<U.RAO>>03894000
            BEGIN  <<TOO MANY BACK REFERENCES>>                <<U.RAO>>03896000
               QUALIFYFILENAME(ACTUALDES,BENTRY);              <<U.RAO>>03898000
               CIERR(ERRNUM := TOOMANYFEQBREF,,0,@BENTRY);     <<U.RAO>>03900000
            END;                                               <<U.RAO>>03902000
            BEGIN  << CIRCULAR CLINE EQUATIONS >>              <<00834>>03904000
               CIERR(ERRNUM := CIRCULARFEQ);                   <<00834>>03906000
            END;                                               <<00834>>03908000
         END; <<OF CASE>>                                      <<U.RAO>>03910000
      END;                                                     <<U.RAO>>03912000
   END;  << BACK REFERENCE CASE>>                              <<U.RAO>>03914000
END;  <<CHECKADESIG>>                                          <<U.RAO>>03916000
                                                               <<U.RAO>>03918000
                                                               <<01549>>03920000
<<                 *********************                   >>  <<01549>>03922000
<<                 * CHECKENVFILEDESIG *                   >>  <<02523>>03924000
<<                 *********************                   >>  <<01549>>03926000
                                                               <<01549>>03928000
LOGICAL SUBROUTINE CHECKENVFILEDESIG;                          <<02523>>03930000
<< CHECK FORM OF THE ACTUAL FILE DESIGNATOR PARAMETER      >>  <<02523>>03932000
<< FOR THE "ENV=" KEYWORD.  NO SYSTEM FILES ALLOWED,       >>  <<02523>>03934000
<< EXCEPT $OLDPASS.                                        >>  <<02523>>03936000
<<                                                         >>  <<02523>>03938000
BEGIN                                                          <<01549>>03940000
CHECKENVFILEDESIG := FALSE;                                    <<02554>>03942000
TOS := CHECKFILENAME'(PARMS(PARMNUM-1)&LSR(8),GPNTRENV,        <<01549>>03944000
           APNTRENV,ERRPNTR);                                  <<01549>>03946000
IF < THEN  <<ERROR IN NAME>>                                   <<01549>>03948000
   BEGIN                                                       <<01549>>03950000
   ERRNUM := TOS;                                              <<01549>>03952000
   PARSE'ERR(ERRNUM, ERRADR);                                  <<01549>>03954000
   RETURN;                                                     <<02554>>03956000
   END                                                         <<01549>>03958000
ELSE IF = THEN  <<ORDINARY ACTUAL FILE DESIGNATOR>>            <<01549>>03960000
   BEGIN                                                       <<01549>>03962000
   DEL;                                                        <<01549>>03964000
   END                                                         <<01549>>03966000
ELSE IF > AND (S0<>0) THEN                                     <<01549>>03968000
   BEGIN  <<CHECK FOR $OLDPASS>>                               <<01549>>03970000
   IF S0 <> 3 <<NOT $OLDPASS>> THEN                            <<01549>>03972000
   BEGIN  <<SYSTEM DEFINED FILE NAME>>                         <<01549>>03974000
      DEL;                                                     <<01851>>03976000
      PARSE'ERR(ERRNUM := FILEADESSYS, PARMPTR);               <<01549>>03978000
      RETURN;                                                  <<02554>>03980000
   END                                                         <<01851>>03982000
   ELSE DEL;                                                   <<01851>>03984000
   END                                                         <<01549>>03986000
ELSE   <<MUST BE BACK REFERENCED FILE>>                        <<01549>>03988000
   BEGIN                                                       <<01549>>03990000
   DEL;  <<POP ZERO FROM CHECKFILENAME'>>                      <<01549>>03992000
      <<IT IS A VALID FILENAME>>                               <<01549>>03994000
   IF GPNTRENV = 0 THEN GPNTRENV := @BLANK;                    <<02554>>03996000
   IF APNTRENV = 0 THEN APNTRENV := @BLANK;                    <<02554>>03998000
   IF PARMPTR(1) = FORMALDES,(PARMLEN - 1) THEN                <<02554>>04000000
      PARSE'ERR(ERRNUM := CIRCULARFEQ,PARMPTR);                <<02554>>04002000
                                                               <<02554>>04004000
   IF ERRNUM <> 0 THEN RETURN;                                 <<02554>>04006000
   CASE XRETJTENTRY(PARMPTR(1),GROUPENV,ACCTENV                <<02554>>04008000
                    ,SIZE,FILE'ENTRY) OF                       <<02554>>04010000
      BEGIN                                                    <<02554>>04012000
         BEGIN                                                 <<02554>>04014000
            IF LOGICAL(DEVICE'PRESENT) THEN                    <<02554>>04016000
               BEGIN                                           <<02554>>04018000
                  INDEX := -1;                                 <<02554>>04020000
                  @BPTR := @DEVICE'DES'NAME;                   <<02554>>04022000
                  WHILE (INDEX := INDEX + 1) <=                <<02554>>04024000
                        (DEVICE'DES'LEN - 5) DO                <<02554>>04026000
                     IF BPTR(INDEX) = ";ENV=" THEN             <<02554>>04028000
                     PARSE'ERR(ERRNUM:=FILECONTENV,PARMPTR);   <<02554>>04030000
               END;                                            <<02554>>04032000
            IF ERRNUM <> 0 THEN RETURN;                        <<02554>>04034000
            CRUNCH(FORMALDES,GROUP,ACCT,DEST,SIZE);            <<02554>>04036000
            @BPTR := @DEST&LSL(1);                             <<02554>>04038000
            IF BPTR = FORMAL'DES'NAME,                         <<02554>>04040000
                      (FORMAL'DES'LEN * 2) THEN                <<02554>>04042000
               PARSE'ERR(ERRNUM := CIRCULARFEQ,PARMPTR);       <<02554>>04044000
         END;                                                  <<02554>>04046000
         BEGIN                                                 <<02554>>04048000
            QUALIFYFILENAME(PARMPTR(1),BFILE'ENTRY);           <<02554>>04050000
            IF PARSE'ONLY THEN                                 <<02554>>04052000
               ERRNUM := FILEBREFMISADES                       <<02554>>04054000
            ELSE                                               <<02554>>04056000
               CIERR(ERRNUM := FILEBREFMISADES,,0,             <<02554>>04058000
                     @BFILE'ENTRY);                            <<02554>>04060000
         END;                                                  <<02554>>04062000
         BEGIN                                                 <<02554>>04064000
            QUALIFYFILENAME(PARMPTR(1),BFILE'ENTRY);           <<02554>>04066000
            IF PARSE'ONLY THEN                                 <<02554>>04068000
               ERRNUM := FILEBREFMISADES                       <<02554>>04070000
            ELSE                                               <<02554>>04072000
               CIERR(ERRNUM := FILEBREFMISADES,,0,             <<02554>>04074000
                     @BFILE'ENTRY);                            <<02554>>04076000
         END;                                                  <<02554>>04078000
      END;         << CASE >>                                  <<02554>>04080000
   END;  << BACK REFERENCE CASE>>                              <<01549>>04082000
   IF ERRNUM = 0 THEN  CHECKENVFILEDESIG := TRUE;              <<02554>>04084000
END;     <<CHECKENVFILEDESIG>>                                 <<02523>>04086000
                                                               <<01549>>04088000
<<                 *********************                   >>  <<U.RAO>>04090000
<<                 *    CHECKDOMAIN    *                   >>  <<U.RAO>>04092000
<<                 *********************                   >>  <<U.RAO>>04094000
                                                               <<U.RAO>>04096000
LOGICAL SUBROUTINE CHECKDOMAIN;                                <<U.RAO>>04098000
BEGIN                                                          <<U.RAO>>04100000
<<THIS ROUTINE PARSES THE DOMAIN PARAMETER IN A FILE EQUATE.>> <<U.RAO>>04102000
<<IT ALSO VERIFIES THAT THE DOMAIN AND THE DEFAULT DESIGNATOR>><<U.RAO>>04104000
<<ARE COMPATIBLE.>>                                            <<U.RAO>>04106000
CHECKDOMAIN := TRUE;                                           <<U.RAO>>04108000
GETNEXT;                                                       <<U.RAO>>04110000
IF FOPTIONS.DEFAULTDES <> 0 THEN  <<DOMAIN SPECIFIED FOR >>    <<U.RAO>>04112000
   PARSE'ERR(-FILEDOMAINSYSDF,PARMPTR)   << SYS DEF FILE >>    <<01200>>04114000
ELSE  <<IS REGULAR FILE REFERENCE>>                            <<U.RAO>>04116000
   BEGIN                                                       <<U.RAO>>04118000
   FLAGDOMAIN := TRUE;   <<DOMAIN SPECIFIED>>                  <<U.RAO>>04120000
   IF (PARMLEN=3) AND (PARMPTR="OLD") THEN                     <<U.RAO>>04122000
      FOPTIONS.DOMAIN := 1                                     <<U.RAO>>04124000
   ELSE IF (PARMLEN=7) AND (PARMPTR="OLDTEMP") THEN            <<U.RAO>>04126000
      FOPTIONS.DOMAIN := 2                                     <<U.RAO>>04128000
   ELSE IF (PARMLEN<>3) OR (PARMPTR<>"NEW") THEN               <<U.RAO>>04130000
      BEGIN  <<UNIDENTIFIED DOMAIN>>                           <<U.RAO>>04132000
      CHECKDOMAIN := FALSE;                                    <<U.RAO>>04134000
      IF PARMLEN = 0 THEN   <<MISSING>>                        <<U.RAO>>04136000
         PARSE'ERR(ERRNUM := FILEXPCTDOMAIN, PARMPTR)          <<01200>>04138000
      ELSE                                                     <<U.RAO>>04140000
         PARSE'ERR(ERRNUM := FILEINVLDDOMAIN, PARMPTR);        <<01200>>04142000
      END                                                      <<U.RAO>>04144000
   END;                                                        <<U.RAO>>04146000
END;  <<SUBROUTINE CHECKDOMAIN>>                               <<U.RAO>>04148000
                                                               <<U.RAO>>04150000
<<                 *********************                   >>  <<U.RAO>>04152000
<<                 *  CHECKLABELDATA   *                   >>  <<U.RAO>>04154000
<<                 *********************                   >>  <<U.RAO>>04156000
                                                               <<U.RAO>>04158000
LOGICAL SUBROUTINE CHECKLABELDATA;                             <<U.RAO>>04160000
<<CHECKS SYNTAX OF TAPE LABEL DATA.  FORM REQUIRED IS>>        <<U.RAO>>04162000
<<LABEL[=[VOLID][,[TYPE][,[EXPIRATION DATE][,[SEQUENCE NO.]]]]]<<U.RAO>>04164000
BEGIN                                                          <<U.RAO>>04166000
CHECKLABELDATA := TRUE;                                        <<U.RAO>>04168000
FOPTIONS.TAPELABELF := TRUE;  <<FLAG REQUIRES TAPE LABEL>>     <<U.RAO>>04170000
FLAGLABELEDTAPE := TRUE;  <<INTERNAL FLAG FOR PMASK>>          <<U.RAO>>04172000
IF <> THEN   <<REDUNDANTLY SPECIFIED PARAMETER>>               <<U.RAO>>04174000
   BEGIN                                                       <<U.RAO>>04176000
   PARSE'ERR(-FILEREDUNDLABEL, PARMPTR);                       <<01200>>04178000
   TAPELABELLEN := 0;                                          <<U.RAO>>04180000
   END;                                                        <<U.RAO>>04182000
IF NEXTDELIM=EQUALS THEN   <<NON-DEFAULT SPECIFIED>>           <<U.RAO>>04184000
   BEGIN                                                       <<U.RAO>>04186000
   CHECKLABELDATA := FALSE;                                    <<U.RAO>>04188000
   GETNEXT;                                                    <<U.RAO>>04190000
   INDEX := LOGICAL(@PARMPTR) - LOGICAL(@PARMSP);              <<02663>>04192000
   @BPTR := @SAVEDCOMIMAGE(INDEX);                             <<02663>>04194000
   IF PARMLEN <> 0 THEN  <<VOLID PRESENT>>                     <<U.RAO>>04196000
      IF PARMPTR = """" THEN << SPECIAL CHARS IN VOLID >>      <<02663>>04198000
         BEGIN                                                 <<02663>>04200000
         STOP := FALSE;                                        <<02663>>04202000
         @BPTR := LOGICAL(@BPTR) + 1;                          <<02663>>04204000
         WHILE NOT STOP DO                                     <<02663>>04206000
            BEGIN                                              <<02663>>04208000
            SCAN BPTR UNTIL %6442,1; << QUOTE'CR >>            <<02663>>04210000
            IF CARRY THEN                                      <<02663>>04212000
               BEGIN                                           <<02663>>04214000
               DEL;                                            <<02663>>04216000
               PARSE'ERR(ERRNUM := FILEMISSQUOTE,PARMPTR);     <<02663>>04218000
               STOP := TRUE;                                   <<02663>>04220000
               END                                             <<02663>>04222000
            ELSE                                               <<02663>>04224000
               BEGIN                                           <<02663>>04226000
               INDEX := LS0 - LOGICAL(@BPTR);                  <<02663>>04228000
               @BPTR := LOGICAL(TOS);                          <<02663>>04230000
               IF BPTR(1) = """" THEN                          <<02663>>04232000
                  BEGIN                                        <<02663>>04234000
                  INDEX := INDEX + 1;                          <<02663>>04236000
                  @BPTR := LOGICAL(@BPTR) + 1;                 <<02663>>04238000
                  END                                          <<02663>>04240000
               ELSE                                            <<02663>>04242000
                  STOP := TRUE;                                <<02663>>04244000
               IF (INDEX + TAPELABELLEN) > 6 THEN              <<02663>>04246000
                  BEGIN                                        <<02663>>04248000
                  PARSE'ERR(ERRNUM:=FILEVOLID2LONG,PARMPTR);   <<02663>>04250000
                  STOP := TRUE;                                <<02663>>04252000
                  END                                          <<02663>>04254000
               ELSE                                            <<02663>>04256000
                  BEGIN                                        <<02663>>04258000
                  MOVE TAPELABEL(TAPELABELLEN) :=              <<02663>>04260000
                       BPTR(-INDEX),(INDEX);                   <<02663>>04262000
                  TAPELABELLEN := TAPELABELLEN + INDEX;        <<02663>>04264000
                  @BPTR := LOGICAL(@BPTR) + 1;                 <<02663>>04266000
                  END;                                         <<02663>>04268000
               END;                                            <<02663>>04270000
            END; << WHILE LOOP >>                              <<02663>>04272000
         INDEX := -1;                                          <<02663>>04274000
         WHILE (INDEX := INDEX + 1) < TAPELABELLEN AND         <<02663>>04276000
               ERRNUM = 0 DO                                   <<02663>>04278000
            BEGIN                                              <<02663>>04280000
            IF NOT (%40 <= INTEGER(TAPELABEL(INDEX))           <<02663>>04282000
                        <= %176) THEN                          <<02663>>04284000
               PARSE'ERR(ERRNUM := FILENONPRINTCHAR,PARMPTR);  <<02663>>04286000
            IF TAPELABEL(INDEX) = "=" THEN GETNEXT;            <<02663>>04288000
            IF TAPELABEL(INDEX) = ";" OR                       <<02663>>04290000
               TAPELABEL(INDEX) = "," THEN                     <<02663>>04292000
               PARSE'ERR(ERRNUM := FILECOMMASEMINOK,PARMPTR);  <<02663>>04294000
            END;                                               <<02663>>04296000
         END                                                   <<02663>>04298000
      ELSE                                                     <<02663>>04300000
      IF PARMLEN > 6 THEN   <<INVALID VOLID>>                  <<U.RAO>>04302000
         PARSE'ERR(ERRNUM := FILEVOLID2LONG, PARMPTR)          <<01200>>04304000
      ELSE                                                     <<U.RAO>>04306000
         BEGIN                                                 <<U.RAO>>04308000
         TOS := PARMS(PARMNUM-1);                              <<U.RAO>>04310000
         DELB;   <<POP POINTER GARBAGE>>                       <<U.RAO>>04312000
         IF TOS.(10:1) THEN  <<EMBEDDED SPECIAL CHARACTER>>    <<U.RAO>>04314000
            PARSE'ERR(ERRNUM := FILEVOLIDSPECAL, PARMPTR)      <<01200>>04316000
         ELSE   <<VOLID OK>>                                   <<U.RAO>>04318000
            BEGIN                                              <<U.RAO>>04320000
            TAPELABELLEN := PARMLEN;                           <<U.RAO>>04322000
            MOVE TAPELABEL := BPTR,(PARMLEN);                  <<02663>>04324000
            END;                                               <<U.RAO>>04326000
         END;                                                  <<U.RAO>>04328000
   IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN                    <<U.RAO>>04330000
      BEGIN   <<TYPE SPECIFIED?>>                              <<U.RAO>>04332000
      TAPELABEL(TAPELABELLEN) := ",";                          <<U.RAO>>04334000
      TAPELABELLEN := TAPELABELLEN+1;                          <<U.RAO>>04336000
      GETNEXT;   <<SET UP FOR TYPE FIELD>>                     <<U.RAO>>04338000
      IF PARMLEN <> 0 THEN   <<TYPE PRESENT>>                  <<U.RAO>>04340000
         IF PARMLEN<>3 OR PARMPTR<>"ANS" AND PARMPTR<>"IBM" THEN        04342000
            PARSE'ERR(ERRNUM := FILEINVVOLTYPE, PARMPTR)       <<01200>>04344000
         ELSE  <<VALID VOLUME TYPE, SAVE IT>>                  <<U.RAO>>04346000
            BEGIN                                              <<U.RAO>>04348000
            MOVE TAPELABEL(TAPELABELLEN) := PARMPTR,(PARMLEN); <<U.RAO>>04350000
            TAPELABELLEN := TAPELABELLEN+PARMLEN;              <<U.RAO>>04352000
            END;   <<OF PROCESSING OF TYPE>>                   <<U.RAO>>04354000
      IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN                 <<U.RAO>>04356000
         BEGIN   <<CHECK FOR EXPIRATION DATE>>                 <<U.RAO>>04358000
         TAPELABEL(TAPELABELLEN) := ",";                       <<U.RAO>>04360000
         TAPELABELLEN := TAPELABELLEN+1;                       <<U.RAO>>04362000
         GETNEXT;  <<SET UP FOR EXPIRATION DATE FIELD>>        <<U.RAO>>04364000
         IF PARMLEN <> 0 THEN  <<EXPIRATION DATE FIELD PRESENT><<U.RAO>>04366000
            IF CHECKEXPDATE(ERRNUM, PARMLEN, PARMPTR,          <<U.RAO>>04368000
                      TAPELABEL(TAPELABELLEN)) THEN            <<U.RAO>>04370000
               TAPELABELLEN := TAPELABELLEN+8;  <<VALID EXP DAT<<U.RAO>>04372000
         IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN              <<U.RAO>>04374000
            BEGIN  <<SEQUENCE NUMBER FIELD SPECIFIED?>>        <<U.RAO>>04376000
            TAPELABEL(TAPELABELLEN) := ",";                    <<U.RAO>>04378000
            TAPELABELLEN := TAPELABELLEN+1;                    <<U.RAO>>04380000
            GETNEXT;                                           <<U.RAO>>04382000
            IF PARMLEN <> 0 THEN  <<SEQ NUM PRESENT>>          <<U.RAO>>04384000
               BEGIN                                           <<U.RAO>>04386000
               TOS := PARMS(PARMNUM-1);                        <<U.RAO>>04388000
               DELB;                                           <<U.RAO>>04390000
               IF LS0.(10:1) OR PARMLEN>4 THEN                 <<U.RAO>>04392000
                  BEGIN                                        <<U.RAO>>04394000
                  PARSE'ERR(ERRNUM := FILEXPINVSEQ, PARMPTR);  <<01200>>04396000
                  DEL;                                         <<U.RAO>>04398000
                  END                                          <<U.RAO>>04400000
               ELSE IF TOS.(8:1) AND PARMPTR<>"NEXT" AND       <<U.RAO>>04402000
                     PARMPTR<>"ADDF" THEN  <<ASCII IN SEQ FIELD<<U.RAO>>04404000
                  PARSE'ERR(ERRNUM := FILEXPINVSEQ, PARMPTR)   <<01200>>04406000
               ELSE   <<SEQUENCE OK>>                          <<U.RAO>>04408000
                  BEGIN                                        <<U.RAO>>04410000
                  MOVE TAPELABEL(TAPELABELLEN) := PARMPTR,(PARMLEN);    04412000
                  TAPELABELLEN := TAPELABELLEN+PARMLEN;        <<U.RAO>>04414000
                  END;                                         <<U.RAO>>04416000
               END;                                            <<U.RAO>>04418000
            END;                                               <<U.RAO>>04420000
         END;                                                  <<U.RAO>>04422000
      END;                                                     <<U.RAO>>04424000
   IF ERRNUM=0 THEN  <<CHECK FOR EXTRANEOUS DATA>>             <<U.RAO>>04426000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>04428000
         BEGIN                                                 <<U.RAO>>04430000
         CHECKLABELDATA := TRUE;                               <<U.RAO>>04432000
         WHILE TAPELABEL(TAPELABELLEN-1) = "," DO              <<U.RAO>>04434000
            TAPELABELLEN := TAPELABELLEN-1;                    <<U.RAO>>04436000
         END                                                   <<U.RAO>>04438000
      ELSE   <<EXTRANEOUS PARAMETER>>                          <<U.RAO>>04440000
         BEGIN                                                 <<U.RAO>>04442000
         GETNEXT;                                              <<U.RAO>>04444000
         PARSE'ERR(ERRNUM := FILEXTRNLABEL, PARMPTR);          <<01200>>04446000
         END;                                                  <<U.RAO>>04448000
   END;                                                        <<U.RAO>>04450000
END;   <<SUBROUTINE CHECKLABELDATA>>                           <<U.RAO>>04452000
                                                               <<U.RAO>>04454000
<<                 *********************                   >>  <<U.RAO>>04456000
<<                 *     PROCDISC      *                   >>  <<U.RAO>>04458000
<<                 *********************                   >>  <<U.RAO>>04460000
                                                               <<U.RAO>>04462000
LOGICAL SUBROUTINE PROCDISC;                                   <<U.RAO>>04464000
BEGIN                                                          <<U.RAO>>04466000
PROCDISC := FALSE;                                             <<U.RAO>>04468000
IF NEXTDELIM <> EQUALS THEN  <<MISSING DELIMITER BEFORE LIST>> <<U.RAO>>04470000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>04472000
ELSE  <<DO SUB PARAMETER LIST>>                                <<U.RAO>>04474000
   BEGIN                                                       <<U.RAO>>04476000
   IF FLAGFILESIZE OR FLAGNUMEXTS OR FLAGINITALLOC THEN        <<U.RAO>>04478000
      BEGIN <<PREVIOUSLY SPECIFIED, CLEAN UP FROM BEFORE, WARN><<U.RAO>>04480000
      PARSE'ERR(-FILEDISCOVERIDE,PARMPTR);                     <<01200>>04482000
      FLAGFILESIZE := FALSE;                                   <<U.RAO>>04484000
      FLAGNUMEXTS := FALSE;                                    <<U.RAO>>04486000
      FLAGINITALLOC := FALSE;                                  <<U.RAO>>04488000
      END;                                                     <<U.RAO>>04490000
   <<FIRST CANDIDATE IS RECORD SIZE>>                          <<U.RAO>>04492000
   GETNEXT;                                                    <<U.RAO>>04494000
   IF PARMLEN <> 0 THEN   <<RECORD SIZE SPECIFIED>>            <<U.RAO>>04496000
      BEGIN                                                    <<U.RAO>>04498000
      FLAGFILESIZE := TRUE;                                    <<U.RAO>>04500000
      FILESIZE := DBINARY(PARMPTR, PARMLEN);                   <<U.RAO>>04502000
      IF <> OR (FILESIZE <= 0D) THEN                           <<U.RAO>>04504000
         BEGIN                                                 <<U.RAO>>04506000
         PARSE'ERR(ERRNUM := FILEFILESIZE,PARMPTR);            <<01200>>04508000
         RETURN;   <<BAIL OUT>>                                <<U.RAO>>04510000
         END;                                                  <<U.RAO>>04512000
      END;                                                     <<U.RAO>>04514000
   <<NEXT CANDIDATE IS THE NUMBER OF EXTENTS>>                 <<U.RAO>>04516000
   IF NEXTDELIM = COMMA THEN  <<OTHER PARMS WERE SPECIFIED>>   <<U.RAO>>04518000
      BEGIN                                                    <<U.RAO>>04520000
      GETNEXT;                                                 <<U.RAO>>04522000
      IF PARMLEN <> 0 THEN   <<BLOCKING FACTOR PRESENT>>       <<U.RAO>>04524000
         BEGIN  <<ATTEMPT TO PARSE IT>>                        <<U.RAO>>04526000
         FLAGNUMEXTS := TRUE;                                  <<U.RAO>>04528000
         NUMEXTENTS := BINARY(PARMPTR, PARMLEN);               <<U.RAO>>04530000
         IF <> OR NOT(1<=NUMEXTENTS<=32) THEN                  <<U.RAO>>04532000
            BEGIN  <<ERROR IN VALUE>>                          <<U.RAO>>04534000
            PARSE'ERR(ERRNUM := FILEEXTENTSPROB, PARMPTR);     <<01200>>04536000
            RETURN                                             <<U.RAO>>04538000
            END;                                               <<U.RAO>>04540000
         END;                                                  <<U.RAO>>04542000
      <<NEXT CANDIDATE IS THE NUMBER OF INITIALLY ALLOCATED EXTENTS>>   04544000
      IF NEXTDELIM = COMMA THEN  <<FURTHER PARMS WERE SPECIFIED>>       04546000
         BEGIN                                                 <<U.RAO>>04548000
         GETNEXT;                                              <<U.RAO>>04550000
         IF PARMLEN <> 0 THEN  <<INITIAL ALLOCATION PRESENT>>  <<U.RAO>>04552000
            BEGIN                                              <<U.RAO>>04554000
            FLAGINITALLOC := TRUE;                             <<U.RAO>>04556000
            IF NOT FLAGNUMEXTS THEN NUMEXTENTS := 32;          <<U.RAO>>04558000
            INITALLOC := BINARY(PARMPTR,PARMLEN);              <<U.RAO>>04560000
            IF <> OR (INITALLOC > NUMEXTENTS) THEN             <<U.RAO>>04562000
               IF PARSE'ONLY THEN ERRNUM := FILEINITALLOCBD    <<01200>>04564000
               ELSE CIERR(ERRNUM:=FILEINITALLOCBD,PARMPTR,     <<01200>>04566000
                          %10000,NUMEXTENTS);                  <<01200>>04568000
            END;                                               <<U.RAO>>04570000
         END;                                                  <<U.RAO>>04572000
      IF NOT BUILDFLAG THEN                                    <<U.RAO>>04574000
         BEGIN  <<EXTENT SIZE MUST FIT IN 5 BITS>>             <<U.RAO>>04576000
         NUMEXTENTS := NUMEXTENTS-1;                           <<U.RAO>>04578000
         INITALLOC := INITALLOC-1;                             <<U.RAO>>04580000
         END;                                                  <<U.RAO>>04582000
      END;                                                     <<U.RAO>>04584000
   IF ERRNUM = 0 THEN                                          <<U.RAO>>04586000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>04588000
         PROCDISC := TRUE                                      <<U.RAO>>04590000
      ELSE  <<UNKNOWN PARAMETER AT END OF LIST>>               <<U.RAO>>04592000
         BEGIN                                                 <<U.RAO>>04594000
         GETNEXT;                                              <<U.RAO>>04596000
         PARSE'ERR(ERRNUM := FILEDISCXPARMS, PARMPTR);         <<01200>>04598000
         END;                                                  <<U.RAO>>04600000
   END;                                                        <<U.RAO>>04602000
END;                                                           <<U.RAO>>04604000
                                                               <<U.RAO>>04606000
<<                 *********************                   >>  <<U.RAO>>04608000
<<                 *   CHECKFORMMSG    *                   >>  <<U.RAO>>04610000
<<                 *********************                   >>  <<U.RAO>>04612000
                                                               <<U.RAO>>04614000
LOGICAL SUBROUTINE CHECKFORMMSG;                               <<U.RAO>>04616000
<<VALIDATES AND PROCESSES FORMS MESSAGE>>                      <<U.RAO>>04618000
BEGIN                                                          <<U.RAO>>04620000
CHECKFORMMSG := FALSE;                                         <<U.RAO>>04622000
IF NEXTDELIM <> EQUALS THEN  <<MISSING MESSAGE>>               <<U.RAO>>04624000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>04626000
ELSE   <<PARSE FORMMSG PARAMETER>>                             <<U.RAO>>04628000
   BEGIN                                                       <<U.RAO>>04630000
   FLAGFORMS := TRUE;                                          <<U.RAO>>04632000
   IF <> THEN  <<REDUNDANTLY SPECIFIED>>                       <<U.RAO>>04634000
      PARSE'ERR(-FILEFORMOVERRID, PARMPTR);                    <<01200>>04636000
   GETNEXT;                                                    <<U.RAO>>04638000
   SCAN PARMPTR UNTIL [8/%15,8/"."],1;  <<LOOK FOR ".">>       <<U.RAO>>04640000
   IF CARRY THEN   <<FOUND CR INSTEAD>>                        <<U.RAO>>04642000
      BEGIN                                                    <<U.RAO>>04644000
      PARSE'ERR(ERRNUM := FILEFMSNOPERIOD, BPS0);              <<01200>>04646000
      DEL;  <<POP POINTER ON TOS>>                             <<U.RAO>>04648000
      END                                                      <<U.RAO>>04650000
   ELSE  <<MESSAGE IS PRESENT, SAVE IT>>                       <<U.RAO>>04652000
      BEGIN                                                    <<U.RAO>>04654000
      FORMSMSGLEN := TOS-@PARMPTR;                             <<U.RAO>>04656000
      IF FORMSMSGLEN > 49 THEN   <<MESSAGE TOO LONG>>          <<U.RAO>>04658000
         BEGIN                                                 <<U.RAO>>04660000
         PARSE'ERR(-FILEFMSTOOLONG, PARMPTR(49));              <<01200>>04662000
         FORMSMSGLEN := 49;                                    <<U.RAO>>04664000
         END;  <<HANDLING OF LINE TOO LONG CASE>>              <<U.RAO>>04666000
      FORMSMSG(FORMSMSGLEN) := ".";                            <<U.RAO>>04668000
      MOVE FORMSMSG := PARMPTR, (FORMSMSGLEN);                 <<U.RAO>>04670000
      CHECKFORMMSG := TRUE;                                    <<U.RAO>>04672000
      FORMSMSGLEN := FORMSMSGLEN+1;  <<FOR PERIOD>>            <<U.RAO>>04674000
      INDEX := -1;@BPTR := @PARMPTR;                           <<04179>>04676000
      WHILE BPTR(INDEX := INDEX + 1) <> "." DO                 <<04179>>04678000
         BEGIN << check for delimiters inside formsmsg >>      <<04179>>04680000
            IF BPTR(INDEX) = "=" OR                            <<04179>>04682000
               BPTR(INDEX) = "," OR                            <<04179>>04684000
               BPTR(INDEX) = ";" THEN                          <<04179>>04686000
               GETNEXT; << advance to next parameter >>        <<04179>>04688000
         END;                                                  <<04179>>04690000
      END;                                                     <<U.RAO>>04692000
   END;                                                        <<U.RAO>>04694000
END;   <<SUBROUTINE CHECKFORMMSG>>                             <<U.RAO>>04696000
                                                               <<U.RAO>>04698000
<<                 *********************                   >>  <<U.RAO>>04700000
<<                 *      PROCDEV      *                   >>  <<U.RAO>>04702000
<<                 *********************                   >>  <<U.RAO>>04704000
                                                               <<U.RAO>>04706000
LOGICAL SUBROUTINE PROCDEV;                                    <<U.RAO>>04708000
<<PARSES DEVICE PARAMETER LIST.  THINGS TO WATCH OUT FOR INCLUDE>>      04710000
<<1) MISSING EQUALS SIGN  2) INVALID DEVICE NAME  3) DS LINE NAME>>     04712000
<<4) OUTPRI  5) NUMCOPIES  6) EXTRANEOUS PARAMETERS.  >>       <<U.RAO>>04714000
BEGIN                                                          <<U.RAO>>04716000
PROCDEV := FALSE;                                              <<U.RAO>>04718000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>04720000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>04722000
ELSE  <<DO SUB PARAMETER LIST>>                                <<U.RAO>>04724000
   BEGIN                                                       <<U.RAO>>04726000
   IF FLAGADEV OR FLAGOUTPRI OR FLAGNUMCOPIES THEN             <<01549>>04728000
      BEGIN  <<REDUNDANTLY SPECIFIED DEVICE PARAMETERS>>       <<U.RAO>>04730000
      PARSE'ERR(-FILEDEVOVERRIDE, PARMPTR); <<WARN USER>>      <<01200>>04732000
      FLAGADEV := FALSE;                                       <<01549>>04734000
      @DEV := @DISC & LSL(1); <<REINITIALIZE POINTER>>         <<02569>>04736000
      DEVLEN := 0;                                             <<02569>>04738000
      FLAGOUTPRI := FALSE;                                     <<U.RAO>>04740000
      FLAGNUMCOPIES := FALSE;                                  <<U.RAO>>04742000
      END;                                                     <<U.RAO>>04744000
   <<FIRST CANDIDATE IS THE DEVICE NAME>>                      <<U.RAO>>04746000
   GETNEXT;                                                    <<U.RAO>>04748000
   IF PARMLEN <> 0 THEN                                        <<U.RAO>>04750000
      BEGIN                                                    <<U.RAO>>04752000
      FLAGADEV := TRUE;  << GOT DEVICE PART >>                 <<02569>>04754000
      IF COMTYPE=SYSDEF THEN  <<SYSTEM DEFINED FILE>>          <<U.RAO>>04756000
         BEGIN  <<DEVICE SYSTEM DEFINED>>                      <<U.RAO>>04758000
         PARSE'ERR(ERRNUM := FILESYSDEFDEV, PARMPTR);          <<01200>>04760000
         RETURN                                                <<U.RAO>>04762000
         END;                                                  <<U.RAO>>04764000
      @BPTR:=@DEV:=@PARMPTR; << SET AT 1ST CHAR OF DEV >>      <<01117>>04766000
      TOS:=PARMS(PARMNUM-1); << CURRENT PARM >>                <<01117>>04768000
      DEVLEN:=PARMLEN;                                         <<01117>>04770000
      IF PARMLEN > MAXDEVLEN THEN                              <<04171>>04772000
         BEGIN                                                 <<04171>>04774000
            DDEL;                                              <<04171>>04776000
            ERRNUM := FILEDEVNAME2LNG;                         <<04171>>04778000
            FLUSH'COMMAND;                                     <<04171>>04780000
                                                               <<04171>>04782000
         END;                                                  <<04171>>04784000
      DELB; << DELETE POINTER WORD >>                          <<01117>>04786000
      IF TOS.(10:1) THEN << DEV CONTAINS SPECIALS >>           <<01117>>04788000
         BEGIN                                                 <<01117>>04790000
           MOVE DEV := DEV WHILE AN,1;                         <<04171>>04792000
           STOP := FALSE;                                      <<04171>>04794000
           DO                                                  <<04171>>04796000
              BEGIN                                            <<04171>>04798000
                 IF BPS0 = "#" THEN                            <<04171>>04800000
                    BEGIN                                      <<04171>>04802000
                       IF (S0 - @BPTR) > MAXDEVCLASSLEN THEN   <<04171>>04804000
                          BEGIN                                <<04171>>04806000
                             DEL;                              <<04171>>04808000
                             ERRNUM := FILEDSNAME2LONG;        <<04171>>04810000
                             FLUSH'COMMAND;                    <<04171>>04812000
                                                               <<04171>>04814000
                          END;                                 <<04171>>04816000
                       TOS := TOS + 1;                         <<04171>>04818000
                       @BPTR := S0;                            <<04171>>04820000
                       ASSEMBLE(DUP);                          <<04171>>04822000
                       MOVE * := * WHILE AN,1;                 <<04171>>04824000
                    END                                        <<04171>>04826000
                 ELSE                                          <<04171>>04828000
                 IF BPS0 = " " THEN                            <<04171>>04830000
                    BEGIN                                      <<04171>>04832000
                       IF PARMLEN > (S0 - @DEV) THEN           <<04171>>04834000
                          BEGIN                                <<04171>>04836000
                             DEL;                              <<04171>>04838000
                             ERRNUM := FILEINVALDEVNAME;       <<04171>>04840000
                             FLUSH'COMMAND;                    <<04171>>04842000
                                                               <<04171>>04844000
                          END                                  <<04171>>04846000
                       ELSE                                    <<04171>>04848000
                          BEGIN                                <<04171>>04850000
                             DEL;                              <<04171>>04852000
                             STOP := TRUE;                     <<04171>>04854000
                          END;                                 <<04171>>04856000
                    END                                        <<04171>>04858000
                 ELSE                                          <<04171>>04860000
                 IF BPS0 = BDELIMS(NEXTDELIM) THEN             <<04171>>04862000
                    BEGIN                                      <<04171>>04864000
                       DEL;                                    <<04171>>04866000
                       STOP := TRUE;                           <<04171>>04868000
                    END                                        <<04171>>04870000
                 ELSE                                          <<04171>>04872000
                    BEGIN                                      <<04171>>04874000
                       DEL;                                    <<04171>>04876000
                       ERRNUM := FILEINVALDEVNAME;             <<04171>>04878000
                       FLUSH'COMMAND;                          <<04171>>04880000
                                                               <<04171>>04882000
                    END;                                       <<04171>>04884000
              END UNTIL STOP;                                  <<04171>>04886000
                                                               <<04171>>04888000
        END  << special character inside dev >>                <<04171>>04890000
     ELSE                                                      <<04171>>04892000
        BEGIN                                                  <<04171>>04894000
           IF DEVLEN > MAXDEVCLASSLEN THEN                              04896000
              BEGIN                                                     04898000
                 ERRNUM := FILEDEVNAME2LNG;                             04900000
                 FLUSH'COMMAND;                                         04902000
              END;                                                      04904000
           X := GETDEVINFO(DEV,DEVINFO) + 1;                   <<04171>>04906000
           CASE *X OF                                          <<04171>>04908000
              BEGIN                                            <<04171>>04910000
                 << virtual device >>                          <<04171>>04912000
                 BEGIN                                         <<04171>>04914000
                    ERRNUM := FILEVIRTUALDEV;                  <<04171>>04916000
                    FLUSH'COMMAND;                             <<04171>>04918000
                 END;                                          <<04171>>04920000
                 << ok >>                                      <<04171>>04922000
                    ;                                          <<04171>>04924000
                 << invalid class >>                           <<04171>>04926000
                 BEGIN                                         <<04171>>04928000
                    ERRNUM := FILEINVLDCLASPEC;                <<04171>>04930000
                    FLUSH'COMMAND;                             <<04171>>04932000
                 END;                                          <<04171>>04934000
                 << unknown class name >>                      <<04171>>04936000
                 BEGIN                                         <<04171>>04938000
                    ERRNUM := FILEUNKNOWNDEV;                  <<04171>>04940000
                    FLUSH'COMMAND;                             <<04171>>04942000
                 END;                                          <<04171>>04944000
                 << unknown logical device number >>           <<04171>>04946000
                 BEGIN                                         <<04171>>04948000
                    ERRNUM := FILEDONTKNOWLDEV;                <<04171>>04950000
                    FLUSH'COMMAND;                             <<04171>>04952000
                 END;                                          <<04171>>04954000
              END; << case of GETDEVINFO returns >>            <<04171>>04956000
        END; << device w/o special characters >>               <<04171>>04958000
      END;  <<PROCESSING OF DEVICE NAME>>                      <<U.RAO>>04960000
   IF (ERRNUM=0) AND (NEXTDELIM=COMMA) THEN                    <<U.RAO>>04962000
      BEGIN  <<MORE PARAMETERS, CHECK FOR OUTPRI>>             <<U.RAO>>04964000
      GETNEXT;                                                 <<U.RAO>>04966000
      IF (COMTYPE=BUILD) OR (COMTYPE=OLD) OR                   <<U.RAO>>04968000
            ((COMTYPE=SYSDEF) LAND (FOPTIONS.DEFAULTDES<>1)) THEN       04970000
         PARSE'ERR(ERRNUM := FILEOUTPRINOT, PARMPTR)           <<01200>>04972000
      ELSE IF PARMLEN <> 0 THEN  <<OUTPRI EVIDENTLY SPECIFIED>><<U.RAO>>04974000
         BEGIN                                                 <<U.RAO>>04976000
         FLAGOUTPRI := TRUE;                                   <<U.RAO>>04978000
         OUTPRI := BINARY(PARMPTR, PARMLEN);                   <<U.RAO>>04980000
         IF <> OR NOT(1<= OUTPRI <= 13) THEN                   <<U.RAO>>04982000
            PARSE'ERR(ERRNUM := FILEOUTPRIINVLD, PARMPTR);     <<01200>>04984000
         END;                                                  <<U.RAO>>04986000
      IF (ERRNUM=0) AND (NEXTDELIM=COMMA) THEN                 <<U.RAO>>04988000
         BEGIN  <<FURTHER PARAMETER(S)>>                       <<U.RAO>>04990000
         GETNEXT;                                              <<U.RAO>>04992000
         IF PARMLEN <> 0 THEN   <<NUMCOPIES SPECIFIED>>        <<U.RAO>>04994000
            BEGIN                                              <<U.RAO>>04996000
            FLAGNUMCOPIES := TRUE;                             <<U.RAO>>04998000
            NUMCOPIES := BINARY(PARMPTR, PARMLEN);             <<U.RAO>>05000000
            IF <> OR NOT(1 <= NUMCOPIES <= 127) THEN           <<U.RAO>>05002000
               PARSE'ERR(ERRNUM := FILENUMCOPINVLD, PARMPTR);  <<01200>>05004000
            END;                                               <<U.RAO>>05006000
         END;  <<NUMCOPIES CASE>>                              <<U.RAO>>05008000
      END;  <<SPOOLING PARAMETERS>>                            <<U.RAO>>05010000
   IF ERRNUM = 0 THEN                                          <<U.RAO>>05012000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>05014000
         PROCDEV := TRUE                                       <<U.RAO>>05016000
      ELSE                                                     <<U.RAO>>05018000
         BEGIN  <<EXTRANEOUS PARAMETERS>>                      <<U.RAO>>05020000
         GETNEXT;                                              <<U.RAO>>05022000
         PARSE'ERR(ERRNUM := FILEDEVXPARMS, PARMPTR);          <<01200>>05024000
      END;                                                     <<U.RAO>>05026000
   END;                                                        <<U.RAO>>05028000
END;  <<SUBROUTINE PROCDEV>>                                   <<U.RAO>>05030000
                                                               <<U.RAO>>05032000
<<                 *********************                   >>  <<U.RAO>>05034000
<<                 *      PROCREC      *                   >>  <<U.RAO>>05036000
<<                 *********************                   >>  <<U.RAO>>05038000
                                                               <<U.RAO>>05040000
LOGICAL SUBROUTINE PROCREC;                                    <<U.RAO>>05042000
<<SYNTAX  REC=[recsize][,[blockfactor][,[F/V/U][,[BINARY/ASCII]]]]>>    05044000
BEGIN                                                          <<U.RAO>>05046000
PROCREC := FALSE;                                              <<U.RAO>>05048000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>05050000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>05052000
ELSE                                                           <<U.RAO>>05054000
   BEGIN  <<PARSE PARAMETER LIST>>                             <<U.RAO>>05056000
   IF FLAGRECSIZE OR FLAGBLOCKFACTOR OR FLAGRECFMT OR FLAGASCII THEN    05058000
      BEGIN  <<REDUNDANTLY SPECIFIED, WARN, CLEAN UP>>         <<U.RAO>>05060000
      PARSE'ERR(-FILERECOVERRIDE, PARMPTR);                    <<01200>>05062000
      FLAGRECSIZE := FALSE;                                    <<U.RAO>>05064000
      FLAGBLOCKFACTOR := FALSE;                                <<U.RAO>>05066000
      FLAGRECFMT := FALSE;                                     <<U.RAO>>05068000
      FOPTIONS.RECORDFMT := 0;  <<DEFAULT TO F>>               <<U.RAO>>05070000
      FLAGASCII := FALSE;                                      <<U.RAO>>05072000
      FOPTIONS.ASCIIBINARY := 0;  <<DEFAULT TO BINARY>>        <<U.RAO>>05074000
      END;                                                     <<U.RAO>>05076000
   <<FIRST CANDIDATE IS RECSIZE>>                              <<U.RAO>>05078000
   GETNEXT;                                                    <<U.RAO>>05080000
   IF PARMLEN <> 0 THEN  <<RECSIZE EVIDENTLY SPECIFIED>>       <<U.RAO>>05082000
      BEGIN                                                    <<U.RAO>>05084000
      FLAGRECSIZE := TRUE;                                     <<U.RAO>>05086000
      RECSIZE := BINARY(PARMPTR, PARMLEN);                     <<U.RAO>>05088000
      IF <> OR (RECSIZE = 0) THEN                              <<U.RAO>>05090000
         PARSE'ERR(ERRNUM := FILEBADRECSIZE, PARMPTR);         <<01200>>05092000
      END;                                                     <<U.RAO>>05094000
   IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN                    <<U.RAO>>05096000
      BEGIN <<FURTHER PARAMETERS TO PARSE>>                    <<U.RAO>>05098000
      <<NEXT CANDIDATE IS THE BLOCKING FACTOR>>                <<U.RAO>>05100000
      GETNEXT;                                                 <<U.RAO>>05102000
      IF PARMLEN <> 0 THEN  <<BLOCKING FACTOR SPECIFIED>>      <<U.RAO>>05104000
         BEGIN                                                 <<U.RAO>>05106000
         FLAGBLOCKFACTOR := TRUE;                              <<U.RAO>>05108000
         BLOCKFACTOR := BINARY(PARMPTR, PARMLEN);              <<U.RAO>>05110000
         IF <> OR NOT (1 <= BLOCKFACTOR <= 255) THEN           <<U.RAO>>05112000
            PARSE'ERR(ERRNUM := FILEBADBLOCKING, PARMPTR);     <<01200>>05114000
         END;                                                  <<U.RAO>>05116000
      IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN                 <<U.RAO>>05118000
         BEGIN  <<FURTHER PARAMETERS, NEXT IS RECORD FORMAT>>  <<U.RAO>>05120000
         GETNEXT;                                              <<U.RAO>>05122000
         IF PARMLEN<>0 THEN  <<RECORD FORMAT SPECIFIED>>       <<U.RAO>>05124000
            BEGIN                                              <<U.RAO>>05126000
            FLAGRECFMT := TRUE;                                <<U.RAO>>05128000
            IF (PARMLEN=1) AND (PARMPTR="F") THEN              <<U.RAO>>05130000
               FOPTIONS.RECORDFMT := 0                         <<U.RAO>>05132000
            ELSE IF (PARMLEN=1) AND (PARMPTR="V") THEN         <<U.RAO>>05134000
               FOPTIONS.RECORDFMT := 1                         <<U.RAO>>05136000
            ELSE IF (PARMLEN=1) AND (PARMPTR="U") THEN         <<U.RAO>>05138000
               FOPTIONS.RECORDFMT := 2                         <<U.RAO>>05140000
            ELSE   <<UNKNOWN RECORD FORMAT>>                   <<U.RAO>>05142000
               PARSE'ERR(ERRNUM := FILEUNKRECFMT, PARMPTR);    <<01200>>05144000
            END;                                               <<U.RAO>>05146000
         IF (NEXTDELIM=COMMA) AND (ERRNUM=0) THEN              <<U.RAO>>05148000
            BEGIN   <<FURTHER PARAMETER(S)>>                   <<U.RAO>>05150000
            GETNEXT;  <<NEXT CANDIDATE IS BINARY/ASCII>>       <<U.RAO>>05152000
            IF PARMLEN <> 0 THEN   <<ASCII/BINARY SPECIFIED>>  <<U.RAO>>05154000
               BEGIN                                           <<U.RAO>>05156000
               FLAGASCII := TRUE;                              <<U.RAO>>05158000
               IF (PARMLEN=5) AND (PARMPTR="ASCII") THEN       <<U.RAO>>05160000
                  FOPTIONS.ASCIIBINARY := TRUE                 <<U.RAO>>05162000
               ELSE IF (PARMLEN=6) AND (PARMPTR="BINARY") THEN <<U.RAO>>05164000
                  FOPTIONS.ASCIIBINARY := FALSE                <<U.RAO>>05166000
               ELSE                                            <<U.RAO>>05168000
                  PARSE'ERR(ERRNUM:=FILEASCIIINVALD, PARMPTR); <<01200>>05170000
               END;                                            <<U.RAO>>05172000
            END;                                               <<U.RAO>>05174000
         END;                                                  <<U.RAO>>05176000
      END;                                                     <<U.RAO>>05178000
   IF ERRNUM = 0 THEN                                          <<U.RAO>>05180000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>05182000
         PROCREC := TRUE                                       <<U.RAO>>05184000
      ELSE  <<EXTRANEOUS DELIMITER - UNKNOWN PARAMETER?>>      <<U.RAO>>05186000
         BEGIN                                                 <<U.RAO>>05188000
         GETNEXT;                                              <<U.RAO>>05190000
         PARSE'ERR(ERRNUM := FILERECXTRANPRM, PARMPTR);        <<01200>>05192000
         END;                                                  <<U.RAO>>05194000
   END;                                                        <<U.RAO>>05196000
END;   <<PROCREC>>                                             <<U.RAO>>05198000
                                                               <<U.RAO>>05200000
<<                 *********************                   >>  <<U.RAO>>05202000
<<                 *     PROCFCODE     *                   >>  <<U.RAO>>05204000
<<                 *********************                   >>  <<U.RAO>>05206000
                                                               <<U.RAO>>05208000
LOGICAL SUBROUTINE PROCFCODE;                                  <<U.RAO>>05210000
BEGIN                                                          <<U.RAO>>05212000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>05214000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>05216000
ELSE                                                           <<U.RAO>>05218000
   BEGIN   <<PARSE PARAMETER>>                                 <<U.RAO>>05220000
   GETNEXT;                                                    <<U.RAO>>05222000
   FLAGFILECODE := TRUE;                                       <<U.RAO>>05224000
   IF <> THEN   <<REDUNDANTLY SPECIFIED>>                      <<U.RAO>>05226000
      PARSE'ERR(-FILEFCODEREDUND, PARMPTR);                    <<01200>>05228000
   IF PARMLEN = 0 THEN  <<MISSING, DEFAULT TO 0>>              <<U.RAO>>05230000
      BEGIN                                                    <<U.RAO>>05232000
      FILECODE := 0;                                           <<U.RAO>>05234000
      PARSE'ERR(-FILEFCODEDEFALT, PARMPTR);                    <<01200>>05236000
      END                                                      <<U.RAO>>05238000
   ELSE  <<FILE CODE PARAMETER PRESENT>>                       <<U.RAO>>05240000
      BEGIN                                                    <<U.RAO>>05242000
      IF (PARMPTR<>NUMERIC) AND (PARMPTR<>"+") AND (PARMPTR<>"-") THEN  05244000
         BEGIN  <<APPARENTLY A NAMED CODE>>                    <<U.RAO>>05246000
         GET'FILECODE(FILECODE,PARMPTR,PARMLEN);               <<01454>>05248000
         IF <> THEN                                            <<01454>>05250000
            PARSE'ERR(ERRNUM := FILEUNKFCODE, PARMPTR);        <<01454>>05252000
         END                                                   <<U.RAO>>05254000
      ELSE   <<NUMERIC FILE CODE>>                             <<U.RAO>>05256000
         BEGIN                                                 <<U.RAO>>05258000
         FILECODE := BINARY(PARMPTR, PARMLEN);                 <<U.RAO>>05260000
         IF <> OR (FILECODE < 0) THEN                          <<U.RAO>>05262000
            PARSE'ERR(ERRNUM := FILEFCODEVALUE, PARMPTR);      <<01200>>05264000
         END;                                                  <<U.RAO>>05266000
      END;                                                     <<U.RAO>>05268000
   END;                                                        <<U.RAO>>05270000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>05272000
   PROCFCODE := FALSE                                          <<U.RAO>>05274000
ELSE IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN        <<U.RAO>>05276000
   BEGIN                                                       <<U.RAO>>05278000
   GETNEXT;                                                    <<U.RAO>>05280000
   PROCFCODE := FALSE;                                         <<U.RAO>>05282000
   PARSE'ERR(ERRNUM := FILECODEXTRNDEL, PARMPTR);              <<01200>>05284000
   END                                                         <<U.RAO>>05286000
ELSE                                                           <<U.RAO>>05288000
   PROCFCODE := TRUE;                                          <<U.RAO>>05290000
END;  <<PROCFCODE>>                                            <<U.RAO>>05292000
                                                               <<U.RAO>>05294000
<<                 *********************                   >>  <<U.RAO>>05296000
<<                 *    PROCACCESS     *                   >>  <<U.RAO>>05298000
<<                 *********************                   >>  <<U.RAO>>05300000
                                                               <<U.RAO>>05302000
LOGICAL SUBROUTINE PROCACCESS;                                 <<U.RAO>>05304000
BEGIN                                                          <<U.RAO>>05306000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>05308000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>05310000
ELSE                                                           <<U.RAO>>05312000
   BEGIN                                                       <<U.RAO>>05314000
   MOVE ACCTYPES := PACCTYPES, (ACCTYPEL);                     <<U.RAO>>05316000
   FLAGACCESSTYPE := TRUE;                                     <<U.RAO>>05318000
   IF <> THEN                                                  <<U.RAO>>05320000
      PARSE'ERR(-FILEACCESSREDND, PARMPTR);                    <<01200>>05322000
   GETNEXT;                                                    <<U.RAO>>05324000
   IF PARMLEN = 0 THEN  <<ACCESS SPECIFICATION REQUIRED>>      <<U.RAO>>05326000
      PARSE'ERR(ERRNUM := FILEACCREQVALUE, PARMPTR)            <<01200>>05328000
   ELSE                                                        <<U.RAO>>05330000
      BEGIN  <<PARAMETER SUPPLIED, SCAN TABLE FOR IT>>         <<U.RAO>>05332000
      TOS := SEARCH(PARMPTR, PARMLEN, ACCTYPES) -1;            <<U.RAO>>05334000
      IF < THEN  <<UNKNOWN ACCESS TYPE>>                       <<U.RAO>>05336000
         BEGIN                                                 <<U.RAO>>05338000
         DEL;                                                  <<U.RAO>>05340000
         PARSE'ERR(ERRNUM := FILEACCINVALID, PARMPTR)          <<01200>>05342000
         END                                                   <<U.RAO>>05344000
      ELSE                                                     <<U.RAO>>05346000
         AOPTIONS.ACCESSTYPE := TOS;  <<ORDINAL IN PACCTYPES>> <<U.RAO>>05348000
      END                                                      <<U.RAO>>05350000
   END;                                                        <<U.RAO>>05352000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>05354000
   PROCACCESS := FALSE                                         <<U.RAO>>05356000
ELSE IF (NEXTDELIM <> CR) AND (NEXTDELIM <> SEMICOLON) THEN    <<U.RAO>>05358000
   BEGIN  <<EXTRANEOUS PARAMETER OR SYNTAX ERROR>>             <<U.RAO>>05360000
   GETNEXT;                                                    <<U.RAO>>05362000
   PROCACCESS := FALSE;                                        <<U.RAO>>05364000
   PARSE'ERR(ERRNUM := FILEACCXTRNPARM, PARMPTR);              <<01200>>05366000
   END                                                         <<U.RAO>>05368000
ELSE                                                           <<U.RAO>>05370000
   PROCACCESS := TRUE                                          <<U.RAO>>05372000
END;  <<SUBROUTINE PROCACCESS>>                                <<U.RAO>>05374000
                                                               <<U.RAO>>05376000
<<                 *********************                   >>  <<U.RAO>>05378000
<<                 *     PROCFBUF      *                   >>  <<U.RAO>>05380000
<<                 *********************                   >>  <<U.RAO>>05382000
                                                               <<U.RAO>>05384000
LOGICAL SUBROUTINE PROCBUF;                                    <<U.RAO>>05386000
BEGIN  <<PARSES BUF= PARAMETER>>                               <<U.RAO>>05388000
AOPTIONS.NOBUF := FALSE;                                       <<U.RAO>>05390000
FLAGBUFINHIBIT := TRUE; <<SO NOBUF IS SET FALSE IN FOPEN>>     <<00886>>05392000
IF <> THEN     <<NOBUF PREVIOUSLY SPECIFIED>>                  <<U.RAO>>05394000
   PARSE'ERR(-FILENOBUFBUF,PARMPTR);                           <<01200>>05396000
NUMBUFFERS := 2;  <<DEFAULT>>                                  <<U.RAO>>05398000
FLAGNUMBUFS := TRUE;                                           <<U.RAO>>05400000
IF <> THEN   <<BUF= PREVIOUSLY SPECIFIED>>                     <<U.RAO>>05402000
   PARSE'ERR(-FILEBUFOVERRIDE, PARMPTR);                       <<01200>>05404000
IF NEXTDELIM = EQUALS THEN   <<NUMBER OF BUFFERS SPECIFIED>>   <<U.RAO>>05406000
   BEGIN                                                       <<U.RAO>>05408000
   GETNEXT;                                                    <<U.RAO>>05410000
   IF PARMLEN <> 0 THEN                                        <<U.RAO>>05412000
      BEGIN                                                    <<U.RAO>>05414000
      NUMBUFFERS := BINARY(PARMPTR, PARMLEN);                  <<U.RAO>>05416000
      IF <> OR NOT(0 <= NUMBUFFERS <= 16) THEN                 <<U.RAO>>05418000
         PARSE'ERR(ERRNUM := FILEINVLDBUFNUM, PARMPTR);        <<01200>>05420000
      END                                                      <<U.RAO>>05422000
   END;                                                        <<U.RAO>>05424000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>05426000
   PROCBUF := FALSE                                            <<U.RAO>>05428000
ELSE IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN        <<U.RAO>>05430000
   BEGIN <<EXTRANEOUS PARAMETER>>                              <<U.RAO>>05432000
   GETNEXT;                                                    <<U.RAO>>05434000
   PROCBUF := FALSE;                                           <<U.RAO>>05436000
   PARSE'ERR(ERRNUM := FILEBUFXTRANDEL, PARMPTR);              <<01200>>05438000
   END                                                         <<U.RAO>>05440000
ELSE                                                           <<U.RAO>>05442000
   PROCBUF := TRUE;                                            <<U.RAO>>05444000
END;                                                           <<U.RAO>>05446000
                                                               <<01549>>05448000
                                                               <<01549>>05450000
<<                 *********************                   >>  <<01549>>05452000
<<                 *     PROCENV       *                   >>  <<01549>>05454000
<<                 *********************                   >>  <<01549>>05456000
                                                               <<01549>>05458000
LOGICAL SUBROUTINE PROCENV;                                    <<01549>>05460000
<<PARSES ENV PARAMETER>>                                       <<01549>>05462000
<<CHECKS FOR EQUAL SIGN>>                                      <<01549>>05464000
<<VALID FILENAME>>                                             <<01549>>05466000
<< OK IF NO FILE NAME, GLOBAL ENV. FILE WILL >>                <<01851>>05468000
<< BE USED BY FOPEN.                         >>                <<01851>>05470000
                                                               <<01549>>05472000
BEGIN                                                          <<01549>>05474000
   PROCENV := FALSE;                                           <<01549>>05476000
   IF NEXTDELIM <> EQUALS THEN                                 <<01549>>05478000
      PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))     <<01549>>05480000
   ELSE                                                        <<01549>>05482000
      BEGIN                                                    <<01549>>05484000
         IF FLAGENV THEN                                       <<01549>>05486000
            BEGIN   <<REDUNDANTLY SPECIFIED ENV PARM>>         <<01549>>05488000
               PARSE'ERR(-FILEENVOVERRIDE,PARMPTR);            <<01549>>05490000
               FLAGENV := FALSE; <<WARN USER>>                 <<01549>>05492000
            END;                                               <<01549>>05494000
         GETNEXT;                                              <<01851>>05496000
         IF PARMLEN <> 0 THEN                                  <<01851>>05498000
            IF NOT CHECKENVFILEDESIG THEN                      <<02523>>05500000
               RETURN;                                         <<01851>>05502000
         @ENV := @PARMPTR;                                     <<01851>>05504000
         ENVLEN := PARMLEN;                                    <<01851>>05506000
         FLAGENV := TRUE;                                      <<01549>>05508000
         IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN       <<01851>>05510000
            PROCENV := TRUE                                    <<01851>>05512000
         ELSE                                                  <<01851>>05514000
            BEGIN                                              <<01851>>05516000
               GETNEXT;                                        <<01851>>05518000
               PARSE'ERR(ERRNUM:=FILEENVXPARMS,PARMPTR);       <<01851>>05520000
            END;                                               <<01851>>05522000
         END;                                                  <<01549>>05524000
    END; <<SUBROUTINE PROCENV>>                                <<01549>>05526000
                                                               <<01549>>05528000
                                                               <<01549>>05530000
                                                               <<01549>>05532000
<<                 *********************                   >>  <<01549>>05534000
<<                 *     PROCOUTQ      *                   >>  <<01549>>05536000
<<                 *********************                   >>  <<01549>>05538000
                                                               <<01549>>05540000
LOGICAL SUBROUTINE PROCOUTQ;                                   <<01549>>05542000
<<PARSES OUTQ PARAMETER>>                                      <<01549>>05544000
<<CHECKS FOR EQUAL SIGN>>                                      <<01549>>05546000
<<VALID ALPHANUMERIC OUTQ NAME UP TO 8 CHARS>>                 <<01549>>05548000
<< OK IF NO OUTQNAME, GLOBAL OUTQ NAME WILL >>                 <<01851>>05550000
<< BE USED BY FOPEN.                        >>                 <<01851>>05552000
                                                               <<01549>>05554000
BEGIN                                                          <<01549>>05556000
                                                               <<01549>>05558000
   PROCOUTQ := FALSE;                                          <<01549>>05560000
   IF NEXTDELIM <> EQUALS THEN                                 <<01549>>05562000
      PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))     <<01549>>05564000
   ELSE                                                        <<01549>>05566000
      BEGIN                                                    <<01549>>05568000
         IF FLAGOUTQ THEN                                      <<01549>>05570000
         BEGIN  <<REDUNDANTLY SPECIFIED OUTQ PARM>>            <<01549>>05572000
            PARSE'ERR(-FILEOUTQOVERRIDE,PARMPTR);              <<01549>>05574000
            FLAGOUTQ := FALSE;                                 <<01549>>05576000
         END;                                                  <<01549>>05578000
         GETNEXT;                                              <<01549>>05580000
            MOVE PARMPTR := PARMPTR WHILE ANS;                 <<01549>>05582000
            TOS := PARMS(PARMNUM-1); <<DOUBLE FOR OUTQNAME>>   <<01549>>05584000
            DELB;  <<POP POINTER WORD>>                        <<01549>>05586000
            IF TOS.(10:1) THEN <<OUTQNAME CONTAINS SPECIALS>>  <<01549>>05588000
               PARSE'ERR(ERRNUM := OUTQNAMEALPHNUM,PARMPTR)    <<01549>>05590000
            ELSE                                               <<01549>>05592000
               IF PARMLEN > 8 THEN                             <<01549>>05594000
               PARSE'ERR(ERRNUM := OUTQNAME2LNG,PARMPTR)       <<01549>>05596000
            ELSE                                               <<01549>>05598000
               IF PARMPTR = NUMERIC THEN                       <<01549>>05600000
               PARSE'ERR(ERRNUM := OUTQNAMENOTALPH,PARMPTR)    <<01549>>05602000
            ELSE                                               <<01549>>05604000
               BEGIN  <<GOOD OUTQ NAME>>                       <<01549>>05606000
                  @OUTQ := @PARMPTR;                           <<01851>>05608000
                  OUTQLEN := PARMLEN;                          <<01851>>05610000
                  FLAGOUTQ := TRUE;                            <<01549>>05612000
                  IF ERRNUM = 0 THEN                           <<01549>>05614000
                     IF (NEXTDELIM = CR) OR                    <<01549>>05616000
                        (NEXTDELIM = SEMICOLON) THEN           <<01549>>05618000
                     PROCOUTQ := TRUE                          <<01549>>05620000
                     ELSE                                      <<01549>>05622000
                        BEGIN                                  <<01549>>05624000
                           GETNEXT;                            <<01549>>05626000
                           PARSE'ERR(ERRNUM := FILEOUTQXPARMS, <<01549>>05628000
                                  PARMPTR);                    <<01549>>05630000
                        END;                                   <<01549>>05632000
               END;                                            <<01549>>05634000
      END;                                                     <<01549>>05636000
END; <<SUBROUTINE PROCOUTQ>>                                   <<01549>>05638000
                                                               <<01549>>05640000
                                                               <<01549>>05642000
<<                 ********************                    >>  <<02569>>05644000
<<                 *     PROCDENS     *                    >>  <<02569>>05646000
<<                 ********************                    >>  <<02569>>05648000
LOGICAL SUBROUTINE PROCDENS;                                   <<02569>>05650000
<<Parses the DEN parameter. Checks for equal sign followed >>  <<02569>>05652000
<<by an optional density value.                            >>  <<02569>>05654000
<<SYNTAX:   ;DEN=[1600/6250]                               >>  <<02569>>05656000
BEGIN                                                          <<02569>>05658000
PROCDENS:=FALSE;                                               <<02569>>05660000
IF NEXTDELIM <> EQUALS THEN                                    <<02569>>05662000
  PARSE'ERR(ERRNUM:=FILEREQEQSIGN,PARMPTR(PARMLEN))            <<02569>>05664000
ELSE                                                           <<02569>>05666000
  BEGIN                                                        <<02569>>05668000
     IF FLAGDENS THEN                                          <<02569>>05670000
       BEGIN     <<REDUNDANTLY SPECFIED DENS PARM>>            <<02569>>05672000
          PARSE'ERR(-FILEDENSOVERRID,PARMPTR);                 <<02569>>05674000
          FLAGDENS := FALSE;   <<WARN USER>>                   <<02569>>05676000
       END;      <<REDUNDANTLY SPECIFIED DENS PARM>>           <<02569>>05678000
     GETNEXT;    <<LOOK FOR DENSITY VALUE>>                    <<02569>>05680000
     IF PARMLEN <> 0 THEN                                      <<02569>>05682000
       BEGIN           <<PARM FOUND>>                          <<02569>>05684000
          IF PARSE'DENSITY(PARMPTR,PARMLEN,DUMMY) THEN         <<02569>>05686000
             FLAGDENS := TRUE                                  <<02569>>05688000
          ELSE                                                 <<02569>>05690000
             BEGIN      << Invalid density subparameter >>     <<02569>>05692000
                PARSE'ERR(ERRNUM:=FILEDENSINVAL,PARMPTR);      <<02569>>05694000
                FLAGDENS := FALSE;                             <<02569>>05696000
             END;                                              <<02569>>05698000
       END             <<PARM FOUND>>                          <<02569>>05700000
     ELSE FLAGDENS := TRUE;    <<DEFAULT CASE>>                <<02569>>05702000
     IF FLAGDENS THEN        << GOOD PARM >>                   <<02569>>05704000
       BEGIN                                                   <<02569>>05706000
          @DENS := @PARMPTR;                                   <<02569>>05708000
          DENSLEN := PARMLEN;                                  <<02569>>05710000
          IF ERRNUM = 0  THEN                                  <<02569>>05712000
            IF (NEXTDELIM = CR) OR (NEXTDELIM = SEMICOLON)     <<02569>>05714000
              THEN PROCDENS := TRUE                            <<02569>>05716000
            ELSE BEGIN                                         <<02569>>05718000
                 GETNEXT;                                      <<02569>>05720000
                 PARSE'ERR(ERRNUM:=FILEDENSXPARM,PARMPTR);     <<02569>>05722000
                 END;                                          <<02569>>05724000
       END;     <<GOOD PARM>>                                  <<02569>>05726000
  END;                                                         <<02569>>05728000
END;      << SUBROUTINE PROCDENS >>                            <<02569>>05730000
                                                               <<02569>>05732000
                                                               <<02569>>05734000
<<                 *********************                   >>  <<U.RAO>>05736000
<<                 *      PROCKEY      *                   >>  <<U.RAO>>05738000
<<                 *********************                   >>  <<U.RAO>>05740000
                                                               <<U.RAO>>05742000
LOGICAL SUBROUTINE PROCKEY;                                    <<U.RAO>>05744000
<<Processes the parameter list.  Note that it is only called       >>   05746000
<<if it appears that a parameter list is present.  In general      >>   05748000
<<this routine only controls the parse;  Anything which is even    >>   05750000
<<moderately complex (i.e, has parameters) is done in a further    >>   05752000
<<subroutine.  In essence, we must do four things in this routine. >>   05754000
<<1)  Identify the parameters which are not appropriate to this    >>   05756000
<<    form of the command.                                         >>   05758000
<<2)  Control the scan through the parameter list.  (done with     >>   05760000
<<    a do loop around a case statement.                           >>   05762000
<<3)  Process trivial parameters like WAIT, NOMR and a few others  >>   05764000
<<    which simply involve setting a few bits somewhere.           >>   05766000
<<4)  Look for extraneous subparameters on the trivial parameters. >>   05768000
<<Another thing to note is that for the most part we allow the     >>   05770000
<<user to specify a parameter redundantly, using the latest        >>   05772000
<<occurrence as the controlling one.                               >>   05774000
BEGIN                                                          <<U.RAO>>05776000
PROCKEY := FALSE;                                              <<U.RAO>>05778000
MOVE KEYLIST := PKEYLIST, (PKEYLISTL);                         <<U.RAO>>05780000
<<NOW GET COMTYPE.  COMTYPE IS AN INTEGER INDICATING WHICH >>  <<U.RAO>>05782000
<<TYPE OF COMMAND THIS IS.                                 >>  <<U.RAO>>05784000
IF BUILDFLAG THEN                                              <<U.RAO>>05786000
   COMTYPE := BUILD                                            <<U.RAO>>05788000
ELSE IF FOPTIONS.DEFAULTDES = 0 THEN  <<REGULAR FILEREFERENCE>><<U.RAO>>05790000
   IF FOPTIONS.DOMAIN = 0 THEN                                 <<U.RAO>>05792000
      COMTYPE := NEW                                           <<U.RAO>>05794000
   ELSE                                                        <<U.RAO>>05796000
      COMTYPE := OLD                                           <<U.RAO>>05798000
ELSE IF FOPTIONS.DEFAULTDES = 2 THEN <<$NEWPASS>>              <<U.RAO>>05800000
   COMTYPE := NEW                                              <<U.RAO>>05802000
ELSE IF FOPTIONS.DEFAULTDES = 3 THEN  <<$OLDPASS>>             <<U.RAO>>05804000
   COMTYPE := OLD                                              <<U.RAO>>05806000
ELSE   <<$STDIN, $STDLIST, $STDINX>>                           <<U.RAO>>05808000
   COMTYPE := SYSDEF;                                          <<U.RAO>>05810000
<<NOW DO BODY OF KEYWORD PROCESSING>>                          <<U.RAO>>05812000
DO    <<UNTIL ERROR OR END OF PARAMETERS>>                     <<U.RAO>>05814000
   BEGIN                                                       <<U.RAO>>05816000
   GETNEXT;  <<SET UP NEXT KEYWORD>>                           <<U.RAO>>05818000
   IF PARMLEN = 0 THEN  <<DOUBLED DELIMITER>>                  <<U.RAO>>05820000
      PARSE'ERR(-FILEEXTRANDELIM, PARMPTR)                     <<01200>>05822000
   ELSE   <<NON-BLANK STRING>>                                 <<U.RAO>>05824000
      BEGIN   <<IDENTIFY KEYWORD>>                             <<U.RAO>>05826000
      TOS := SEARCH(PARMPTR, PARMLEN, KEYLIST, DICTPTR);       <<U.RAO>>05828000
      <<BEFORE PROCESSING, CHECK TO SEE THAT THIS KEYWORD IS>> <<U.RAO>>05830000
      <<APPROPRIATE FOR THIS PARTICULAR VERSION OF THE COMMAND><<U.RAO>>05832000
      IF (S0 <> 0)  <<VALID KEY NAME>>   AND                   <<U.RAO>>05834000
         (((1&LSL(COMTYPE)) LAND LOGICAL(DICTPTR)) <> 0) THEN  <<U.RAO>>05836000
         BEGIN  <<KEYWORD OUT OF CONTEXT>>                     <<U.RAO>>05838000
         DEL;  <<POP ORDINAL OF KEYWORD>>                      <<U.RAO>>05840000
         <<FIXUP KEYWORD TO BE PARAMETER TO GENMSG>>           <<U.RAO>>05842000
         TOS := PARMPTR(PARMLEN);                              <<U.RAO>>05844000
         PARMPTR(X) := 0;                                      <<U.RAO>>05846000
         CASE *COMTYPE OF                                      <<U.RAO>>05848000
            BEGIN                                              <<U.RAO>>05850000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTBLD         <<01200>>05852000
            ELSE                                               <<01200>>05854000
               CIERR(ERRNUM:=FILECONTXTBLD,PARMPTR,0,@PARMPTR);<<01200>>05856000
                                                               <<01200>>05858000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTSYSDF       <<01200>>05860000
            ELSE                                               <<01200>>05862000
               CIERR(ERRNUM:=FILECONTXTSYSDF,PARMPTR,0,        <<01200>>05864000
                     @PARMPTR);                                <<01200>>05866000
                                                               <<01200>>05868000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTOLD         <<01200>>05870000
            ELSE                                               <<01200>>05872000
               CIERR(ERRNUM:=FILECONTXTOLD,PARMPTR,0,@PARMPTR);<<01200>>05874000
                                                               <<01200>>05876000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTNEW         <<01200>>05878000
            ELSE                                               <<01200>>05880000
               CIERR(ERRNUM:=FILECONTXTNEW,PARMPTR,0,@PARMPTR);<<01200>>05882000
            END;                                               <<U.RAO>>05884000
         PARMPTR(PARMLEN) := TOS;                              <<U.RAO>>05886000
         RETURN                                                <<U.RAO>>05888000
         END;                                                  <<U.RAO>>05890000
      <<WE KNOW THAT THIS KEYWORD IS APPROPRIATE TO THIS>>     <<U.RAO>>05892000
      <<FORM OF THE FILE OR BUILD COMMAND.  NOW ACTUALLY PROCESS>>      05894000
      <<THE KEYWORD>>                                          <<U.RAO>>05896000
      CASE *TOS OF                                             <<U.RAO>>05898000
         BEGIN                                                 <<U.RAO>>05900000
            BEGIN  <<UNKNOWN KEYWORD>>                         <<U.RAO>>05902000
            IF BUILDFLAG THEN                                  <<U.RAO>>05904000
               PARSE'ERR(ERRNUM := BLDUNKNOWNKEY, PARMPTR)     <<01200>>05906000
            ELSE   <<FILE COMMAND>>                            <<U.RAO>>05908000
               PARSE'ERR(ERRNUM := FILEUNKNOWNKEY, PARMPTR);   <<01200>>05910000
            RETURN;                                            <<U.RAO>>05912000
            END;                                               <<U.RAO>>05914000
                                                               <<U.RAO>>05916000
            <<DEV = >>                                         <<U.RAO>>05918000
            IF NOT PROCDEV THEN RETURN;                        <<U.RAO>>05920000
                                                               <<U.RAO>>05922000
            <<DISC = >>                                        <<U.RAO>>05924000
            IF NOT PROCDISC THEN RETURN;                       <<U.RAO>>05926000
                                                               <<U.RAO>>05928000
            <<REC = >>                                         <<U.RAO>>05930000
            IF NOT PROCREC THEN RETURN;                        <<U.RAO>>05932000
                                                               <<U.RAO>>05934000
            <<FILE CODE>>                                      <<U.RAO>>05936000
            IF NOT PROCFCODE THEN RETURN;                      <<U.RAO>>05938000
                                                               <<U.RAO>>05940000
            <<CCTL>>                                           <<U.RAO>>05942000
            BEGIN                                              <<U.RAO>>05944000
               FOPTIONS.CCTL := TRUE;   <<ALSO CHECKS PREVIOUS STATE>>  05946000
               IF = AND FLAGCCTL THEN   <<INCONSISTENT WITH AND >>      05948000
                  PARSE'ERR(-FILENOCCTLCCTL, PARMPTR);         <<01200>>05950000
               FLAGCCTL := TRUE;                               <<U.RAO>>05952000
            END;                                               <<U.RAO>>05954000
                                                               <<U.RAO>>05956000
            <<NOCCTL>>                                         <<U.RAO>>05958000
            BEGIN                                              <<U.RAO>>05960000
               FOPTIONS.CCTL := FALSE;                         <<U.RAO>>05962000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS CCTL>><<U.RAO>>05964000
                  PARSE'ERR(-FILECCTLNOCCTL, PARMPTR);         <<01200>>05966000
               FLAGCCTL := TRUE;                               <<U.RAO>>05968000
            END;                                               <<U.RAO>>05970000
                                                               <<U.RAO>>05972000
            <<TEMP>>                                           <<U.RAO>>05974000
            BEGIN                                              <<U.RAO>>05976000
               FLAGDISP := TRUE;                               <<U.RAO>>05978000
               IF <> THEN  <<POSSIBLE CONTRADICTION>>          <<U.RAO>>05980000
                  IF DISPOSITION = DELETE THEN                 <<U.RAO>>05982000
                     PARSE'ERR(-FILEDELTEMP, PARMPTR)          <<01200>>05984000
                  ELSE IF DISPOSITION = SAVE THEN              <<U.RAO>>05986000
                     PARSE'ERR(-FILESAVETEMP, PARMPTR);        <<01200>>05988000
               DISPOSITION := TEMP;                            <<U.RAO>>05990000
            END;                                               <<U.RAO>>05992000
                                                               <<U.RAO>>05994000
            <<SAVE>>                                           <<U.RAO>>05996000
            BEGIN                                              <<U.RAO>>05998000
               FLAGDISP := TRUE;                               <<U.RAO>>06000000
               IF <> THEN  <<POSSIBLE CONFLICT WITH PREVIOUS SPEC>>     06002000
                  IF DISPOSITION = DELETE THEN                 <<U.RAO>>06004000
                     PARSE'ERR(-FILEDELSAVE, PARMPTR)          <<01200>>06006000
                  ELSE IF DISPOSITION = TEMP THEN              <<U.RAO>>06008000
                     PARSE'ERR(-FILETEMPSAVE, PARMPTR);        <<01200>>06010000
               DISPOSITION := SAVE;                            <<U.RAO>>06012000
            END;                                               <<U.RAO>>06014000
                                                               <<U.RAO>>06016000
            <<DEL>>                                            <<U.RAO>>06018000
            BEGIN                                              <<U.RAO>>06020000
               FLAGDISP := TRUE;                               <<U.RAO>>06022000
               IF <> THEN  <<POSSIBLE INCONSISTENCY WITH PREVIOUS>>     06024000
                  IF DISPOSITION  = TEMP THEN                  <<U.RAO>>06026000
                     PARSE'ERR(-FILETEMPDEL, PARMPTR)          <<01200>>06028000
                  ELSE IF DISPOSITION = SAVE THEN              <<U.RAO>>06030000
                     PARSE'ERR(-FILESAVEDEL, PARMPTR);         <<01200>>06032000
               DISPOSITION := DELETE;                          <<U.RAO>>06034000
            END;                                               <<U.RAO>>06036000
                                                               <<U.RAO>>06038000
            <<ACCESS>>                                         <<U.RAO>>06040000
            IF NOT PROCACCESS THEN RETURN;                     <<U.RAO>>06042000
                                                               <<U.RAO>>06044000
            <<SHARE>>                                          <<U.RAO>>06046000
            BEGIN                                              <<U.RAO>>06048000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>06050000
               IF <> THEN                                      <<U.RAO>>06052000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<U.RAO>>06054000
                     PARSE'ERR(-FILEEXCLSHARE, PARMPTR)        <<01200>>06056000
                  ELSE IF AOPTIONS.EXCLACCESS = EXCLUSIVEREAD THEN      06058000
                     PARSE'ERR(-FILEEXCLSHARE,PARMPTR);        <<01549>>06060000
               AOPTIONS.EXCLACCESS := SHARE;                   <<U.RAO>>06062000
            END;                                               <<U.RAO>>06064000
                                                               <<U.RAO>>06066000
            <<EAR>>                                            <<U.RAO>>06068000
            BEGIN                                              <<U.RAO>>06070000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>06072000
               IF <> THEN                                      <<U.RAO>>06074000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<U.RAO>>06076000
                     PARSE'ERR(-FILEEXCLEAR, PARMPTR)          <<01200>>06078000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<U.RAO>>06080000
                     PARSE'ERR(-FILESHAREEAR, PARMPTR);        <<01200>>06082000
               AOPTIONS.EXCLACCESS := EXCLUSIVEREAD;           <<U.RAO>>06084000
            END;                                               <<U.RAO>>06086000
                                                               <<01549>>06088000
            <<SEMI>>                                           <<01549>>06090000
            BEGIN                                              <<01549>>06092000
               FLAGEXCLUSIVE := TRUE;                          <<01549>>06094000
               IF <> THEN                                      <<01549>>06096000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<01549>>06098000
                     PARSE'ERR(-FILEEXCLSEMI,PARMPTR)          <<01549>>06100000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<01549>>06102000
                     PARSE'ERR(-FILESHARESEMI,PARMPTR);        <<01549>>06104000
               AOPTIONS.EXCLACCESS := EXCLUSIVEREAD;           <<01549>>06106000
            END;                                               <<01549>>06108000
                                                               <<01549>>06110000
                                                               <<U.RAO>>06112000
            <<EXC>>                                            <<U.RAO>>06114000
            BEGIN                                              <<U.RAO>>06116000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>06118000
               IF <> THEN                                      <<U.RAO>>06120000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVEREAD THEN  <<U.RAO>>06122000
                     PARSE'ERR(-FILEEAREXCL, PARMPTR)          <<01200>>06124000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<U.RAO>>06126000
                     PARSE'ERR(-FILESHAREEXCL, PARMPTR);       <<01200>>06128000
               AOPTIONS.EXCLACCESS := EXCLUSIVE;               <<U.RAO>>06130000
            END;                                               <<U.RAO>>06132000
                                                               <<U.RAO>>06134000
            <<BUF = >>                                         <<U.RAO>>06136000
            IF NOT PROCBUF THEN RETURN;                        <<U.RAO>>06138000
                                                               <<U.RAO>>06140000
            <<NOBUF>>                                          <<U.RAO>>06142000
            BEGIN                                              <<U.RAO>>06144000
               AOPTIONS.NOBUF := TRUE;                         <<U.RAO>>06146000
               FLAGNUMBUFS := FALSE;  << IN CASE PREVIOUS BUF= <<U.RAO>>06148000
               IF <> THEN  <<WAS A PREVIOUS BUF = PARAMETER>>  <<U.RAO>>06150000
                  PARSE'ERR(-FILEBUFNOBUF, PARMPTR);           <<01200>>06152000
               FLAGBUFINHIBIT := TRUE;  <<INHIBIT BUFFERING>>  <<U.RAO>>06154000
            END;                                               <<U.RAO>>06156000
            <<COPY>>                                           <<01549>>06158000
            BEGIN                                              <<01549>>06160000
               AOPTIONS.COPY := TRUE;                          <<01549>>06162000
               IF = AND FLAGCOPY THEN                          <<01549>>06164000
                  PARSE'ERR(-FILENOCOPYCOPY, PARMPTR);         <<01549>>06166000
               FLAGCOPY := TRUE;                               <<01549>>06168000
            END;                                               <<01549>>06170000
                                                               <<01549>>06172000
            <<NOCOPY>>                                         <<01549>>06174000
            BEGIN                                              <<01549>>06176000
               AOPTIONS.COPY := FALSE;                         <<01549>>06178000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS COPY>><<01549>>06180000
                  PARSE'ERR(-FILECOPYNOCOPY, PARMPTR);         <<01549>>06182000
               FLAGCOPY := TRUE;                               <<01549>>06184000
            END;                                               <<01549>>06186000
                                                               <<01549>>06188000
                                                               <<U.RAO>>06190000
            <<MR>>                                             <<U.RAO>>06192000
            BEGIN                                              <<U.RAO>>06194000
               AOPTIONS.MULTIRECORD := TRUE;                   <<U.RAO>>06196000
               IF = AND FLAGMULTIREC THEN                      <<U.RAO>>06198000
                  PARSE'ERR(-FILENOMRMR, PARMPTR);             <<01200>>06200000
               FLAGMULTIREC := TRUE;                           <<U.RAO>>06202000
            END;                                               <<U.RAO>>06204000
                                                               <<U.RAO>>06206000
            <<NOMR>>                                           <<U.RAO>>06208000
            BEGIN                                              <<U.RAO>>06210000
               AOPTIONS.MULTIRECORD := FALSE;                  <<U.RAO>>06212000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS MR>>  <<U.RAO>>06214000
                  PARSE'ERR(-FILEMRNOMR, PARMPTR);             <<01200>>06216000
               FLAGMULTIREC := TRUE;                           <<U.RAO>>06218000
            END;                                               <<U.RAO>>06220000
                                                               <<U.RAO>>06222000
            <<GLOBAL MULTIACCESS>>                             <<01549>>06224000
            BEGIN                                              <<01549>>06226000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>06228000
            IF <> THEN                                         <<01549>>06230000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>06232000
                  BEGIN                                        <<01549>>06234000
                  PARSE'ERR(-FILENOMULTGMULT, PARMPTR);        <<01549>>06236000
                  PARSE'ERR(-FILEMULTIGMULTI, PARMPTR);        <<01549>>06238000
                  END;                                         <<01549>>06240000
            AOPTIONS.MULTIACCESS:=GLOBALMULTI;                 <<01549>>06242000
            END;                                               <<01549>>06244000
            <<LOCAL MULTIACCESS>>                              <<01549>>06246000
            BEGIN                                              <<01549>>06248000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>06250000
            IF <> THEN                                         <<01549>>06252000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>06254000
                  BEGIN                                        <<01549>>06256000
                  PARSE'ERR(-FILENOMULTIMULTI, PARMPTR);       <<01549>>06258000
                  ;  <<ALREADY WAS SET TO LOCAL>>              <<01549>>06260000
                  PARSE'ERR(-FILEGMULTIMULTI, PARMPTR);        <<01549>>06262000
                  END;                                         <<01549>>06264000
            AOPTIONS.MULTIACCESS:=LOCALMULTI;                  <<01549>>06266000
            END;                                               <<01549>>06268000
                                                               <<01549>>06270000
            <<NO MULTIACCESS>>                                 <<01549>>06272000
            BEGIN                                              <<01549>>06274000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>06276000
            IF <> THEN                                         <<01549>>06278000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>06280000
                  BEGIN                                        <<01549>>06282000
                  ;  <<ALREADY SET TO NO MULTIACCESS>>         <<01549>>06284000
                  PARSE'ERR(-FILEMULTINOMULTI, PARMPTR);       <<01549>>06286000
                  PARSE'ERR(-FILEGMULTNOMULT, PARMPTR);        <<01549>>06288000
                  END;                                         <<01549>>06290000
            AOPTIONS.MULTIACCESS:=NOMULTI;                     <<01549>>06292000
            END;                                               <<01549>>06294000
            <<NOLABEL>>                                        <<U.RAO>>06296000
            BEGIN                                              <<U.RAO>>06298000
               FOPTIONS.TAPELABELF := FALSE;                   <<U.RAO>>06300000
               IF <> THEN  <<INCONSISTENTLY SPECIFIED>>        <<U.RAO>>06302000
                  BEGIN                                        <<U.RAO>>06304000
                  PARSE'ERR(-FILELABELNOLABEL, PARMPTR);       <<01200>>06306000
                  TAPELABELLEN := 0;  <<RESET>>                <<U.RAO>>06308000
                  END;                                         <<U.RAO>>06310000
               FLAGLABELEDTAPE := TRUE;                        <<01099>>06312000
            END;                                               <<U.RAO>>06314000
                                                               <<U.RAO>>06316000
            <<FORMS>>                                          <<U.RAO>>06318000
            IF NOT CHECKFORMMSG THEN RETURN;                   <<U.RAO>>06320000
                                                               <<U.RAO>>06322000
            <<LABEL=>>                                         <<U.RAO>>06324000
            IF NOT CHECKLABELDATA THEN RETURN;                 <<U.RAO>>06326000
                                                               <<U.RAO>>06328000
            <<LOCK>>                                           <<U.RAO>>06330000
            BEGIN                                              <<U.RAO>>06332000
               AOPTIONS.LOCKING := TRUE;                       <<U.RAO>>06334000
               IF = AND FLAGDYNLOCKING THEN                    <<U.RAO>>06336000
                  PARSE'ERR(-FILENOLOCKLOCK, PARMPTR);         <<01200>>06338000
               FLAGDYNLOCKING := TRUE;                         <<U.RAO>>06340000
            END;                                               <<U.RAO>>06342000
                                                               <<U.RAO>>06344000
            <<NOLOCK>>                                         <<U.RAO>>06346000
            BEGIN                                              <<U.RAO>>06348000
               AOPTIONS.LOCKING := FALSE;                      <<04.RO>>06350000
               IF <> THEN   <<INCONSISTENT>>                   <<U.RAO>>06352000
                  PARSE'ERR(-FILELOCKNOLOCK, PARMPTR);         <<01200>>06354000
               FLAGDYNLOCKING := TRUE;                         <<U.RAO>>06356000
            END;                                               <<U.RAO>>06358000
                                                               <<U.RAO>>06360000
            <<WAIT>>                                           <<U.RAO>>06362000
            BEGIN                                              <<U.RAO>>06364000
               AOPTIONS.NOWAIT := FALSE;                       <<U.RAO>>06366000
               IF <> THEN                                      <<U.RAO>>06368000
                  PARSE'ERR(-FILENOWAITWAIT, PARMPTR);         <<01200>>06370000
               FLAGWAIT := TRUE;                               <<U.RAO>>06372000
            END;                                               <<U.RAO>>06374000
                                                               <<U.RAO>>06376000
            <<NOWAIT>>                                         <<U.RAO>>06378000
            BEGIN                                              <<U.RAO>>06380000
               AOPTIONS.NOWAIT := TRUE;                        <<U.RAO>>06382000
               IF = AND FLAGWAIT THEN                          <<U.RAO>>06384000
                  PARSE'ERR(-FILEWAITNOWAIT, PARMPTR);         <<01200>>06386000
               FLAGWAIT := TRUE;                               <<U.RAO>>06388000
            END;                                               <<U.RAO>>06390000
                                                               <<01549>>06392000
            <<STD>>                                            <<01549>>06394000
            BEGIN                                              <<01549>>06396000
            FLAGFTYPE:=TRUE;                                   <<01549>>06398000
            IF <> THEN                                         <<01549>>06400000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>06402000
                  BEGIN                                        <<01549>>06404000
                  ;  <<ALREADY SET TO STD>>                    <<01549>>06406000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>06408000
                  PARSE'ERR(-FILERIOSTD, PARMPTR);             <<01549>>06410000
                  ;                                            <<01549>>06412000
                  PARSE'ERR(-FILECIRSTD, PARMPTR);             <<01549>>06414000
                  ;                                            <<01549>>06416000
                  PARSE'ERR(-FILEMSGSTD, PARMPTR);             <<01549>>06418000
                  END;                                         <<01549>>06420000
            FOPTIONS.FILETYPE:=STD;                            <<01549>>06422000
            END;                                               <<01549>>06424000
                                                               <<01549>>06426000
            <<RIO>>                                            <<01549>>06428000
            BEGIN                                              <<01549>>06430000
            FLAGFTYPE:=TRUE;                                   <<01549>>06432000
            IF <> THEN                                         <<01549>>06434000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>06436000
                  BEGIN                                        <<01549>>06438000
                  PARSE'ERR(-FILESTDRIO, PARMPTR);             <<01549>>06440000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>06442000
                  ;  <<ALREADY SET TO RIO>>                    <<01549>>06444000
                  ;                                            <<01549>>06446000
                  PARSE'ERR(-FILECIRRIO, PARMPTR);             <<01549>>06448000
                  ;                                            <<01549>>06450000
                  PARSE'ERR(-FILEMSGRIO, PARMPTR);             <<01549>>06452000
                  END;                                         <<01549>>06454000
            FOPTIONS.FILETYPE:=RIO;                            <<01549>>06456000
            END;                                               <<01549>>06458000
                                                               <<01549>>06460000
            <<NORIO>>                                          <<01549>>06462000
            BEGIN                                              <<01549>>06464000
            FLAGFTYPE:=TRUE;                                   <<01549>>06466000
            IF <> THEN                                         <<01549>>06468000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>06470000
                  BEGIN                                        <<01549>>06472000
                  ;  <<ALREADY SET TO STD>>                    <<01549>>06474000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>06476000
                  PARSE'ERR(-FILERIOSTD, PARMPTR);             <<01549>>06478000
                  ;                                            <<01549>>06480000
                  PARSE'ERR(-FILECIRSTD, PARMPTR);             <<01549>>06482000
                  ;                                            <<01549>>06484000
                  PARSE'ERR(-FILEMSGSTD, PARMPTR);             <<01549>>06486000
                  END;                                         <<01549>>06488000
            FOPTIONS.FILETYPE:=STD;                            <<01549>>06490000
            END;                                               <<01549>>06492000
                                                               <<01549>>06494000
                                                               <<01549>>06496000
            <<ENV>>                                            <<01549>>06498000
            IF NOT PROCENV THEN RETURN;                        <<01549>>06500000
                                                               <<01549>>06502000
            <<OUTQ>>                                           <<01549>>06504000
            IF NOT PROCOUTQ THEN RETURN;                       <<01549>>06506000
                                                               <<01549>>06508000
            <<MSG>>                                            <<01549>>06510000
            BEGIN                                              <<01549>>06512000
            FLAGFTYPE:=TRUE;                                   <<01549>>06514000
            IF <> THEN                                         <<01549>>06516000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>06518000
                  BEGIN                                        <<01549>>06520000
                  PARSE'ERR(-FILESTDMSG, PARMPTR);             <<01549>>06522000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>06524000
                  PARSE'ERR(-FILERIOMSG, PARMPTR);             <<01549>>06526000
                  ;                                            <<01549>>06528000
                  PARSE'ERR(-FILECIRMSG, PARMPTR);             <<01549>>06530000
                  END;                                         <<01549>>06532000
            FOPTIONS.FILETYPE:=MSG;                            <<01549>>06534000
            END;                                               <<01549>>06536000
                                                               <<01549>>06538000
            <<CIR>>                                            <<01549>>06540000
            BEGIN                                              <<01549>>06542000
            FLAGFTYPE:=TRUE;                                   <<01549>>06544000
            IF <> THEN                                         <<01549>>06546000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>06548000
                  BEGIN                                        <<01549>>06550000
                  PARSE'ERR(-FILESTDCIR, PARMPTR);             <<01549>>06552000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>06554000
                  PARSE'ERR(-FILERIOCIR, PARMPTR);             <<01549>>06556000
                  ;                                            <<01549>>06558000
                  ;  <<ALREADY SET TO CIRCULAR>>               <<01549>>06560000
                  ;                                            <<01549>>06562000
                  PARSE'ERR(-FILEMSGCIR, PARMPTR);             <<01549>>06564000
                  END;                                         <<01549>>06566000
            FOPTIONS.FILETYPE:=CIR;                            <<01549>>06568000
            END;                                               <<01549>>06570000
                                                               <<01549>>06572000
                                                               <<U.RAO>>06574000
            << DEN >>                                          <<02569>>06576000
            IF NOT PROCDENS THEN RETURN;                       <<02569>>06578000
                                                               <<02569>>06580000
         END;  <<OF CASE>>                                     <<U.RAO>>06582000
      END;  <<OF ELSE CLAUSE>>                                 <<U.RAO>>06584000
   END                                                         <<U.RAO>>06586000
      UNTIL NEXTDELIM <> SEMICOLON;                            <<U.RAO>>06588000
                                                               <<U.RAO>>06590000
<<Parse terminated because the next delimiter indicated that  ><<U.RAO>>06592000
<<what followed was not a keyword.  If it was not a carriage  ><<U.RAO>>06594000
<<return then there was a syntax error.  Since all of the     ><<U.RAO>>06596000
<<parsers of keywords with subparameters are responsible for  ><<U.RAO>>06598000
<<checking for extraneous or unexpected delimiters, the only  ><<U.RAO>>06600000
<<time the next delimiter would not be a carriage return would><<U.RAO>>06602000
<<be after one of the keywords which has no qualifiers.       ><<U.RAO>>06604000
IF NEXTDELIM <> CR THEN                                        <<U.RAO>>06606000
   BEGIN  <<HANDLE EXTRANEOUS DELIMITERS>>                     <<U.RAO>>06608000
   <<FIRST FIXUP SO PARAMETER NAME CAN BE PASSED TO CIERR>>    <<U.RAO>>06610000
   TOS := @PARMPTR;                                            <<U.RAO>>06612000
   TOS := BPS0(PARMLEN);                                       <<U.RAO>>06614000
   BPS1(X) := 0;                                               <<U.RAO>>06616000
   GETNEXT;                                                    <<U.RAO>>06618000
   IF PARSE'ONLY THEN ERRNUM := FILENOXPCTSPARM                <<01200>>06620000
   ELSE                                                        <<01200>>06622000
      CIERR(ERRNUM := FILENOXPCTSPARM, PARMPTR, 0, @BPS1);     <<01200>>06624000
   BPS1(X) := TOS;  <<RESTORE PREVIOUS VALUE OVER 0>>          <<U.RAO>>06626000
   DEL;  <<POP POINTER>>                                       <<U.RAO>>06628000
   END                                                         <<U.RAO>>06630000
ELSE                                                           <<U.RAO>>06632000
   PROCKEY := TRUE;                                            <<U.RAO>>06634000
END;  <<SUBROUTINE PROCKEY>>                                   <<U.RAO>>06636000
                                                               <<U.RAO>>06638000
<<                 *********************                   >>  <<U.RAO>>06640000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>06642000
<<                 *********************                   >>  <<U.RAO>>06644000
                                                               <<U.RAO>>06646000
<<MAIN BODY OF FILE COMMAND>>                                  <<U.RAO>>06648000
<<This code does three things, parse the file name part, invoke<<U.RAO>>06650000
<<the parse of any keywords which might be present, and do the><<U.RAO>>06652000
<<call to the routine which sets up the JDT entry.>>           <<U.RAO>>06654000
<<Note that when a failure is detected, this procedure is exited>>      06656000
<<immediately.>>                                               <<U.RAO>>06658000
                                                               <<01200>>06660000
<< NORMAL ENTRY POINT FOR :FILE COMMAND >>                     <<01255>>06662000
PARSE'ONLY := FALSE;                                           <<01200>>06664000
GOTO STARTPARSE;                                               <<01200>>06666000
                                                               <<01200>>06668000
<< PARSE'FILE'EQ IS AN ENTRY POINT TO PERFORM ONLY THE PARSE >><<01200>>06670000
<< OF A FILE EQUATION.  THE PARSED FILE EQUATION TABLE IS    >><<01200>>06672000
<< NOT ADDED TO THE JDT BUT RATHER RETURNED TO THE CALLER    >><<01200>>06674000
<< THROUGH THE 1ST PARAMETER OF THE CALL.                    >><<01200>>06676000
PARSE'FILE'EQ:                                                 <<01200>>06678000
PARSE'ONLY := TRUE;                                            <<01200>>06680000
                                                               <<01200>>06682000
STARTPARSE:                                                    <<01200>>06684000
PARMNUM := 0;                                                  <<U.RAO>>06686000
MOVE SAVEDCOMIMAGE := PARMSP,(CIS'BCOMBUFLEN);                 << I.A >>06688000
MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARMS);                  <<U.RAO>>06690000
IF NUMPARMS=0 THEN  <<LACKS REQUIRED FORMAL FILE DESIGNATOR>>  <<U.RAO>>06692000
   BEGIN                                                       <<U.RAO>>06694000
   PARMNUM := 1;                                               <<U.RAO>>06696000
   CIERR(ERRNUM := FILEREQFDESIG,PARMSP(1));                   <<U.RAO>>06698000
   RETURN;                                                     <<U.RAO>>06700000
   END;                                                        <<U.RAO>>06702000
<<FIRST STEP IS TO PARSE THE FORMAL FILE DESIGNATOR>>          <<U.RAO>>06704000
IF NOT CHECKFDESIG THEN RETURN;                                <<U.RAO>>06706000
<<HAVE VALID FORMAL FILE DESIGNATOR.  NOW LOOK FOR ACTUAL FDESIG.>>     06708000
IF NUMPARMS=1 THEN <<REQUIRES AT LEAST ONE OTHER PARM>>        <<U.RAO>>06710000
   BEGIN                                                       <<U.RAO>>06712000
   CIERR(ERRNUM := FILEREQSOMEPARM,FORMALDES(PARMLEN));        <<U.RAO>>06714000
   RETURN                                                      <<U.RAO>>06716000
   END;                                                        <<U.RAO>>06718000
IF NEXTDELIM=EQUALS THEN   <<ACTUAL DESIGNATOR PROMISED>>      <<U.RAO>>06720000
   IF NOT CHECKADESIG THEN RETURN;                             <<U.RAO>>06722000
<<CHECK FOR FILE DOMAIN>>                                      <<U.RAO>>06724000
IF NEXTDELIM=COMMA THEN   <<DOMAIN PROMISED>>                  <<U.RAO>>06726000
   IF NOT CHECKDOMAIN THEN RETURN;                             <<U.RAO>>06728000
<<THE ONLY LEGAL THING AFTER THIS IS THE KEYWORD LIST, IF ANY>>         06730000
IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN             <<U.RAO>>06732000
   BEGIN  <<UNEXPECTED DELIMITERS, SYNTAX ERROR>>              <<U.RAO>>06734000
   GETNEXT;                                                    <<U.RAO>>06736000
   PARSE'ERR(ERRNUM := FILEXSTRTPARMCR, PARMPTR(-1));          <<01200>>06738000
   RETURN                                                      <<U.RAO>>06740000
   END;                                                        <<U.RAO>>06742000
<<NOW HAVE NAME INFO COMPLETELY PARSED.>>                      <<U.RAO>>06744000
                                                               <<U.RAO>>06746000
<<NEXT STEP IS THE PARSE OF THE PARAMETER LIST, IF PRESENT.>>  <<U.RAO>>06748000
IF NEXTDELIM = SEMICOLON THEN  <<SOME PARAMETERS EVIDENTLY EXIST>>      06750000
   IF NOT PROCKEY THEN RETURN;                                 <<U.RAO>>06752000
                                                               <<U.RAO>>06754000
<<At this point we have parsed the entire command.  If we made it   >>  06756000
<<this far, there are no obvious problems.  All parameters have been>>  06758000
<<put into the appropriate forms and saved in local variables by the>>  06760000
<<appropriate names.  It remains but to build the entry and         >>  06762000
<<insert it in the Job Directory Table.                             >>  06764000
PARMNUM := 0;                                                  <<U.RAO>>06766000
                                                               <<02569>>06768000
<< Device flag set only if one of the components is present >> <<02569>>06770000
FLAGDEV := FLAGADEV LOR FLAGDENS LOR FLAGENV LOR FLAGOUTQ;     <<02569>>06772000
                                                               <<02569>>06774000
WENTRY := FLAGS1;  <<PMASK WORD 1>>                            <<U.RAO>>06776000
WENTRY(1) := FLAGS2;  <<SECOND WORD OF PMASK>>                 <<U.RAO>>06778000
WENTRY(2) := 0;   <<NAME AND DEVICE LENGTH AND KEYWORD LEN>>   <<01549>>06780000
IF FLAGANAME THEN  <<ACTUAL DESIGNATOR PRESENT>>               <<U.RAO>>06782000
   BEGIN                                                       <<U.RAO>>06784000
   BENTRY(4) := ACTUALDESLEN;                                  <<U.RAO>>06786000
   MOVE BENTRY(NEXTENTRYX) := ACTUALDES, (ACTUALDESLEN);       <<U.RAO>>06788000
   NEXTENTRYX := NEXTENTRYX+INTEGER(ACTUALDESLEN);             <<U.RAO>>06790000
   END;                                                        <<U.RAO>>06792000
IF FLAGDEV THEN                                                <<02569>>06794000
   BEGIN           << SOME DEVICE INFO SPECIFIED >>            <<02569>>06796000
   IF FLAGADEV THEN                                            <<02569>>06798000
      BEGIN        << DEVICE NAME SPECIFIED >>                 <<02569>>06800000
   MOVE BENTRY(NEXTENTRYX) := DEV, (DEVLEN);                   <<U.RAO>>06802000
   NEXTENTRYX := NEXTENTRYX+DEVLEN;                            <<U.RAO>>06804000
      END;                                                     <<02569>>06806000
   IF FLAGDENS THEN                                            <<02569>>06808000
      BEGIN                                                    <<02569>>06810000
          MOVE BENTRY(NEXTENTRYX) := ";DEN=";                  <<02569>>06812000
          NEXTENTRYX := NEXTENTRYX + 5;                        <<02569>>06814000
          MOVE BENTRY(NEXTENTRYX) := DENS, (DENSLEN);          <<02569>>06816000
          NEXTENTRYX := NEXTENTRYX + DENSLEN;                  <<02569>>06818000
          KEYS'LEN := KEYS'LEN + DENSLEN + 5;                  <<02569>>06820000
      END;                                                     <<02569>>06822000
   IF FLAGENV THEN                                             <<01851>>06824000
      BEGIN                                                    <<01851>>06826000
         MOVE BENTRY(NEXTENTRYX) := ";ENV=";                   <<01851>>06828000
         NEXTENTRYX := NEXTENTRYX + 5;                         <<01851>>06830000
         MOVE BENTRY(NEXTENTRYX) := ENV,(ENVLEN);              <<01851>>06832000
         NEXTENTRYX := NEXTENTRYX + ENVLEN;                    <<01851>>06834000
         KEYS'LEN := KEYS'LEN + ENVLEN + 5;                    <<02569>>06836000
      END;                                                     <<01851>>06838000
   IF FLAGOUTQ THEN                                            <<01851>>06840000
      BEGIN                                                    <<01851>>06842000
         MOVE BENTRY(NEXTENTRYX) := ";OUTQ=";                  <<01851>>06844000
         NEXTENTRYX := NEXTENTRYX + 6;                         <<01851>>06846000
         MOVE BENTRY(NEXTENTRYX) := OUTQ,(OUTQLEN);            <<01851>>06848000
         NEXTENTRYX := NEXTENTRYX + OUTQLEN;                   <<01851>>06850000
         KEYS'LEN := KEYS'LEN + OUTQLEN + 6;                   <<01851>>06852000
      END;                                                     <<01851>>06854000
   IF KEYS'LEN <> 0 THEN                                       <<01851>>06856000
      BEGIN                                                    <<01851>>06858000
         KEYS'LEN := KEYS'LEN + 1;                             <<01851>>06860000
         BENTRY(NEXTENTRYX) := %15;                            <<01851>>06862000
         NEXTENTRYX := NEXTENTRYX + 1;                         <<01851>>06864000
      END;                                                     <<01851>>06866000
   BENTRY(5) := DEVLEN + KEYS'LEN;                             <<01851>>06868000
   END;                                                        <<U.RAO>>06870000
<<THIS ENDS THE VARIABLE PORTIONS OF THE WENTRY>>              <<U.RAO>>06872000
X := (NEXTENTRYX+1)&LSR(1);  <<WORD OFFSET FROM WENTRY BASE>>  <<U.RAO>>06874000
WENTRY(X) := FOPTIONS;                                         <<U.RAO>>06876000
WENTRY(X:=X+1) := AOPTIONS;                                    <<U.RAO>>06878000
TOS := NUMBUFFERS&LSL(8);                                      <<U.RAO>>06880000
TOS.(8:5) := INITALLOC;                                        <<U.RAO>>06882000
WENTRY(X:=X+1) := TOS LOR LOGICAL(DISPOSITION);                <<U.RAO>>06884000
WENTRY(X:=X+1) := RECSIZE;                                     <<U.RAO>>06886000
WENTRY(X:=X+1) := LOGICAL(NUMEXTENTS)&LSL(11) LOR LOGICAL(BLOCKFACTOR); 06888000
TOS := FILESIZE;                                               <<U.RAO>>06890000
ASSEMBLE(XCH);                                                 <<U.RAO>>06892000
WENTRY(X:=X+1) := TOS;  <<FIRST WORD OF FILESIZE>>             <<U.RAO>>06894000
WENTRY(X:=X+1) := TOS;  <<SECOND WORD>>                        <<U.RAO>>06896000
WENTRY(X:=X+1) := FILECODE;                                    <<U.RAO>>06898000
WENTRY(X:=X+1) := (LOGICAL(OUTPRI)&LSL(7)LOR LOGICAL(NUMCOPIES))&LSL(5);06900000
      WENTRY(X:=X+1) := 0;  <<USER LABELS COUNT>>              <<U.RAO>>06902000
      WENTRY(X:=X+1) := FORMSMSGLEN + TAPELABELLEN;            <<U.RAO>>06904000
      IF WENTRY(X) <> 0 THEN                                   <<U.RAO>>06906000
         BEGIN  <<MOVE IN OPTIONAL DATA>>                      <<U.RAO>>06908000
         TOS := (@WENTRY(X)+1)&LSL(1);  <<BYTE ADDRESS>>       <<U.RAO>>06910000
         IF FORMSMSGLEN<>0 THEN   <<MOVE IN FORMS MESSAGE>>    <<U.RAO>>06912000
            MOVE * := FORMSMSG, (FORMSMSGLEN), 2;              <<U.RAO>>06914000
         IF TAPELABELLEN<>0 THEN   <<MOVE IN TAPE LABEL DATA>> <<U.RAO>>06916000
            BEGIN                                              <<U.RAO>>06918000
            IF FORMSMSGLEN=0 THEN   <<MUST INSERT ".">>        <<U.RAO>>06920000
               BEGIN                                           <<U.RAO>>06922000
               BPS0 := ".";                                    <<U.RAO>>06924000
               TOS := TOS+1;                                   <<U.RAO>>06926000
               WENTRY(X) := WENTRY(X)+1;                       <<U.RAO>>06928000
               FORMSMSGLEN := 1;                               <<U.RAO>>06930000
               END;                                            <<U.RAO>>06932000
            MOVE * := TAPELABEL,(TAPELABELLEN),2;              <<U.RAO>>06934000
            BPS0 := ";";                                       <<U.RAO>>06936000
            WENTRY(X) := WENTRY(X)+1;                          <<U.RAO>>06938000
            TAPELABELLEN := TAPELABELLEN+1;                    <<U.RAO>>06940000
            END;                                               <<U.RAO>>06942000
         DEL;                                                  <<U.RAO>>06944000
         X := X+(FORMSMSGLEN+TAPELABELLEN+1)&LSR(1);           <<U.RAO>>06946000
         END;                                                  <<U.RAO>>06948000
IF PARSE'ONLY THEN                                             <<01200>>06950000
   BEGIN                                                       <<01200>>06952000
   << COPY LOCAL TABLE ENTRY OVER THE STRING PASSED TO     >>  <<01200>>06954000
   << PARSE'FILE'EQ.  THIS RETURNS THE PARSED FILE         >>  <<01200>>06956000
   << EQUATION INFO TO THE CALLER.                         >>  <<01200>>06958000
   X := (X+1) * 2;                                             <<01200>>06960000
   MOVE PARMSP := BENTRY, (X);                                 <<01200>>06962000
   END                                                         <<01200>>06964000
ELSE                                                           <<01200>>06966000
   BEGIN                                                       <<01200>>06968000
   << ADD TABLE ENTRY TO JDT >>                                <<01200>>06970000
   IF ADDJTENTRY(FORMALDES,GROUP,ACCT,-3,X+1,WENTRY) <> 0 THEN <<01200>>06972000
      CIERR(ERRNUM := FEQTABFULLXPLCT);  << INSERT FAILED >>   <<01200>>06974000
   END;                                                        <<01200>>06976000
RETURN;                                                        <<U.RAO>>06978000
                                                               <<U.RAO>>06980000
<<  ***  END OF CXFILE  ***   >>                               <<U.RAO>>06982000
                                                               <<U.RAO>>06984000
<<  ***   CXBUILD   ***  >>                                    <<U.RAO>>06986000
CXBUILD:                                                       <<U.RAO>>06988000
                                                               <<U.RAO>>06990000
<<This differs from the procedure for the FILE command primarily>>      06992000
<<in that we do an FOPEN instead of calling jobtables.          >>      06994000
                                                               <<U.RAO>>06996000
BUILDFLAG := TRUE;                                             <<U.RAO>>06998000
PARSE'ONLY := FALSE;                                           <<01255>>07000000
FOPTIONS := %2000;   <<DISALLOWS FILE EQUATES  >>              <<U.RAO>>07002000
PARMNUM := 0;                                                  <<U.RAO>>07004000
MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARMS);                  <<U.RAO>>07006000
IF NUMPARMS=0 THEN  <<LACKS REQUIRED FILE NAME>>               <<U.RAO>>07008000
   BEGIN                                                       <<U.RAO>>07010000
   PARMNUM := 1;                                               <<U.RAO>>07012000
   CIERR(ERRNUM := BLDREQFILENAME, PARMSP(1));                 <<U.RAO>>07014000
   END                                                         <<U.RAO>>07016000
ELSE IF BLDCHECKFDESIG THEN  <<FILE NAME IS VALID>>            <<U.RAO>>07018000
IF NEXTDELIM=COMMA THEN   <<DOMAIN NOT APPROPRIATE>>           <<U.RAO>>07020000
   BEGIN                                                       <<U.RAO>>07022000
   GETNEXT;                                                    <<U.RAO>>07024000
   CIERR(ERRNUM := BLDDOMAINNOT,PARMPTR);                      <<U.RAO>>07026000
   END                                                         <<U.RAO>>07028000
ELSE IF NEXTDELIM=EQUALS THEN  <<ACTUAL DESIGNATOR NOT APPROPRIATE>>    07030000
   BEGIN                                                       <<U.RAO>>07032000
   GETNEXT;                                                    <<U.RAO>>07034000
   CIERR(ERRNUM := BLDNOTADES,PARMPTR);                        <<U.RAO>>07036000
   END                                                         <<U.RAO>>07038000
ELSE  <<NAME SEEMS OK>>                                        <<U.RAO>>07040000
   BEGIN                                                       <<U.RAO>>07042000
   IF NEXTDELIM=SEMICOLON THEN  <<APPARENTLY KEYWORD LIST FOLLOWS>>     07044000
      IF NOT PROCKEY THEN   <<PARSE OF KEYWORD LIST FAILED>>   <<U.RAO>>07046000
         RETURN;                                               <<U.RAO>>07048000
   <<NOW JUST DO BUILD - FOPEN, FOLLOWED BY FCLOSE>>           <<U.RAO>>07050000
   SAVEDELIM := DEV(DEVLEN);                                   <<02053>>07052000
   DEV(DEVLEN) := %15; <<GET'DEV'PARMS WILL NOT GET CONFUSED >><<01835>>07054000
   IF FILECODE = 1090 THEN                                     <<00506>>07056000
      BEGIN                                                    <<00506>>07058000
      BLOCKFACTOR:=32;                                         <<00506>>07060000
      FOPTIONS.(13:1):=1;                                      <<00506>>07062000
      RECSIZE:=-256;                                           <<00506>>07064000
      IF NUMEXTENTS <= 0 THEN NUMEXTENTS:=1;                   <<00506>>07066000
      TOS:=FILESIZE:=FILESIZE+DOUBLE(BLOCKFACTOR);             <<00506>>07068000
      FILESIZE:=FILESIZE/DOUBLE(BLOCKFACTOR*NUMEXTENTS);       <<00506>>07070000
      TOS:=NUMEXTENTS*BLOCKFACTOR;                             <<00506>>07072000
      ASSEMBLE(DIVL);                                          <<00506>>07074000
      IF TOS <> 0 THEN FILESIZE:=FILESIZE+1D;                  <<00506>>07076000
      ASSEMBLE(DEL);                                           <<00506>>07078000
      FILESIZE:=FILESIZE*DOUBLE((BLOCKFACTOR)*NUMEXTENTS);     <<00506>>07080000
      FILESIZE:=FILESIZE-DOUBLE(BLOCKFACTOR);                  <<00506>>07082000
      FLAGBLOCKFACTOR:=1;                                      <<00506>>07084000
      END;                                                     <<00506>>07086000
   TOS := 0;  <<RETURN SPACE FOR FOPEN>>                       <<U.RAO>>07088000
   TOS := @FORMALDES;                                          <<U.RAO>>07090000
   TOS := FOPTIONS;                                            <<U.RAO>>07092000
   TOS := %100;   <<EXCLUSIVE ACCESS>>                         <<U.RAO>>07094000
   TOS := RECSIZE;                                             <<U.RAO>>07096000
   TOS := @DEV;                                                <<U.RAO>>07098000
   TOS := 0;  <<FORMS MESSAGE>>                                <<U.RAO>>07100000
   TOS := 0;   <<USER LABELS>>                                 <<U.RAO>>07102000
   TOS := BLOCKFACTOR;                                         <<U.RAO>>07104000
   TOS := 1;   <<NUMBER OF BUFFERS FOR OPEN>>                  <<U.RAO>>07106000
   TOS := FILESIZE;                                            <<U.RAO>>07108000
   TOS := NUMEXTENTS;                                          <<U.RAO>>07110000
   TOS := INITALLOC;                                           <<U.RAO>>07112000
   TOS := FILECODE;                                            <<U.RAO>>07114000
   <<NOW DO OPTION VARIABLE MASK>>                             <<U.RAO>>07116000
   TOS := %16020;   <<PROTOTYPE SPL OPTION VAR MASK>>          <<U.RAO>>07118000
   TOS.(6:1)  := FLAGRECSIZE;                                  <<U.RAO>>07120000
   TOS.(7:1)  := FLAGADEV;                                     <<02569>>07122000
   TOS.(10:1) := FLAGBLOCKFACTOR;                              <<U.RAO>>07124000
   TOS.(12:1) := FLAGFILESIZE;                                 <<U.RAO>>07126000
   TOS.(13:1) := FLAGNUMEXTS;                                  <<U.RAO>>07128000
   TOS.(14:1) := FLAGINITALLOC;                                <<U.RAO>>07130000
   TOS.(15:1) := FLAGFILECODE;                                 <<U.RAO>>07132000
   <<MASK IS COMPLETE, ALL PARMS STACKED.>>                    <<U.RAO>>07134000
   ASSEMBLE(PCAL DFOPEN);                                      <<00200>>07136000
   IF CARRY THEN                                               <<U.RAO>>07138000
      BEGIN  <<OPEN FAILED ON NEW FILE>>                       <<U.RAO>>07140000
      FERROR'(*, PARMNUM);                                     <<U.RAO>>07142000
      QUALIFYFILENAME(FORMALDES, BENTRY);                      <<U.RAO>>07144000
      CIERR(ERRNUM := BLDFAILED,,0,@BENTRY);                   <<U.RAO>>07146000
      END                                                      <<U.RAO>>07148000
   ELSE                                                        <<U.RAO>>07150000
      BEGIN  <<TRY CLOSE>>                                     <<U.RAO>>07152000
      FCLOSE(S0,DISPOSITION,0);                                <<U.RAO>>07154000
      IF CARRY THEN                                            <<U.RAO>>07156000
         BEGIN                                                 <<U.RAO>>07158000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>07160000
         QUALIFYFILENAME(FORMALDES,BENTRY);                    <<U.RAO>>07162000
         CIERR(ERRNUM := BLDFAILED,,0,@BENTRY);                <<U.RAO>>07164000
         END;                                                  <<U.RAO>>07166000
      END;                                                     <<U.RAO>>07168000
   DEV(DEVLEN) := SAVEDELIM;                                   <<02053>>07170000
   END;                                                        <<U.RAO>>07172000
END;   <<PROCEDURE CXFILE/CXBUILD>>                            <<U.RAO>>07174000
$PAGE "FILE MANAGEMENT COMMAND EXECUTORS--RESET,SAVE,PURGE,RENAME"      07176000
$CONTROL    SEGMENT  =  CIFILEM                                         07178000
                                                                        07180000
      PROCEDURE CXRESET EXECUTORHEAD;                                   07182000
      OPTION PRIVILEGED,UNCALLABLE;                                     07184000
      BEGIN                                                             07186000
<< RESET, CRESET commands:  If a particular equate is to be >> <<U.RAO>>07188000
<< reset, then find it in the JDT, remove it and contract the>><<U.RAO>>07190000
<< table.  If all are to be reset, just delete the table.   >> <<U.RAO>>07192000
      DOUBLE ARRAY PARMS(0:1) =Q;                              <<U.RAO>>07194000
      BYTE POINTER BADPARM = PARMS+2;                          <<U.RAO>>07196000
      LOGICAL LBADPARM = BADPARM;                              <<U.RAO>>07198000
      INTEGER NUMPARMS;                                        <<U.RAO>>07200000
      INTEGER                                                           07202000
        JDTEND = DB+6,                                         <<U.RAO>>07204000
        JDTJCW = DB+5,    <<JOB CONTROL TABLE>>                <<U.RAO>>07206000
         JDTLINEEQ=DB+4,                                                07208000
         JDTFILEEQ=DB+3;                                                07210000
                                                                        07212000
      ARRAY                                                             07214000
        JDTJCWARR(@) = DB+5,  <<POINTS TO JCW TABLE>>          <<U.RAO>>07216000
         JDTLINE(@) = DB+4,                                             07218000
         JDTFILE(@) = DB+3;                                             07220000
      LOGICAL BLANK := "  ";  <<FOR BPNTR>>                    <<U.RAO>>07222000
<<>>                                                           <<U.RAO>>07224000
      LOGICAL X2 = PARMS+1;                                    <<U.RAO>>07226000
      LOGICAL GPNTR := 0;                                      <<U.RAO>>07228000
      LOGICAL APNTR := 0;                                      <<U.RAO>>07230000
      BYTE POINTER GROUP=GPNTR,BPNTR:=@BLANK,ACCNT=APNTR,FORMDES=PARMS; 07232000
      INTEGER TNUM;                                                     07234000
      ENTRY CXCRESET;                                                   07236000
                                                                        07238000
      IF FALSE THEN                                                     07240000
         BEGIN                                                          07242000
CXCRESET:                                                               07244000
         TNUM := 4;           <<LINE EQUATION TABLE>>                   07246000
         END ELSE TNUM := 3;  <<FILE EQUATION TABLE>>                   07248000
      MYCOMMAND(PARMSP,,2,NUMPARMS,PARMS);                     <<U.RAO>>07250000
      IF <> OR NUMPARMS=0 THEN                                 <<U.RAO>>07252000
         BEGIN  <<PARAMETER SPECIFICATION ERROR>>              <<U.RAO>>07254000
         IF = THEN PARMNUM := 1 ELSE PARMNUM := 2;             <<U.RAO>>07256000
         TOS := ERRNUM := (IF TNUM=3 THEN RESETPARMERR         <<U.RAO>>07258000
                                     ELSE CRESETPARMERR);      <<U.RAO>>07260000
         IF PARMNUM = 1 THEN TOS := @PARMSP(1)                 <<U.RAO>>07262000
                        ELSE TOS := @FORMDES;                  <<U.RAO>>07264000
         CIERR(*,*);                                           <<U.RAO>>07266000
         RETURN                                                <<U.RAO>>07268000
         END;                                                  <<U.RAO>>07270000
      IF FORMDES="@" AND X2=%443 THEN                          <<U.RAO>>07272000
         BEGIN<<ALL FILES ELIMINATED>>                                  07274000
         TOS := LOCKJIR;<<LOCK DOWN JOB SIR>>                           07276000
         SETXPXGLOB +PXGWJDT;<<GET JDT DST>>                            07278000
         EXCHANGEDB(ARRDB0(X).(6:10));                                  07280000
         IF TNUM = 3 THEN                                               07282000
         <<:FILE RESET>>                                                07284000
         IF JDTFILEEQ <> JDTLINEEQ THEN                                 07286000
         BEGIN                                                          07288000
            MOVE JDTFILE := JDTLINE,(JDTEND-JDTLINEEQ);                 07290000
            JDTEND := JDTEND-JDTLINEEQ+JDTFILEEQ;              <<U.RAO>>07292000
            JDTJCW := JDTJCW-JDTLINEEQ+JDTFILEEQ;              <<U.RAO>>07294000
            JDTLINEEQ := JDTFILEEQ;                                     07296000
         END ELSE ELSE                                                  07298000
         <<:CLINE RESET>>                                               07300000
            BEGIN   <<MOVE JCW TABLE UP>>                      <<U.RAO>>07302000
            MOVE JDTLINE := JDTJCWARR,(JDTEND-JDTJCW);         <<U.RAO>>07304000
            JDTEND := JDTEND-JDTJCW+JDTLINEEQ;                 <<U.RAO>>07306000
            JDTJCW := JDTLINEEQ;                               <<U.RAO>>07308000
            END;                                               <<U.RAO>>07310000
         EXCHANGEDB(0);                                                 07312000
         UNLOCKJIR (*);                                                 07314000
         END                                                            07316000
      ELSE                                                              07318000
         BEGIN<<INDIVIDUAL FILE>>                                       07320000
        TOS:=CHECKFILENAME'(PARMS&LSR(8),GPNTR,APNTR,LBADPARM);<<U.RAO>>07322000
         IF < THEN  <<PROBLEM PARSING FILE NAME>>              <<U.RAO>>07324000
            BEGIN                                              <<U.RAO>>07326000
            PARMNUM := 1;                                      <<U.RAO>>07328000
            ERRNUM := S0;                                      <<U.RAO>>07330000
            CIERR(*,BADPARM);                                  <<U.RAO>>07332000
            END                                                <<U.RAO>>07334000
         ELSE IF > THEN   <<SYSTEM DEFINED FILE>>              <<U.RAO>>07336000
            BEGIN                                              <<U.RAO>>07338000
            PARMNUM := 1;                                      <<U.RAO>>07340000
            CIERR(ERRNUM := REQFORMALFDESIG, FORMDES);         <<U.RAO>>07342000
            END                                                <<U.RAO>>07344000
         ELSE                                                  <<U.RAO>>07346000
            BEGIN                                              <<U.RAO>>07348000
            <<HAVE VALID FORMAL FILE DESIGNATOR. IT NOW REMAINS<<U.RAO>>07350000
            <<TO ATTEMPT TO REMOVE THIS FILE EQUATE>>          <<U.RAO>>07352000
            IF GPNTR = 0 THEN GPNTR := @BPNTR; <<SET TO BLANK>><<U.RAO>>07354000
            IF APNTR = 0 THEN APNTR := @BPNTR;                 <<U.RAO>>07356000
            IF XREMJTENTRY(FORMDES,GROUP,ACCNT,TNUM) <> 0 THEN <<U.RAO>>07358000
               BEGIN                                           <<U.RAO>>07360000
               TOS := IF TNUM=3 THEN ERRNUM := -FEQNOTFOUND    <<04785>>07362000
                               ELSE ERRNUM := -ERRLNOTFOUND;   <<04785>>07364000
               CIERR(*,FORMDES);                               <<U.RAO>>07366000
               END;                                            <<U.RAO>>07368000
            END;                                               <<U.RAO>>07370000
         END;                                                  <<U.RAO>>07372000
      END;<<CXRESET>>                                                   07374000
PROCEDURE CXRENAME EXECUTORHEAD;                                        07376000
   OPTION PRIVILEGED, UNCALLABLE;                                       07378000
BEGIN                                                                   07380000
LOGICAL DL := %26015;  <<COMMA, CR>>                           <<U.RAO>>07382000
INTEGER NUMPARMS;                                              <<U.RAO>>07384000
DOUBLE ARRAY PARMS(0:3)=Q;                                     <<U.RAO>>07386000
BYTE POINTER OLDFNAME = PARMS;                                 <<U.RAO>>07388000
BYTE OLDFNAMELEN = PARMS+1;                                    <<U.RAO>>07390000
BYTE POINTER NEWFNAME = PARMS+2;                               <<U.RAO>>07392000
BYTE POINTER TEMPPARM = PARMS+4;                               <<U.RAO>>07394000
BYTE TEMPPARMLEN = PARMS+5;                                    <<U.RAO>>07396000
BYTE POINTER ERRPTR = PARMS+6;                                 <<U.RAO>>07398000
INTEGER FOPTIONS := %2001;  <<OLD PERM., DISALLOW FILE EQ.>>   <<U.RAO>>07400000
BYTE ARRAY FULLFILENAME(0:35);                                 <<U.RAO>>07402000
                                                               <<U.RAO>>07404000
MYCOMMAND(PARMSP,DL,4,NUMPARMS,PARMS);                         <<U.RAO>>07406000
IF NUMPARMS > 3 THEN                                           <<U.RAO>>07408000
   BEGIN  <<TOO MANY PARAMETERS>>                              <<U.RAO>>07410000
   PARMNUM := 4;                                               <<U.RAO>>07412000
   CIERR(ERRNUM := RENAME2MP, ERRPTR);                         <<U.RAO>>07414000
   END                                                         <<U.RAO>>07416000
ELSE IF NUMPARMS=0 THEN                                        <<U.RAO>>07418000
   BEGIN  <<EXPECTED OLD FILE NAME>>                           <<U.RAO>>07420000
   PARMNUM := 1;                                               <<U.RAO>>07422000
   CIERR(ERRNUM := RENAMEREQOLDNAME, PARMSP(1));               <<U.RAO>>07424000
   END                                                         <<U.RAO>>07426000
ELSE IF NUMPARMS=1 THEN                                        <<U.RAO>>07428000
   BEGIN  <<EXPECTED NEW FILE NAME>>                           <<U.RAO>>07430000
   PARMNUM := 2;                                               <<U.RAO>>07432000
   CIERR(ERRNUM := RENAMEREQNEWNAME, OLDFNAME(OLDFNAMELEN));   <<U.RAO>>07434000
   END                                                         <<U.RAO>>07436000
ELSE IF CIBADFILENAME(ERRNUM,PARMS) THEN                       <<U.RAO>>07438000
   PARMNUM := 1  <<FIRST FILE NAME FAILED TO PARSE>>           <<U.RAO>>07440000
ELSE IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN                    <<U.RAO>>07442000
   PARMNUM := 2                                                <<U.RAO>>07444000
ELSE                                                           <<U.RAO>>07446000
   BEGIN                                                       <<U.RAO>>07448000
   <<WE KNOW THAT WE HAVE AT LEAST TWO GOOD PARMS.  NOW WE>>   <<U.RAO>>07450000
   <<START GETTING TO THE HEART OF THE MATTER>>                <<U.RAO>>07452000
   IF NUMPARMS = 3 THEN  <<CHECK FOR "TEMP">>                  <<U.RAO>>07454000
      IF (TEMPPARMLEN <> 4) OR (TEMPPARM <> "TEMP") THEN       <<U.RAO>>07456000
         BEGIN                                                 <<U.RAO>>07458000
         PARMNUM := 3;                                         <<U.RAO>>07460000
         CIERR(ERRNUM := RENAMEEXPECTTEMP,TEMPPARM);           <<U.RAO>>07462000
         RETURN                                                <<U.RAO>>07464000
         END                                                   <<U.RAO>>07466000
      ELSE                                                     <<U.RAO>>07468000
         FOPTIONS := %2002;  <<OLD TEMP, DISALLOW FILE EQ.>>   <<U.RAO>>07470000
   TOS := FOPEN(OLDFNAME,FOPTIONS,%10500); <<NOBUF,EXC,KSAM>>  <<06.RO>>07472000
   IF CARRY THEN  <<OPEN ON OLD FILE FAILED>>                  <<U.RAO>>07474000
      BEGIN                                                    <<U.RAO>>07476000
      FERROR'(*,PARMNUM);                                      <<U.RAO>>07478000
      QUALIFYFILENAME(OLDFNAME,FULLFILENAME);                  <<U.RAO>>07480000
      CIERR(ERRNUM := RENAMEOLDFFSERR,,0,@FULLFILENAME);       <<U.RAO>>07482000
      END                                                      <<U.RAO>>07484000
   ELSE  <<OPEN SUCCEEDED>>                                    <<U.RAO>>07486000
      BEGIN   <<TRY NEW NAME>>                                 <<U.RAO>>07488000
      FRENAME(S0,NEWFNAME);                                    <<U.RAO>>07490000
      IF CARRY THEN   <<RENAME FAILED>>                        <<U.RAO>>07492000
         BEGIN                                                 <<U.RAO>>07494000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>07496000
         CIERR(ERRNUM := RENAMEFAILED);                        <<U.RAO>>07498000
         END                                                   <<U.RAO>>07500000
      ELSE   <<NOW JUST CLOSE THE NEWLY NAMED FILE>>           <<U.RAO>>07502000
         BEGIN                                                 <<U.RAO>>07504000
         FCLOSE(S0,0,0);                                       <<U.RAO>>07506000
         IF CARRY THEN   <<CLOSE SOMEHOW FAILED>>              <<U.RAO>>07508000
            BEGIN                                              <<U.RAO>>07510000
            FERROR'(*,PARMNUM);                                <<U.RAO>>07512000
            CIERR(ERRNUM := RENAMECLSFAILED);                  <<U.RAO>>07514000
            END;                                               <<U.RAO>>07516000
         END;                                                  <<U.RAO>>07518000
      END;                                                     <<U.RAO>>07520000
   END;                                                        <<U.RAO>>07522000
END;                                                           <<U.RAO>>07524000
PROCEDURE CXPURGE EXECUTORHEAD;                                         07526000
   OPTION PRIVILEGED, UNCALLABLE;                                       07528000
BEGIN                                                                   07530000
DOUBLE DL := [8/",",8/";",8/%15,8/0]D;  <<DELIMITERS>>         <<U.RAO>>07532000
EQUATE                                                         <<U.RAO>>07534000
   SEMI = 1;                                                   << I.A >>07536000
INTEGER NUMPARMS;                                              <<U.RAO>>07538000
INTEGER FCHECKCODE = NUMPARMS;                                 <<U.RAO>>07540000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>07542000
BYTE POINTER FILENAME = PARMS;                                 <<U.RAO>>07544000
BYTE FILENAMELEN = PARMS+1;                                    <<U.RAO>>07546000
LOGICAL FILEDATA = PARMS+1;                                    <<U.RAO>>07548000
BYTE POINTER TEMPPARM = PARMS+2;                               <<U.RAO>>07550000
BYTE TEMPPARMLEN = PARMS+3;                                    <<U.RAO>>07552000
BYTE POINTER EXTRAPARM = PARMS+4;                              <<U.RAO>>07554000
BYTE ARRAY TEMPFILENAME(0:35);  <<FOR ERROR REPORTING>>        <<U.RAO>>07556000
LOGICAL FOPTIONS := %2001;   <<OLD PERM, DISALLOW FILE EQ.>>   <<U.RAO>>07558000
EQUATE DELETE = 4,                                             <<U.RAO>>07560000
       AOPTIONS = %10501;                                      <<U.RAO>>07562000
DEFINE DELIMITER=FILEDATA.(11:5)#;                             <<U.RAO>>07564000
                                                               <<U.RAO>>07566000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>07568000
IF NUMPARMS > 2 THEN                                           <<U.RAO>>07570000
   BEGIN  <<TOO MANY PARAMETERS>>                              <<U.RAO>>07572000
   PARMNUM := 3;                                               <<U.RAO>>07574000
   CIERR(ERRNUM := PURGE2MP, EXTRAPARM);                       <<U.RAO>>07576000
   END                                                         <<U.RAO>>07578000
ELSE IF NUMPARMS = 0 THEN                                      <<U.RAO>>07580000
   BEGIN <<TOO FEW PARAMETERS>>                                <<U.RAO>>07582000
   PARMNUM := 1;                                               <<U.RAO>>07584000
   CIERR(ERRNUM := PURGEREQFNAME, PARMSP(1));                  <<U.RAO>>07586000
   END                                                         <<U.RAO>>07588000
ELSE IF CIBADFILENAME(ERRNUM,PARMS) THEN                       <<U.RAO>>07590000
   PARMNUM := 1                                                <<U.RAO>>07592000
ELSE                                                           <<U.RAO>>07594000
   BEGIN                                                       <<U.RAO>>07596000
   <<CHECK SEPARATING DELIMITER>>                              <<U.RAO>>07598000
   IF DELIMITER=SEMI THEN                                      <<U.RAO>>07600000
      CIERR(ERRNUM := -PURGESEMICOLON,  FILENAME(FILENAMELEN));<<04785>>07602000
   <<HAVE VALID FILE NAME.  CHECK FOR "TEMP">>                 <<U.RAO>>07604000
   IF NUMPARMS = 2 THEN  <<EXPECT "TEMP">>                     <<U.RAO>>07606000
      IF (TEMPPARMLEN<>4) OR (TEMPPARM<>"TEMP") THEN           <<U.RAO>>07608000
         BEGIN                                                 <<U.RAO>>07610000
         PARMNUM := 2;                                         <<U.RAO>>07612000
         CIERR(ERRNUM := PURGEEXPECTTEMP, TEMPPARM);           <<U.RAO>>07614000
         RETURN                                                <<U.RAO>>07616000
         END                                                   <<U.RAO>>07618000
      ELSE                                                     <<U.RAO>>07620000
         FOPTIONS := %2002;  <<OLD TEMP, DISALLOW FILE EQ.>>   <<U.RAO>>07622000
   TOS :=DFOPEN(FILENAME,FOPTIONS,AOPTIONS);                   <<00200>>07624000
   IF CARRY THEN  <<OPEN FAILED>>                              <<U.RAO>>07626000
      BEGIN                                                    <<U.RAO>>07628000
      FCHECK(S0,FCHECKCODE);                                   <<U.RAO>>07630000
      IF FCHECKCODE<>52 AND FCHECKCODE<>53 AND FCHECKCODE<>58  <<U.RAO>>07632000
         THEN                                                  <<U.RAO>>07634000
         BEGIN   <<SERIOUS PURGE ERROR>>                       <<U.RAO>>07636000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>07638000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>07640000
         CIERR(ERRNUM := PURGEFOPENFAILD,,0,@TEMPFILENAME);    <<U.RAO>>07642000
         END                                                   <<U.RAO>>07644000
      ELSE                                                     <<U.RAO>>07646000
         BEGIN                                                 <<U.RAO>>07648000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>07650000
         CIERR(ERRNUM := -PURGEFNOTFOUND,FILENAME,0,           <<04785>>07652000
     @TEMPFILENAME);                                           <<04785>>07654000
         END                                                   <<U.RAO>>07656000
      END                                                      <<U.RAO>>07658000
   ELSE                                                        <<U.RAO>>07660000
      BEGIN <<GOOD OPEN>>                                      <<U.RAO>>07662000
      FCLOSE(S0,DELETE,0);                                     <<U.RAO>>07664000
      IF CARRY THEN                                            <<U.RAO>>07666000
         BEGIN  <<CLOSE FAILED>>                               <<U.RAO>>07668000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>07670000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>07672000
         CIERR(ERRNUM := PURGECLOSEFAILD,,0,@TEMPFILENAME);    <<U.RAO>>07674000
         END;                                                  <<U.RAO>>07676000
      END;                                                     <<U.RAO>>07678000
   END;                                                        <<U.RAO>>07680000
END;  <<CXPURGE>>                                              <<U.RAO>>07682000
PROCEDURE MAKEFN(FN);                                          <<04784>>07684000
BYTE ARRAY FN; <<MINIMUM OF 9 CHARACTERS >>                    <<04784>>07686000
BEGIN                                                          <<04784>>07688000
<<*********************************************************>>  <<04784>>07690000
<<                                                         >>  <<04784>>07692000
<<                 M A K E F N                             >>  <<04784>>07694000
<<*********************************************************>>  <<04784>>07696000
COMMENT.                                                       <<04784>>07698000
  This procedure will use the chronos intrinsics to generate   <<04784>>07700000
a file name which is used by the SAVE command to temporarily   <<04784>>07702000
create a file to save $OLDPASS to to avoid the problem of      <<04784>>07704000
running into duplicate temporary file names.  This file        <<04784>>07706000
will be used to rename $OLDPASS to and then saved as a         <<04784>>07708000
permanent file, and later renamed again to the desired file    <<04784>>07710000
name specified by the user.                                    <<04784>>07712000
CHRONOS RETURN THE FOLLOWING THREE WORDS:                      <<04784>>07714000
       00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15         <<04784>>07716000
WORD 1:LAST 2 DIGITS OF YR : DAY OF YEAR (JULIAN SEQ)  :       <<04784>>07718000
WORD 2:          HOUR         :        MINUTE          :       <<04784>>07720000
WORD 3:        SECOND         :   TENTHS OF SECONDS    :       <<04784>>07722000
       00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15         <<04784>>07724000
This routine places the character "S" in the first position    <<04784>>07726000
of the output string, the julian day of the year into pos-     <<04784>>07728000
ition one through three (converted into characters). Minutes   <<04784>>07730000
into four and five.  And seconds into six and seven, and a     <<04784>>07732000
blank into eight                                               <<04784>>07734000
      0      1    2     3     4     5     6     7     8        <<04784>>07736000
  :   S   :   JULIAN DAY   :  HOURS    :  MINUTES  : BLANK :   <<04784>>07738000
      0      1    2     3     4     5     6     7     8        <<04784>>07740000
A secondary entry point MAKEFN' is used whenever duplicate     <<04784>>07742000
names occur.  In this circumstance as attempt is make to stay  <<04784>>07744000
within the same day and hour by incrementing minutes from the  <<04784>>07746000
value 60.  If this fails the hour is reset and incremented     <<04784>>07748000
beginning with the value 24.  Should this fail the day is      <<04784>>07750000
reset and all value are incremented beginning with the value   <<04784>>07752000
367 for the day, 00 for the hour and 00, for the minute.  AS   <<04784>>07754000
a last resort the day, hour, minute string is reset to zero.   <<04784>>07756000
;                                                              <<04784>>07758000
<<*********************************************************>>  <<04784>>07760000
   LONG DTGL;                                                  <<04784>>07762000
   ARRAY DTG(*)=DTGL;                                          <<04784>>07764000
   DOUBLE DTGC=DTGL+1;                                         <<04784>>07766000
   BYTE ARRAY DTGB(*)=DTGL;                                    <<04784>>07768000
   INTEGER                                                     <<04784>>07770000
      I,                                                       <<04784>>07772000
      DAY,                                                     <<04784>>07774000
      HOUR,                                                    <<04784>>07776000
      MINUTE;   << USED BY MAKEFN' >>                          <<04784>>07778000
   ENTRY MAKEFN';                                              <<04784>>07780000
   MOVE FN := "S0000000 ";  << HOUSEKEEP >>                    <<04784>>07782000
   DTG := CALENDAR;  <<YEAR-DAY  REPLACES UPPER PART >>        <<04784>>07784000
                     << OF CHRONOS                   >>        <<04784>>07786000
   DTGC := CLOCK;    <<HOUR-MINUTE-SECOND-FRACTION   >>        <<04784>>07788000
                     << LOWER PART.                  >>        <<04784>>07790000
   I := 1; <<CONVERSION POSITION INDEX FOR JULIAN DAY>>        <<04784>>07792000
   IF DTG.(7:9) < 10 THEN                                      <<04784>>07794000
      I := 3                                                   <<04784>>07796000
   ELSE                                                        <<04784>>07798000
      IF DTG.(7:9) <100 THEN                                   <<04784>>07800000
         I := 2;                                               <<04784>>07802000
   ASCII(DTG.(7:9),10,FN(I));  << CONVERT DAY  >>              <<04784>>07804000
   I := IF DTG(1).(0:8) < 10 THEN 5 ELSE 4; <<ADJUST HOUR >>   <<04784>>07806000
                                            <<INDEX       >>   <<04784>>07808000
   IF DTGB(2) <> 0 THEN                                        <<04784>>07810000
      ASCII(DTG(1).(0:8),10,FN(I)); <<HOUR <> ZERO  >>         <<04784>>07812000
   I := IF DTG(1).(8:8) < 10 THEN 7 ELSE 6; <<ADJUST MINUTE>>  <<04784>>07814000
                                            <<INDEX        >>  <<04784>>07816000
   IF DTGB(3) <> 0 THEN                                        <<04784>>07818000
      ASCII(DTG(1).(8:8),10,FN(I)); << MINUTE <> 0  >>         <<04784>>07820000
   RETURN;  << NORMAL ENTRY >>                                 <<04784>>07822000
                                                               <<04784>>07824000
MAKEFN':                                                       <<04784>>07826000
   << SECONDARY ENTRY FOR DUPLICATE NAMES  >>                  <<04784>>07828000
   DAY := BINARY(FN(1),3);   <<CONVERT RECEIVED VALUES >>      <<04784>>07830000
   HOUR := BINARY(FN(4),2);                                    <<04784>>07832000
   MINUTE := BINARY(FN(6),2);                                  <<04784>>07834000
   IF MINUTE < 60 THEN                                         <<04784>>07836000
      BEGIN   << BUILD PHONY MINUTE NUMBER >>                  <<04784>>07838000
      MOVE FN(6) := "60";                                      <<04784>>07840000
      RETURN;                                                  <<04784>>07842000
      END;                                                     <<04784>>07844000
   IF MINUTE < 99 THEN                                         <<04784>>07846000
      BEGIN  << BUILD PHONY MINUTE NUMBER  >>                  <<04784>>07848000
      MINUTE := MINUTE + 1;                                    <<04784>>07850000
      ASCII(MINUTE,10,FN(6));                                  <<04784>>07852000
      RETURN;                                                  <<04784>>07854000
      END;                                                     <<04784>>07856000
   IF HOUR < 24 THEN                                           <<04784>>07858000
      BEGIN   << BUILD PHONY HOUR NUMBER >>                    <<04784>>07860000
      MOVE FN(4) := "2400";                                    <<04784>>07862000
      RETURN;                                                  <<04784>>07864000
      END;                                                     <<04784>>07866000
   IF HOUR < 99 THEN                                           <<04784>>07868000
      BEGIN  << BUMP PHONY HOUR NUMBER  >>                     <<04784>>07870000
      HOUR := HOUR +1;                                         <<04784>>07872000
      ASCII(HOUR,10,FN(4));                                    <<04784>>07874000
      RETURN;                                                  <<04784>>07876000
      END;                                                     <<04784>>07878000
   IF DAY < 366 THEN                                           <<04784>>07880000
      BEGIN   << BUILD PHONY DAY NUMBER >>                     <<04784>>07882000
      MOVE FN(1) :="3670000";                                  <<04784>>07884000
      RETURN;                                                  <<04784>>07886000
      END;                                                     <<04784>>07888000
   IF DAY < 999 THEN                                           <<04784>>07890000
      BEGIN  << BUMP PHONY DAY NUMBER  >>                      <<04784>>07892000
      DAY := DAY + 1;                                          <<04784>>07894000
      ASCII(DAY,10,FN(1));                                     <<04784>>07896000
      RETURN;                                                  <<04784>>07898000
      END;                                                     <<04784>>07900000
   MOVE FN(1) := "0000000";   << LAST RESORT >>                <<04784>>07902000
END;    << MAKEFN >>                                           <<04784>>07904000
PROCEDURE CXSAVE EXECUTORHEAD;                                          07906000
   OPTION PRIVILEGED, UNCALLABLE;                                       07908000
BEGIN                                                          <<U.RAO>>07910000
DOUBLE DL := [8/",",8/";",8/%15,8/0]D;  <<DELIMITERS>>         <<U.RAO>>07912000
EQUATE                                                         <<U.RAO>>07914000
   SEMI = 1;                                                   << I.A >>07916000
LOGICAL DUMMY = DL,                                            <<04784>>07918000
        TRIEDONCE := FALSE;                                    <<04784>>07920000
INTEGER NUMPARMS,                                              <<04784>>07922000
        FNUM,                                                  <<04784>>07924000
        ERRORCODE;                                             <<04784>>07926000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>07928000
BYTE POINTER OLDFNAME = PARMS;                                 <<U.RAO>>07930000
BYTE OLDFNAMELEN=PARMS+1;                                      <<U.RAO>>07932000
LOGICAL FILENAMEDATA = PARMS+1;                                <<U.RAO>>07934000
DEFINE DELIMITER = FILENAMEDATA.(11:5)#;                       <<U.RAO>>07936000
BYTE POINTER NEWFNAME = PARMS+2;                               <<U.RAO>>07938000
BYTE POINTER ERRPARM = PARMS+4;                                <<U.RAO>>07940000
BYTE ARRAY TEMPFNAME(0:35);                                    <<U.RAO>>07942000
BYTE ARRAY STEMPFNAME(0:8);                                    <<04784>>07944000
BYTE POINTER SPTR;                                             <<04784>>07946000
LOGICAL LERRPTR = ERRPARM;                                     <<U.RAO>>07948000
SUBROUTINE RENAMESTEMP;                                        <<04784>>07950000
BEGIN                                                          <<04784>>07952000
<< THIS PROCEDURE IS USED WHEN THE CXSAVE PROC. GOTTEN A >>    <<04784>>07954000
<< TEMPORARY "S" FILE NAME TO RENAME $OLDPASS TO.  IT    >>    <<04784>>07956000
<< NOW NEEDS TO CLOSE THAT "S" FILE PERMANENT AND RENAME >>    <<04784>>07958000
<< IT TO THE FILE NAME DESIRED BY THE USER.              >>    <<04784>>07960000
                                                               <<04784>>07962000
<< CLOSE THE TEMP. "S" FILE SOMEHOW, PREFERABLY PERMANENT>>    <<04784>>07964000
   FCLOSE(FNUM,1,0);    << CLOSE AS PERMANENT >>               <<04784>>07966000
   IF <> THEN    << CLOSE FAILED >>                            <<04784>>07968000
   BEGIN                                                       <<04784>>07970000
      FCLOSE(FNUM,0,0);  << CLOSE WITH SAME DISPOSITION>>      <<04784>>07972000
      IF <> THEN                                               <<04784>>07974000
         FCLOSE(FNUM,-1,0);    << MUST CLOSE >>                <<04784>>07976000
      FERROR'(FNUM,PARMNUM);                                   <<04784>>07980000
      QUALIFYFILENAME(SPTR,TEMPFNAME);                         <<04784>>07982000
      CIERR(ERRNUM:=SAVETEMPCLOSE,,0,@TEMPFNAME);              <<04784>>07984000
      RETURN;                                                  <<04784>>07986000
   END;                                                        <<04784>>07988000
   FNUM := FOPEN(SPTR,1,%104); << OPEN "S" FILE >>             <<04784>>07990000
   IF <> THEN                                                  <<04784>>07992000
      BEGIN                                                    <<04784>>07994000
      QUALIFYFILENAME(SPTR,TEMPFNAME);                         <<04784>>07996000
      CIERR(ERRNUM:=SAVETEMPCLOSE,,0,@TEMPFNAME);              <<04784>>07998000
      RETURN;                                                  <<04784>>08000000
      END;                                                     <<04784>>08002000
   FRENAME(FNUM,NEWFNAME);  <<RENAME TO USERS NAME>>           <<04784>>08004000
   IF <> THEN                                                  <<04784>>08006000
      BEGIN                                                    <<04784>>08008000
      FERROR'(FNUM,PARMNUM);                                   <<04784>>08010000
      QUALIFYFILENAME(SPTR,TEMPFNAME);                         <<04784>>08012000
      FCLOSE(FNUM,-1,0);     <<MUST CLOSE>>                    <<04784>>08014000
      CIERR(ERRNUM := SAVETEMPFAIL,,0,@TEMPFNAME);             <<04784>>08016000
      RETURN;                                                  <<04784>>08018000
      END;                                                     <<04784>>08020000
   FCLOSE(FNUM,1,0);    << CLOSE NEWFNAME >>                   <<04784>>08022000
   IF <> THEN                                                  <<04784>>08024000
      FCLOSE(FNUM,-1,0);    << MUST CLOSE >>                   <<04784>>08026000
                                                               <<04784>>08028000
END;      << RENAMESTEMP >>                                    <<04784>>08030000
                                                               <<04784>>08032000
LOGICAL SUBROUTINE FCHECKERR;                                  <<04784>>08034000
BEGIN                                                          <<04784>>08036000
<< USED TO CHECK THE FILE ERROR CODE RETURNED BY INTRINSIC >>  <<04784>>08038000
<< FRENAME.  IF ERROR PRINTS ERROR MSG AND RETURNS.        >>  <<04784>>08040000
FCHECKERR := FALSE;                                            <<04784>>08042000
FCHECK(FNUM,ERRORCODE);                                        <<04784>>08044000
IF ERRORCODE <> 101 THEN                                       <<04784>>08046000
   BEGIN                                                       <<04784>>08048000
   FERROR'(FNUM,PARMNUM);                                      <<04784>>08050000
   CIERR(ERRNUM := RENAMEFAILED);                              <<04784>>08052000
   FCHECKERR := TRUE;                                          <<04784>>08054000
   END;                                                                 08056000
END;        << FCHECKERR  >>                                   <<04784>>08058000
                                                               <<U.RAO>>08060000
              <<******************************>>               <<04784>>08062000
              <<                              >>               <<04784>>08064000
              <<    M A I N   C O D E         >>               <<04784>>08066000
              <<                              >>               <<04784>>08068000
              <<******************************>>               <<04784>>08070000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>08072000
IF NUMPARMS > 2 THEN                                           <<U.RAO>>08074000
   BEGIN                                                       <<U.RAO>>08076000
   PARMNUM := 3;                                               <<U.RAO>>08078000
   CIERR(ERRNUM := SAVE2MP, ERRPARM);                          <<U.RAO>>08080000
   END                                                         <<U.RAO>>08082000
ELSE IF NUMPARMS = 0 THEN                                      <<U.RAO>>08084000
   BEGIN                                                       <<U.RAO>>08086000
   PARMNUM := 1;                                               <<U.RAO>>08088000
   CIERR(ERRNUM := SAVEREQFNAME,PARMSP(1));                    <<U.RAO>>08090000
   END                                                         <<U.RAO>>08092000
ELSE                                                           <<U.RAO>>08094000
   BEGIN                                                       <<U.RAO>>08096000
   IF DELIMITER=SEMI THEN  <<EXPECTED COMMA, FOUND ";", WARN>> <<U.RAO>>08098000
      CIERR(ERRNUM := -SAVESEMICOLON, OLDFNAME(OLDFNAMELEN));  <<04785>>08100000
   <<HAVE AT LEAST A LEGAL NUMBER OF PARMS. NOW VALIDATE THEM>><<U.RAO>>08102000
   TOS := CHECKFILENAME'(PARMS&LSR(8),DUMMY,DUMMY,LERRPTR);    <<U.RAO>>08104000
   IF < THEN  <<FILE NAME ERROR OF SOME SORT>>                 <<U.RAO>>08106000
      BEGIN                                                    <<U.RAO>>08108000
      PARMNUM := 1;                                            <<U.RAO>>08110000
      ERRNUM := S0;                                            <<U.RAO>>08112000
      CIERR(*,ERRPARM);                                        <<U.RAO>>08114000
      END                                                      <<U.RAO>>08116000
   ELSE IF > AND S0 <> 0 THEN                                  <<U.RAO>>08118000
      BEGIN <<SYSTEM DEFINED FILE - $OLDPASS?>>                <<U.RAO>>08120000
      IF TOS <> 3 THEN  <<NOT $OLDPASS>>                       <<U.RAO>>08122000
         BEGIN                                                 <<U.RAO>>08124000
         PARMNUM := 1;                                         <<U.RAO>>08126000
         CIERR(ERRNUM := SAVEEXPECTOLDPASS,OLDFNAME);          <<U.RAO>>08128000
         END                                                   <<U.RAO>>08130000
      ELSE IF NUMPARMS <> 2 THEN  <<MISSING NEW FILE NAME>>    <<U.RAO>>08132000
         BEGIN                                                 <<U.RAO>>08134000
         PARMNUM := 2;                                         <<U.RAO>>08136000
         CIERR(ERRNUM := SAVEREQFNAME, OLDFNAME(OLDFNAMELEN)); <<U.RAO>>08138000
         END                                                   <<U.RAO>>08140000
      ELSE                                                     <<U.RAO>>08142000
         BEGIN  <<HAVE $OLDPASS, CHECK NEW FILE NAME>>         <<U.RAO>>08144000
         TOS := CHECKFILENAME'(PARMS(1)&LSR(8),DUMMY,DUMMY,LERRPTR);    08146000
         IF < THEN   <<FILE NAME ERROR>>                       <<U.RAO>>08148000
            BEGIN                                              <<U.RAO>>08150000
            PARMNUM := 2;                                      <<U.RAO>>08152000
            ERRNUM := S0;                                      <<U.RAO>>08154000
            CIERR(*,ERRPARM);                                  <<U.RAO>>08156000
            END                                                <<U.RAO>>08158000
         ELSE IF > AND TOS <> 0 THEN                           <<U.RAO>>08160000
            BEGIN  <<SYS DEFINED FILE>>                        <<U.RAO>>08162000
            PARMNUM := 2;                                      <<U.RAO>>08164000
            CIERR(ERRNUM := SAVEREQFNAME,NEWFNAME);            <<U.RAO>>08166000
            END                                                <<U.RAO>>08168000
         ELSE  <<OK - LET'S DO IT>>                            <<U.RAO>>08170000
            BEGIN                                              <<U.RAO>>08172000
            FNUM:= FOPEN(,%2032,%10500);                       <<04784>>08174000
            IF <>    THEN  <<OPEN FAILED>>                     <<04784>>08176000
               BEGIN                                           <<U.RAO>>08178000
               FERROR'(FNUM,PARMNUM);                          <<04784>>08180000
               QUALIFYFILENAME(NEWFNAME,TEMPFNAME);            <<U.RAO>>08182000
               CIERR(ERRNUM := SAVEOPENOLDPASS,,0,@TEMPFNAME); <<U.RAO>>08184000
               END                                             <<U.RAO>>08186000
            ELSE  <<OPEN WORKED, NOW TRY RENAME>               <<RV.PV>>08188000
               BEGIN                                           <<U.RAO>>08190000
                   FRENAME (FNUM,NEWFNAME);                    <<04784>>08192000
                   IF <>    THEN                               <<04784>>08194000
                      BEGIN   <<RENAME FAILED >>               <<04784>>08196000
                      IF FCHECKERR THEN       <<GET FILE ERR>> <<04784>>08198000
                      RETURN                                   <<04784>>08200000
                      ELSE                                     <<04784>>08204000
                        BEGIN  << GET TEMP "S" NAME >>         <<04784>>08206000
                        @SPTR := @STEMPFNAME;                  <<04784>>08208000
TRYAGAIN:               IF TRIEDONCE THEN MAKEFN'(SPTR) ELSE   <<04784>>08210000
                                MAKEFN(SPTR);                  <<04784>>08212000
                        FRENAME(FNUM,SPTR);                    <<04784>>08214000
                        IF <> AND STEMPFNAME <> "S0000000"     <<04784>>08216000
                           THEN                                <<04784>>08218000
                           IF FCHECKERR THEN                   <<04784>>08220000
                               RETURN                          <<04784>>08222000
                               ELSE                            <<04784>>08224000
                                  BEGIN                        <<04784>>08226000
                                  TRIEDONCE := TRUE;           <<04784>>08228000
                                  GOTO TRYAGAIN;               <<04784>>08230000
                                  END                          <<04784>>08232000
                        ELSE RENAMESTEMP   <<"S" NAME TO NEWFNA<<04784>>08234000
                        END     << GET TEMP "S" NAME >>        <<04784>>08236000
                      END     << RENAME FAILED >>              <<04784>>08238000
                   ELSE                                        <<RV.PV>>08240000
                   BEGIN <<RENAME WORKED, CLOSE WITH SAVE>>    <<RV.PV>>08242000
                       FCLOSE(FNUM,1,0);                       <<04784>>08244000
                       IF <>    THEN   <<CLOSE FAILED >>       <<04784>>08246000
                       BEGIN                                   <<RV.PV>>08248000
                          FERROR'(FNUM,PARMNUM);               <<04784>>08250000
                          QUALIFYFILENAME(NEWFNAME,TEMPFNAME); <<RV.PV>>08252000
                          CIERR(ERRNUM:=SAVECLOSOLDPASS,,0,    <<RV.PV>>08254000
                                @TEMPFNAME);                   <<RV.PV>>08256000
                       END                                     <<RV.PV>>08258000
                   END;                                        <<RV.PV>>08260000
               END                                             <<U.RAO>>08262000
            END                                                <<U.RAO>>08264000
         END                                                   <<U.RAO>>08266000
      END                                                      <<U.RAO>>08268000
   ELSE  IF NUMPARMS=1 THEN  <<REGULAR FILE NAME>>             <<U.RAO>>08270000
      BEGIN                                                    <<U.RAO>>08272000
      FNUM:= FOPEN(OLDFNAME,%2002,%10500);                     <<04784>>08274000
      IF <>    THEN  <<OPEN FAILED>>                           <<04784>>08276000
         BEGIN                                                 <<U.RAO>>08278000
         FERROR'(FNUM,PARMNUM);                                <<04784>>08280000
         QUALIFYFILENAME(OLDFNAME,TEMPFNAME);                  <<U.RAO>>08282000
         CIERR(ERRNUM := SAVETEMPOPEN,,0,@TEMPFNAME);          <<U.RAO>>08284000
         END                                                   <<U.RAO>>08286000
      ELSE                                                     <<U.RAO>>08288000
         BEGIN                                                 <<U.RAO>>08290000
         FCLOSE(FNUM,1,0);                                     <<04784>>08292000
         IF <>    THEN  <<CLOSE FAILED>>                       <<04784>>08294000
            BEGIN                                              <<U.RAO>>08296000
            FERROR'(FNUM,PARMNUM);                             <<04784>>08298000
            QUALIFYFILENAME(OLDFNAME,TEMPFNAME);               <<U.RAO>>08300000
            CIERR(ERRNUM := SAVETEMPCLOSE,,0,@TEMPFNAME);      <<U.RAO>>08302000
            END                                                <<U.RAO>>08304000
         END                                                   <<U.RAO>>08306000
      END                                                      <<U.RAO>>08308000
   ELSE  <<REGULAR FILE NAME BUT 2 PARAMETERS>>                <<U.RAO>>08310000
      CIERR(ERRNUM := SAVE2MP,NEWFNAME);                       <<U.RAO>>08312000
   END;                                                        <<U.RAO>>08314000
END;  <<CXSAVE>>                                               <<U.RAO>>08316000
INTEGER PROCEDURE FORMACCESS'(LEVEL,ACCSTRING,SEC,NUMPARMS,ERRNUM);     08318000
VALUE LEVEL;                                                   <<U.RAO>>08320000
INTEGER LEVEL,  <<LEVEL OF SECURITY - 0/1/2 = FILE/GROUP/ACCT>><<U.RAO>>08322000
        NUMPARMS, <<NUMBER OF PARAMETERS ENCOUNTERED BEFORE RETURN>>    08324000
        ERRNUM;  <<THE USUAL MEANING>>                         <<U.RAO>>08326000
BYTE ARRAY ACCSTRING;  <<POINTER TO THE ACCESS LIST>>          <<U.RAO>>08328000
DOUBLE SEC;  <<THE SECURITY MATRIX TO BE RETURNED>>            <<U.RAO>>08330000
  <<RETURN VALUE IS ADDRESS OF NEXT NON-BLANK AFTER ACCSTRING>><<U.RAO>>08332000
OPTION UNCALLABLE,PRIVILEGED;                                  <<U.RAO>>08334000
                                                               <<U.RAO>>08336000
  <<THIS PROCEDURE PARSES THE SECURITY SPECIFICATION AND RETURNS THE>>  08338000
  <<MATRIX APPROPRIATE TO THE <LEVEL> IN <SEC>.  >>            <<U.RAO>>08340000
                                                               <<U.RAO>>08342000
BEGIN                                                          <<U.RAO>>08344000
LOGICAL LEVELMASK := 1;<<BIT 15=>FILE, BIT 14=>GROUP, BIT 13=>ACCT>>    08346000
BYTE POINTER STRINGPTR = FORMACCESS';                          <<U.RAO>>08348000
BYTE POINTER PERMIT;  <<USED IN ANALYZING VALIDITY OF USER LIST<<U.RAO>>08350000
<<INDIVIDUAL PARAMETER CHARACTERISTICS VARIABLES>>             <<U.RAO>>08352000
BYTE POINTER PARM;  <<POINTER TO CURRENT PARAMETER>>           <<U.RAO>>08354000
INTEGER PARMLEN;    <<LENGTH OF CURRENT PARAMETER>>            <<U.RAO>>08356000
BYTE DELIM;         <<NEXT DELIMITER AFTER PARAMETER>>         <<U.RAO>>08358000
<<VARIABLES FOR PARSE>>                                        <<U.RAO>>08360000
BYTE ARRAY PBACCESSORS(0:1)=PB :=                              <<U.RAO>>08362000
   6,3,"ANY",%7,                                               <<U.RAO>>08364000
   5,2,"AC" ,%7,                                               <<U.RAO>>08366000
   5,2,"AL" ,%3,                                               <<U.RAO>>08368000
   5,2,"GU" ,%3,                                               <<U.RAO>>08370000
   5,2,"GL" ,%3,                                               <<U.RAO>>08372000
   5,2,"CR" ,%1,                                               <<U.RAO>>08374000
   0;                                                          <<U.RAO>>08376000
BYTE ARRAY ACCESSORS(0:31);                                    <<U.RAO>>08378000
BYTE ARRAY PBACCESSMODES(0:1)=PB :=                            <<U.RAO>>08380000
   3,1,"R",                                                    <<U.RAO>>08382000
   3,1,"A",                                                    <<U.RAO>>08384000
   3,1,"W",                                                    <<U.RAO>>08386000
   3,1,"L",                                                    <<U.RAO>>08388000
   3,1,"X",                                                    <<U.RAO>>08390000
   3,1,"S",                                                    <<U.RAO>>08392000
   0;                                                          <<U.RAO>>08394000
BYTE ARRAY ACCESSMODES(0:24);                                  <<U.RAO>>08396000
<<VARIABLES FOR PROCESSING MATRIX  (ALREADY SET FOR FILE)>>    <<U.RAO>>08398000
INTEGER FACTOR := 6;  <<BIT WIDTH OF MODE FIELD IN MATRIX>>    <<U.RAO>>08400000
INTEGER BASE := 3;  <<NUMBER OF WASTE BITS IN MATRIX+1>>       <<U.RAO>>08402000
INTEGER SHIFTCOUNT;  <<USED WHEN USER HAS DUPLICATE ACCESS>>   <<U.RAO>>08404000
                                                               <<U.RAO>>08406000
<<                 *********************                   >>  <<U.RAO>>08408000
<<                 *   PRINTWARNING    *                   >>  <<U.RAO>>08410000
<<                 *********************                   >>  <<U.RAO>>08412000
                                                               <<U.RAO>>08414000
SUBROUTINE PRINTWARNING;  <<PRINTS DUPLICATE ACCESS WARNING>>  <<U.RAO>>08416000
BEGIN                                                          <<U.RAO>>08418000
CASE *(SHIFTCOUNT/FACTOR) OF                                   <<U.RAO>>08420000
   BEGIN                                                       <<U.RAO>>08422000
   CIERR(ERRNUM := -ACCESSRREDUND, PARM);  <<READ>>            <<04785>>08424000
   CIERR(ERRNUM := -ACCESSAREDUND, PARM);  <<APPEND>>          <<04785>>08426000
   CIERR(ERRNUM := -ACCESSWREDUND, PARM);  <<WRITE>>           <<04785>>08428000
   CIERR(ERRNUM := -ACCESSLREDUND, PARM);  <<LOCK>>            <<04785>>08430000
   CIERR(ERRNUM := -ACCESSXREDUND, PARM);  <<EXECUTE>>         <<04785>>08432000
   CIERR(ERRNUM := -ACCESSSREDUND, PARM);  <<SAVE>>            <<04785>>08434000
   END;                                                        <<U.RAO>>08436000
END;  <<SUBROUTINE PRINTWARNING>>                              <<U.RAO>>08438000
                                                               <<U.RAO>>08440000
<<                 *********************                   >>  <<U.RAO>>08442000
<<                 *  CHECKDUPACCESS   *                   >>  <<U.RAO>>08444000
<<                 *********************                   >>  <<U.RAO>>08446000
                                                               <<U.RAO>>08448000
SUBROUTINE CHECKDUPACCESS(ACCESSMASK);                         <<U.RAO>>08450000
VALUE ACCESSMASK;                                              <<U.RAO>>08452000
DOUBLE ACCESSMASK;                                             <<U.RAO>>08454000
BEGIN                                                          <<U.RAO>>08456000
<<THIS SUBROUTINE CHECKS FOR THE POSSIBLITY OF THE USER>>      <<U.RAO>>08458000
<<HAVING SPECIFIED AN ACCESS:USER POINT REDUNDANTLY.  IF>>     <<U.RAO>>08460000
<<SO THE ROUTINE WARNS THE USER, BUT ALLOWS IT.>>              <<U.RAO>>08462000
<<THE ESSENCE OF THE PROBLEM IS THAT WE ARE PASSED A BIT>>     <<U.RAO>>08464000
<<MASK (ACCESSMASK) INDICATING THE POINTS WE JUST PARSED.>>    <<U.RAO>>08466000
<<THIS REQUIRES US TO CAREFULLY UNPACK THE INFO FROM THE >>    <<U.RAO>>08468000
<<MASK.  THE DIFFICULTY ARISES FROM THE FACT THAT THE MASK>>   <<U.RAO>>08470000
<<IS DIFFERENT BASED ON WHETHER IT IS FOR FILE, ACCT OR GROUP>><<U.RAO>>08472000
<<THE ALGORITHM IS 1) FIND OUT WHETHER ANY BITS WERE >>        <<U.RAO>>08474000
<<REDUNDANT, THEN 2) SCAN THROUGH THOSE REDUNDANT BITS,>>      <<U.RAO>>08476000
<<IDENTIFYING THEM AS TO THEIR MEANING.  FORTUNATELY THIS>>    <<U.RAO>>08478000
<<CHECK IS DONE ON A PER USER MODE BASIS, ALLOWING US TO>>     <<U.RAO>>08480000
<<PUT OUT A REASONABLE MESSAGE.>>                              <<U.RAO>>08482000
TOS := ACCESSMASK;                                             <<U.RAO>>08484000
TOS := SEC;    <<FIRST AND DOUBLES TOGETHER FOR REDUNDANT BITS><<U.RAO>>08486000
ASSEMBLE(                                                      <<U.RAO>>08488000
   CAB,  <<TWO LEAST SIGNIFICANT WORDS ON TOS>>                <<U.RAO>>08490000
   AND;  <<MERGE                             >>                <<U.RAO>>08492000
   CAB,  <<NOW DO TWO MOST SIGNIFICANT WORDS>>                 <<U.RAO>>08494000
   CAB;                                                        <<U.RAO>>08496000
   AND);  <<MERGE, LEAVING MSW ON TOS>>                        <<U.RAO>>08498000
IF DS1<>0D THEN                                                <<U.RAO>>08500000
   BEGIN   <<SOMETHING WAS REDUNDANT, FIND IT>>                <<U.RAO>>08502000
   SHIFTCOUNT := -BASE;  <<ACCOUNTS FOR UNUSED BITS>>          <<U.RAO>>08504000
   WHILE S0<>0 DO                                              <<U.RAO>>08506000
      BEGIN                                                    <<U.RAO>>08508000
      SHIFTCOUNT := SHIFTCOUNT+1;  <<FOR SCAN IDIOSINCRACIES>> <<U.RAO>>08510000
      ASSEMBLE(SCAN);                                          <<U.RAO>>08512000
      SHIFTCOUNT := SHIFTCOUNT+XREG;                           <<U.RAO>>08514000
      PRINTWARNING;                                            <<U.RAO>>08516000
      END;                                                     <<U.RAO>>08518000
   DEL;  <<POP EXHAUSTED WORD>>                                <<U.RAO>>08520000
   SHIFTCOUNT := 16-BASE;  <<REINITIALIZE FOR SECOND WORD>>    <<U.RAO>>08522000
   WHILE S0<>0 DO                                              <<U.RAO>>08524000
      BEGIN                                                    <<U.RAO>>08526000
      SHIFTCOUNT := SHIFTCOUNT+1;  <<DITTO FOR SCAN INSTR>>    <<U.RAO>>08528000
      ASSEMBLE(SCAN);                                          <<U.RAO>>08530000
      SHIFTCOUNT := SHIFTCOUNT+XREG;                           <<U.RAO>>08532000
      PRINTWARNING;                                            <<U.RAO>>08534000
      END;                                                     <<U.RAO>>08536000
   DEL;                                                        <<U.RAO>>08538000
   END                                                         <<U.RAO>>08540000
ELSE DDEL;                                                     <<U.RAO>>08542000
END;                                                           <<U.RAO>>08544000
                                                               <<U.RAO>>08546000
<<                 *********************                   >>  <<U.RAO>>08548000
<<                 *       NEXT        *                   >>  <<U.RAO>>08550000
<<                 *********************                   >>  <<U.RAO>>08552000
                                                               <<U.RAO>>08554000
SUBROUTINE NEXT;                                               <<U.RAO>>08556000
   <<FINDS THE NEXT PARAMETER, CALCULATES ITS LENGTH,>>        <<U.RAO>>08558000
   <<SETS APPROPRIATE VARIABLES, FINDS NEXT DELIMITER>>        <<U.RAO>>08560000
BEGIN                                                          <<U.RAO>>08562000
NUMPARMS := NUMPARMS+1;                                        <<U.RAO>>08564000
SCAN STRINGPTR WHILE %6440,1;                                  <<U.RAO>>08566000
ASSEMBLE(DUP,DDUP);                                            <<U.RAO>>08568000
@PARM := TOS;                                                  <<U.RAO>>08570000
MOVE * := * WHILE AS,0;                                        <<U.RAO>>08572000
ASSEMBLE(CAB,SUB);  <<CALCULATE LENGTH>>                       <<U.RAO>>08574000
PARMLEN := TOS;                                                <<U.RAO>>08576000
SCAN * WHILE %6440,1;  <<FIND NEXT DELIM>>                     <<U.RAO>>08578000
DELIM := BPS0;                                                 <<U.RAO>>08580000
@STRINGPTR := TOS+1;                                           <<U.RAO>>08582000
END;                                                           <<U.RAO>>08584000
                                                               <<U.RAO>>08586000
<<                 *********************                   >>  <<U.RAO>>08588000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>08590000
<<                 *********************                   >>  <<U.RAO>>08592000
                                                               <<U.RAO>>08594000
<<FILE SECURITY MATRIX FORMAT>>                                <<U.RAO>>08596000
<<----------------------------------------------------------------->>   08598000
<<!   !   ! R ! R ! R ! R ! R ! R ! A ! A ! A ! A ! A ! A ! W ! W !>>   08600000
<<!   !   !ANY! AC! AL! GU! GL! CR!ANY! AC! AL! GU! GL! CR!ANY! AC!>>   08602000
<<----------------------------------------------------------------->>   08604000
<<! W ! W ! W ! W ! L ! L ! L ! L ! L ! L ! X ! X ! X ! X ! X ! X !>>   08606000
<<! AL! GU! GL! CR!ANY! AC! AL! GU! GL!(CR!ANY! AC! AL! GU! GL! CR!>>   08608000
<<----------------------------------------------------------------->>   08610000
                                                               <<U.RAO>>08612000
<<FILE SECURITY VARIABLES SET ON ENTRY>>                       <<U.RAO>>08614000
IF LEVEL = 1 THEN  <<GROUP>>                                   <<U.RAO>>08616000
   BEGIN                                                       <<U.RAO>>08618000
<<GROUP SECURITY MATRIX FORMAT>>                               <<U.RAO>>08620000
<<----------------------------------------------------------------->>   08622000
<<!   !   ! R ! R ! R ! R ! R ! A ! A ! A ! A ! A ! W ! W ! W ! W !>>   08624000
<<!   !   !ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU!>>   08626000
<<----------------------------------------------------------------->>   08628000
<<! W ! L ! L ! L ! L ! L ! X ! X ! X ! X ! X ! S ! S ! S ! S ! S !>>   08630000
<<! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!>>   08632000
<<----------------------------------------------------------------->>   08634000
   FACTOR := 5;                                                <<U.RAO>>08636000
   LEVELMASK := 2;                                             <<U.RAO>>08638000
   END                                                         <<U.RAO>>08640000
ELSE  IF > THEN  <<ACCOUNT SECURITY MATRIX>>                   <<U.RAO>>08642000
   BEGIN                                                       <<U.RAO>>08644000
<<ACCOUNT SECURITY MATRIX>>                                    <<U.RAO>>08646000
<<----------------------------------------------------------------->>   08648000
<<!   !   !   !   ! R ! R ! A ! A ! W ! W ! L ! L ! X ! X ! S ! S !>>   08650000
<<!   !   !   !   !ANY! AC!ANY! AC!ANY! AC!ANY! AC!ANY! AC!ANY! AC!>>   08652000
<<----------------------------------------------------------------->>   08654000
   BASE := 5;                                                  <<U.RAO>>08656000
   FACTOR := 2;                                                <<U.RAO>>08658000
   LEVELMASK := 4;                                             <<U.RAO>>08660000
   END;                                                        <<U.RAO>>08662000
NUMPARMS := 0;                                                 <<U.RAO>>08664000
<<ALL VARIABLES HAVE BEEN INITIALIZED (EXCEPT SEC)>>           <<U.RAO>>08666000
<<NOW WE START THE ACTUAL PROCESSING. THE SCHEME IS   >>       <<U.RAO>>08668000
<<  CHECK FOR "("                                     >>       <<U.RAO>>08670000
<<  WHILE MORE ACCESS LISTS DO                        >>       <<U.RAO>>08672000
<<     PROCESS SPECIFIED ACCESS MODES INTO ACCESS MASK>>       <<U.RAO>>08674000
<<     CHECK FOR ":"                                  >>       <<U.RAO>>08676000
<<     FOR EACH SPECIFIED ACCESSOR, LOR THE ACCESS    >>       <<U.RAO>>08678000
<<        MASK INTO THE SECURITY MATRIX               >>       <<U.RAO>>08680000
<<     END                                            >>       <<U.RAO>>08682000
<<  CHECK FOR ")"                                     >>       <<U.RAO>>08684000
                                                               <<U.RAO>>08686000
SCAN ACCSTRING WHILE %6440,1;  <<STRIP BLANKS>>                <<U.RAO>>08688000
IF BPS0 <> "(" THEN                                            <<U.RAO>>08690000
   CIERR(ERRNUM := ACCESSEXPECTLPAREN, BPS0)                   <<U.RAO>>08692000
ELSE  <<HAVE LEADING "(">>                                     <<U.RAO>>08694000
   BEGIN                                                       <<U.RAO>>08696000
   TOS := TOS+1;                                               <<U.RAO>>08698000
   SCAN * WHILE %6440,1;  <<SCAN FOR NEXT NON-BLANK>>          <<U.RAO>>08700000
   @STRINGPTR := TOS;  <<INITIALIZE STRINGPTR>>                <<U.RAO>>08702000
   IF STRINGPTR = ")" THEN  <<NULL ACCESS STRING>>             <<U.RAO>>08704000
      BEGIN                                                    <<U.RAO>>08706000
      SCAN STRINGPTR(1) WHILE %6440,1;                         <<U.RAO>>08708000
      @STRINGPTR := TOS;                                       <<U.RAO>>08710000
      NUMPARMS := 1;                                           <<U.RAO>>08712000
      RETURN                                                   <<U.RAO>>08714000
      END;                                                     <<U.RAO>>08716000
   <<NOW INITIALIZE SECURITY MASK>>                            <<U.RAO>>08718000
   IF LEVEL=2 THEN SEC := [16/1,16/0]D <<ACCOUNT, FORCE S:AC>> <<U.RAO>>08720000
              ELSE SEC := 0D;                                  <<U.RAO>>08722000
   <<OK, WE HAVE THE PRELIMINARIES DONE WITH.  THE TASK>>      <<U.RAO>>08724000
   <<NOW IS TO PARSE THE BODY OF THE ACCESS LIST>>             <<U.RAO>>08726000
   MOVE ACCESSMODES := PBACCESSMODES,(25);                     <<U.RAO>>08728000
   MOVE ACCESSORS := PBACCESSORS,(32);                         <<U.RAO>>08730000
   DO BEGIN  <<UNTIL NO MORE ACCESS LISTS>>                    <<U.RAO>>08732000
      <<FIRST TASK IS TO CREATE ACCESS MASK TEMPLATE>>         <<U.RAO>>08734000
      TOS := 0D;   <<INITIALIZE TEMPLATE>>                     <<U.RAO>>08736000
      DO BEGIN  <<UNTIL END OF MODELIST>>                      <<U.RAO>>08738000
         <<STRATEGY IS TO LOOP THROUGH MODE LIST, CREATING>>   <<U.RAO>>08740000
         <<A DOUBLE WITH BITS SET FOR "ANY" WITH  THE >>       <<U.RAO>>08742000
         <<SPECIFIED MODES AND THE SPECIFIED BIT SPACING>>     <<U.RAO>>08744000
         NEXT;  <<SET CHARACTERISTICS OF NEXT PARM>>           <<U.RAO>>08746000
         TOS := SEARCH(PARM,PARMLEN,ACCESSMODES) - 1;          <<U.RAO>>08748000
         IF < THEN <<UNKNOWN ACCESS MODE>>                     <<U.RAO>>08750000
            BEGIN                                              <<U.RAO>>08752000
            IF LEVEL < 1 THEN ERRNUM:=ACCESSUNKNOWNFMODE       <<U.RAO>>08754000
            ELSE IF = THEN    ERRNUM:=ACCESSUNKNOWNGMODE       <<U.RAO>>08756000
            ELSE              ERRNUM:=ACCESSUNKNOWNAMODE;      <<U.RAO>>08758000
            CIERR(ERRNUM,PARM);                                <<U.RAO>>08760000
            RETURN;                                            <<U.RAO>>08762000
            END;                                               <<U.RAO>>08764000
         IF (S0=5) AND (LEVEL<>1) THEN                         <<U.RAO>>08766000
            BEGIN <<WARN - ILLEGAL USE OF SAVE MODE>>          <<U.RAO>>08768000
            DEL;                                               <<U.RAO>>08770000
            IF LEVEL = 0 THEN ERRNUM := -ACCESSFSNOTPERMIT     <<04785>>08772000
                         ELSE ERRNUM := -ACCESSASNOTPERMIT;    <<04785>>08774000
            CIERR(ERRNUM,PARM);                               <<<04785>>08776000
            END                                                <<U.RAO>>08778000
         ELSE                                                  <<U.RAO>>08780000
            BEGIN <<EVERYTHING GOOD, SET MASK BIT>>            <<U.RAO>>08782000
            X := TOS*FACTOR+BASE;  <<OFFSET FROM BIT 31>>      <<U.RAO>>08784000
            ASSEMBLE(DCSL 0,X;  <<ROTATE TO BIT 31>>           <<U.RAO>>08786000
                     TSBC 15);  <<SET ACCESS BIT>>             <<U.RAO>>08788000
            <<NOTE:  X HAS THE SHIFT COUNT IN IT, UPON WHICH>> <<U.RAO>>08790000
            <<THE FOLLOWING ASSEMBLE DEPENDS.  DON'T MESS IT UP<<U.RAO>>08792000
            IF <> THEN  <<ACCESS MODE REDUNDANTLY SPECIFIED>>  <<U.RAO>>08794000
               CIERR(ERRNUM := -ACCESSREDUNDMODE, PARM);       <<04785>>08796000
            ASSEMBLE(DCSR 0,X);  <<ROTATE BACK>>               <<U.RAO>>08798000
            END                                                <<U.RAO>>08800000
         END UNTIL DELIM <> ",";                               <<U.RAO>>08802000
      <<ACCESS MODE LIST PARSED. NOW CHECK FOR ":">>           <<U.RAO>>08804000
      IF DELIM <> ":" THEN                                     <<U.RAO>>08806000
         BEGIN                                                 <<U.RAO>>08808000
         CIERR(ERRNUM := ACCESSEXPECTCOLON, STRINGPTR(-1));    <<U.RAO>>08810000
         RETURN                                                <<U.RAO>>08812000
         END;                                                  <<U.RAO>>08814000
      <<NOW PROCESS USER LIST.  AS WE FIND A VALID USER, >>    <<U.RAO>>08816000
      <<WE SHIFT THE PROTOTYPE MODE LIST (DOUBLE ON TOS) >>    <<U.RAO>>08818000
      <<AND LOR IT INTO THE NEW SECURITY MATRIX>>              <<U.RAO>>08820000
      DO BEGIN  <<UNTIL END OF USER LIST>>                     <<U.RAO>>08822000
         NEXT;                                                 <<U.RAO>>08824000
         X := SEARCH(PARM,PARMLEN,ACCESSORS,PERMIT)-1;         <<U.RAO>>08826000
         IF < THEN <<UNKNOWN ACCESSOR TYPE>>                   <<U.RAO>>08828000
            BEGIN                                              <<U.RAO>>08830000
            IF LEVEL < 1 THEN ERRNUM := ACCESSUNKNOWNFUSER     <<U.RAO>>08832000
            ELSE IF = THEN ERRNUM := ACCESSUNKNOWNGUSER        <<U.RAO>>08834000
            ELSE ERRNUM := ACCESSUNKNOWNAUSER;                 <<U.RAO>>08836000
            CIERR(ERRNUM,PARM);                                <<U.RAO>>08838000
            RETURN                                             <<U.RAO>>08840000
            END;                                               <<U.RAO>>08842000
         IF (LOGICAL(PERMIT) LAND LEVELMASK) = 0 THEN          <<U.RAO>>08844000
            BEGIN  <<WARN - NOT PERMITTED FOR THIS LEVEL>>     <<U.RAO>>08846000
            DEL;                                               <<U.RAO>>08848000
            IF LEVEL=1 THEN ERRNUM := -ACCESSCRNOTPERMIT       <<04785>>08850000
                        ELSE ERRNUM := -ACCESSUSNOTPERMIT;     <<04785>>08852000
            CIERR(ERRNUM,PARM);                                <<04785>>08854000
            END                                                <<U.RAO>>08856000
         ELSE                                                  <<U.RAO>>08858000
            BEGIN                                              <<U.RAO>>08860000
            <<HAVE VALID USER TYPE AND A VALID ACCESS MODE>>   <<U.RAO>>08862000
            <<MASK.  NOW PROCESS THE MASK INTO THE SECURITY>>  <<U.RAO>>08864000
            <<MATRIX.  THE INDEX REGISTER HAS THE ORDINAL OF>> <<U.RAO>>08866000
            <<THE USER TYPE AND THE PROTOTYPE MODE MASK IS >>  <<U.RAO>>08868000
            <<IN S-0 AND S-1>>                                 <<U.RAO>>08870000
            ASSEMBLE(DDUP;  <<COPY MODE MASK>>                 <<U.RAO>>08872000
                     DCSR 0,X); <<SHIFT COPY BY USER TYPE>>    <<U.RAO>>08874000
            CHECKDUPACCESS(DS1);                               <<U.RAO>>08876000
            TOS := SEC;                                        <<U.RAO>>08878000
            ASSEMBLE(CAB, <<GET 2 LEAST SIGNIFICANT WORDS>>    <<U.RAO>>08880000
                     OR;  <<MERGE THEM>>                       <<U.RAO>>08882000
                     CAB, <<GET 2 MOST SIGNIFICANT WORDS>>     <<U.RAO>>08884000
                     CAB;                                      <<U.RAO>>08886000
                     OR,  <<MERGE THEM>>                       <<U.RAO>>08888000
                     XCH); <<PUT BACK IN ORDER>>               <<U.RAO>>08890000
            SEC := TOS;  <<NEW BITS LOR'D INTO OLD MASK>>      <<U.RAO>>08892000
            END;                                               <<U.RAO>>08894000
         END UNTIL DELIM <> ",";                               <<U.RAO>>08896000
      DDEL;  <<POP PROTOTYPE MODE MASK>>                       <<U.RAO>>08898000
      END UNTIL DELIM <> ";";  <<GLOBAL DO LOOP>>              <<U.RAO>>08900000
                                                               <<U.RAO>>08902000
   <<WE HAVE NOW PROCESSED THE ENTIRE SET OF ACCESS LISTS>>    <<U.RAO>>08904000
   <<TIME TO FOLD OUR TENTS AND STEAL AWAY INTO THE NIGHT>>    <<U.RAO>>08906000
   IF DELIM <> ")" THEN                                        <<U.RAO>>08908000
      CIERR(ERRNUM := ACCESSEXPECTRPAREN, STRINGPTR(-1))       <<U.RAO>>08910000
   ELSE                                                        <<U.RAO>>08912000
      BEGIN  <<FIND NEXT NON-BLANK BEYOND ")">>                <<U.RAO>>08914000
      SCAN STRINGPTR WHILE %6440,1;                            <<U.RAO>>08916000
      @STRINGPTR := TOS;                                       <<U.RAO>>08918000
      END;                                                     <<U.RAO>>08920000
   END;                                                        <<U.RAO>>08922000
END;  <<FORMACCESS'>>                                          <<U.RAO>>08924000
INTEGER PROCEDURE GETFLABEL (FILEREF, LEN, FLABEL, FLDN, FADDR,         08926000
      FNUM,SIRINFO);                                           <<04.RO>>08928000
   VALUE LEN;                                                           08930000
   BYTE ARRAY FILEREF;                 <<U-SUPPLIED FILEREF>>           08932000
   INTEGER LEN;                        <<ITS LENGTH>>                   08934000
   ARRAY FLABEL;                       <<128 WD TARGET ARRAY>>          08936000
   INTEGER FLDN;                       <<FILE'S LDN>>                   08938000
   DOUBLE FADDR;                       <<FILE'S SECTOR ADDR>>           08940000
   INTEGER FNUM;  <<FNUM OF FILE FOR WHICH WE WANT FILE LABEL>><<04.RO>>08942000
   DOUBLE SIRINFO;                     <<SIR AND FLAGS TO RELEASE>>     08944000
   OPTION VARIABLE, PRIVILEGED, UNCALLABLE;                             08946000
<< ANALYZES THE FILEREFERENCE;  GETS THE FILE LABEL;  VERIFIES LOCKWORD;08948000
   AND ENSURES THAT CALLER IS CREATOR.                                  08950000
   FILESIR LOCKED ON RETURN FOR UPDATE.                                 08952000
                                                                        08954000
   ALTERNATE CALL:                                                      08956000
INTEGER PROCEDURE GETFLABEL (FILEREF, LEN, FLABEL);                     08958000
   SAME AS ABOVE BUT FILESIR RELEASED.  FOR EXAMINATION.                08960000
                                                                        08962000
   RETURNS ERROR NUMBER IF ONE WAS FOUND.>>                    <<U.RAO>>08964000
                                                                        08966000
BEGIN                                                                   08968000
   DOUBLE ARRAY      DJIT1 (@)         = DB+2;                          08970000
   INTEGER           RETURNVAL         = GETFLABEL;                     08972000
   LOGICAL           PMASK             = Q-4;                           08974000
   BYTE POINTER      BFLABEL           := @FLABEL;                      08976000
   DEFINE            FLANAME           = BFLABEL (16)  #;      << I.A >>08978000
   INTEGER           TYPE              := ACCOUNTLEVEL;        <<38.PV>>08980000
   DOUBLE            FLABADDR          ;                       <<RV.PV>>08982000
   INTEGER           LDEV              ;                       <<RV.PV>>08984000
   BYTE POINTER      GPNTR,                                             08986000
                     ERRPTR,  <<DUMMY FOR CHECKFILENAME'>>     <<U.RAO>>08988000
                     APNTR;                                             08990000
   LOGICAL           LGPNTR            = GPNTR,                         08992000
                     LERRPTR           = ERRPTR,               <<U.RAO>>08994000
                     LAPNTR            = APNTR;                         08996000
   INTEGER ARRAY     UAN (0:3),                                         08998000
                     FNAME (0:57),                                      09000000
                     GNAME (*)         = FNAME (4),                     09002000
                     ANAME (*)         = GNAME (4);                     09004000
   BYTE ARRAY        BANUN (*)         = UAN,                           09006000
                     BFNAME (*)        = FNAME,                         09008000
                     BGNAME (*)        = GNAME,                         09010000
                     BANAME (*)        = ANAME,                         09012000
                     LOCK (*)          = ANAME (4);                     09014000
                                                                        09016000
   FNAME := "  ";                                                       09018000
   MOVE FNAME (1) := FNAME, (31);                                       09020000
   TOS := 0;  <<RETURN SPACE>>                                 <<U.RAO>>09022000
   TOS := @FILEREF;                                            <<U.RAO>>09024000
   TOS := LEN;                                                 <<U.RAO>>09026000
   TOS := CHECKFILENAME'(*,LGPNTR,LAPNTR,LERRPTR);             <<U.RAO>>09028000
   IF < THEN  <<FILE NAME PARSE ERROR>>                        <<U.RAO>>09030000
      BEGIN                                                    <<U.RAO>>09032000
      RETURNVAL := S0;                                         <<U.RAO>>09034000
      CIERR(*,ERRPTR);                                         <<U.RAO>>09036000
      RETURN                                                   <<U.RAO>>09038000
      END                                                      <<U.RAO>>09040000
   ELSE IF > THEN  <<REQUIRES ACTUAL DESIGNATOR>>              <<U.RAO>>09042000
      BEGIN                                                    <<U.RAO>>09044000
      CIERR(RETURNVAL := REQFORMALFDESIG);                     <<U.RAO>>09046000
      RETURN                                                   <<U.RAO>>09048000
      END;                                                     <<U.RAO>>09050000
   MOVE BFNAME := FILEREF WHILE ANS, 0;                                 09052000
   IF BPS0 = "/" THEN                                                   09054000
      BEGIN                                                             09056000
      TOS := @LOCK;                                                     09058000
      ASSEMBLE (XCH, INCA);                                             09060000
      MOVE * := * WHILE ANS, 0;                                         09062000
      END;                                                              09064000
   IF BPS0 = "." THEN                                                   09066000
      BEGIN                                                             09068000
      TYPE := TYPE -1;                                                  09070000
      MOVE BGNAME := GPNTR WHILE ANS, 0;                                09072000
      IF BPS0 = "." THEN                                                09074000
         BEGIN                                                          09076000
         TYPE := TYPE -1;                                               09078000
         MOVE BANAME := APNTR WHILE ANS;                                09080000
         END ELSE                                              <<31.PV>>09082000
          WHO (,,,,,BANAME);                                   <<31.PV>>09084000
      END ELSE                                                 <<31.PV>>09086000
       WHO (,,,,BGNAME,BANAME);                                <<31.PV>>09088000
   <<AT THIS POINT WE HAVE THE FILE NAME.  NEXT WE OPEN THE>>  <<04.RO>>09090000
   <<FILE.  THIS HAS NO RELEVANCE TO THE ACTUAL ACCESSING OF>> <<04.RO>>09092000
   <<THE FILE.  IT'S ONLY PURPOSE IS TO CAUSE A MOUNT OF THE>> <<04.RO>>09094000
   <<PRIVATE VOLUME, IF NECESSARY>>                            <<04.RO>>09096000
   FNUM := FOPEN(FILEREF,%2001,%10717);<<INONLY,NOBUF,NO SEC.>><<01652>>09098000
   IF <> THEN                                                  <<04.RO>>09100000
      BEGIN   <<OPEN FAILED, TELL USER>>                       <<04.RO>>09102000
      FERROR'(FNUM, TYPE);                                     <<04.RO>>09104000
      QUALIFYFILENAME(FILEREF, BFNAME);                        <<04.RO>>09106000
      CIERR(RETURNVAL := GETFLABOPEN,,0,@BFNAME);              <<04.RO>>09108000
      RETURN                                                   <<04.RO>>09110000
      END;                                                     <<04.RO>>09112000
   PUSH (DL);                                                           09114000
   X := TOS-PS0(-1);                                           <<U.RAO>>09116000
   EXCHANGEDB (ARRDB6 (X).(6:10));                                      09118000
   TOS := DJIT1 (4);                                                    09120000
   TOS := DJIT1 (5);                                                    09122000
   TOS := DJIT1 (10);                                                   09124000
   TOS := DJIT1 (11);                                                   09126000
   EXCHANGEDB (0);                                                      09128000
   MOVE UAN := ARRS7, (8);                                              09130000
   TOS := FILESIR;                                                      09132000
   TOS := GETSIR (FILESIR);                                             09134000
   IF PMASK THEN SIRINFO := DS1;                                        09136000
   FGETINFO (FNUM,,,,,,LDEV,,,,,,,,,,,,,FLABADDR);             <<RV.PV>>09138000
   TOS := 0;                                                            09140000
   TOS := LDEV;                                                <<RV.PV>>09142000
   TOS := FLABADDR;                                            <<RV.PV>>09144000
   TOS := 0;                                                            09146000
   TOS := @FLABEL;                                                      09148000
   IF PMASK THEN                                                        09150000
      BEGIN                                                             09152000
      FLDN := S4;                                                       09154000
      FADDR := DS3;                                                     09156000
      END;                                                              09158000
   TOS := FLABIO (*,*,*,*);                                             09160000
   IF TOS <> 0 THEN  <<DISC IO ERROR>>                         <<U.RAO>>09162000
      BEGIN                                                    <<U.RAO>>09164000
      TOS := SIRINFO;                                          <<06.RO>>09166000
      RELSIR(*,*);  <<RELEASE FILE SIR>>                       <<06.RO>>09168000
      CIERR(RETURNVAL := DISCIOERR);                           <<U.RAO>>09170000
      FCLOSE(FNUM,0,0);                                        <<06.RO>>09172000
      RETURN;                                                  <<06.RO>>09174000
      END;                                                     <<U.RAO>>09176000
   IF FLANAME <> BANUN,(16) THEN  <<CREATOR CONFLICT>>         <<U.RAO>>09178000
      BEGIN                                                    <<U.RAO>>09180000
      TOS := SIRINFO;                                          <<06.RO>>09182000
      RELSIR(*,*);   <<RELEASE FILE SYSTEM SIR>>               <<06.RO>>09184000
      CIERR(RETURNVAL := NOTCREATOR);                          <<U.RAO>>09186000
      FCLOSE(FNUM,0,0);                                        <<06.RO>>09188000
      RETURN;                                                  <<06.RO>>09190000
      END;                                                     <<U.RAO>>09192000
   IF NOT (PMASK) THEN                                                  09194000
      BEGIN                                                    <<04.RO>>09196000
         TOS := SIRINFO;                                       <<06.RO>>09198000
         RELSIR(*,*);  <<RELEASE FILE SIR>>                    <<06.RO>>09200000
         FCLOSE(FNUM,0,0);                                     <<04.RO>>09202000
      END;                                                     <<04.RO>>09204000
   END    <<GETFLABEL>>;                                                09206000
LOGICAL PROCEDURE ALTSECURITY(ERRNUM,FILEREF,TYPE,SEC);        <<U.RAO>>09208000
VALUE FILEREF,TYPE,SEC;                                        <<U.RAO>>09210000
DOUBLE FILEREF,SEC;                                            <<U.RAO>>09212000
INTEGER ERRNUM,TYPE;                                           <<U.RAO>>09214000
OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                       <<U.RAO>>09216000
<<THIS PROCEDURE IS CALLED BY CXRELEASE, CXSECURE, CXALTSEC>>  <<U.RAO>>09218000
<<ITS FUNCTION IS TO ACTUALLY DO THE FILE LABEL MANIPULATIONS>><<U.RAO>>09220000
<<FILEREF IS A DOUBLE WITH A BYTE POINTER TO THE BEGINNING OF>><<U.RAO>>09222000
<<THE FILE REFERENCE IN WORD 1 AND THE LENGTH OF THE FILE    >><<U.RAO>>09224000
<<REFERENCE IN WORD 2.  THIS IS USUALLY OBTAINED BY A LSR(8) >><<U.RAO>>09226000
<<ON THE DOUBLE RETURNED FROM MYCOMMAND.                     >><<U.RAO>>09228000
<<TYPE = 1 => SECURE THE FILE                                >><<U.RAO>>09230000
<<     = 0 => RELEASE THE FILE                               >><<U.RAO>>09232000
<<     = -1 => ALTER THE SECURITY MASK.                      >><<U.RAO>>09234000
<<SEC IS PRESENT IFF TYPE = -1 AND IS NEW SECURITY MASK.     >><<U.RAO>>09236000
BEGIN                                                          <<U.RAO>>09238000
DOUBLE SIRINFO; <<FILE SYSTEM SIR>>                            <<U.RAO>>09240000
DOUBLE FADDR;                                                  <<U.RAO>>09242000
INTEGER FLDN;  <<LOGICAL DEVICE NUMBER>>                       <<U.RAO>>09244000
INTEGER ARRAY FLABEL(0:127);                                   <<U.RAO>>09246000
DOUBLE ARRAY DFLABEL(*)=FLABEL;                                <<U.RAO>>09248000
LOGICAL PMASK = Q-4;                                           <<U.RAO>>09250000
BYTE POINTER FREF = FILEREF;                                   <<U.RAO>>09252000
INTEGER LEN = FILEREF+1;                                       <<U.RAO>>09254000
INTEGER FNUM;  <<HOLDS FNUM OF FILEREF OPENED IN GETFLABEL>>   <<04.RO>>09256000
                                                               <<U.RAO>>09258000
ALTSECURITY := FALSE;                                          <<U.RAO>>09260000
ERRNUM := GETFLABEL(FREF,LEN,FLABEL,FLDN,FADDR,FNUM,SIRINFO);  <<U.RAO>>09262000
IF ERRNUM = 0 THEN                                             <<U.RAO>>09264000
   BEGIN  <<OK - GO ON>>                                       <<U.RAO>>09266000
   IF PMASK THEN <<ALTSEC, SINCE NEW SECURITY MASK PASSED>>    <<U.RAO>>09268000
      DFLABEL(FLSECMATRIX) := SEC                              <<U.RAO>>09270000
   ELSE  <<RELEASE/SECURE>>                                    <<U.RAO>>09272000
      FLABEL(FLSECURE).(15:1) := TYPE;                         <<U.RAO>>09274000
   TOS := FLABIO(FLDN,FADDR,1,FLABEL);                         <<U.RAO>>09276000
   TOS := SIRINFO;                                             <<U.RAO>>09278000
   RELSIR(*,*);  <<RELEASE FILE SYSTEM SIR GOTTEN BY GETFLABEL><<U.RAO>>09280000
   FCLOSE(FNUM,0,0);  <<CLOSE MODIFIED FILE>>                  <<04.RO>>09282000
   ALTSECURITY := TRUE;                                        <<U.RAO>>09284000
   IF TOS <> 0 THEN                                            <<U.RAO>>09286000
      BEGIN                                                    <<U.RAO>>09288000
      ALTSECURITY := FALSE;                                    <<U.RAO>>09290000
      CIERR(ERRNUM := DISCIOERR);                              <<U.RAO>>09292000
      END;                                                     <<U.RAO>>09294000
   FLABEL := 0;                                                <<U.RAO>>09296000
   MOVE FLABEL(1) := FLABEL,(127);                             <<U.RAO>>09298000
   END;                                                        <<U.RAO>>09300000
END;                                                           <<U.RAO>>09302000
PROCEDURE CXRELEASE EXECUTORHEAD;                              <<U.RAO>>09304000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>09306000
BEGIN                                                          <<U.RAO>>09308000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>09310000
BYTE POINTER ERRPTR = PARMS+2;                                 <<U.RAO>>09312000
INTEGER NUMPARMS;                                              <<U.RAO>>09314000
DOUBLE DL:=COMMASEMICR;                                        <<U.RAO>>09316000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>09318000
PARMNUM := 1;                                                  <<U.RAO>>09320000
IF NUMPARMS >= 2 THEN                                          <<U.RAO>>09322000
   CIERR(ERRNUM := RELEASE2MP, ERRPTR)                         <<U.RAO>>09324000
ELSE IF NUMPARMS < 1 THEN                                      <<U.RAO>>09326000
   CIERR(ERRNUM := RELEASENOTENUF, PARMSP(1))                  <<U.RAO>>09328000
ELSE   <<EVERYTHING PARSED OK>>                                <<U.RAO>>09330000
   IF ALTSECURITY(ERRNUM,PARMS&LSR(8),0) THEN                  <<U.RAO>>09332000
      PARMNUM := 0;  <<EVERYTHING IS FINE>>                    <<U.RAO>>09334000
END;                                                           <<U.RAO>>09336000
PROCEDURE CXSECURE EXECUTORHEAD;                               <<U.RAO>>09338000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>09340000
BEGIN                                                          <<U.RAO>>09342000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>09344000
BYTE POINTER ERRPTR = PARMS+2;                                 <<U.RAO>>09346000
INTEGER NUMPARMS;                                              <<U.RAO>>09348000
DOUBLE DL := COMMASEMICR;                                      <<U.RAO>>09350000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>09352000
PARMNUM := 1;                                                  <<U.RAO>>09354000
IF NUMPARMS >= 2 THEN                                          <<U.RAO>>09356000
   CIERR(ERRNUM := SECURE2MP,ERRPTR)                           <<U.RAO>>09358000
ELSE IF NUMPARMS < 1 THEN                                      <<U.RAO>>09360000
   CIERR(ERRNUM := SECURENOTENUF, PARMSP(1))                   <<U.RAO>>09362000
ELSE  <<EVERYTHING PARSED OK SO FAR>>                          <<U.RAO>>09364000
   IF ALTSECURITY(ERRNUM, PARMS&LSR(8),1) THEN                 <<U.RAO>>09366000
      PARMNUM := 0;                                            <<U.RAO>>09368000
END;                                                           <<U.RAO>>09370000
PROCEDURE CXALTSEC EXECUTORHEAD;                               <<U.RAO>>09372000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>09374000
BEGIN                                                          <<U.RAO>>09376000
DOUBLE ARRAY PARMS(0:1) = Q;                                   <<U.RAO>>09378000
INTEGER DL := SEMICR;                                          <<U.RAO>>09380000
INTEGER NUMPARMS;                                              <<U.RAO>>09382000
DOUBLE SEC := [6/32,6/32,6/32,6/32,6/32]D;                     <<U.RAO>>09384000
BYTE POINTER ACCSTRING = PARMS+2;                              <<U.RAO>>09386000
                                                               <<U.RAO>>09388000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>09390000
IF NUMPARMS < 1 THEN                                           <<U.RAO>>09392000
   BEGIN                                                       <<U.RAO>>09394000
   PARMNUM := 1;                                               <<U.RAO>>09396000
   CIERR(ERRNUM := ALTSECNOTENUF, PARMSP(1));                  <<U.RAO>>09398000
   END                                                         <<U.RAO>>09400000
ELSE                                                           <<U.RAO>>09402000
   BEGIN                                                       <<U.RAO>>09404000
   IF > THEN  <<MODELIST INCLUDED?>>                           <<U.RAO>>09406000
      BEGIN                                                    <<U.RAO>>09408000
      TOS := FORMACCESS'(0,ACCSTRING,SEC,NUMPARMS,ERRNUM);     <<U.RAO>>09410000
      IF ERRNUM > 0 THEN   <<ERROR REPORTED>>                  <<U.RAO>>09412000
         BEGIN                                                 <<U.RAO>>09414000
         PARMNUM := NUMPARMS;                                  <<U.RAO>>09416000
         RETURN                                                <<U.RAO>>09418000
         END;                                                  <<U.RAO>>09420000
      IF BPS0 <> %15 <<CR>> THEN                               <<U.RAO>>09422000
         BEGIN                                                 <<U.RAO>>09424000
         PARMNUM := NUMPARMS+1;                                <<U.RAO>>09426000
         CIERR(ERRNUM := ALTSEC2MP, BPS0);                     <<U.RAO>>09428000
         RETURN                                                <<U.RAO>>09430000
         END;                                                  <<U.RAO>>09432000
      END;                                                     <<U.RAO>>09434000
   IF NOT ALTSECURITY(ERRNUM,PARMS&LSR(8),-1,SEC) THEN         <<U.RAO>>09436000
      PARMNUM := 1;                                            <<U.RAO>>09438000
   END;                                                        <<U.RAO>>09440000
END;  <<CXALTSEC>>                                             <<U.RAO>>09442000
$PAGE    "LISTF EXECUTOR AND RELATED PROCEDURES"                        09444000
$CONTROL   SEGMENT  =  CILISTF                                          09446000
                                                                        09448000
PROCEDURE LISTFNOTMTDMSG (GHVSNAME',SOURCEDST);                <<RV.PV>>09450000
    VALUE SOURCEDST;  INTEGER SOURCEDST;                       <<RV.PV>>09452000
    ARRAY GHVSNAME';                                           <<RV.PV>>09454000
    OPTION PRIVILEGED, UNCALLABLE;                             <<04.RO>>09456000
    BEGIN                                                      <<RV.PV>>09458000
       INTEGER ERRNUM;                                         <<04785>>09460000
        ARRAY                                                  <<RV.PV>>09462000
            HVSNAME (0:(NAMESIZE*3)-1);                        <<RV.PV>>09464000
        BYTE ARRAY                                             <<RV.PV>>09466000
            STRING (0:((NAMESIZE*3)*2)+2);                     <<RV.PV>>09468000
        TOS := @HVSNAME;                                       <<RV.PV>>09470000
        TOS := SOURCEDST;                                      <<RV.PV>>09472000
        TOS := @GHVSNAME';                                     <<RV.PV>>09474000
        TOS := NAMESIZE*3;                                     <<RV.PV>>09476000
        ASSEMBLE (MFDS);                                       <<RV.PV>>09478000
        FORMNAME (1,STRING,HVSNAME (NAMESIZE*2),               <<RV.PV>>09480000
                  HVSNAME (NAMESIZE),HVSNAME,HVSNAME);         <<RV.PV>>09482000
        CIERR (ERRNUM := -LISTFHVSNOTMTD,,0,@STRING);          <<04785>>09484000
    END;<<OF LISTFNOTMTDMSG>>                                  <<RV.PV>>09486000
                                                               <<04.KM>>09488000
                                                               <<04.KM>>09490000
$CONTROL  SEGMENT=CILISTF                                      <<04.KM>>09492000
<<********************************************************************>>09494000
<< M U L T I L I N E >>                                        <<04.KM>>09496000
                                                               <<04.KM>>09498000
INTEGER PROCEDURE MULTILINE(FILE,MSG,MSGLEN,FIELD,FIELDLEN,    <<04.KM>>09500000
                            LASTCCTL,PREFIX,PREFIXLEN);        <<04.KM>>09502000
  VALUE FILE,MSG,MSGLEN,FIELD,FIELDLEN,LASTCCTL,PREFIXLEN;     <<04.KM>>09504000
  INTEGER FILE,MSGLEN,FIELD,FIELDLEN,LASTCCTL,PREFIXLEN;       <<04.KM>>09506000
  BYTE POINTER MSG;                                            <<04.KM>>09508000
  BYTE ARRAY PREFIX;                                           <<04.KM>>09510000
  OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                       <<04.KM>>09512000
BEGIN                                                          <<04.KM>>09514000
  COMMENT:                                                     <<04.KM>>09516000
    WRITES "MSG" TO "FILE" AT POSITION "FIELD" WITHIN RECORD.  <<04.KM>>09518000
    IF "MSGLEN" EXCEEDS "FIELDLEN", THE MESSAGE IS BROKEN ON   <<04.KM>>09520000
    WORD BOUNDARY AND WRITTEN ON MULTIPLE LINES.  FIRST LINE   <<04.KM>>09522000
    MAY BE PREFACED BY "PREFIX" -- SUBSEQUENT LINES CONTAIN    <<04.KM>>09524000
    BLANKS TO THE LEFT OF "FIELD".  LAST LINE IS WRITTEN WITH  <<04.KM>>09526000
    "CCTL" CARRIAGE CONTROL.                                   <<04.KM>>09528000
                                                               <<04.KM>>09530000
    RETURNS SAME CONDITION CODE AS FCONTROL OR FWRITE.  ALSO   <<04.KM>>09532000
    RETURNS FILE SYSTEM ERROR NUMBER (FCHECK).                 <<04.KM>>09534000
                                                               <<04.KM>>09536000
    INPUT PARAMETERS:                                          <<04.KM>>09538000
      MSGLEN=    # BYTES (POSITIVE)                            <<04.KM>>09540000
      FIELD=     0-ORIGINED BYTE POSITION WITHIN RECORD        <<04.KM>>09542000
      FIELDLEN=  # BYTES (POSITIVE)                            <<04.KM>>09544000
      LASTCCTL=  "FWRITE" CCTL                                 <<04.KM>>09546000
      PREFIXLEN= # BYTES (POSITIVE).                           <<04.KM>>09548000
                                                               <<04.KM>>09550000
    DEFAULT VALUES ARE:                                        <<04.KM>>09552000
      FILE=      $STDLIST                                      <<04.KM>>09554000
      MSGLEN=    0                                             <<04.KM>>09556000
      FIELD=     0                                             <<04.KM>>09558000
      FIELDLEN=  RECSIZE-FIELD                                 <<04.KM>>09560000
      LASTCCTL=  0                                             <<04.KM>>09562000
      PREFIXLEN= 0.                                            <<04.KM>>09564000
                                                               <<04.KM>>09566000
    IF "FIELD" EXCEEDS RECSIZE THE DEFAULT IS TAKEN.  HOWEVER, <<04.KM>>09568000
    FIELD+FIELDLEN MAY EXCEED RECSIZE.  IF FILE<=0 OR FIELD<0  <<04.KM>>09570000
    OR FIELDLEN<=0, THE CORRESPONDING DEFAULT IS TAKEN.  IF    <<04.KM>>09572000
    "MSG" OR "PREFIX" IS NOT PASSED, THE CORRESPONDING DEFAULT <<04.KM>>09574000
    "MSGLEN" OR "PREFIXLEN" IS TAKEN.                          <<04.KM>>09576000
    ;                                                          <<04.KM>>09578000
                                                               <<04.KM>>09580000
  INTEGER MLINEVALUE= MULTILINE;                               <<04.KM>>09582000
  LABEL EXITINSTR;                                             <<04.KM>>09584000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<04.KM>>09586000
                                                               <<04.KM>>09588000
  DEFINE FNFLAG= QPARM.(8:1) #,        <<FILE PASSED>>         <<04.KM>>09590000
         MFLAG=  QPARM.(9:1) #,        <<MSG PASSED>>          <<04.KM>>09592000
         MLFLAG= QPARM.(10:1) #,       <<MSGLEN PASSED>>       <<04.KM>>09594000
         FFLAG=  QPARM.(11:1) #,       <<FIELD PASSED>>        <<04.KM>>09596000
         FLFLAG= QPARM.(12:1) #,       <<FIELDLEN PASSED>>     <<04.KM>>09598000
         LFLAG=  QPARM.(13:1) #,       <<LASTCCTL PASSED>>     <<04.KM>>09600000
         PFLAG=  QPARM.(14:1) #,       <<PREFIX PASSED>>       <<04.KM>>09602000
         PLFLAG= QPARM #;              <<PREFIXLEN PASSED>>    <<04.KM>>09604000
  DEFINE QCC=     6:2 #;                                       <<04.KM>>09606000
  EQUATE CCL=     1,                                           <<04.KM>>09608000
         CCE=     2,                                           <<04.KM>>09610000
         CCG=     0,                                           <<04.KM>>09612000
         STDLIST= 2;                                           <<04.KM>>09614000
  BYTE TOPSTACK= MULTILINE,                                    <<04.KM>>09616000
       DUMMY=    TOPSTACK;                                     <<04.KM>>09618000
  BYTE POINTER TEMP;                                           <<04.KM>>09620000
  INTEGER QSTATUS= Q-1,                                        <<04.KM>>09622000
          X=       X,                                          <<04.KM>>09624000
          S0=      S-0,                                        <<04.KM>>09626000
          DL,                                                  <<04.KM>>09628000
          LAST,                                                <<04.KM>>09630000
          RECSIZE,                                             <<04.KM>>09632000
          CCTL;                                                <<04.KM>>09634000
  LOGICAL QPARM= Q-4;                                          <<04.KM>>09636000
  POINTER WTEMP;                                               <<04.KM>>09638000
  INTRINSIC FWRITE,FGETINFO,FCHECK;                            <<04.KM>>09640000
                                                               <<04.KM>>09642000
  ARRAY WBUF(*)=     Q;                                        <<04.KM>>09644000
  BYTE ARRAY BUF(*)= WBUF;                                     <<04.KM>>09646000
                                                               <<04.KM>>09648000
                                                               <<04.KM>>09650000
  <<*******************>>                                      <<04.KM>>09652000
  << SUBROUTINE CXEXIT >>                                      <<04.KM>>09654000
  <<*******************>>                                      <<04.KM>>09656000
                                                               <<04.KM>>09658000
  SUBROUTINE CXEXIT(CCODE); VALUE CCODE; INTEGER CCODE;        <<04.KM>>09660000
  BEGIN                                                        <<04.KM>>09662000
    QSTATUS.(QCC):=CCODE;                                      <<04.KM>>09664000
    IF CCODE=CCE THEN MULTILINE:=0                             <<04.KM>>09666000
    ELSE FCHECK(FILE,MLINEVALUE);                              <<04.KM>>09668000
    EXITPROC;                                                  <<04.KM>>09670000
  END <<SUBROUTINE CXEXIT>>;                                   <<04.KM>>09672000
                                                               <<04.KM>>09674000
                                                               <<04.KM>>09676000
  <<***************************>>                              <<04.KM>>09678000
  << SUBROUTINE BLANKLEFTFIELD >>                              <<04.KM>>09680000
  <<***************************>>                              <<04.KM>>09682000
                                                               <<04.KM>>09684000
  SUBROUTINE BLANKLEFTFIELD;                                   <<04.KM>>09686000
  BEGIN                                                        <<04.KM>>09688000
    BUF:=" ";                                                  <<04.KM>>09690000
    MOVE BUF(1):=BUF,(FIELD);                                  <<04.KM>>09692000
  END <<SUBROUTINE BLANKLEFTFIELD>>;                           <<04.KM>>09694000
                                                               <<04.KM>>09696000
                                                               <<04.KM>>09698000
  <<*********************>>                                    <<04.KM>>09700000
  << SUBROUTINE BYTESIZE >>                                    <<04.KM>>09702000
  <<*********************>>                                    <<04.KM>>09704000
                                                               <<04.KM>>09706000
  INTEGER SUBROUTINE BYTESIZE(LENGTH);                         <<04.KM>>09708000
    VALUE LENGTH; INTEGER LENGTH;                              <<??,KM>>09710000
  BEGIN                                                        <<04.KM>>09712000
    BYTESIZE:=IF LENGTH=-32768 OR LENGTH>=16384 THEN 32767     <<04.KM>>09714000
              ELSE IF LENGTH<0 THEN -LENGTH                    <<04.KM>>09716000
              ELSE 2*LENGTH;                                   <<04.KM>>09718000
  END <<SUBROUTINE BYTESIZE>>;                                 <<04.KM>>09720000
                                                               <<04.KM>>09722000
                                                               <<04.KM>>09724000
  <<**************************>>                               <<04.KM>>09726000
  << SUBROUTINE LASTWORDINDEX >>                               <<04.KM>>09728000
  <<**************************>>                               <<04.KM>>09730000
                                                               <<04.KM>>09732000
  INTEGER SUBROUTINE LASTWORDINDEX;                            <<04.KM>>09734000
  BEGIN                                                        <<04.KM>>09736000
    COMMENT:                                                   <<04.KM>>09738000
      FIND WORD BOUNDARY.  WE ASSUME THAT MSG(0) IS NONBLANK   <<04.KM>>09740000
      (IE., "MSG" HAS BEEN LEFT-DEBLANKED);                    <<04.KM>>09742000
                                                               <<04.KM>>09744000
    X:=FIELDLEN;                                               <<04.KM>>09746000
    WHILE X>0 AND MSG(X)<>" " DO X:=X-1;                       <<04.KM>>09748000
    LASTWORDINDEX:=IF X>0 THEN X ELSE FIELDLEN;                <<04.KM>>09750000
  END <<SUBROUTINE LASTWORDINDEX>>;                            <<04.KM>>09752000
                                                               <<04.KM>>09754000
                                                               <<04.KM>>09756000
  <<***********************>>                                  <<04.KM>>09758000
  << SUBROUTINE SKIPBLANKS >>                                  <<04.KM>>09760000
  <<***********************>>                                  <<04.KM>>09762000
                                                               <<04.KM>>09764000
  SUBROUTINE SKIPBLANKS;                                       <<04.KM>>09766000
  BEGIN                                                        <<04.KM>>09768000
    X:=0;                                                      <<04.KM>>09770000
    WHILE X<MSGLEN AND MSG(X)=" " DO X:=X+1;                   <<04.KM>>09772000
    @MSG:=@MSG(X);                                             <<04.KM>>09774000
    MSGLEN:=MSGLEN-X;                                          <<04.KM>>09776000
  END <<SUBROUTINE SKIPBLANKS>>;                               <<04.KM>>09778000
                                                               <<04.KM>>09780000
                                                               <<04.KM>>09782000
  <<*********************>>                                    <<04.KM>>09784000
  << SUBROUTINE WORDSIZE >>                                    <<04.KM>>09786000
  <<*********************>>                                    <<04.KM>>09788000
                                                               <<04.KM>>09790000
  INTEGER SUBROUTINE WORDSIZE(BYTELENGTH);                     <<04.KM>>09792000
    VALUE BYTELENGTH; INTEGER BYTELENGTH;                      <<04.KM>>09794000
  BEGIN                                                        <<04.KM>>09796000
    WORDSIZE:=(BYTELENGTH/2)+BYTELENGTH.(15:1);                <<04.KM>>09798000
  END <<SUBROUTINE WORDSIZE>>;                                 <<04.KM>>09800000
                                                               <<04.KM>>09802000
                                                               <<04.KM>>09804000
  <<**********************>>                                   <<04.KM>>09806000
  << SUBROUTINE WRITELINE >>                                   <<04.KM>>09808000
  <<**********************>>                                   <<04.KM>>09810000
                                                               <<04.KM>>09812000
  SUBROUTINE WRITELINE;                                        <<04.KM>>09814000
  BEGIN                                                        <<04.KM>>09816000
    COMMENT:                                                   <<04.KM>>09818000
      FILL IN "FIELD" WITH AS MUCH OF "MSG" AS POSSIBLE.       <<04.KM>>09820000
      WE ASSUME THAT "MSG" HAS BEEN RIGHT-DEBLANKED.  NOTE     <<04.KM>>09822000
      THAT AREA TO THE LEFT OF "FIELD" MAY OR MAY NOT BE       <<04.KM>>09824000
      BLANK, TO BE SET-UP BY CALLER;                           <<04.KM>>09826000
                                                               <<04.KM>>09828000
    SKIPBLANKS;                                                <<04.KM>>09830000
    IF MSGLEN<=FIELDLEN THEN           <<ASSUME FL>=1>>        <<04.KM>>09832000
      BEGIN                                                    <<04.KM>>09834000
      LAST:=MSGLEN;                    <<ASSUME ML>0>>         <<04.KM>>09836000
      CCTL:=LASTCCTL;                                          <<04.KM>>09838000
      END                                                      <<04.KM>>09840000
    ELSE                                                       <<04.KM>>09842000
      BEGIN                                                    <<04.KM>>09844000
      LAST:=LASTWORDINDEX;                                     <<04.KM>>09846000
      CCTL:=0;                                                 <<04.KM>>09848000
      END;                                                     <<04.KM>>09850000
    MOVE BUF(FIELD):=MSG,(LAST);                               <<04.KM>>09852000
    FWRITE(FILE,WBUF,-(FIELD+LAST),CCTL);                      <<04.KM>>09854000
    IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                 <<04.KM>>09856000
    @MSG:=@MSG(LAST);                                          <<04.KM>>09858000
    MSGLEN:=MSGLEN-LAST;                                       <<04.KM>>09860000
  END <<SUBROUTINE WRITELINE>>;                                <<04.KM>>09862000
                                                               <<04.KM>>09864000
                                                               <<04.KM>>09866000
  <<************************>>                                 <<04.KM>>09868000
  << SUBROUTINE WRITEPREFIX >>                                 <<04.KM>>09870000
  <<************************>>                                 <<04.KM>>09872000
                                                               <<04.KM>>09874000
  SUBROUTINE WRITEPREFIX;                                      <<04.KM>>09876000
  BEGIN                                                        <<04.KM>>09878000
    COMMENT:                                                   <<04.KM>>09880000
      WRITE PREFIX ON SEPARATE LINE;                           <<04.KM>>09882000
                                                               <<04.KM>>09884000
    TOS:=WORDSIZE(PREFIXLEN);          <<ALLOCATE BUFFER>>     <<04.KM>>09886000
    @TEMP:=(@WTEMP:=@S0)&LSL(1);                               <<04.KM>>09888000
    ASSEMBLE(ADDS 0);                                          <<04.KM>>09890000
    MOVE TEMP:=PREFIX,(PREFIXLEN);                             <<04.KM>>09892000
    FWRITE(FILE,WTEMP,-PREFIXLEN,0);                           <<04.KM>>09894000
    IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                 <<04.KM>>09896000
    TOS:=WORDSIZE(PREFIXLEN);          <<DEALLOCATE BUFFER>>   <<04.KM>>09898000
    ASSEMBLE(SUBS 0);                                          <<04.KM>>09900000
  END <<SUBROUTINE WRITEPREFIX>>;                              <<04.KM>>09902000
                                                               <<04.KM>>09904000
                                                               <<04.KM>>09906000
  <<************************>>                                 <<04.KM>>09908000
  << MAIN PROCEDURE BODY    >>                                 <<04.KM>>09910000
  <<                        >>                                 <<04.KM>>09912000
  << CHECK CALLING SEQUENCE >>                                 <<04.KM>>09914000
  <<************************>>                                 <<04.KM>>09916000
                                                               <<04.KM>>09918000
  PUSH(DL);                                                    <<04.KM>>09920000
  DL:=TOS;                                                     <<04.KM>>09922000
  IF NOT FNFLAG OR FILE<=0 THEN FILE:=STDLIST;                 <<04.KM>>09924000
                                                               <<04.KM>>09926000
  IF NOT MFLAG OR NOT MLFLAG OR MSGLEN<0 OR                    <<04.KM>>09928000
     @MSG<DL OR @MSG(MSGLEN)>@TOPSTACK THEN                    <<04.KM>>09930000
    BEGIN                                                      <<04.KM>>09932000
    @MSG:=@DUMMY;                                              <<04.KM>>09934000
    MSGLEN:=0;                                                 <<04.KM>>09936000
    END;                                                       <<04.KM>>09938000
  WHILE MSGLEN>0 AND MSG(MSGLEN-1)=" " DO MSGLEN:=MSGLEN-1;    <<04.KM>>09940000
                                                               <<04.KM>>09942000
  COMMENT:                                                     <<04.KM>>09944000
    CHECK "FIELD" & "FIELDLEN".  DEVICE RECORD SIZE IS         <<04.KM>>09946000
    DIMINISHED BY TWO (ONE FOR CCTL) TO AVOID PRINTING IN LAST <<05.KM>>09948000
    COLUMN, CAUSING EXTRA LF OR HOME-UP ON SOME DEVICES.       <<05.KM>>09950000
    "FIELD" CANNOT EQUAL "RECSIZE" TO ENSURE THAT FIELDLEN>=1; <<05.KM>>09952000
                                                               <<04.KM>>09954000
  FGETINFO(FILE,<<FNAME>>,<<FOPS>>,<<AOPS>>,RECSIZE);          <<04.KM>>09956000
  IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                   <<04.KM>>09958000
  RECSIZE:=BYTESIZE(RECSIZE)-2;                                <<05.KM>>09960000
  IF NOT FFLAG OR FIELD<0 OR FIELD>=RECSIZE THEN FIELD:=0;     <<04.KM>>09962000
  IF NOT FLFLAG OR FIELDLEN=0 THEN FIELDLEN:=RECSIZE-FIELD;    <<04.KM>>09964000
                                                               <<04.KM>>09966000
  IF NOT LFLAG THEN CCTL:=0;                                   <<04.KM>>09968000
                                                               <<04.KM>>09970000
  IF NOT PFLAG OR NOT PLFLAG OR PREFIXLEN<0 OR                 <<04.KM>>09972000
     @PREFIX<DL OR @PREFIX(PREFIXLEN)>@TOPSTACK THEN           <<04.KM>>09974000
    BEGIN                                                      <<04.KM>>09976000
    @PREFIX:=@DUMMY;                                           <<04.KM>>09978000
    PREFIXLEN:=0;                                              <<04.KM>>09980000
    END;                                                       <<04.KM>>09982000
                                                               <<04.KM>>09984000
  <<****************>>                                         <<04.KM>>09986000
  << OUTPUT MESSAGE >>                                         <<04.KM>>09988000
  <<****************>>                                         <<04.KM>>09990000
                                                               <<04.KM>>09992000
  TOS:=WORDSIZE(FIELD+FIELDLEN);       <<ALLOCATE "WBUF">>     <<04.KM>>09994000
  ASSEMBLE(ADDS 0);                                            <<04.KM>>09996000
                                                               <<04.KM>>09998000
  IF PREFIXLEN>FIELD THEN WRITEPREFIX                          <<04.KM>>10000000
  ELSE IF PREFIXLEN>0 THEN                                     <<04.KM>>10002000
    BEGIN                                                      <<04.KM>>10004000
    BLANKLEFTFIELD;                                            <<04.KM>>10006000
    MOVE BUF:=PREFIX,(PREFIXLEN);                              <<04.KM>>10008000
    WRITELINE;                                                 <<04.KM>>10010000
    END;                                                       <<04.KM>>10012000
  BLANKLEFTFIELD;                                              <<04.KM>>10014000
  WHILE MSGLEN>0 DO WRITELINE;                                 <<04.KM>>10016000
  CXEXIT(CCE);                                                 <<04.KM>>10018000
                                                               <<04.KM>>10020000
EXITINSTR:                                                     <<04.KM>>10022000
END <<PROCEDURE MULTILINE>>;                                   <<04.KM>>10024000
                                                               <<04.KM>>10026000
                                                               <<04.KM>>10028000
                                                               <<04.KM>>10030000
                                                               <<04.KM>>10032000
$CONTROL  SEGMENT=CILISTF                                      <<04.KM>>10034000
<<********************************************************************>>10036000
<< L I S T F D I S M N T >>                                    <<04.KM>>10038000
                                                               <<04.KM>>10040000
PROCEDURE LISTFDISMNT(MOUNTDST,FATALERR,GROUP,ACCT,ERRNUM);    <<04.KM>>10042000
  VALUE FATALERR;                                              <<04.KM>>10044000
  INTEGER MOUNTDST,FATALERR,ERRNUM;                            <<04.KM>>10046000
  ARRAY GROUP,ACCT;                                            <<04.KM>>10048000
  OPTION PRIVILEGED,UNCALLABLE;                                <<04.KM>>10050000
BEGIN                                                          <<04.KM>>10052000
  EQUATE CATRECSIZE=   80,                                     <<04.KM>>10054000
         MAXMSG=       160,                                    <<04.KM>>10056000
         NAMEFIELD=    4,                                      <<04.KM>>10058000
         MAXPREFIX=    NAMEFIELD+22,                           <<04.KM>>10060000
         EXPLAINFIELD= MAXPREFIX;                              <<04.KM>>10062000
  EQUATE NOMOUNT=        0,                                    <<04.KM>>10064000
         CONDMOUNT'BIND= -3,                                   <<04.KM>>10066000
         SINGLESPACE=    0,                                    <<04.KM>>10068000
         NOPARM=         %100000,                              <<04.KM>>10070000
         RETURNIT=       -1,                                   <<04.KM>>10072000
         STDLIST=        2;                                    <<04.KM>>10074000
  BYTE ARRAY MSG(0:MAXMSG-1),                                  <<04.KM>>10076000
             PREFIX(0:MAXPREFIX-1),                            <<04.KM>>10078000
             INBUF(0:CATRECSIZE),                              <<04.KM>>10080000
             HOMEVS(0:7);                                      <<04.KM>>10082000
  BYTE POINTER NEXT,                                           <<04.KM>>10084000
               LAST;                                           <<04.KM>>10086000
  INTEGER DUMMY,                                               <<04.KM>>10088000
          PREFIXLEN,                                           <<04.KM>>10090000
          REQ'ERROR,                                           <<04.KM>>10092000
          MSGLEN,                                              <<04.KM>>10094000
          DSTENTINFO;                                          <<04.KM>>10096000
  LOGICAL FIRSTERROR:=TRUE;                                    <<04.KM>>10098000
                                                               <<04.KM>>10100000
  EQUATE DSTINFO=  0,                                          <<04.KM>>10102000
         OURINFOSIZE= 7;                                       <<04.KM>>10104000
  INTEGER ARRAY IMPINFO(0:OURINFOSIZE-1)= Q;                   <<04.KM>>10106000
  INTEGER IMPLEN=     IMPINFO,                                 <<04.KM>>10108000
          IMPINFOLEN= IMPLEN+1,                                <<04.KM>>10110000
          IMPENTLEN=  IMPINFOLEN+1,                            <<04.KM>>10112000
          IMPENTLOC=  IMPENTLEN+1;                             << I.A >>10114000
                                                               <<04.KM>>10116000
  EQUATE OURENTSIZE= 10;                                       <<04.KM>>10118000
  INTEGER ARRAY ENTINFO(0:OURENTSIZE-1)= Q;                    <<04.KM>>10120000
  INTEGER ENTERR=           ENTINFO,                           <<04.KM>>10122000
          ENTPVINFO=        ENTERR+1;                          <<04.KM>>10124000
  INTEGER ARRAY ENTNAME(*)= ENTPVINFO+1,                       <<04.KM>>10126000
                ENTGRP(*)=  ENTNAME,                           <<04.KM>>10128000
                ENTACCT(*)= ENTNAME+4;                         <<04.KM>>10130000
  INTRINSIC FREEDSEG;                                          <<04.KM>>10132000
  INTEGER PROCEDURE FORMSG(IBUF,MSET,MNUM,PMASK,P1,P2,P3,P4,   <<04.KM>>10134000
                           P5,OBUF,OSIZE,OLEN,DEST,CNTL);      <<04.KM>>10136000
    VALUE MSET,MNUM,PMASK,P1,P2,P3,P4,P5,OSIZE,DEST,CNTL;      <<04.KM>>10138000
    BYTE ARRAY IBUF,OBUF;                                      <<04.KM>>10140000
    INTEGER MSET,MNUM,PMASK,P1,P2,P3,P4,P5,OSIZE,OLEN,DEST,    <<04.KM>>10142000
            CNTL;                                              <<04.KM>>10144000
    OPTION EXTERNAL;                                           <<04.KM>>10146000
                                                               <<04.KM>>10148000
  SUBROUTINE DEF'MOVEFROMDSEG;                                 <<04.KM>>10150000
                                                               <<04.KM>>10152000
                                                               <<04.KM>>10154000
  <<*******************>>                                      <<04.KM>>10156000
  << SUBROUTINE APPEND >>                                      <<04.KM>>10158000
  <<*******************>>                                      <<04.KM>>10160000
                                                               <<04.KM>>10162000
  LOGICAL SUBROUTINE APPEND(NAME,SUFFIX,BUF);                  <<04.KM>>10164000
    VALUE SUFFIX; BYTE ARRAY NAME,BUF; INTEGER SUFFIX;         <<04.KM>>10166000
  BEGIN                                                        <<04.KM>>10168000
    IF NAME(7)=" " THEN MOVE BUF:=NAME WHILE ANS,1             <<04.KM>>10170000
    ELSE MOVE BUF:=NAME,(8),2;                                 <<04.KM>>10172000
    @LAST:=TOS;                                                <<04.KM>>10174000
    LAST:=SUFFIX;                                              <<04.KM>>10176000
    APPEND:=@LAST(1);                                          <<04.KM>>10178000
  END <<SUBROUTINE APPEND>>;                                   <<04.KM>>10180000
                                                               <<04.KM>>10182000
                                                               <<04.KM>>10184000
  <<********************>>                                     <<04.KM>>10186000
  << SUBROUTINE DMERROR >>                                     <<04.KM>>10188000
  <<********************>>                                     <<04.KM>>10190000
                                                               <<04.KM>>10192000
  SUBROUTINE DMERROR(MSGSET,MSGNUM,GROUP,ACCT);                <<04.KM>>10194000
    VALUE MSGSET,MSGNUM; INTEGER MSGSET,MSGNUM;                <<04.KM>>10196000
    BYTE ARRAY GROUP,ACCT;                                     <<04.KM>>10198000
  BEGIN                                                        <<04.KM>>10200000
    IF FIRSTERROR THEN                                         <<04.KM>>10202000
      BEGIN                                                    <<04.KM>>10204000
      IF JOBSESSIONMAIN THEN FWRITE(STDLIST,DUMMY,0,0);        <<04.KM>>10206000
      CIERR(-(ERRNUM:=IM'MNTERR));                             <<04.KM>>10208000
      FIRSTERROR:=FALSE;                                       <<04.KM>>10210000
      END;                                                     <<04.KM>>10212000
    IF NOT JOBSESSIONMAIN OR REQUESTSERVICE THEN RETURN;       <<07.KM>>10214000
    @NEXT:=APPEND(GROUP,".",PREFIX(NAMEFIELD));                <<04.KM>>10216000
    PREFIXLEN:=APPEND(ACCT,":",NEXT)-LOGICAL(@PREFIX);         <<04.KM>>10218000
    MSGLEN:=0;                                                 <<04.KM>>10220000
    FORMSG(INBUF,MSGSET,MSGNUM,NOPARM,0,0,0,0,0,MSG,MAXMSG,    <<04.KM>>10222000
           MSGLEN,RETURNIT,0);                                 <<04.KM>>10224000
    MULTILINE(<<FILE>>,MSG,MSGLEN,EXPLAINFIELD,<<FIELDLEN>>,   <<04.KM>>10226000
              SINGLESPACE,PREFIX,PREFIXLEN);                   <<04.KM>>10228000
  END <<SUBROUTINE DMERROR>>;                                  <<04.KM>>10230000
                                                               <<04.KM>>10232000
                                                               <<04.KM>>10234000
  <<*********************>>                                    <<04.KM>>10236000
  << MAIN PROCEDURE BODY >>                                    <<04.KM>>10238000
  <<*********************>>                                    <<04.KM>>10240000
                                                               <<04.KM>>10242000
  MOVE PREFIX:="  *.";                                         <<04.KM>>10244000
  IF MOUNTDST>0 THEN                                           <<04.KM>>10246000
    BEGIN                                                      <<04.KM>>10248000
    MOVEFROMDSEG(@IMPINFO,MOUNTDST,DSTINFO,OURINFOSIZE);       <<04.KM>>10250000
    MOVE HOMEVS:="*       ";                                   <<04.KM>>10252000
    FOR DSTENTINFO:=IMPINFOLEN STEP IMPENTLEN                  <<04.KM>>10254000
                    UNTIL IMPENTLOC-1 DO                       <<04.KM>>10256000
      BEGIN                                                    <<04.KM>>10258000
      MOVEFROMDSEG(@ENTINFO,MOUNTDST,DSTENTINFO,OURENTSIZE);   <<04.KM>>10260000
      IF ENTERR<>0 THEN                                        <<04.KM>>10262000
        BEGIN                                                  <<04.KM>>10264000
        DMERROR(PVERRMSGSET,ENTERR,ENTGRP,ENTACCT)             <<04.KM>>10266000
        END                                                    <<04.KM>>10268000
      ELSE                                                     <<04.KM>>10270000
        BEGIN                                                  <<04.KM>>10272000
        REQ'ERROR:=CONDMOUNT'BIND;                             <<04.KM>>10274000
        DISMOUNT(HOMEVS,ENTGRP,ENTACCT,REQ'ERROR,ENTPVINFO);   <<04.KM>>10276000
        IF <> THEN                                             <<04.KM>>10278000
          BEGIN                                                <<04.KM>>10280000
          DMERROR(PVERRMSGSET,REQ'ERROR,ENTGRP,ENTACCT);       <<04.KM>>10282000
          END;                                                 <<04.KM>>10284000
        END;                                                   <<04.KM>>10286000
      END;                                                     <<04.KM>>10288000
    FREEDSEG(MOUNTDST,0);                                      <<04.KM>>10290000
    MOUNTDST:=0;                                               <<04.KM>>10292000
    END;                                                       <<04.KM>>10294000
                                                               <<04.KM>>10296000
  IF FATALERR>NOMOUNT THEN                                     <<04.KM>>10298000
    BEGIN                                                      <<04.KM>>10300000
    DMERROR(CIERRMSGSET,IM'MNTERR+FATALERR,GROUP,ACCT);        <<04.KM>>10302000
    END;                                                       <<04.KM>>10304000
END <<PROCEDURE LISTFDISMNT>>;                                 <<04.KM>>10306000
                                                              <<00.GEN>>10308000
                                                              <<00.GEN>>10310000
$CONTROL  SEGMENT=CILISTF                                      <<03.KM>>10312000
                                                               <<03.KM>>10314000
INTEGER PROCEDURE DIRMATCH(DESIGNATOR,REALNAME);              <<00.GEN>>10316000
                          VALUE DESIGNATOR,REALNAME;          <<00.GEN>>10318000
                          BYTE POINTER DESIGNATOR,            <<00.GEN>>10320000
                                       REALNAME;              <<00.GEN>>10322000
                          OPTION UNCALLABLE;                  <<00.GEN>>10324000
BEGIN                                                         <<00.GEN>>10326000
  COMMENT:                                                    <<00.GEN>>10328000
    COMPARES GENERIC AND DIRECTORY NAMES AND RETURNS AN       <<00.GEN>>10330000
    INDICATOR OF THE MATCH, VIZ.:                             <<00.GEN>>10332000
                                                              <<00.GEN>>10334000
      -1 = INITIAL SUBSTRING OF "DESIGNATOR" IS LESS          <<00.GEN>>10336000
           THAN "REALNAME"                                    <<00.GEN>>10338000
       0 = "DESIGNATOR" AND "REALNAME" MATCH                  <<00.GEN>>10340000
       1 = "DESIGNATOR" AND "REALNAME" DO NOT MATCH.          <<00.GEN>>10342000
                                                              <<00.GEN>>10344000
    NOTE THAT -1 CAN BE RETURNED ONLY IF THE INITIAL          <<00.GEN>>10346000
    SUBSTRING OF "DESIGNATOR" STARTS WITH AN ALPHABETIC       <<00.GEN>>10348000
    CHARACTER.                                                <<00.GEN>>10350000
                                                              <<00.GEN>>10352000
    ASCERTIONS:                                               <<00.GEN>>10354000
      (1) "DESIGNATOR" CONTAINS ONLY ALPHANUMERIC, "?",       <<00.GEN>>10356000
          "#" AND "@" CHARACTERS                              <<00.GEN>>10358000
      (2) "DESIGNATOR" DOES NOT CONTAIN THE SEQUENCES         <<00.GEN>>10360000
          "@?" & "@@" (THESE SHOULD BE CONVERTED TO           <<00.GEN>>10362000
          "?@" & "@" BY THE PATTERN BUILDER)                  <<00.GEN>>10364000
      (3) "REALNAME" CONTAINS ONLY ALPHANUMERIC CHARACTERS    <<00.GEN>>10366000
      (4) "DESIGNATOR" & "REALNAME" ARE 8 BYTES LONG, WITH    <<00.GEN>>10368000
          BLANK-FILL ON THE RIGHT                             <<00.GEN>>10370000
      (5) "DESIGNATOR" & "REALNAME" ARE BOTH THE SAME CASE,   <<00.GEN>>10372000
          VIZ. UPPER- OR LOWER-CASE;                          <<00.GEN>>10374000
                                                              <<00.GEN>>10376000
                                                              <<00.GEN>>10378000
  EQUATE NOCODE= -2,                                          <<00.GEN>>10380000
         LTCODE= -1,                                          <<00.GEN>>10382000
         EQCODE=  0,                                          <<00.GEN>>10384000
         GTCODE=  1;                                          <<00.GEN>>10386000
                                                              <<00.GEN>>10388000
  BYTE POINTER DLEFT,                                         <<00.GEN>>10390000
               NLEFT;                                         <<00.GEN>>10392000
  INTEGER X=         X,                                       <<00.GEN>>10394000
          MATCHCODE= DIRMATCH;                                <<00.GEN>>10396000
                                                              <<00.GEN>>10398000
  ARRAY NEXTQ(*)=    Q;                <<ALLOCATE ON TOS>>    <<00.GEN>>10400000
  BYTE POINTER DPTR= NEXTQ,                                   <<00.GEN>>10402000
               NPTR= DPTR+1;                                  <<00.GEN>>10404000
  INTEGER LENGTH=    NPTR+1;                                  <<00.GEN>>10406000
                                                              <<00.GEN>>10408000
                                                              <<00.GEN>>10410000
  <<*************************>>                               <<00.GEN>>10412000
  << DEFINE LESSER'SUBSTRING >>                               <<00.GEN>>10414000
  <<*************************>>                               <<00.GEN>>10416000
                                                              <<00.GEN>>10418000
  DEFINE LESSER'SUBSTRING=                                    <<00.GEN>>10420000
    < AND (DPTR<>SPECIAL OR DPTR=" ") #;                      <<00.GEN>>10422000
                                                              <<00.GEN>>10424000
  <<**************************>>                              <<00.GEN>>10426000
  << DEFINE RESET'MATCHSTART >>                               <<00.GEN>>10428000
  <<**************************>>                              <<00.GEN>>10430000
                                                              <<00.GEN>>10432000
  COMMENT:                                                    <<00.GEN>>10434000
    S-2 = @DPTR                                               <<00.GEN>>10436000
    S-1 = @NPTR                                               <<00.GEN>>10438000
    S-0 = LENGTH OF COMPARE.                                  <<00.GEN>>10440000
                                                              <<00.GEN>>10442000
    BACK-UP POINTERS SO THAT "@" WILL MATCH LONGER            <<00.GEN>>10444000
    SUBSTRING.  "DPTR" IS RESET TO THE RIGHT OF               <<00.GEN>>10446000
    LAST "@".  "NPTR" IS RESET TO THE RIGHT OF LAST           <<00.GEN>>10448000
    INITIAL MATCH DETERMINED BY "FIND'MATCHSTART";            <<00.GEN>>10450000
                                                              <<00.GEN>>10452000
  DEFINE RESET'MATCHSTART=                                    <<00.GEN>>10454000
    BEGIN                                                     <<00.GEN>>10456000
      @NLEFT:=@NLEFT+1;                                       <<00.GEN>>10458000
      DEL; DDEL;                                              <<00.GEN>>10460000
      TOS:=@DLEFT;                                            <<00.GEN>>10462000
      TOS:=@NLEFT;                                            <<00.GEN>>10464000
      TOS:=@REALNAME(8)-@NLEFT;                               <<00.GEN>>10466000
      DIRMATCH:=NOCODE;                                       <<00.GEN>>10468000
      FIND'MATCHSTART;                                        <<00.GEN>>10470000
    END <<DEFINE RESET'MATCHSTART>>#;                         <<00.GEN>>10472000
                                                              <<00.GEN>>10474000
  <<*********************>>                                   <<00.GEN>>10476000
  << DEFINE TURNOFFTRAPS >>                                   <<00.GEN>>10478000
  <<*********************>>                                   <<00.GEN>>10480000
                                                              <<00.GEN>>10482000
  DEFINE TURNOFFTRAPS=                                        <<00.GEN>>10484000
    BEGIN                                                     <<00.GEN>>10486000
      COMMENT:                                                <<00.GEN>>10488000
        AVOID INTEGER OVERFLOW FOR BYTE ADDRESS               <<00.GEN>>10490000
        ARITHMETIC;                                           <<00.GEN>>10492000
                                                              <<00.GEN>>10494000
      PUSH(STATUS);                                           <<00.GEN>>10496000
      TOS.(2:1):=0;                                           <<00.GEN>>10498000
      SET(STATUS);                                            <<00.GEN>>10500000
    END <<DEFINE TURNOFFTRAPS>>#;                             <<00.GEN>>10502000
                                                              <<00.GEN>>10504000
  <<****************>>                                        <<00.GEN>>10506000
  << SUBROUTINE MIN >>                                        <<00.GEN>>10508000
  <<****************>>                                        <<00.GEN>>10510000
                                                              <<00.GEN>>10512000
  INTEGER SUBROUTINE MIN(I,J); VALUE I,J; INTEGER I,J;        <<00.GEN>>10514000
  BEGIN                                                       <<00.GEN>>10516000
    MIN:=IF I<=J THEN I ELSE J;                               <<00.GEN>>10518000
  END <<SUBROUTINE MIN>>;                                     <<00.GEN>>10520000
                                                               <<03.KM>>10522000
                                                               <<03.KM>>10524000
  <<****************************>>                             <<03.KM>>10526000
  << SUBROUTINE FIND'MATCHSTART >>                             <<03.KM>>10528000
  <<****************************>>                             <<03.KM>>10530000
                                                               <<03.KM>>10532000
  SUBROUTINE FIND'MATCHSTART;                                  <<03.KM>>10534000
  BEGIN                                                        <<03.KM>>10536000
    COMMENT:                                                   <<03.KM>>10538000
      SCAN "NPTR" FOR MATCH WITH CHARACTER FOLLOWING           <<03.KM>>10540000
      "@" IN "DSTR".  SAVE POSITION IN "NLEFT" AND             <<03.KM>>10542000
      SET "LENGTH" TO LENGTH OF COMPARE;                       <<03.KM>>10544000
                                                               <<03.KM>>10546000
    IF DPTR="#" THEN                                           <<03.KM>>10548000
    BEGIN                                                      <<03.KM>>10550000
      WHILE (LENGTH:=LENGTH-1)>=0 AND                          <<03.KM>>10552000
            NPTR<>NUMERIC DO @NPTR:=@NPTR+1;                   <<03.KM>>10554000
    END                                                        <<03.KM>>10556000
    ELSE BEGIN                                                 <<03.KM>>10558000
      WHILE (LENGTH:=LENGTH-1)>=0 AND                          <<03.KM>>10560000
            NPTR<>DPTR DO @NPTR:=@NPTR+1;                      <<03.KM>>10562000
    END;                                                       <<03.KM>>10564000
                                                               <<03.KM>>10566000
    LENGTH:=LENGTH+1;                                          <<03.KM>>10568000
    IF <= THEN DIRMATCH:=GTCODE                                <<03.KM>>10570000
    ELSE BEGIN                                                 <<03.KM>>10572000
      @NLEFT:=@NPTR;                                           <<03.KM>>10574000
      LENGTH:=MIN(@DESIGNATOR(8)-@DPTR, @REALNAME(8)-@NPTR);   <<03.KM>>10576000
    END;                                                       <<03.KM>>10578000
  END <<SUBROUTINE FIND'MATCHSTART>>;                          <<03.KM>>10580000
                                                               <<03.KM>>10582000
                                                               <<03.KM>>10584000
  <<**************************>>                               <<03.KM>>10586000
  << SUBROUTINE CHECK'ENDCOND >>                               <<03.KM>>10588000
  <<**************************>>                               <<03.KM>>10590000
                                                               <<03.KM>>10592000
  SUBROUTINE CHECK'ENDCOND;                                    <<03.KM>>10594000
  BEGIN                                                        <<03.KM>>10596000
    COMMENT:                                                   <<03.KM>>10598000
      ENSURE THAT BOTH "DPTR" AND "NPTR" STRINGS ARE           <<03.KM>>10600000
      EXHAUSTED.  IF EQCODE, THEN AT LEAST ONE STRING          <<03.KM>>10602000
      IS EXHAUSTED;                                            <<03.KM>>10604000
                                                               <<03.KM>>10606000
    IF MATCHCODE=EQCODE THEN                                   <<03.KM>>10608000
    BEGIN                                                      <<03.KM>>10610000
      IF @DPTR=@DESIGNATOR(8) THEN                             <<03.KM>>10612000
      BEGIN                                                    <<03.KM>>10614000
        IF @NPTR<>@REALNAME(8) AND                             <<03.KM>>10616000
           NPTR<>" " THEN DIRMATCH:=GTCODE;                    <<03.KM>>10618000
      END                                                      <<03.KM>>10620000
      ELSE                                                     <<03.KM>>10622000
        IF DPTR<>" " THEN                                      <<03.KM>>10624000
        BEGIN                                                  <<03.KM>>10626000
          IF DPTR<>"@" OR                                      <<03.KM>>10628000
             @DPTR<>@DESIGNATOR(7) AND                         <<03.KM>>10630000
             DPTR(1)<>" " THEN DIRMATCH:=GTCODE;               <<03.KM>>10632000
        END;                                                   <<03.KM>>10634000
    END;                                                       <<03.KM>>10636000
  END <<SUBROUTINE CHECK'ENDCOND>>;                            <<03.KM>>10638000
                                                              <<00.GEN>>10640000
  <<********************>>                                    <<00.GEN>>10642000
  << SUBROUTINE CLOSURE >>                                    <<00.GEN>>10644000
  <<********************>>                                    <<00.GEN>>10646000
                                                              <<00.GEN>>10648000
  LOGICAL SUBROUTINE CLOSURE;                                 <<00.GEN>>10650000
  BEGIN                                                       <<00.GEN>>10652000
    COMMENT:                                                  <<00.GEN>>10654000
      RETURN "TRUE" IF WE'VE ENCOUNTERED AN EMBEDDED          <<00.GEN>>10656000
      "@" (CLOSURE WILDCARD).  WE ASSUME THAT WE'VE           <<00.GEN>>10658000
      DONE A "SIMPLEMATCH" FIRST.  THUS, FAILURE TO           <<00.GEN>>10660000
      FIND CLOSURE WILDCARD MEANS THAT NO FURTHER             <<00.GEN>>10662000
      MATCH IS POSSIBLE (MATCH=GTCODE).  NOTE THAT            <<00.GEN>>10664000
      IF CLOSURE WILDCARD IS AT THE END OF "DPTR",            <<00.GEN>>10666000
      THE MATCH IS DONE (MATCH=EQCODE) SINCE IT WILL          <<00.GEN>>10668000
      MATCH REMAINDER OF "NPTR";                              <<00.GEN>>10670000
                                                              <<00.GEN>>10672000
    CLOSURE:=FALSE;                                           <<00.GEN>>10674000
    IF MATCHCODE=NOCODE THEN                                  <<00.GEN>>10676000
    BEGIN                                                     <<00.GEN>>10678000
      IF DPTR<>"@" THEN DIRMATCH:=GTCODE                      <<00.GEN>>10680000
      ELSE                                                    <<00.GEN>>10682000
        IF @DPTR=@DESIGNATOR(7) OR                            <<00.GEN>>10684000
           DPTR(1)=" " THEN DIRMATCH:=EQCODE                  <<00.GEN>>10686000
      ELSE IF NPTR=" " THEN DIRMATCH:=GTCODE                  <<00.GEN>>10688000
      ELSE BEGIN                                              <<00.GEN>>10690000
        @DPTR:=@DPTR+1;                                       <<00.GEN>>10692000
        @DLEFT:=@DPTR;                                        <<00.GEN>>10694000
        @NLEFT := @NPTR;                                       <<01516>>10696000
        LENGTH:=@REALNAME(8)-@NPTR;                           <<00.GEN>>10698000
        FIND'MATCHSTART;                                      <<00.GEN>>10700000
        IF MATCHCODE=NOCODE THEN CLOSURE:=TRUE;               <<00.GEN>>10702000
      END;                                                    <<00.GEN>>10704000
    END;                                                      <<00.GEN>>10706000
  END <<SUBROUTINE CLOSURE>>;                                 <<00.GEN>>10708000
                                                              <<00.GEN>>10710000
  <<************************>>                                <<00.GEN>>10712000
  << SUBROUTINE SIMPLEMATCH >>                                <<00.GEN>>10714000
  <<************************>>                                <<00.GEN>>10716000
                                                              <<00.GEN>>10718000
  SUBROUTINE SIMPLEMATCH;                                     <<00.GEN>>10720000
  BEGIN                                                       <<00.GEN>>10722000
    COMMENT:                                                  <<00.GEN>>10724000
      S-3 = @DPTR                                             <<00.GEN>>10726000
      S-2 = @NPTR                                             <<00.GEN>>10728000
      S-1 = LENGTH OF COMPARE                                 <<00.GEN>>10730000
      S-0 = "SIMPLEMATCH" RETURN ADDRESS.                     <<00.GEN>>10732000
                                                              <<00.GEN>>10734000
      MATCH ALPHANUMERIC CHARACTERS AND SINGLE-BYTE           <<00.GEN>>10736000
      WILDCARD CHARACTERS ("?" AND "#");                      <<00.GEN>>10738000
                                                              <<00.GEN>>10740000
    X:=TOS;                            <<SAVE RETN ADDR>>     <<00.GEN>>10742000
    DO BEGIN                                                  <<00.GEN>>10744000
      IF * <> *,(TOS),0 THEN                                  <<00.GEN>>10746000
      BEGIN                                                   <<00.GEN>>10748000
  LOOP:                                                       <<00.GEN>>10750000
        IF DPTR="?" AND NPTR<>SPECIAL OR                      <<00.GEN>>10752000
           DPTR="#" AND NPTR=NUMERIC THEN                     <<00.GEN>>10754000
        BEGIN                                                 <<00.GEN>>10756000
          @DPTR:=@DPTR+1;                                     <<00.GEN>>10758000
          ASSEMBLE(INCB,DECA);                                <<00.GEN>>10760000
          IF <> THEN GO LOOP;                                 <<00.GEN>>10762000
        END;                                                  <<00.GEN>>10764000
      END;                                                    <<00.GEN>>10766000
    END UNTIL LENGTH=0 OR DPTR<>NPTR;                         <<00.GEN>>10768000
    IF = THEN DIRMATCH:=EQCODE;        <<LENGTH=0>>           <<00.GEN>>10770000
    TOS:=X;                            <<RESET RETN ADDR>>    <<00.GEN>>10772000
  END <<SUBROUTINE SIMPLEMATCH>>;                             <<00.GEN>>10774000
                                                              <<00.GEN>>10776000
                                                              <<00.GEN>>10778000
  <<***********************>>                                 <<00.GEN>>10780000
  <<                       >>                                 <<00.GEN>>10782000
  << BEGIN PROCEDURE MATCH >>                                 <<00.GEN>>10784000
  <<                       >>                                 <<00.GEN>>10786000
  <<***********************>>                                 <<00.GEN>>10788000
                                                              <<00.GEN>>10790000
  TURNOFFTRAPS;                                               <<00.GEN>>10792000
  IF DESIGNATOR=REALNAME,(8),0 THEN DIRMATCH:=EQCODE          <<00.GEN>>10794000
  ELSE IF LESSER'SUBSTRING THEN DIRMATCH:=LTCODE              <<00.GEN>>10796000
  ELSE BEGIN                                                  <<00.GEN>>10798000
    COMMENT:                                                  <<00.GEN>>10800000
      S-2 = @DPTR                                             <<00.GEN>>10802000
      S-1 = @NPTR                                             <<00.GEN>>10804000
      S-0 = COMPARE LENGTH;                                   <<00.GEN>>10806000
                                                              <<00.GEN>>10808000
    DIRMATCH:=NOCODE;                                         <<00.GEN>>10810000
    SIMPLEMATCH;                                              <<00.GEN>>10812000
    IF CLOSURE THEN                                           <<00.GEN>>10814000
    BEGIN                                                     <<00.GEN>>10816000
      DO BEGIN                                                <<00.GEN>>10818000
        DO SIMPLEMATCH UNTIL NOT CLOSURE;                     <<00.GEN>>10820000
        CHECK'ENDCOND;                                        <<00.GEN>>10822000
        IF MATCHCODE<>EQCODE THEN RESET'MATCHSTART;           <<00.GEN>>10824000
      END UNTIL MATCHCODE<>NOCODE;                             <<01454>>10826000
    END;                                                       <<01454>>10828000
  END;                                                         <<01454>>10830000
END <<PROCEDURE DIRMATCH>>;                                    <<01454>>10832000
                                                               <<01454>>10834000
                                                               <<01454>>10836000
                                                               <<01454>>10838000
PROCEDURE GET'FILECODE(FILECODE,MNEMONIC,MNEMONIC'LENGTH);     <<01454>>10840000
   INTEGER FILECODE,MNEMONIC'LENGTH;                           <<01454>>10842000
   BYTE ARRAY MNEMONIC;                                        <<01454>>10844000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01454>>10846000
                                                               <<01454>>10848000
COMMENT                                                        <<01454>>10850000
   This procedure contains two entry points for converting file<<01454>>10852000
   code mnemonics to file code values and vice versa.          <<01454>>10854000
                                                               <<01454>>10856000
GET'FILECODE                                                   <<01454>>10858000
   This entry point takes a character string, compares it to   <<01454>>10860000
   a list of HP defined file code mnemonics, and returns the   <<01454>>10862000
   integer value of the corresponding file code.               <<01454>>10864000
                                                               <<01454>>10866000
   INPUT                                                       <<01454>>10868000
      MNEMONIC -- byte array containing the character string.  <<01454>>10870000
      MNEMONIC'LENGTH -- length of the character string        <<01454>>10872000
         contained in MNEMONIC.  Must be > 0.                  <<01454>>10874000
   OUTPUT                                                      <<01454>>10876000
      FILECODE -- integer file code corresponding to the string<<01454>>10878000
         passed in MNEMONIC.  If there is no HP defined file   <<01454>>10880000
         code corresponding to the input string, the value     <<01454>>10882000
         returned in FILECODE is 0.                            <<01454>>10884000
   CONDITION CODE                                              <<01454>>10886000
      CCE -- string passed is an HP defined file code mnemonic.<<01454>>10888000
      CCG -- string passed is not an HP defined mnemonic.      <<01454>>10890000
      CCL -- error in call, length <= 0.                       <<01454>>10892000
                                                               <<01454>>10894000
GET'FILEMNEMONIC                                               <<01454>>10896000
   This entry point takes an integer value, compares it to a   <<01454>>10898000
   list of HP defined file codes, and returns the mnemonic     <<01454>>10900000
   corresponding to the input value.                           <<01454>>10902000
                                                               <<01454>>10904000
   INPUT                                                       <<01454>>10906000
      FILECODE -- integer file code.                           <<01454>>10908000
   OUTPUT                                                      <<01454>>10910000
      MNEMONIC -- 5 character mnemonic corresponding to the    <<01454>>10912000
         input value.  The mnemonic is left-justified with     <<01454>>10914000
         trailing blanks.  If the file code does not have a    <<01454>>10916000
         corresponding mnemonic, the string is all blanks.     <<01454>>10918000
      MNEMONIC'LENGTH -- the number of non-blank characters    <<01454>>10920000
         returned in MNEMONIC.                                 <<01454>>10922000
   CONDITION CODE                                              <<01454>>10924000
      CCE -- the input value had a corresponding mnemonic.     <<01454>>10926000
      CCG -- no mnemonic for file code value.                  <<01454>>10928000
      CCL -- not returned.                                     <<01454>>10930000
                                                               <<01454>>10932000
ISSUES                                                         <<01454>>10934000
   1)  The dictionary entries are of fixed length so that they <<01454>>10936000
       can be indexed.                                         <<01454>>10938000
   2)  The search for GET'FILEMNEMONIC is faster than the      <<01454>>10940000
       search for GET'FILECODE because LISTF's are done more   <<01454>>10942000
       frequently than FILE or BUILD commands.                 <<01454>>10944000
                                                               <<01454>>10946000
ADDING A NEW MNEMONIC                                          <<01454>>10948000
   1)  Change NUMBER'CODES to reflect the new number of        <<01454>>10950000
       mnemonics.                                              <<01454>>10952000
   2)  Insert an entry into BOTH the dictionary and the the    <<01454>>10954000
       file code array so that the indices match.              <<01454>>10956000
;                                                              <<01454>>10958000
                                                               <<01454>>10960000
                                                               <<01454>>10962000
                                                               <<01454>>10964000
BEGIN                                                          <<01454>>10966000
   ENTRY GET'FILEMNEMONIC;                                     <<01454>>10968000
                                                               <<01454>>10970000
   BYTE ARRAY LOCAL'BUFFER(0:7);                               <<01454>>10972000
                                                               <<01454>>10974000
   INTEGER ENTRY'NUMBER,  << INDEX OF ENTRY >>                 <<01454>>10976000
           LOWER'BOUND,   << BOUNDS FOR BINARY SEARCH >>       <<01454>>10978000
           UPPER'BOUND;                                        <<01454>>10980000
                                                               <<01454>>10982000
<< NUMBER'CODES -- the number of file codes and associated >>  <<01454>>10984000
<<    mnemonics contained in the two data structures.      >>  <<01454>>10986000
                                                               <<01454>>10988000
   EQUATE NUMBER'CODES = 59,                                   <<04783>>10990000
          DICT'LENGTH = NUMBER'CODES*8 + 1;                    <<01454>>10992000
                                                               <<01454>>10994000
   BYTE ARRAY LOCAL'DICT(0:DICT'LENGTH-1);                     <<01454>>10996000
                                                               <<01454>>10998000
<< MNEMONIC'DICT -- a byte array formatted for use by the    >><<01454>>11000000
<<    SEARCH intrinsic.  The "name" portion of each entry is >><<01454>>11002000
<<    five characters containing a file code mnemonic left-  >><<01454>>11004000
<<    justified with trailing blanks.  The definition        >><<01454>>11006000
<<    portion of each entry is the length of the mnemonic.   >><<01454>>11008000
                                                               <<01454>>11010000
   BYTE ARRAY MNEMONIC'DICT(0:DICT'LENGTH-1) = PB :=           <<01454>>11012000
                                                               <<01454>>11014000
8,5,"USL  ",3,     << 1024 >>                                  <<01454>>11016000
8,5,"BASD ",4,     << 1025 >>                                  <<01454>>11018000
8,5,"BASP ",4,     << 1026 >>                                  <<01454>>11020000
8,5,"BASFP",5,     << 1027 >>                                  <<01454>>11022000
8,5,"RL   ",2,     << 1028 >>                                  <<01454>>11024000
8,5,"PROG ",4,     << 1029 >>                                  <<01454>>11026000
8,5,"SL   ",2,     << 1031 >>                                  <<01454>>11028000
8,5,"VFORM",5,     << 1035 >>                                  <<01454>>11030000
8,5,"VFAST",5,     << 1036 >>                                  <<01454>>11032000
8,5,"VREF ",4,     << 1037 >>                                  <<01454>>11034000
8,5,"XLSAV",5,     << 1040 >>                                  <<01454>>11036000
8,5,"XLBIN",5,     << 1041 >>                                  <<01454>>11038000
8,5,"XLDSP",5,     << 1042 >>                                  <<01454>>11040000
8,5,"EDITQ",5,     << 1050 >>                                  <<01454>>11042000
8,5,"EDTCQ",5,     << 1051 >>                                  <<01454>>11044000
8,5,"EDTCT",5,     << 1052 >>                                  <<01454>>11046000
8,5,"TDPDT",5,     << 1054 >>                                           11048000
8,5,"TDPQM",5,     << 1055 >>                                           11050000
8,5,"TDPP ",4,     << 1056 >>                                           11052000
8,5,"TDPCP",5,     << 1057 >>                                           11054000
8,5,"TDPQ ",4,     << 1058 >>                                           11056000
8,5,"TDPXQ",5,     << 1059 >>                                           11058000
8,5,"RJEPN",5,     << 1060 >>                                  <<01454>>11060000
8,5,"QPROC",5,     << 1070 >>                                  <<01454>>11062000
8,5,"KSAMK",5,     << 1080 >>                                  <<01454>>11064000
8,5,"GRAPH",5,     << 1083 >>                                  <<01454>>11066000
8,5,"SD   ",2,     << 1084 >>                                  <<01454>>11068000
8,5,"LOG  ",3,     << 1090 >>                                  <<01454>>11070000
8,5,"WDOC ",4,     << 1100 >>                                  <<01454>>11072000
8,5,"WDICT",5,     << 1101 >>                                  <<01454>>11074000
8,5,"WCONF",5,     << 1102 >>                                  <<04783>>11076000
8,5,"W2601",5,     << 1103 >>                                  <<04783>>11078000
8,5,"PCELL",5,     << 1110 >>                                  <<01454>>11080000
8,5,"PFORM",5,     << 1111 >>                                  <<01454>>11082000
8,5,"P2680",5,     << 1112 >>                                  <<01454>>11084000
8,5,"PCCMP",5,     << 1113 >>                                  <<01454>>11086000
8,5,"RASTR",5,     << 1114 >>                                  <<04783>>11088000
8,5,"OPTLF",5,     << 1130 >>                                  <<01652>>11090000
8,5,"TEPES",5,     << 1131 >>                                  <<01454>>11092000
8,5,"TEPEL",5,     << 1132 >>                                  <<01454>>11094000
8,5,"SAMPL",5,     << 1133 >>                                  <<04783>>11096000
8,5,"MPEDL",5,     << 1139 >>                                  <<04783>>11098000
8,5,"TSR  ",3,     << 1140 >>                                  <<04783>>11100000
8,5,"TSD  ",3,     << 1141 >>                                  <<04783>>11102000
8,5,"DRAW ",4,     << 1145 >>                                  <<04783>>11104000
8,5,"FIG  ",3,     << 1146 >>                                           11106000
8,5,"DSTOR",5,     << 1156 >>                                  <<04783>>11108000
8,5,"TCODE",5,     << 1157 >>                                  <<04783>>11110000
8,5,"RCODE",5,     << 1158 >>                                  <<04783>>11112000
8,5,"ICODE",5,     << 1159 >>                                  <<04783>>11114000
8,5,"MDIST",5,     << 1166 >>                                  <<04783>>11116000
8,5,"MTEXT",5,     << 1167 >>                                  <<04783>>11118000
8,5,"VCSF ",4,     << 1176 >>                                  <<04783>>11120000
8,5,"TTYPE",5,     << 1177 >>                                  <<04783>>11122000
8,5,"TVFC ",4,     << 1178 >>                                           11124000
8,5,"NCONF",5,     << 1192 >>                                  <<04783>>11126000
8,5,"NTRAC",5,     << 1193 >>                                  <<04783>>11128000
8,5,"NLOG ",4,     << 1194 >>                                  <<04783>>11130000
8,5,"MIDAS",5,     << 1195 >>                                  <<04783>>11132000
0;                                                             <<01454>>11134000
                                                               <<01454>>11136000
<< MNEMONIC'CODE -- an ascending ordered integer array       >><<01454>>11138000
<<    containing those HP defined file codes which have a    >><<01454>>11140000
<<    corresponding mnemonic.  The index of each element     >><<01454>>11142000
<<    corresponds to the entry number returned by the SEARCH >><<01454>>11144000
<<    intrinsic for its mnemonic.                            >><<01454>>11146000
                                                               <<01454>>11148000
   INTEGER ARRAY MNEMONIC'CODE(1:NUMBER'CODES) = PB :=         <<01454>>11150000
                                                               <<01454>>11152000
1024      << USL   >>                                          <<01454>>11154000
,1025     << BASD  >>                                          <<01454>>11156000
,1026     << BASP  >>                                          <<01454>>11158000
,1027     << BASFP >>                                          <<01454>>11160000
,1028     << RL    >>                                          <<01454>>11162000
,1029     << PROG  >>                                          <<01454>>11164000
,1031     << SL    >>                                          <<01454>>11166000
,1035     << VFORM >>                                          <<01454>>11168000
,1036     << VFAST >>                                          <<01454>>11170000
,1037     << VREF  >>                                          <<01454>>11172000
,1040     << XLSAV >>                                          <<01454>>11174000
,1041     << XLBIN >>                                          <<01454>>11176000
,1042     << XLDSP >>                                          <<01454>>11178000
,1050     << EDITQ >>                                          <<01454>>11180000
,1051     << EDTCQ >>                                          <<01454>>11182000
,1052     << EDTCT >>                                          <<01454>>11184000
<< 1053:       RESERVED FOR EDIT EXTENSIONS >>                          11186000
,1054     << TDPDT >>                                                   11188000
,1055     << TDPQM >>                                                   11190000
,1056     << TDPP  >>                                                   11192000
,1057     << TDPCP >>                                                   11194000
,1058     << TDPQ  >>                                                   11196000
,1059     << TDPCQ >>                                                   11198000
,1060     << RJEPN >>                                          <<01454>>11200000
<< 1061-1069:  RESERVED FOR RJE EXTENSIONS >>                  <<01454>>11202000
,1070     << QPROC >>                                          <<01454>>11204000
<< 1071&1072 -- QUERY WORK FILES >>                            <<01454>>11206000
<< 1073-1079:  RESERVED FOR QUERY EXTENSIONS >>                <<01454>>11208000
,1080     << KSAMK >>                                          <<01454>>11210000
,1083     << GRAPH >>                                          <<01454>>11212000
,1084     << SD    >>                                          <<01454>>11214000
,1090     << LOG   >>                                          <<01454>>11216000
,1100     << WDOC  >>                                          <<01454>>11218000
,1101     << WDICT >>                                          <<01454>>11220000
,1102     << WCONF >>                                          <<04783>>11222000
,1103     << W2601 >>                                          <<04783>>11224000
<< 1104-1109: RESERVED FOR WORD EXTENSIONS >>                  <<04783>>11226000
,1110     << PCELL >>                                          <<01454>>11228000
,1111     << PFORM >>                                          <<01454>>11230000
,1112     << P2680 >>                                          <<01454>>11232000
,1113     << PCCMP >>                                          <<01454>>11234000
,1114     << RASTR >>                                          <<04783>>11236000
<< 1115-1129: RESERVED FOR PSP EXTENSIONS >>                   <<04783>>11238000
,1130     << OPTLF >>                                          <<01652>>11240000
,1131     << TEPES >>                                          <<01454>>11242000
,1132     << TEPEL >>                                          <<01454>>11244000
,1133     << SAMPL >>                                          <<04783>>11246000
<< 1134-1138: RESERVED FOR PERF. TOOLS EXTENSIONS >>           <<04783>>11248000
,1139     << MPEDL >>                                          <<04783>>11250000
,1140     << TSR   >>                                          <<04783>>11252000
,1141     << TSD   >>                                          <<04783>>11254000
<< 1142-1144: RESERVED FOR TOOLSET EXTENSIONS >>               <<04783>>11256000
,1145     << DRAW  >>                                          <<04783>>11258000
,1146     << FIG   >>                                                   11260000
<< 1147-1149:  RESERVED FOR SANDBOX EXTENSIONS >>                       11262000
<< 1150-1155: RESERVED FOR SLATE >>                            <<04783>>11264000
,1156     << DSTOR >>                                          <<04783>>11266000
,1157     << TCODE >>                                          <<04783>>11268000
,1158     << RCODE >>                                          <<04783>>11270000
,1159     << ICODE >>                                          <<04783>>11272000
<< 1160-1165: RESERVED FOR RAPID >>                            <<04783>>11274000
,1166     << MDIST >>                                          <<04783>>11276000
,1167     << MTEXT >>                                          <<04783>>11278000
<< 1168-1170: RESERVED FOR HPMAIL >>                           <<04783>>11280000
,1176     << VCSF  >>                                          <<04783>>11282000
,1177     << TTYPE >>                                          <<04783>>11284000
,1178     << TVFC  >>                                                   11286000
<< 1178-1186: RESERVED FOR TERMINAL I/O >>                     <<04783>>11288000
<< 1187-1191: RESERVED FOR DS >>                               <<04783>>11290000
,1192     << NCONF >>                                          <<04783>>11292000
,1193     << NTRAC >>                                          <<04783>>11294000
,1194     << NLOG  >>                                          <<04783>>11296000
,1195     << MIDAS >>                                          <<04783>>11298000
<< 1196-1199: RESERVED FOR DS NETWORK MANAGEMENT >>            <<04783>>11300000
<< 1200-1210: RESERVED FOR KANJI >>                            <<04783>>11302000
<< 1211-1224: RESERVED FOR DS'83 >>                            <<04783>>11304000
;                                                              <<01454>>11306000
                                                               <<01454>>11308000
                                                               <<01454>>11310000
SUBROUTINE BINARY'SEARCH;                                      <<01454>>11312000
BEGIN                                                          <<01454>>11314000
   << INITIALIZE LOOP VARIABLES >>                             <<01454>>11316000
   LOWER'BOUND := 1;                                           <<01454>>11318000
   UPPER'BOUND := NUMBER'CODES;                                <<01454>>11320000
                                                               <<01454>>11322000
   WHILE LOWER'BOUND <= UPPER'BOUND DO                         <<01454>>11324000
      BEGIN                                                    <<01454>>11326000
      X := (LOWER'BOUND + UPPER'BOUND)/2;                      <<01454>>11328000
                                                               <<01454>>11330000
      IF FILECODE < MNEMONIC'CODE(X) THEN                      <<01454>>11332000
         UPPER'BOUND := X - 1     << LESS THAN CASE >>         <<01454>>11334000
      ELSE IF > THEN                                           <<01454>>11336000
         LOWER'BOUND := X + 1     << GREATER THAN CASE >>      <<01454>>11338000
      ELSE                                                     <<01454>>11340000
         BEGIN                                                 <<01454>>11342000
         ENTRY'NUMBER := X;       << FOUND ENTRY >>            <<01454>>11344000
         RETURN;                                               <<01454>>11346000
         END;                                                  <<01454>>11348000
      END;                << OF SEARCH LOOP >>                 <<01454>>11350000
                                                               <<01454>>11352000
   ENTRY'NUMBER := 0;     << ENTRY NOT FOUND >>                <<01454>>11354000
                                                               <<01454>>11356000
END;      << OF BINARY'SEARCH >>                               <<01454>>11358000
                                                               <<01454>>11360000
                                                               <<01454>>11362000
                                                               <<01454>>11364000
<< ENTRY POINT FOR GET'FILECODE >>                             <<01454>>11366000
                                                               <<01454>>11368000
   CC := CCL;           << SET COND CODE FOR ERROR CASE >>     <<01454>>11370000
                                                               <<01454>>11372000
   << LENGTH MUST BE POSITIVE >>                               <<01454>>11374000
   IF MNEMONIC'LENGTH <= 0 THEN RETURN;         << CCL >>      <<01454>>11376000
                                                               <<01454>>11378000
   << INITIALIZE VARIABLES FOR NOT FOUND CASE >>               <<01454>>11380000
   FILECODE := 0;                                              <<01454>>11382000
   CC := CCG;                                                  <<01454>>11384000
                                                               <<01454>>11386000
   << NO MNEMONICS > 5 CHARACTERS >>                           <<01454>>11388000
   IF MNEMONIC'LENGTH > 5 THEN RETURN;          << CCG >>      <<01454>>11390000
                                                               <<01454>>11392000
   << GET LOCAL COPY OF MNEMONIC UPSHIFTED >>                  <<01454>>11394000
   MOVE LOCAL'BUFFER := "      ";                              <<01454>>11396000
   MOVE LOCAL'BUFFER := MNEMONIC,(MNEMONIC'LENGTH);            <<01454>>11398000
   MOVE LOCAL'BUFFER := LOCAL'BUFFER WHILE ANS;                <<01454>>11400000
                                                               <<01454>>11402000
   << SEARCH FOR MNEMONIC IN DICTIONARY >>                     <<01454>>11404000
   MOVE LOCAL'DICT := MNEMONIC'DICT,(DICT'LENGTH);             <<01454>>11406000
   ENTRY'NUMBER := SEARCH(LOCAL'BUFFER,5,LOCAL'DICT);          <<01454>>11408000
                                                               <<01454>>11410000
   IF ENTRY'NUMBER <> 0 THEN                                   <<01454>>11412000
      BEGIN              << FOUND MNEMONIC >>                  <<01454>>11414000
      CC := CCE;                                               <<01454>>11416000
      FILECODE := MNEMONIC'CODE(ENTRY'NUMBER);                 <<01454>>11418000
      END;                                                     <<01454>>11420000
                                                               <<01454>>11422000
   RETURN;         << ALL DONE WITH GET'FILECODE ENTRY POINT >><<01454>>11424000
                                                               <<01454>>11426000
                                                               <<01454>>11428000
GET'FILEMNEMONIC:                                              <<01454>>11430000
                                                               <<01454>>11432000
   << INITIALIZE OUTPUT VARIABLES FOR NOT FOUND CASE >>        <<01454>>11434000
   CC := CCG;                                                  <<01454>>11436000
   MNEMONIC'LENGTH := 0;                                       <<01454>>11438000
   MOVE MNEMONIC := "     ";                                   <<01454>>11440000
                                                               <<01454>>11442000
   << CHECK IF FILE CODE IN RANGE OF POSSIBLE MNEMONICS >>     <<01454>>11444000
   IF MNEMONIC'CODE(1) <= FILECODE <=                          <<01454>>11446000
      MNEMONIC'CODE(NUMBER'CODES) THEN                         <<01454>>11448000
      BEGIN                                                    <<01454>>11450000
      BINARY'SEARCH;     << BINARY'SEARCH SETS ENTRY'NUMBER >> <<01454>>11452000
                                                               <<01454>>11454000
      IF ENTRY'NUMBER <> 0 THEN                                <<01454>>11456000
         BEGIN                << FOUND CODE >>                 <<01454>>11458000
                                                               <<01454>>11460000
         << GET LOCAL COPY OF DICTIONARY ENTRY >>              <<01454>>11462000
         MOVE LOCAL'BUFFER :=                                  <<01454>>11464000
              MNEMONIC'DICT( (ENTRY'NUMBER-1)*8 ),(8);         <<01454>>11466000
                                                               <<01454>>11468000
         << SET RETURN VARIABLES >>                            <<01454>>11470000
         CC := CCE;                                            <<01454>>11472000
         MOVE MNEMONIC := LOCAL'BUFFER(2),(5);                 <<01454>>11474000
         MNEMONIC'LENGTH := LOCAL'BUFFER(7);                   <<01454>>11476000
         END;                                                  <<01454>>11478000
      END;                                                     <<01454>>11480000
                                                               <<01454>>11482000
                                                               <<01454>>11484000
END;     << OF GET'FILECODE/MNEMONIC >>                        <<01454>>11486000
                                                               <<01454>>11488000
                                                               <<01454>>11490000
INTEGER PROCEDURE LISTFILE (PARMS);                           <<00.GEN>>11492000
   INTEGER ARRAY PARMS;                                       <<00.GEN>>11494000
   OPTION PRIVILEGED, UNCALLABLE;                                       11496000
BEGIN                                                                   11498000
                                                                        11500000
   DOUBLE ARRAY      DPARMS (*)        = PARMS;                         11502000
<< "OWN" VARIABLES IN <PARMS>. >>                                       11504000
   INTEGER ARRAY     FNAME (*)         = PARMS,                         11506000
                     CURRENTG (*)      = PARMS (4),                     11508000
                     CURRENTA (*)      = PARMS (8),                     11510000
                     CURRENTGA (*)     = CURRENTG;                      11512000
   DEFINE            DETAIL            = PARMS (12) #,                  11514000
                     DETAILLENGTH      = PARMS (13) #,   <<WORDS>>      11516000
                     FPNTR1            = PARMS (14) #,                  11518000
                     FPNTR2            = PARMS (15) #,                  11520000
                     SIRS              = DPARMS (8) #,                  11522000
                     FILENUM           = PARMS (18) #,                  11524000
                     DEVSIZE           = PARMS (19) #,   <<BYTES>>      11526000
                     LINENO            = PARMS (20) #,                  11528000
                     NUMPERLINECOUNT   = PARMS (21) #,         <<RV.PV>>11530000
                     GLINKAGEW         = PARMS (23) #;         << I.A >>11532000
                                                                        11534000
<< LOCALS >>                                                            11536000
   EQUATE            MAXDETAILLENGTH   = 72,                            11538000
                     MDLWORDSM1        = MAXDETAILLENGTH/2 -1,          11540000
                     FINFOSIZE         = 128,                           11542000
                     LONGDEV           = 128;                           11544000
   INTEGER ARRAY     FLABEL (*),                                        11546000
                     BUF (0:MDLWORDSM1);                                11548000
   DOUBLE ARRAY      DFLABEL (*)       = FLABEL;                        11550000
   BYTE ARRAY        BBUF (*)          = BUF,                           11552000
                     TBUF (0:9);                                        11554000
   INTEGER           LEN,                                               11556000
                     BF,                                                11558000
                     NX;                                                11560000
   LOGICAL           FIRSTFILE := FALSE,  << 1ST IN GROUP >>   <<01724>>11562000
                     BADFLABEL := FALSE;  << BAD FILE LABEL >> <<01724>>11564000
   << DOUBLE (TOS) / X  --->  DOUBLE (Q), SINGLE (REM)    (ON TOS) >>   11566000
   << DOUBLE (TOS) * X  --->  DOUBLE (PRODUCT)  (ON TOS) >>             11568000
                                                                        11570000
<< FILE LABEL >>                                                        11572000
   << FOLLOWING 3 ARRAY ADDRESSES ARE SET WHEN (IF) <FLABEL> IS INTITL>>11574000
INTEGER ARRAY     FLGA (*)       << = FLABEL (4) >>;           <<0307>> 11576000
DOUBLE ARRAY      FLEXTMAP (*)   << = FLABEL (44) >>;          <<0307>> 11578000
   BYTE ARRAY        BFLGA (*)      << = FLGA >>;                       11580000
   DEFINE            FLFLIM            = DFLABEL (15) #,                11582000
                     FLEOF             = DFLABEL (21) #,                11584000
                     FLCODE            = FLABEL (26) #,                 11586000
                     FLOPENED          = FLABEL (27) <> 0 AND           11588000
                         FLABEL (35) =ABSOLUTE(COLDLOADID) #,           11590000
                     FLRECFORMAT       = FLABEL (36) .(8:2) #,          11592000
                     FLASCII           = LOGICAL (FLABEL(36).(13:1)) #, 11594000
                     FLCNTRL           = LOGICAL (FLABEL(36).(7:1)) #,  11596000
                     FLFILETYPE    =LOGICAL(FLABEL(36).(2:3))#,<<01549>>11598000
                     FLKSAM            = (FLFILETYPE = 1) #,   <<01549>>11600000
                     FLMSGFILE         = (FLFILETYPE = 6) #,   <<01549>>11602000
                     FLRECSIZE         = FLABEL (37) #,                 11604000
                     FLBLKSIZE         = FLABEL (38) #,                 11606000
                     FLNUMEXTS         = FLABEL (39) .(11:5) #,         11608000
                  FLLASTEXTSIZE     = FLABEL (40) #,           <<0307>> 11610000
                     FLEXTSIZE         = FLABEL (41) #;                 11612000
   BYTE ARRAY        PRIV (0:4) = PB   := "PRIV ";                      11614000
   ARRAY             FILETYPE(0:7)=PB:="     R ? O ? M ?";     <<01549>>11616000
                                                                        11618000
<< MISC. JUNK >>                                                        11620000
      DEFINE                                                            11622000
                     EJECT             = BEGIN                          11624000
                                         FWRITE (FILENUM, BUF, 0, %61); 11626000
                                         IF <> THEN                     11628000
                                            BEGIN                       11630000
                                            TOS := 2;                   11632000
                                            GOTO EXIT;                  11634000
                                            END;                        11636000
                                         LINENO := 1;                   11638000
                                         END  #,                        11640000
                     FINISHWRITE       = IF <> THEN                     11642000
                                            BEGIN                       11644000
                                            TOS := 2;                   11646000
                                            GOTO EXIT;                  11648000
                                            END;                        11650000
                                         LINENO := LINENO  #,           11652000
                     SPACE             = BEGIN                          11654000
                                         FWRITE (FILENUM, BUF, 0, %40); 11656000
                                         FINISHWRITE +1;                11658000
                                         END #,                         11660000
                     DSPACE            = BEGIN                          11662000
                                         FWRITE (FILENUM, BUF, 0, %60); 11664000
                                         FINISHWRITE +2;                11666000
                                         END #;                         11668000
                                                                        11670000
<< LIST FORMAT >>                                                       11672000
   ARRAY             TITLE1 (0:33) = PB :=  "FILENAME",        <<U.RAO>>11674000
"  CODE  ------------LOGICAL RECORD-----------  ----SPACE----";<<U.RAO>>11676000
   ARRAY             TITLE1A (0:33) = PB := "        ",        <<U.RAO>>11678000
"          SIZE  TYP        EOF      LIMIT R/B  SECTORS #X MX";<<U.RAO>>11680000
   EQUATE            OPPOS             = 8,                             11682000
                     CODEPOS           = 10,                            11684000
                     RSIZEPOS          = 21,                            11686000
                     RTYPPOS           = 24,                            11688000
                     REOFPOS           = 37,                            11690000
                     RLIMPOS           = 48,                            11692000
                     RBPOS             = 52,                            11694000
                     SECTPOS           = 61,                            11696000
                     NXPOS             = 64,                            11698000
                     MXPOS             = 67;                   <<U.RAO>>11700000
   ARRAY             AGTITLE (0:25) = PB :=                            "11702000
ACCOUNT=              GROUP=              (CONT.) ";                    11704000
   EQUATE            GROUPPOS          = 15,                            11706000
                     ACCTPOS           = 5;                             11708000
                                                                        11710000
SUBROUTINE RIGHTNUM (NUM, BBUFDEST);                                    11712000
   VALUE BBUFDEST, NUM;                                                 11714000
   INTEGER BBUFDEST, NUM;                                               11716000
<< RIGHT-JUSTIFIED NUMBER AT BBUF (BBUFDEST) >>                         11718000
BEGIN                                                                   11720000
   LEN := ASCII (NUM, 10, TBUF);                                        11722000
   MOVE BBUF (BBUFDEST -LEN +1) := TBUF, (LEN);                         11724000
   END    <<RIGHTNUM>>;                                                 11726000
SUBROUTINE RIGHTDNUM (DNUM, BBUFDEST);                                  11728000
   VALUE BBUFDEST, DNUM;                                                11730000
   INTEGER BBUFDEST;                                                    11732000
   DOUBLE DNUM;                                                         11734000
<< RIGHT-JUSTIFIED DOUBLE AT BBUF (BBUFDEST) >>                         11736000
BEGIN                                                                   11738000
   LEN := DASCII (DNUM, 10, TBUF);                                      11740000
   MOVE BBUF (BBUFDEST -LEN +1) := TBUF, (LEN);                         11742000
   END    <<RIGHTDNUM>>;                                                11744000
SUBROUTINE PRINTAG (LENGTH);                                            11746000
   VALUE LENGTH;                                                        11748000
   INTEGER LENGTH;                                                      11750000
<< PRINT "ACCOUNT/GROUP" TITLE >>                                       11752000
BEGIN                                                                   11754000
   MOVE BUF := AGTITLE, (LENGTH);                                       11756000
   MOVE BUF (ACCTPOS) := CURRENTA, (4);                                 11758000
   MOVE BUF (GROUPPOS) := CURRENTG, (4);                                11760000
   FWRITE (FILENUM, BUF, LENGTH, 0);                                    11762000
   FINISHWRITE +1;                                                      11764000
   END    <<PRINTAG>>;                                                  11766000
SUBROUTINE PRINTTITLE;                                                  11768000
<< PRINTS COLUMN HEADING INFORMATION.                                   11770000
   VERY SIMPLE PRINT FOR NOW. >>                                        11772000
BEGIN                                                                   11774000
   SPACE;                                                               11776000
   MOVE BUF := TITLE1, (DETAILLENGTH);                                  11778000
   FWRITE (FILENUM, BUF, DETAILLENGTH, 0);                              11780000
   FINISHWRITE +1;                                                      11782000
   IF DETAIL <> 0 THEN                                                  11784000
      BEGIN                                                             11786000
      MOVE BUF := TITLE1A, (DETAILLENGTH);                              11788000
      FWRITE (FILENUM, BUF, DETAILLENGTH, 0);                           11790000
      FINISHWRITE +1;                                                   11792000
      END;                                                              11794000
   SPACE;                                                               11796000
   NUMPERLINECOUNT := 0;                                                11798000
   END    <<PRINTTITLE>>;                                               11800000
                                                                        11802000
                                                                        11804000
                                                                        11806000
SUBROUTINE PRINTFORM1 (BUFSTART, LENGTH);                               11808000
   VALUE BUFSTART, LENGTH;                                              11810000
   INTEGER BUFSTART, LENGTH;                                            11812000
<< SIMPLY PRINT BUF (BUFSTART), LENGTH.  >>                             11814000
BEGIN                                                                   11816000
   FWRITE (FILENUM, BUF (BUFSTART), LENGTH, 0);                         11818000
   FINISHWRITE +1;                                                      11820000
   END    <<PRINTFORM1>>;                                               11822000
SUBROUTINE PRINTFORM2 (LENGTH, NUMBERPERLINE);                          11824000
   VALUE LENGTH, NUMBERPERLINE;                                         11826000
   INTEGER LENGTH, NUMBERPERLINE;                                       11828000
<< PUT 4 BLANKS AT BUF (LENGTH) AND WRITE IT OUT %320,                  11830000
   UNLESS THIS IS LAST ONE ON THE LINE.  >>                             11832000
BEGIN                                                                   11834000
   NUMPERLINECOUNT := NUMPERLINECOUNT -1;                               11836000
   IF < THEN    <<1ST FILE: INITIALIZE <NUMPERLINECOUNT>.>>             11838000
      NUMPERLINECOUNT := NUMBERPERLINE -1;                              11840000
   IF > THEN                                                            11842000
      BEGIN                                                             11844000
      BUF (LENGTH) := "  ";                                             11846000
      BUF (X +1) := "  ";                                               11848000
      FWRITE (FILENUM, BUF, LENGTH +2, %320);                           11850000
      FINISHWRITE;    << <LINENO> NOT MODIFIED >>                       11852000
      END                                                               11854000
   ELSE                                                                 11856000
      BEGIN                                                             11858000
      FWRITE (FILENUM, BUF, LENGTH, 0);                                 11860000
      FINISHWRITE +1;                                                   11862000
      NUMPERLINECOUNT := NUMBERPERLINE;                                 11864000
      END;                                                              11866000
   END    <<PRINTFORM2>>;                                               11868000
                                                                        11870000
SUBROUTINE PRINTLINE;                                                   11872000
BEGIN                                                                   11874000
   TOS := DETAIL & LSL(1);                                              11876000
   IF DEVSIZE >= LONGDEV THEN TOS := TOS +1;                            11878000
   CASE TOS OF                                                          11880000
      BEGIN                                                             11882000
         PRINTFORM2 (4, 6);                                             11884000
         PRINTFORM2 (4, 11);                                            11886000
         PRINTFORM1 (0, 25);                                            11888000
         PRINTFORM2 (25, 2);                                            11890000
         PRINTFORM1 (0, 34);                                   <<U.RAO>>11892000
         PRINTFORM1 (0,34);                                    <<U.RAO>>11894000
      END;                                                              11896000
   END    <<PRINTLINE>>;                                                11898000
                                                                        11900000
                                                                        11902000
SUBROUTINE FORMATINFO;                                                  11904000
BEGIN                                                                   11906000
   BUF := "  ";                                                         11908000
   MOVE BUF (1) := BUF, (MDLWORDSM1);                                   11910000
IF DETAIL >= 2 THEN                                                     11912000
   BEGIN                                                                11914000
   TOS := DOUBLE (FLBLKSIZE);          <<BLOCK FACTOR>>                 11916000
   TOS := FLRECSIZE;                                                    11918000
   IF = THEN TOS := TOS +128                                            11920000
   ELSE IF < THEN TOS := (-TOS +1) & LSR(1);                            11922000
   IF FLMSGFILE THEN TOS:=TOS+3;  <<ADD IN MG HDR LENGTH>>     <<01565>>11924000
   ASSEMBLE (LDIV, DEL);                                                11926000
   RIGHTNUM ((BF := TOS), RBPOS);                                       11928000
   TOS := @FLEXTMAP;                                                    11930000
   X := FLNUMEXTS;                                                      11932000
   TOS := 0;                                                            11934000
   DO BEGIN                                                             11936000
      IF DPS1(X) <> 0D THEN TOS := TOS +1;                              11938000
      X := X -1;                                                        11940000
      END                                                               11942000
   UNTIL <;                                                             11944000
   RIGHTNUM ((NX := TOS), NXPOS);                                       11946000
   ASSEMBLE (DEL);                                                      11948000
   RIGHTNUM(FLNUMEXTS+1, MXPOS);                               <<0307>> 11950000
                                                               <<0307>> 11952000
   << COMPUTE FILE SPACE IN SECTORS.  NOTE: LAST EXTENT MAY >> <<0307>> 11954000
   << CONTAIN FEWER SECTORS THAN THE OTHERS.                >> <<0307>> 11956000
   TOS := IF FLEXTMAP(FLNUMEXTS) = 0D THEN                     <<0307>> 11958000
              LOGICAL(NX)**LOGICAL(FLEXTSIZE)                  <<0307>> 11960000
          ELSE                                                 <<0307>> 11962000
             (LOGICAL(NX)-1)**LOGICAL(FLEXTSIZE) +             <<0307>> 11964000
         DOUBLE(LOGICAL(FLLASTEXTSIZE));                                11966000
   RIGHTDNUM (*, SECTPOS);                                              11968000
   END;                                                                 11970000
IF DETAIL >= 1 THEN                                                     11972000
   BEGIN                                                                11974000
   IF FLOPENED THEN BBUF(OPPOS) := "*";<<OPENED FLAG>>                  11976000
   IF FLCODE < 0 THEN   << PRIVILEGED FILE >>                  <<01454>>11978000
      MOVE BBUF(CODEPOS) := PRIV,(4)                           <<01454>>11980000
   ELSE IF > THEN   << FILE CODE > 0     >>                    <<01454>>11982000
      BEGIN         << CHECK FOR HP CODE >>                    <<01454>>11984000
      GET'FILEMNEMONIC(FLCODE,BBUF(CODEPOS),LEN);              <<01454>>11986000
      IF <> THEN    << NOT HP MNEMONIC CODE >>                 <<01454>>11988000
         ASCII(FLCODE,10,BBUF(CODEPOS));                       <<01454>>11990000
      END                                                      <<01454>>11992000
   ELSE   << FILE CODE = 0, TRY KSAM >>                        <<01454>>11994000
      IF FLKSAM THEN MOVE BBUF(CODEPOS) := "KSAM ";            <<01454>>11996000
   TOS := FLRECSIZE;                   <<REC SIZE>>                     11998000
   IF = THEN TOS := TOS +128;                                           12000000
   IF > THEN TOS := "W"                                                 12002000
   ELSE                                                                 12004000
      BEGIN                                                             12006000
      TOS := -TOS;                                                      12008000
      IF FLASCII THEN TOS:="B" ELSE                                     12010000
         BEGIN                                                          12012000
         TOS:=TOS&ASR(1);                                               12014000
         TOS:="W";                                                      12016000
         END;                                                           12018000
      END;                                                              12020000
   IF FLRECFORMAT = 1 AND NOT FLMSGFILE THEN                   <<01549>>12022000
      BEGIN                                                             12024000
      ASSEMBLE (DECB, DECB);                                            12026000
      IF S0 = "B" THEN ASSEMBLE (DECB, DECB);                           12028000
      END;                                                              12030000
   BBUF (RSIZEPOS) := TOS;                                              12032000
   RIGHTNUM (*, X -1);                                                  12034000
   CASE FLRECFORMAT OF                 <<REC TYP>>                      12036000
      BEGIN                                                             12038000
      TOS := "F";                                                       12040000
      TOS := "V";                                                       12042000
      TOS := "U";                                                       12044000
                                                               <<01724>>12046000
   << UNDEFINED VALUE (3) -- BAD FILE LABEL >>                 <<01724>>12048000
      BEGIN                                                    <<01724>>12050000
      BADFLABEL := TRUE;                                       <<01724>>12052000
      TOS := "*";                                              <<01724>>12054000
      END;                                                     <<01724>>12056000
                                                               <<01724>>12058000
      END;                                                              12060000
   BBUF (RTYPPOS) := TOS;                                               12062000
   BBUF (RTYPPOS +1) := IF FLASCII THEN "A" ELSE "B";                   12064000
   IF FLCNTRL THEN BBUF (RTYPPOS +2) := "C";                            12066000
   BBUF(RTYPPOS+(IF FLCNTRL THEN 3 ELSE 2)) :=                 <<01549>>12068000
      BYTE(FILETYPE(FLFILETYPE));                              <<01549>>12070000
   RIGHTDNUM (FLEOF, REOFPOS);         <<FILE EOF>>                     12072000
   RIGHTDNUM (FLFLIM, RLIMPOS);        <<FILE LIMIT>>                   12074000
   END;                                                                 12076000
                                                               <<01724>>12078000
   << IF BAD FILE LABEL, STAR OUT BUFFER. >>                   <<01724>>12080000
   IF BADFLABEL THEN                                           <<01724>>12082000
      BEGIN                                                    <<01724>>12084000
      BUF := "**";                                             <<01724>>12086000
      MOVE BUF(1) := BUF,(MDLWORDSM1);                         <<01724>>12088000
      END;                                                     <<01724>>12090000
                                                               <<01724>>12092000
   MOVE BUF := FNAME, (4);             <<FILENAME>>                     12094000
                                                                        12096000
   END    <<FORMATINFO>>;                                               12098000
   IF DETAIL > 0 THEN                                                   12100000
      BEGIN    <<READ IN FILE LABLE>>                                   12102000
      TOS := FINFOSIZE;                                                 12104000
      @BFLGA := (@FLGA := (@FLABEL := @S0) +4) & LSL(1);                12106000
      @FLEXTMAP := @S0 +44;                                             12108000
      ASSEMBLE (ADDS 0);                                                12110000
      TOS := 0D;  <<RETURN FOR ATTACHIO>>                      <<RV.PV>>12112000
      TOS := LUN (FPNTR1.(0:8),GLINKAGEW.(MVTABXF));           <<RV.PV>>12114000
      TOS := ATTACHIO (*,0,0,@FLABEL,0,128,FPNTR1.(8:8),FPNTR2,1);      12116000
      ASSEMBLE (DEL);                                                   12118000
      IF TOS.(13:3) <> 1 THEN                                           12120000
         BEGIN                         <<FILE LABEL I/O ERROR>>         12122000
         TOS:=SIRS;                                                     12124000
         IF<>THEN RELSIR(*,*);                                          12126000
         CIERR(-LISTFFLABIOERR);                               <<U.RAO>>12128000
         TOS := 1;                                                      12130000
         GOTO EXIT;                                                     12132000
         END;                                                           12134000
      END;                                                              12136000
   TOS := SIRS;                                                         12138000
   IF <> THEN RELSIR (*, *);                                            12140000
                                                                        12142000
   <<GOT ALL THE INFO.  NOW FORMAT AND PRINT>>                          12144000
   IF LINENO<0 THEN                                            <<05.KM>>12146000
      BEGIN                                                    <<05.KM>>12148000
      LINENO:=-LINENO;                                         <<05.KM>>12150000
      FIRSTFILE:=TRUE;                                         <<05.KM>>12152000
      END;                                                     <<05.KM>>12154000
   IF LINENO = 61 THEN EJECT;                                           12156000
   IF DETAIL>0 AND FIRSTFILE THEN                              <<06.KM>>12158000
      BEGIN                                                             12160000
      MOVE CURRENTGA := FLGA, (8);                                      12162000
      IF LINENO <> 1 THEN                                               12164000
         IF LINENO <= 52 THEN DSPACE                                    12166000
         ELSE EJECT;                                                    12168000
      PRINTAG (20);                                                     12170000
      END                                                               12172000
   ELSE                                                                 12174000
      BEGIN                                                             12176000
      IF LINENO <> 1 THEN                                               12178000
         BEGIN                                                          12180000
         IF LINENO <= 58 THEN GOTO PRINTINFOL;                          12182000
         EJECT;                                                         12184000
         END;                                                           12186000
      IF DETAIL > 0 THEN PRINTAG (25);                                  12188000
      END;                                                              12190000
   PRINTTITLE;                                                          12192000
PRINTINFOL:                                                             12194000
   FORMATINFO;                                                          12196000
    PRINTLINE;                                                          12198000
   TOS := 0;                                                            12200000
                                                                        12202000
EXIT:                                                                   12204000
   LISTFILE := TOS;                                                     12206000
   IF DETAIL > 0 THEN                                         <<01.02>> 12208000
     BEGIN                                                    <<01.02>> 12210000
       DFLABEL(8):=0D; <<WIPE OUT LOCKWORD>>                  <<01.02>> 12212000
       DFLABEL(9):=0D;                                        <<01.02>> 12214000
     END;                                                     <<01.02>> 12216000
   END    <<LISTFILE>>;                                                 12218000
INTEGER PROCEDURE LISTSAVEFILES (ELEMENT, LEVEL, PARMS, SIRS);          12220000
   VALUE LEVEL, PARMS, SIRS;                                            12222000
   INTEGER ARRAY ELEMENT;                                               12224000
   INTEGER LEVEL, PARMS;                                                12226000
   DOUBLE SIRS;                                                         12228000
   OPTION PRIVILEGED, UNCALLABLE;                                       12230000
BEGIN                                                                   12232000
   DEFINE P'FNAME=      RPARMS #,                              <<03.KM>>12234000
          P'FNAME1=     RPARMS(1) #,                           <<03.KM>>12236000
          P'GANAME=     RPARMS(2) #,                           <<03.KM>>12238000
          P'GNAME=      RPARMS(2) #,                           <<03.KM>>12240000
          P'GNAME1=     RPARMS(3) #,                           <<03.KM>>12242000
          P'ANAME=      RPARMS(4) #,                           <<03.KM>>12244000
          P'ANAME1=     RPARMS(5) #,                           <<03.KM>>12246000
          P'FPNTR=      RPARMS(7) #,                           <<03.KM>>12248000
          P'SIRS=       RPARMS(8) #,                           <<03.KM>>12250000
          P'LINENO=     RPARMSW(20) #,                         <<06.KM>>12252000
          P'GLINKAGEW=  RPARMSW(23) #,                         <<03.KM>>12254000
          P'GOTENTRY=   RPARMSW(24) #,                         <<03.KM>>12256000
          P'IMPMNTDST=  RPARMSW(25) #,                         <<03.KM>>12258000
          P'IMPMNTERR=  RPARMSW(26) #,                         <<03.KM>>12260000
          P'IMPMNTNAME= RPARMSW(27) #;                         << I.A >>12262000
   DEFINE PVGROUP=    LOGICAL(P'GLINKAGEW.(PVF)) #,            <<03.KM>>12264000
          RELEASESIR=                                          <<03.KM>>12266000
            BEGIN                                              <<03.KM>>12268000
            TOS:=SIRS;                                         <<03.KM>>12270000
            IF <> THEN RELSIR(*,*) ELSE DDEL;                  <<03.KM>>12272000
            END #;                                             <<03.KM>>12274000
   INTEGER PVINFO'ERROR;                                       <<10.KM>>12276000
   EQUATE NOMOUNT= 0;                                          <<03.KM>>12278000
   ARRAY LEAFNAME(*)=S-6;                                      <<04.KM>>12280000
   DOUBLE ARRAY DELEMENT(*)=ELEMENT,RPARMS(*);                          12282000
   INTEGER POINTER PPRESULT;                                  <<00.GEN>>12284000
   INTEGER ARRAY RPARMSW (*) = RPARMS;                         <<06.KM>>12286000
   EQUATE            DIRDST            = 20;                            12288000
                                                                        12290000
<<   ********************************************    >>        <<U.RAO>>12292000
<<   *   A RECIP procedure for CXLISTF          *    >>        <<U.RAO>>12294000
<<   ********************************************    >>        <<U.RAO>>12296000
                                                               <<U.RAO>>12298000
   IF REQUESTSERVICE THEN                                               12300000
      BEGIN                                                             12302000
      LISTSAVEFILES:=ABORTSCAN'SIR;                            <<03.KM>>12304000
      RETURN;                                                  <<03.KM>>12306000
      END;                                                              12308000
   TOS:=DELEMENT;                                             <<00.GEN>>12310000
   TOS:=DELEMENT(1);                                          <<00.GEN>>12312000
   TOS:=DELEMENT(2);                                          <<01.GEN>>12314000
   TOS:=ELEMENT(GLINKAGE);                                    <<00.GEN>>12316000
   EXCHANGEDB(0);                                             <<00.GEN>>12318000
   @RPARMS:=@ARRQ0(PARMS-DELTAQ);                             <<00.GEN>>12320000
                                                              <<00.GEN>>12322000
   @PPRESULT:=@RPARMS+SYSL'PPRINX;                            <<00.GEN>>12324000
   IF LOGICAL(D'TYPE.(ALLFLAG)) THEN                          <<00.GEN>>12326000
   BEGIN                                                      <<00.GEN>>12328000
     COMMENT:                                                 <<00.GEN>>12330000
       (S-6,S-3) = LEAF NAME                                   <<04.KM>>12332000
       (S-2,S-0) = MISC ENTRY INFO;                            <<04.KM>>12334000
                                                              <<00.GEN>>12336000
     CASE *LEVEL OF BEGIN                                     <<00.GEN>>12338000
       TOS:=DIRMATCH(G'FNAME,LEAFNAME);                       <<00.GEN>>12340000
       TOS:=DIRMATCH(G'GNAME,LEAFNAME);                       <<00.GEN>>12342000
       TOS:=DIRMATCH(G'ANAME,LEAFNAME);                       <<00.GEN>>12344000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>12346000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>12348000
     END;                                                     <<00.GEN>>12350000
     IF TOS<>0 THEN                                           <<00.GEN>>12352000
     BEGIN                                                    <<00.GEN>>12354000
       LISTSAVEFILES:=IF < THEN NEXTUNCLE'SIR                  <<03.KM>>12356000
                      ELSE NEXTBROTHER'SIR;                    <<03.KM>>12358000
       EXCHANGEDB(DIRDST);                                     <<03.KM>>12360000
       RETURN;                                                 <<03.KM>>12362000
     END;                                                     <<00.GEN>>12364000
   END;                                                       <<00.GEN>>12366000
                                                              <<00.GEN>>12368000
   CASE *LEVEL OF                                              <<04.KM>>12370000
     BEGIN                                                     <<04.KM>>12372000
     COMMENT:                                                  <<04.KM>>12374000
       (S-6,S-3)= LEAF NAME                                    <<04.KM>>12376000
       (S-2,S-1)= FPNTR (VALID IFF FILE LEVEL)                 <<04.KM>>12378000
       S-0=       GLINKAGEW (VALID IFF GROUP LEVEL).           <<04.KM>>12380000
                                                               <<04.KM>>12382000
       EACH CASE LEAVES "LISTSAVEFILES" VALUE ON TOS;          <<04.KM>>12384000
                                                               <<04.KM>>12386000
     <<0>> BEGIN <<FILE>>                                      <<04.KM>>12388000
           DEL;                                                <<04.KM>>12390000
           P'FPNTR:=TOS;                                       <<04.KM>>12392000
           P'FNAME1:=TOS;                                      <<04.KM>>12394000
           P'FNAME:=TOS;                                       <<04.KM>>12396000
           P'SIRS:=SIRS;                                       <<04.KM>>12398000
           P'GOTENTRY:=TRUE;                                   <<04.KM>>12400000
           IF LISTFILE(RPARMS)<=1 THEN TOS:=NEXTSON            <<04.KM>>12402000
           ELSE                                                <<04.KM>>12404000
             BEGIN                                             <<04.KM>>12406000
             RPARMSW(1):=-1;                                   <<04.KM>>12408000
             TOS:=ABORTSCAN;                                   <<04.KM>>12410000
             END;                                              <<04.KM>>12412000
           END;                                                <<04.KM>>12414000
                                                               <<04.KM>>12416000
     <<1>> BEGIN <<GROUP>>                                     <<04.KM>>12418000
           P'GLINKAGEW:=TOS;                                   <<04.KM>>12420000
           DDEL;                                               <<04.KM>>12422000
           P'GNAME1:=TOS;                                      <<04.KM>>12424000
           P'GNAME:=TOS;                                       <<04.KM>>12426000
           IF P'LINENO>0 THEN P'LINENO:=-P'LINENO;             <<10.KM>>12428000
           RELEASESIR;                                         <<04.KM>>12430000
           IF NOT PVGROUP THEN TOS:=NEXTSON                    <<04.KM>>12432000
           ELSE IF IMPLICITMNT(P'GNAME,P'ANAME,P'IMPMNTDST,    <<04.KM>>12434000
                               PVINFO'ERROR) THEN              <<10.KM>>12436000
             BEGIN                                             <<04.KM>>12438000
             P'GLINKAGEW.(MVTABXF):=PVINFO'ERROR.(PVMVTABXF);  <<10.KM>>12440000
             TOS:=REVISIT;                                     <<04.KM>>12442000
             END                                               <<04.KM>>12444000
           ELSE IF PVINFO'ERROR=NOMOUNT THEN                   <<10.KM>>12446000
             BEGIN                                             <<04.KM>>12448000
             P'IMPMNTERR:=PVINFO'ERROR;                        <<10.KM>>12450000
             TOS:=REVISIT;             <<DDS USED BY "MOUNT">> <<05.KM>>12452000
             END                                               <<04.KM>>12454000
           ELSE                                                <<04.KM>>12456000
             BEGIN                                             <<04.KM>>12458000
             P'IMPMNTERR:=PVINFO'ERROR;                        <<10.KM>>12460000
             MOVE P'IMPMNTNAME:=P'GANAME,(8);                  <<04.KM>>12462000
             TOS:=ABORTSCAN;                                   <<04.KM>>12464000
             END;                                              <<04.KM>>12466000
           END;                                                <<04.KM>>12468000
                                                               <<04.KM>>12470000
     <<2>> BEGIN <<ACCOUNT>>                                   <<04.KM>>12472000
           DEL;                                                <<04.KM>>12474000
           DDEL;                                               <<04.KM>>12476000
           P'ANAME1:=TOS;                                      <<04.KM>>12478000
           P'ANAME:=TOS;                                       <<04.KM>>12480000
           TOS:=NEXTSON'SIR;                                   <<04.KM>>12482000
           END;                                                <<04.KM>>12484000
                                                               <<05.KM>>12486000
     <<3>> TOS:=ABORTSCAN'SIR;         <<SHOULDN'T HAPPEN>>    <<10.KM>>12488000
     <<4>> TOS:=ABORTSCAN'SIR;         <<SHOULDN'T HAPPEN>>    <<10.KM>>12490000
     END <<CASE>>;                                             <<04.KM>>12492000
   EXCHANGEDB(DIRDST);                                         <<04.KM>>12494000
   LISTSAVEFILES:=TOS;                                         <<04.KM>>12496000
   END;                                                                 12498000
                                                              <<00.GEN>>12500000
                                                              <<00.GEN>>12502000
PROCEDURE GETDIRINFO(STARTINX,DEFLEVEL,PPRESULT);             <<00.GEN>>12504000
                    VALUE STARTINX,DEFLEVEL;                  <<00.GEN>>12506000
                    INTEGER STARTINX,                         <<00.GEN>>12508000
                            DEFLEVEL;                         <<00.GEN>>12510000
                    INTEGER ARRAY PPRESULT;                   <<00.GEN>>12512000
                    OPTION PRIVILEGED,UNCALLABLE;              <<01.KM>>12514000
BEGIN                                                         <<00.GEN>>12516000
  COMMENT:                                                    <<00.GEN>>12518000
    ACQUIRES THE GROUP OR ACCOUNT INDEX AND LOG-ON            <<00.GEN>>12520000
    GROUP AND ACCOUNT NAMES FROM THE JIT.  THESE              <<00.GEN>>12522000
    ARE STORED INTO "D'INX", "G'GNAME" AND "G'ANAME"          <<00.GEN>>12524000
    OF "PPRESULT";                                            <<00.GEN>>12526000
                                                              <<00.GEN>>12528000
  DEFINE MVF= 1:1 #;                                          <<00.GEN>>12530000
  EQUATE PXGLOB= -1,                                          <<00.GEN>>12532000
         JITLAN= 16,                                          <<05.GEN>>12534000
         JITLGN= 24,                                          <<05.GEN>>12536000
         JITAIP= 32;                                          <<05.GEN>>12538000
  DOUBLE QJITIPS;                                             <<00.GEN>>12540000
  DOUBLE ARRAY DPPRESULT(*)=PPRESULT;                         <<00.GEN>>12542000
  INTEGER JITDST=  S-0,                                       <<00.GEN>>12544000
          QJITAIP= QJITIPS,                                   <<00.GEN>>12546000
          QJITGIP= QJITIPS+1;                                 <<00.GEN>>12548000
  INTEGER POINTER PS0= S-0;                                   <<00.GEN>>12550000
  SWITCH DEFAULT:= NODEFAULT,ADEFAULT,GDEFAULT;               <<00.GEN>>12552000
                                                              <<00.GEN>>12554000
  SUBROUTINE DEF'MOVEFROMDSEG;                                <<00.GEN>>12556000
                                                              <<00.GEN>>12558000
                                                              <<00.GEN>>12560000
                                                              <<00.GEN>>12562000
  PUSH(DL);                                                   <<00.GEN>>12564000
  TOS:=TOS-PS0(PXGLOB)+PXGWJIT;      <<@JITDST WORD>>         <<00.GEN>>12566000
  TOS:=PS0.(6:10);                   <<JITDST>>               <<00.GEN>>12568000
  MOVEFROMDSEG(@QJITIPS,JITDST,JITAIP,2);                     <<00.GEN>>12570000
  CASE *STARTINX OF BEGIN                                     <<00.GEN>>12572000
    <<0>> D'INX:=0D;                                          <<00.GEN>>12574000
    <<1>> MOVEFROMDSEG(@D'INX,JITDST,QJITAIP,2);              <<00.GEN>>12576000
    <<2>> BEGIN                                               <<00.GEN>>12578000
            MOVEFROMDSEG(@D'INX,JITDST,                       <<00.GEN>>12580000
                         QJITGIP.(8:8)+2*QJITGIP.(MVF),2);    <<00.GEN>>12582000
            D'INX1.(PVF):=QJITGIP.(PVF);                      <<00.GEN>>12584000
          END;                                                <<00.GEN>>12586000
  END;                                                        <<00.GEN>>12588000
  GOTO *DEFAULT(DEFLEVEL);                                    <<00.GEN>>12590000
                                                              <<00.GEN>>12592000
GDEFAULT:                                                     <<00.GEN>>12594000
  MOVEFROMDSEG(@G'GNAME,JITDST,JITLGN,4);                     <<00.GEN>>12596000
  MOVE D'GNAME:=G'GNAME,(4);                                   <<01.KM>>12598000
                                                              <<00.GEN>>12600000
ADEFAULT:                                                     <<00.GEN>>12602000
  MOVEFROMDSEG(@G'ANAME,JITDST,JITLAN,4);                     <<00.GEN>>12604000
  MOVE D'ANAME:=G'ANAME,(4);                                   <<01.KM>>12606000
                                                              <<00.GEN>>12608000
NODEFAULT:                                                    <<00.GEN>>12610000
                                                              <<00.GEN>>12612000
END <<PROCEDURE GETDIRINFO>>;                                 <<00.GEN>>12614000
                                                              <<00.GEN>>12616000
                                                              <<00.GEN>>12618000
INTEGER PROCEDURE GETGENNAME(QNAME,ERRBASE,LEAFNAME,NAMEFOUND,<<01.GEN>>12620000
                             GENERIC);                        <<01.GEN>>12622000
                            VALUE ERRBASE,LEAFNAME,GENERIC;   <<01.GEN>>12624000
                            BYTE POINTER QNAME;               <<00.GEN>>12626000
                            INTEGER ERRBASE;                  <<00.GEN>>12628000
                            BYTE POINTER LEAFNAME;            <<00.GEN>>12630000
                            LOGICAL NAMEFOUND;                <<01.GEN>>12632000
                            INTEGER POINTER GENERIC;          <<01.GEN>>12634000
                            OPTION VARIABLE,UNCALLABLE;       <<00.GEN>>12636000
BEGIN                                                         <<00.GEN>>12638000
  COMMENT:                                                    <<00.GEN>>12640000
    SCAN "QNAME" FOR DIRECTORY NAME, VIZ:  UP TO 8 ALPHA-     <<00.GEN>>12642000
    NUMERIC CHARACTERS STARTING WITH ALPHABETIC, DELIMITED BY <<00.GEN>>12644000
    SPECIAL (ULTIMATELY A 'CR').  IF ERROR IS DETECTED,       <<00.GEN>>12646000
    OFFSET IS ADDED TO "ERRBASE" TO DETERMINE ERROR CODE.     <<00.GEN>>12648000
    "GETGENNAME" RETURNS THE ERROR CODE (>0) OR A NO-ERROR    <<00.GEN>>12650000
    INDICATION (=0).  ROUTINE MOVES DIRECTORY NAME INTO       <<00.GEN>>12652000
    "LEAFNAME" AND, IN "QNAME", RETURNS POINTER TO DELIMITER. <<00.GEN>>12654000
    "GENERIC" IS NONZERO IF DIRECTORY NAME CONTAINED "@",     <<00.GEN>>12656000
    "?" OR "#".                                               <<00.GEN>>12658000
                                                              <<00.GEN>>12660000
    NOTE THAT "@@" AND "@?" ARE AMBIGUOUS.  THESE ARE AUTO-   <<00.GEN>>12662000
    MATICALLY CORRECTED TO "@" AND "?@".  (ON THE OTHER HAND, <<00.GEN>>12664000
    "@#" IS MEANINGFUL AND IS NOT EQUIVALENT TO "#@".)        <<00.GEN>>12666000
                                                              <<00.GEN>>12668000
    ON ENTRY, "NAMEFOUND" INDICATES WHETHER A LEAFNAME        <<01.GEN>>12670000
    HAD BEEN FOUND PREVIOUSLY.  ON EXIT, "NAMEFOUND" IS       <<01.GEN>>12672000
    TRUE IF LEAFNAME WAS FOUND.  IF NO LEAFNAME IS FOUND      <<01.GEN>>12674000
    AND "NAMEFOUND" WAS TRUE ON ENTRY, THEN WE FLAG AN        <<01.GEN>>12676000
    ERROR.                                                    <<01.GEN>>12678000
                                                              <<01.GEN>>12680000
    NOTE THAT WE ASSUME THAT TRAPS ARE OFF ON ENTRY.  ALSO    <<00.GEN>>12682000
    NOTE THAT NAME IS UPSHIFTED IN "QNAME" ITSELF.  CALLER    <<00.GEN>>12684000
    SHOULD BLANK-FILL "LEAFNAME" BEFORE CALL;                 <<00.GEN>>12686000
                                                               <<01.KM>>12688000
  LABEL EXITINSTR;                                             <<01.KM>>12690000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<01.KM>>12692000
                                                              <<00.GEN>>12694000
  DEFINE SKIPWILDCARD=                                        <<00.GEN>>12696000
           BEGIN                                              <<00.GEN>>12698000
             BPS1:=BPS0;               <<MOVE "?" OR "@">>    <<00.GEN>>12700000
             ASSEMBLE(INCB,INCA);      <<AND SKIP IT    >>    <<00.GEN>>12702000
             GENERIC:=GENERIC+1;                              <<00.GEN>>12704000
           END #,                                             <<00.GEN>>12706000
         SKIPALL'AT=                                          <<00.GEN>>12708000
           BEGIN                                              <<00.GEN>>12710000
             BPS1:="@";                <<MOVE "@" AND   >>    <<00.GEN>>12712000
             GENERIC:=GENERIC+1;       <<SKIP SUBSEQUENT>>    <<00.GEN>>12714000
             IGNOREALL'AT;                                    <<00.GEN>>12716000
           END #,                                             <<00.GEN>>12718000
         IGNOREALL'AT=                                        <<00.GEN>>12720000
           BEGIN                                              <<00.GEN>>12722000
             ASSEMBLE(INCB,INCA);                             <<00.GEN>>12724000
             SCAN * WHILE CR'AT,1;                            <<00.GEN>>12726000
           END #,                                              <<00608>>12728000
         IGNORE'WILDCARD=                                      <<00608>>12730000
           BEGIN                                               <<00608>>12732000
             ASSEMBLE(INCB,INCA);                              <<00608>>12734000
           END #;                                              <<00608>>12736000
                                                              <<00.GEN>>12738000
  DEFINE NOGENERIC= NOT PARMMASK #;                           <<01.GEN>>12740000
                                                              <<00.GEN>>12742000
  EQUATE EXPECTALPHA=  FILEEXPECTALPHA-FFNAMEBASE,            <<00.GEN>>12744000
         NAMEMISSING=  FILENAMEMISSING-FFNAMEBASE,            <<00.GEN>>12746000
         NAMETOOLONG=  FILENAMETOOLONG-FFNAMEBASE,            <<00.GEN>>12748000
         MISSINGDELIM= FILEMISSINGDELIM-FFNAMEBASE,           <<00.GEN>>12750000
         NOGENNAME=    FILENOGENNAME-FFNAMEBASE;              <<00.GEN>>12752000
                                                              <<00.GEN>>12754000
  EQUATE CR=%15,                                              <<00.GEN>>12756000
         CRBLANK= [8/CR,8/" "],                               <<00.GEN>>12758000
         CR'AT=   [8/CR,8/"@"];                               <<00.GEN>>12760000
                                                              <<00.GEN>>12762000
  BYTE POINTER BPS0=S-0,                                      <<00.GEN>>12764000
               BPS1=S-1,                                      <<00.GEN>>12766000
               BUF,                                            <<00608>>12768000
               DELIM:=@QNAME;                                 <<00.GEN>>12770000
  INTEGER DUMGEN,                                             <<00.GEN>>12772000
          LENGTH;                                             <<01.GEN>>12774000
  LOGICAL PARMMASK=Q-4;                                       <<00.GEN>>12776000
                                                              <<00.GEN>>12778000
                                                              <<00.GEN>>12780000
  SUBROUTINE ERROR(OFFSET); VALUE OFFSET; INTEGER OFFSET;     <<00.GEN>>12782000
  BEGIN                                                       <<00.GEN>>12784000
    CIERR((GETGENNAME:=ERRBASE+OFFSET),QNAME);                <<00.GEN>>12786000
    @QNAME:=@DELIM;                                           <<00.GEN>>12788000
    EXITPROC;                                                  <<01.KM>>12790000
  END <<SUBROUTINE ERROR>>;                                   <<00.GEN>>12792000
                                                              <<00.GEN>>12794000
                                                              <<00.GEN>>12796000
  GETGENNAME:=0;                                              <<00.GEN>>12798000
  IF NOGENERIC THEN @GENERIC:=@DUMGEN;                        <<00.GEN>>12800000
  SCAN QNAME WHILE CRBLANK,1;          <<SKIP LEAD BLANKS>>   <<00.GEN>>12802000
  @QNAME:=TOS;                                                <<00.GEN>>12804000
  IF > THEN ERROR(EXPECTALPHA);                               <<00.GEN>>12806000
  IF QNAME="#" THEN ERROR(IF NOGENERIC THEN NOGENNAME         <<00.GEN>>12808000
                          ELSE EXPECTALPHA);                  <<00.GEN>>12810000
                                                              <<00.GEN>>12812000
  GENERIC:=0;                                                 <<00.GEN>>12814000
  TOS:=TOS:=@QNAME;                    <<FIND LEN OF NAME>>    <<00608>>12816000
  DO BEGIN                                                     <<00608>>12818000
    MOVE * := * WHILE ANS,0;                                   <<00608>>12820000
    WHILE BPS0="?" OR BPS0="#" OR BPS0="@" DO                  <<00608>>12822000
      IGNORE'WILDCARD;                                         <<00608>>12824000
  END UNTIL BPS0=SPECIAL;                                      <<00608>>12826000
  @DELIM := TOS;                                               <<00608>>12828000
  LENGTH := TOS-@QNAME;                                        <<00608>>12830000
  COMMENT:                                                     <<00608>>12832000
    ALLOCATE SPACE FOR BUF & USE BUF AS A WORK-                <<00608>>12834000
    SPACE AS WE MAY                                            <<00608>>12836000
      1) NEED TO MODIFY THE NAME IN QNAME                      <<00608>>12838000
      2) FIND THAT THE NAME IS LONGER THAN 8                   <<00608>>12840000
         CHAR. (IE TOO LONG FOR LEAFNAME)                      <<00608>>12842000
    BUF MUST BE ABLE TO HOLD 'LENGTH' BYTES OF DATA            <<00608>>12844000
    PLUS A CR.;                                                <<00608>>12846000
  TOS := (LENGTH+2)/2;                 <<# OF WORDS IN BUF>>   <<00608>>12848000
  @BUF := @S0 & LSL(1);                                        <<00608>>12850000
  ASSEMBLE(ADDS 0);                                            <<00608>>12852000
  BUF(LENGTH) := CR;                                           <<00608>>12854000
  MOVE BUF := QNAME,(LENGTH);                                  <<00608>>12856000
                                                               <<00608>>12858000
  TOS:=TOS:=@BUF;                      <<SCAN GENERIC NAME>>   <<00608>>12860000
  DO BEGIN                                                    <<00.GEN>>12862000
    MOVE * := * WHILE ANS,0;                                  <<00.GEN>>12864000
    WHILE BPS0="?" OR BPS0="#" DO SKIPWILDCARD;               <<00.GEN>>12866000
    IF BPS0="@" THEN                                          <<00.GEN>>12868000
    BEGIN                                                     <<00.GEN>>12870000
      SKIPALL'AT;                      <<"@...@" ==> "@">>    <<00.GEN>>12872000
      WHILE BPS0="?" DO                <<"@?...?" ==> >>      <<00.GEN>>12874000
      BEGIN                            <<"?...?@"     >>      <<00.GEN>>12876000
        BPS1(-1):="?";                                        <<00.GEN>>12878000
        BPS1:="@";                                            <<00.GEN>>12880000
        IGNOREALL'AT;                  <<"@...@" ==> "@">>    <<00.GEN>>12882000
      END;                                                    <<00.GEN>>12884000
    END;                                                      <<00.GEN>>12886000
  END UNTIL BPS0=SPECIAL AND BPS0<>"#";                       <<00.GEN>>12888000
  DEL;                                                         <<00608>>12890000
  LENGTH:=TOS-@BUF;                                            <<00608>>12892000
                                                              <<00.GEN>>12894000
  IF <> THEN NAMEFOUND:=TRUE                                  <<01.GEN>>12896000
  ELSE IF NAMEFOUND THEN ERROR(NAMEMISSING);                  <<01.GEN>>12898000
  IF GENERIC>0 AND NOGENERIC THEN ERROR(NOGENNAME);           <<00.GEN>>12900000
  IF LENGTH>8 THEN ERROR(NAMETOOLONG);                        <<00.GEN>>12902000
  MOVE LEAFNAME:=BUF,(LENGTH);                                 <<00608>>12904000
  SCAN DELIM WHILE CRBLANK,1;          <<SKIP TRAIL BLANKS>>  <<00.GEN>>12906000
  @QNAME:=TOS;                                                <<00.GEN>>12908000
  IF >= THEN ERROR(MISSINGDELIM);      <<ALPHANUMERIC>>       <<00.GEN>>12910000
                                                               <<01.KM>>12912000
EXITINSTR:                                                     <<01.KM>>12914000
END <<PROCEDURE GETGENNAME>>;                                 <<00.GEN>>12916000
                                                              <<00.GEN>>12918000
                                                              <<00.GEN>>12920000
LOGICAL PROCEDURE PRODUCEPARMS(LEAFLEVEL,QNAME,PPRESULT,      <<00.GEN>>12922000
                               DELIM,ERRNUM);                 <<00.GEN>>12924000
                              VALUE LEAFLEVEL,QNAME;          <<00.GEN>>12926000
                              INTEGER LEAFLEVEL;              <<00.GEN>>12928000
                              BYTE POINTER QNAME;             <<00.GEN>>12930000
                              ARRAY PPRESULT;                 <<00.GEN>>12932000
                              BYTE POINTER DELIM;             <<00.GEN>>12934000
                              INTEGER ERRNUM;                 <<00.GEN>>12936000
                              OPTION PRIVILEGED,UNCALLABLE;   <<00.GEN>>12938000
BEGIN                                                         <<00.GEN>>12940000
  COMMENT:                                                    <<00.GEN>>12942000
    PARSES FULLY-QUALIFIED "LEAFLEVEL" NAME IN "QNAME" AND    <<00.GEN>>12944000
    SETS UP DIRECSCAN PARAMETERS IN "PPRESULT".  RETURNS      <<00.GEN>>12946000
    FINAL DELIMITER IN "DELIM".  NAMES IN "QNAME" MAY CONTAIN <<00.GEN>>12948000
    BLANKS AROUND DELIMITERS.  IF NO NAME IS PRESENT, WE       <<01.KM>>12950000
    RETURN ONE OF THE FOLLOWING DEFAULTS:                      <<01.KM>>12952000
                                                              <<05.GEN>>12954000
    LEAFLEVEL = 0, FILE F[.G[.A]]:  @.LGN.LAN                 <<05.GEN>>12956000
     (INPUT)    1, GROUP G[.A]:  @.LAN                        <<05.GEN>>12958000
                2, ACCOUNT A:  @                              <<05.GEN>>12960000
                3, USER U[.A]:  @.LAN                         <<05.GEN>>12962000
                4, VOL SET DEFN V[.G[.A]]:  @.LGN.LAN         <<05.GEN>>12964000
                                                              <<00.GEN>>12966000
    OTHER OUTPUTS ARE:                                        <<05.GEN>>12968000
                                                              <<05.GEN>>12970000
    STARTLEVEL = 0: GLOBAL SEARCH FOR F.G.A, V.G.A, U[.A], A  <<00.GEN>>12972000
     (OUTPUT)    1: USE ACCT INX PTR FOR F.G, V[.G]           <<05.GEN>>12974000
                 2: USE GROUP INX PTR FOR F                   <<00.GEN>>12976000
                                                              <<00.GEN>>12978000
    ENDLEVEL = 0: F[.G[.A]], @[.G[.A]]                        <<00.GEN>>12980000
    (OUTPUT)   1: G[.A], @[.A]                                <<05.GEN>>12982000
               2: @.@.@, A                                    <<00.GEN>>12984000
               3: U[.A], @[.A]                                <<00.GEN>>12986000
               4: V[.G[.A]], @[.G[.A]]                        <<00.GEN>>12988000
                                                              <<00.GEN>>12990000
    RESULT IS RETURNED IN "PPRESULT" IN THE FORM:             <<00.GEN>>12992000
                                                              <<00.GEN>>12994000
      ********************                                    <<00.GEN>>12996000
      * D'INX      (2WD) * 0                                  <<00.GEN>>12998000
      *------------------*                                    <<00.GEN>>13000000
      * D'TYPE     (1WD) * 2                                  <<00.GEN>>13002000
      *------------------*                                    <<00.GEN>>13004000
      * D'FNAME    (4WD) * 3   "D'XXX" CONTAIN THE NAMES USED <<00.GEN>>13006000
      * D'VNAME          *     FOR THE DIRECTORY SEARCH.  THE <<00.GEN>>13008000
      *------------------*     NAMES MUST BE IN ONE OF THE    <<00.GEN>>13010000
      * D'GNAME    (4WD) * 7   FOLLOWING FORMS:               <<00.GEN>>13012000
      * D'UNAME          *       F.G.A     @.@.A              <<00.GEN>>13014000
      *------------------*       @.G.A     @.@.@              <<00.GEN>>13016000
      * D'ANAME    (4WD) * 11                                 <<00.GEN>>13018000
      *                  *                                    <<00.GEN>>13020000
      *------------------*                                    <<00.GEN>>13022000
      * D'LOCKWORD (4WD) * 15                                 <<00.GEN>>13024000
      *                  *                                    <<00.GEN>>13026000
      *------------------*                                    <<00.GEN>>13028000
      * G'FNAME    (4WD) * 19  "G'XXX" CONTAIN THE GENERIC    <<00.GEN>>13030000
      * G'VNAME          *     NAMES ACTUALLY SPECIFIED.      <<00.GEN>>13032000
      *------------------*     THESE ARE USED BY THE "RECIP"  <<00.GEN>>13034000
      * G'GNAME    (4WD) * 23  PROCEDURE TO DETERMINE A MATCH <<00.GEN>>13036000
      * G'UNAME          *     DURING THE DIRECTORY SEARCH.   <<00.GEN>>13038000
      *------------------*                                    <<00.GEN>>13040000
      * G'ANAME    (4WD) * 27                                 <<00.GEN>>13042000
      *                  *                                    <<00.GEN>>13044000
      ********************                                    <<00.GEN>>13046000
    ;                                                         <<00.GEN>>13048000
                                                               <<01.KM>>13050000
  LABEL EXITINSTR;                                             <<01.KM>>13052000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<01.KM>>13054000
                                                              <<00.GEN>>13056000
  DEFINE TURNOFFTRAPS=                                        <<00.GEN>>13058000
           BEGIN                                              <<00.GEN>>13060000
             PUSH(STATUS);                                    <<00.GEN>>13062000
             TOS.(2:1):=0;                                    <<00.GEN>>13064000
             SET(STATUS);                                     <<00.GEN>>13066000
           END #;                                             <<00.GEN>>13068000
  DEFINE NAMEMISSING= ERRBASE+FILENAMEMISSING-FFNAMEBASE #;   <<05.GEN>>13070000
  EQUATE NOINX=    0,                                         <<00.GEN>>13072000
         ACCTINX=  1,                                         <<00.GEN>>13074000
         GROUPINX= 2;                                         <<00.GEN>>13076000
  INTEGER ARRAY INITPARMS(*)=PB:=                             <<02.GEN>>13078000
    3(0),3("@       "),4("  "),3("@       ");                 <<05.GEN>>13080000
  INTEGER ARRAY INITSTART(*)=PB:=                             <<00.GEN>>13082000
    GROUPINX,ACCTINX,NOINX,NOINX,ACCTINX;                     <<00.GEN>>13084000
  INTEGER ARRAY INITDEF(*)=PB:=                               <<00.GEN>>13086000
    GROUPINX,ACCTINX,NOINX,ACCTINX,GROUPINX;                  <<00.GEN>>13088000
  INTEGER ARRAY INITBASE(*)=PB:=                              <<00.GEN>>13090000
    FFNAMEBASE,FGNAMEBASE,FANAMEBASE,USERNAMEBASE,VSDNAMEBASE;<<00.GEN>>13092000
  INTEGER ARRAY INITALL(*)=PB:= 1,2,3,2,1;                    <<03.GEN>>13094000
                                                              <<00.GEN>>13096000
  INTEGER STARTINX,                                           <<00.GEN>>13098000
          DEFLEVEL,                                           <<00.GEN>>13100000
          ERRBASE,                                            <<00.GEN>>13102000
          GENERIC,                                            <<00.GEN>>13104000
          ALLLEVEL:= 0;                                       <<05.GEN>>13106000
  LOGICAL NAMEFOUND:=FALSE;                                   <<01.GEN>>13108000
  SWITCH PARSER:= FILES,GROUPS,ACCOUNTS,USERS,VSDS;           <<00.GEN>>13110000
                                                              <<00.GEN>>13112000
                                                              <<00.GEN>>13114000
  SUBROUTINE ERROR(MSGNUM); VALUE MSGNUM; INTEGER MSGNUM;     <<00.GEN>>13116000
  BEGIN                                                       <<00.GEN>>13118000
    CIERR((ERRNUM:=MSGNUM),QNAME);                            <<00.GEN>>13120000
    EXITPROC;                                                  <<01.KM>>13122000
  END <<SUBROUTINE ERROR>>;                                   <<00.GEN>>13124000
                                                              <<00.GEN>>13126000
                                                              <<00.GEN>>13128000
  PRODUCEPARMS:=FALSE;                                        <<00.GEN>>13130000
  TURNOFFTRAPS;                        <<FOR BYTE ADR ARITH>> <<00.GEN>>13132000
  MOVE PPRESULT:=INITPARMS,(31);       <<F.G.A="@.@.@">>      <<02.GEN>>13134000
  STARTINX:=INITSTART(LEAFLEVEL);                             <<05.GEN>>13136000
  DEFLEVEL:=INITDEF(LEAFLEVEL);                               <<05.GEN>>13138000
  ERRBASE:=INITBASE(LEAFLEVEL);                               <<00.GEN>>13140000
  GOTO *PARSER(LEAFLEVEL);                                    <<00.GEN>>13142000
                                                              <<00.GEN>>13144000
  <<**********************>>                                  <<00.GEN>>13146000
  << PARSE QUALIFIED NAME >>                                  <<00.GEN>>13148000
  <<**********************>>                                  <<00.GEN>>13150000
                                                              <<00.GEN>>13152000
FILES:                                                        <<00.GEN>>13154000
VSDS:                                                         <<00.GEN>>13156000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'FNAME,NAMEFOUND,     <<01.GEN>>13158000
                         GENERIC))<>0                         <<01.GEN>>13160000
     THEN RETURN;                                             <<00.GEN>>13162000
  IF GENERIC>0 THEN ALLLEVEL:=1;                              <<00.GEN>>13164000
  IF QNAME="/" THEN                                           <<00.GEN>>13166000
  BEGIN                                                       <<00.GEN>>13168000
    IF LEAFLEVEL=VSDEFLEVEL THEN ERROR(VSDNOLOCKWORD);        <<00.GEN>>13170000
    IF NOT NAMEFOUND THEN ERROR(NAMEMISSING);                 <<04.GEN>>13172000
    @QNAME:=@QNAME+1;                                         <<00.GEN>>13174000
    IF (ERRNUM:=GETGENNAME(QNAME,FLWORDBASE,D'LOCKWORD,       <<02.GEN>>13176000
                           NAMEFOUND))<>0                     <<02.GEN>>13178000
       THEN RETURN;                                           <<00.GEN>>13180000
  END;                                                        <<00.GEN>>13182000
  IF NOT NAMEFOUND OR QNAME<>"." THEN GO COMPLETEPARMS;       <<04.GEN>>13184000
  @QNAME:=@QNAME+1;                                           <<00.GEN>>13186000
  ERRBASE:=FGNAMEBASE;                                        <<00.GEN>>13188000
  STARTINX:=DEFLEVEL:=ACCTINX;                                <<00.GEN>>13190000
                                                              <<00.GEN>>13192000
GROUPS:                                                       <<00.GEN>>13194000
USERS:                                                        <<00.GEN>>13196000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'GNAME,NAMEFOUND,     <<02.GEN>>13198000
                         GENERIC))<>0                         <<01.GEN>>13200000
     THEN RETURN;                                             <<00.GEN>>13202000
  IF GENERIC>0 THEN ALLLEVEL:=2;                              <<00.GEN>>13204000
  IF NOT NAMEFOUND OR QNAME<>"." THEN GO COMPLETEPARMS;       <<01.GEN>>13206000
  @QNAME:=@QNAME+1;                                           <<00.GEN>>13208000
  ERRBASE:=FANAMEBASE;                                        <<00.GEN>>13210000
  STARTINX:=DEFLEVEL:=NOINX;                                  <<00.GEN>>13212000
                                                              <<00.GEN>>13214000
ACCOUNTS:                                                     <<00.GEN>>13216000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'ANAME,NAMEFOUND,     <<02.GEN>>13218000
                         GENERIC))<>0                         <<01.GEN>>13220000
     THEN RETURN;                                             <<00.GEN>>13222000
  IF GENERIC>0 THEN ALLLEVEL:=3;                              <<00.GEN>>13224000
                                                              <<00.GEN>>13226000
COMPLETEPARMS:                                                <<00.GEN>>13228000
  IF NOT NAMEFOUND THEN                                       <<04.GEN>>13230000
  BEGIN                                                       <<04.GEN>>13232000
    IF QNAME="." THEN ERROR(NAMEMISSING);                     <<04.GEN>>13234000
    ALLLEVEL:=INITALL(LEAFLEVEL);                             <<04.GEN>>13236000
  END;                                                        <<04.GEN>>13238000
  @DELIM:=@QNAME;                                             <<00.GEN>>13240000
  D'TYPE.(STARTLEVELF):=STARTINX;                             <<00.GEN>>13242000
  D'TYPE.(TOLEVELF):=LEAFLEVEL;                               <<00.GEN>>13244000
                                                              <<00.GEN>>13246000
  <<***************************>>                             <<00.GEN>>13248000
  << SET UP GROUP/ACCT INDEX & >>                             <<00.GEN>>13250000
  << DEFAULT GROUP/ACCT NAMES  >>                             <<00.GEN>>13252000
  <<***************************>>                             <<00.GEN>>13254000
                                                              <<00.GEN>>13256000
  IF STARTINX<>NOINX OR DEFLEVEL<>NOINX THEN                  <<00.GEN>>13258000
  BEGIN                                                       <<00.GEN>>13260000
    GETDIRINFO(STARTINX,DEFLEVEL,PPRESULT);                   <<00.GEN>>13262000
  END;                                                        <<00.GEN>>13264000
                                                              <<00.GEN>>13266000
  <<*****************>>                                       <<00.GEN>>13268000
  << SET UP ENDLEVEL >>                                       <<00.GEN>>13270000
  <<*****************>>                                       <<00.GEN>>13272000
                                                              <<00.GEN>>13274000
  CASE *ALLLEVEL OF BEGIN              <<SET ENDLEVELFX>>     <<00.GEN>>13276000
    <<0>> BEGIN                                               <<00.GEN>>13278000
            MOVE D'FNAME:=G'FNAME,(12);                       <<00.GEN>>13280000
            D'TYPE.(ENDLEVELFX):=LEAFLEVEL;                   <<00.GEN>>13282000
          END;                                                <<00.GEN>>13284000
    <<1>> BEGIN                                               <<00.GEN>>13286000
            MOVE D'GNAME:=G'GNAME,(8);                        <<00.GEN>>13288000
            D'TYPE.(ENDLEVELFX):=ALLXXX+LEAFLEVEL;            <<00.GEN>>13290000
          END;                                                <<00.GEN>>13292000
    <<2>> BEGIN                                               <<00.GEN>>13294000
            MOVE D'ANAME:=G'ANAME,(4);                        <<00.GEN>>13296000
            D'TYPE.(ENDLEVELFX):=                             <<00.GEN>>13298000
              IF LEAFLEVEL=USERLEVEL THEN ALLUSERS            <<00.GEN>>13300000
              ELSE ALLGROUPS;                                 <<00.GEN>>13302000
          END;                                                <<00.GEN>>13304000
    <<3>> D'TYPE.(ENDLEVELFX):=ALLACCTS;                      <<00.GEN>>13306000
  END;                                                        <<00.GEN>>13308000
  PRODUCEPARMS:=TRUE;                                         <<01.GEN>>13310000
                                                               <<01.KM>>13312000
EXITINSTR:                                                     <<01.KM>>13314000
END  <<PROCEDURE PRODUCEPARMS>>;                              <<00.GEN>>13316000
                                                              <<00.GEN>>13318000
                                                              <<00.GEN>>13320000
PROCEDURE CXLISTF EXECUTORHEAD;                                <<U.RAO>>13322000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>13324000
BEGIN                                                          <<U.RAO>>13326000
                                                               <<03.KM>>13328000
DEFINE P'GANAME=     RECIPPARMS(4) #,                          <<04.KM>>13330000
       P'GOTENTRY=   RECIPPARMS(24) #,                         <<03.KM>>13332000
       P'IMPMNTDST=  RECIPPARMS(25) #,                         <<03.KM>>13334000
       P'IMPMNTERR=  RECIPPARMS(26) #,                         <<03.KM>>13336000
       P'IMPMNTGRP=  RECIPPARMS(27) #,                         <<03.KM>>13338000
       P'IMPMNTACCT= RECIPPARMS(31) #;                         <<03.KM>>13340000
DEFINE PAGEEJECT = FWRITE(FNUM,DATEBUF,0,%61) #;               <<09.MM>>13342000
EQUATE NOMNTERR= -1,                                           <<03.KM>>13344000
       NOMOUNT=  0;                                            <<03.KM>>13346000
EQUATE F'STDLIST      = 1,                                     <<00852>>13348000
       NEW'FILE       = 0,                                     <<00852>>13350000
       TEMP'DOMAIN    = 2,                                     <<00852>>13352000
       CURRENT'DOMAIN = 0;                                     <<00852>>13354000
DOUBLE DL := COMMASEMICR;                                      <<U.RAO>>13356000
INTEGER NUMPARMS;                                              <<U.RAO>>13358000
DOUBLE ARRAY PARMS(0:3)=Q;                                     <<U.RAO>>13360000
INTEGER ARRAY RECIPPARMS(0:SYSL'PARMLEN-1);                   <<00.GEN>>13362000
INTEGER ARRAY PPRESULT(*)=RECIPPARMS(SYSL'PPRINX);            <<00.GEN>>13364000
BYTE POINTER LEAFNAME = PARMS;                                 <<U.RAO>>13366000
INTEGER LEAFNAMECHAR = PARMS+1;                                <<U.RAO>>13368000
BYTE LEAFNAMELEN = PARMS+1;                                    <<U.RAO>>13370000
BYTE POINTER LISTLEVEL = PARMS+2;                              <<U.RAO>>13372000
BYTE LISTLEVELLEN = PARMS+3;                                   <<U.RAO>>13374000
BYTE POINTER LISTFILE = PARMS+2;  <<TRICKY BIT>>               <<U.RAO>>13376000
INTEGER LISTFILECHAR = PARMS+3;                                <<U.RAO>>13378000
BYTE POINTER EXTRAPARM = PARMS+6;                              <<U.RAO>>13380000
BYTE EXTRAPARMLEN = PARMS+7;                                   <<U.RAO>>13382000
EQUATE COMMA = 0, SEMI = 1, CR = 2;                            <<U.RAO>>13384000
BYTE POINTER DELIM;                                           <<00.GEN>>13386000
INTEGER FOPTIONS := %2504;                                     <<U.RAO>>13388000
INTEGER FCLOSE'FOPTIONS := 0;                                  <<00852>>13390000
LOGICAL STDLIST := TRUE;                                       <<U.RAO>>13392000
INTEGER FNUM := 2;  <<DEFAULT TO $STDLIST>>                    <<U.RAO>>13394000
ARRAY DATEBUF(0:13);  <<USED FOR TIME STAMP OF OUTPUT>>        <<02.RO>>13396000
INTEGER DEV := 0;  <<DEVICE TYPE OF LIST FILE>>                <<03.RO>>13398000
LOGICAL INTERACTIVE;                                           <<09.MM>>13400000
                                                               <<U.RAO>>13402000
<<INITIALIZE PARMS ARRAY>>                                     <<U.RAO>>13404000
PARMS := 0D;                                                   <<U.RAO>>13406000
TOS := @PARMS+2;                                               <<U.RAO>>13408000
TOS := @PARMS+1;                                               <<U.RAO>>13410000
TOS := 6;                                                      <<U.RAO>>13412000
ASSEMBLE(MOVE);                                                <<U.RAO>>13414000
MYCOMMAND(PARMSP,DL,4,NUMPARMS,PARMS);                         <<U.RAO>>13416000
PARMNUM := 1;                                                  <<U.RAO>>13418000
IF NOT PRODUCEPARMS(0,PARMSP,PPRESULT,DELIM,ERRNUM) THEN      <<00.GEN>>13420000
    RETURN;  <<ERROR IN PARSING LEAFNAME>>                     <<U.RAO>>13422000
IF (NUMPARMS > 0) AND  <<NOT JUST A CR>>                       <<U.RAO>>13424000
   (@DELIM < @LEAFNAME+INTEGER(LEAFNAMELEN)) THEN             <<00.GEN>>13426000
   BEGIN  <<EXTRANEOUS STUFF IN LEAFNAME>>                     <<U.RAO>>13428000
   TOS := ERRNUM := LISTFEXTRANEOUS;                           <<U.RAO>>13430000
   TOS := @DELIM;                                             <<00.GEN>>13432000
   CIERR(*,*);                                                 <<U.RAO>>13434000
   RETURN                                                      <<U.RAO>>13436000
   END;                                                        <<U.RAO>>13438000
                                                               <<U.RAO>>13440000
IF NUMPARMS=0 THEN LEAFNAMECHAR := CR;                         <<U.RAO>>13442000
                                                               <<U.RAO>>13444000
<<CHECK FOR LISTLEVEL, IF ANY>>                                <<U.RAO>>13446000
IF LEAFNAMECHAR.(11:5)=COMMA THEN  <<LISTLEVEL PRESENT>>       <<U.RAO>>13448000
   BEGIN                                                       <<U.RAO>>13450000
   PARMNUM := 2;                                               <<U.RAO>>13452000
   TOS := BINARY(LISTLEVEL,INTEGER(LISTLEVELLEN));             <<U.RAO>>13454000
   IF <> OR NOT(-1 <= S0 <= 2) THEN                            <<U.RAO>>13456000
      BEGIN   <<BAD CONVERSION OR BAD NUMBER>>                 <<U.RAO>>13458000
      CIERR(ERRNUM := -LISTFBADLEVEL, LISTLEVEL);              <<04785>>13460000
      IF TOS < -1 THEN    <<GIVE LISTF,-1>>                    <<U.RAO>>13462000
         TOS := -1                                             <<U.RAO>>13464000
      ELSE                <<GIVE LISTF,2>>                     <<U.RAO>>13466000
         TOS := 2;                                             <<U.RAO>>13468000
      END;                                                     <<U.RAO>>13470000
   IF S0 > 2 THEN TOS := 2;  <<MAX LEVEL>>                     <<U.RAO>>13472000
   IF S0 < 0 THEN  <<LISTF -1 CASE?>>                          <<U.RAO>>13474000
      BEGIN  <<CHECK CAPABILITY>>                              <<U.RAO>>13476000
      IF D'TYPE.(STARTLEVELF) = 0 THEN  <<SYSTEM LEVEL FILE>> <<00.GEN>>13478000
         BEGIN                                                 <<U.RAO>>13480000
         SETXPXGLOB;  <<FOR CAPABILITY CHECK>>                 <<04.RO>>13482000
         IF NOT SMCAP AND                                      <<00450>>13484000
            NOT (AMCAP LAND CHECKHOMEACCT(PPRESULT)=0) THEN    <<00450>>13486000
            BEGIN << NOT (SMCAP OR AMCAP AND HOMEACCT =     >> <<00450>>13488000
                  <<                         REQUESTEDACCT) >> <<00450>>13490000
            IF CHECKHOMEACCT(PPRESULT)=0 THEN                  <<00450>>13492000
               CIERR(ERRNUM := LISTFAMCAP)                     <<00450>>13494000
            ELSE CIERR(ERRNUM := LISTFSMCAP);                  <<00450>>13496000
            RETURN                                             <<U.RAO>>13498000
            END;                                               <<U.RAO>>13500000
         END                                                   <<U.RAO>>13502000
      ELSE   <<CHECK FOR ACCOUNT MANAGER CAPABILITY>>          <<04.RO>>13504000
         BEGIN                                                 <<04.RO>>13506000
         SETXPXGLOB;                                           <<04.RO>>13508000
         IF NOT AMCAP AND NOT SMCAP THEN                       <<04.RO>>13510000
            BEGIN                                              <<04.RO>>13512000
            CIERR(ERRNUM := LISTFAMCAP);                       <<04.RO>>13514000
            RETURN                                             <<04.RO>>13516000
            END;                                               <<04.RO>>13518000
         END;                                                  <<04.RO>>13520000
      RECIPPARMS(13) := 0;                                     <<U.RAO>>13522000
      END;  <<LISTF -1 CASE>>                                  <<U.RAO>>13524000
   PARMS := PARMS(1);                                          <<U.RAO>>13526000
   PARMS(1) := PARMS(2);  <<FIXUP FOR MISSING LISTLEVEL>>      <<U.RAO>>13528000
   END                                                         <<U.RAO>>13530000
ELSE                                                           <<U.RAO>>13532000
   TOS := 0;   <<LISTLEVEL DEFAULT>>                           <<U.RAO>>13534000
RECIPPARMS(12) := S0;  <<LISTLEVEL IN BINARY>>                 <<U.RAO>>13536000
CASE TOS OF                                                    <<U.RAO>>13538000
   BEGIN   <<SET WIDTH OF ENTRY IN WORDS>>                     <<U.RAO>>13540000
   RECIPPARMS(13) := 4;                                        <<U.RAO>>13542000
   RECIPPARMS(13) := 25;                                       <<U.RAO>>13544000
   RECIPPARMS(13) := 34;                                       <<U.RAO>>13546000
   END;                                                        <<U.RAO>>13548000
<<WE HAVE NOW PROCESSED THE LISTLEVEL. NOW DO LISTFILE>>       <<U.RAO>>13550000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>13552000
IF LEAFNAMECHAR.(11:5)=SEMI THEN  <<PROBABLY IS ONE>>         <<U.RAO>>13554000
   BEGIN                                                       <<U.RAO>>13556000
   IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN RETURN;              <<U.RAO>>13558000
   STDLIST := FALSE;  <<USER SPECIFIED A FILE >>               <<U.RAO>>13560000
   END                                                         <<U.RAO>>13562000
ELSE IF LEAFNAMECHAR.(11:5)=COMMA THEN  <<ERROR>>              <<U.RAO>>13564000
   BEGIN                                                       <<U.RAO>>13566000
   CIERR(ERRNUM := LISTFEXPECTFILE, LISTFILE);                 <<U.RAO>>13568000
   RETURN                                                      <<U.RAO>>13570000
   END;                                                        <<U.RAO>>13572000
                                                               <<U.RAO>>13574000
IF (LISTFILECHAR.(11:5) <> CR) AND (EXTRAPARMLEN<>0) THEN      <<U.RAO>>13576000
   BEGIN                                                       <<U.RAO>>13578000
   PARMNUM := PARMNUM+1;                                       <<U.RAO>>13580000
   CIERR(ERRNUM := LISTF2MP,EXTRAPARM);                        <<U.RAO>>13582000
   RETURN                                                      <<U.RAO>>13584000
   END;                                                        <<U.RAO>>13586000
PARMNUM := 0;                                                  <<U.RAO>>13588000
                                                               <<U.RAO>>13590000
IF NOT STDLIST THEN   <<OPEN USER DEFINED FILE>>               <<U.RAO>>13592000
FNUM := FOPEN(LISTFILE, FOPTIONS, %101);                       <<00267>>13594000
IF CARRY THEN                                                  <<U.RAO>>13596000
   BEGIN                                                       <<U.RAO>>13598000
   FERROR'(FNUM, PARMNUM);                                     <<U.RAO>>13600000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>13602000
   RETURN                                                      <<U.RAO>>13604000
   END;                                                        <<U.RAO>>13606000
RECIPPARMS(18) := FNUM;                                        <<U.RAO>>13608000
                                                               <<U.RAO>>13610000
FGETINFO(FNUM,,FOPTIONS,,RECIPPARMS(19),DEV);                  <<09.MM>>13612000
<< DETERMINE FINAL DOMAIN OF LIST FILE >>                      <<00852>>13614000
FCLOSE'FOPTIONS.(13:3) := IF FOPTIONS.(14:2) = NEW'FILE        <<00852>>13616000
                             THEN TEMP'DOMAIN                  <<00852>>13618000
                          ELSE CURRENT'DOMAIN;                 <<00852>>13620000
TOS := RECIPPARMS(19);                                         <<U.RAO>>13622000
IF < THEN TOS := -TOS                                          <<U.RAO>>13624000
ELSE TOS := TOS&LSL(1);  <<CONVERT TO BYTE COUNT>>             <<U.RAO>>13626000
RECIPPARMS(19) := TOS;  <<LINE LENGTH>>                        <<U.RAO>>13628000
                                                               <<U.RAO>>13630000
<<SET OTHER FILE ATTRIBUTES>>                                  <<U.RAO>>13632000
RECIPPARMS(20):=-1;                    <<1ST-TIME LINE# FLAG>> <<05.KM>>13634000
RECIPPARMS(21) := 0;                                           <<U.RAO>>13636000
RECIPPARMS := FNUM;                                            <<U.RAO>>13638000
RECIPPARMS(1) := 0;                                            <<U.RAO>>13640000
                                                               <<U.RAO>>13642000
<<PUT OUT TIME STAMP IF JOB OR LIST FILE>>                     <<02.RO>>13644000
INTERACTIVETEST;                                               <<02.RO>>13646000
INTERACTIVE:=TOS;                                              <<09.MM>>13648000
IF NOT INTERACTIVE AND STDLIST OR                              <<09.MM>>13650000
   NOT STDLIST AND DEV.(8:8) >= 8  <<NOT DISC>> THEN           <<03.RO>>13652000
   BEGIN                                                       <<02.RO>>13654000
   <<IF JOB AND (STDLIST OF USERFILE IS STDLIST) DO PAGEEJECT>><<09.MM>>13656000
   IF NOT INTERACTIVE AND FOPTIONS.(10:3)=F'STDLIST            <<09.MM>>13658000
      THEN PAGEEJECT;                                          <<09.MM>>13660000
   DATE'LINE(DATEBUF);                                         <<02.RO>>13662000
   FWRITE(FNUM, DATEBUF, -27, %60);                            <<02.RO>>13664000
   RECIPPARMS(20):=-3;                 <<1ST-TIME LINE# FLAG>> <<05.KM>>13666000
   END;                                                        <<02.RO>>13668000
                                                               <<02.RO>>13670000
P'GOTENTRY:=FALSE;                                             <<03.KM>>13672000
P'IMPMNTDST:=0;                                                <<03.KM>>13674000
P'IMPMNTERR:=NOMNTERR;                                         <<03.KM>>13676000
IF LOGICAL(D'INX1.(PVF)) THEN                                  <<03.KM>>13678000
   BEGIN                                                       <<03.KM>>13680000
   COMMENT:                                                    <<03.KM>>13682000
     FORCE ACCT-LEVEL SEARCH TO ENSURE THAT WE VISIT           <<03.KM>>13684000
     GROUP ENTRY AND FORCE IMPLICIT MOUNT;                     <<03.KM>>13686000
                                                               <<03.KM>>13688000
   D'TYPE.(STARTLEVELF):=1;                                    <<03.KM>>13690000
   GETDIRINFO(1,2,PPRESULT);                                   <<03.KM>>13692000
   END;                                                        <<03.KM>>13694000
MOVE P'GANAME:=D'GNAME,(4),2; <<IN CASE WE DON'T VISIT NODE>>  <<06.KM>>13696000
MOVE * := D'ANAME,(4);                                         <<06.KM>>13698000
RECIPPARMS (22) := D'TYPE;                                    <<00.GEN>>13700000
RECIPPARMS (23) := D'INX1;  <<GLINKAGE INITIALIZATION>>       <<00.GEN>>13702000
RECIPPARMS(SAVEBUFFINDEX) := 0; << see syslist >>              <<04178>>13704000
RECIPPARMS(SAVEBUFFINDEX + ASIZE + 1) := 0;                    <<04178>>13706000
                                                               <<RV.PV>>13708000
<<NOW SET UP COMMON DIRECSCAN STUFF ON STACK>>                 <<RV.PV>>13710000
TOS := 0D;  <<RETURN VALUE>>                                   <<U.RAO>>13712000
TOS := D'TYPE;                                                <<00.GEN>>13714000
TOS.(HITFLAG) := 1;                                            <<RV.PV>>13716000
TOS := D'INX1.(MVTABXF);               <<LINKAGE>>            <<04.GEN>>13718000
TOS := D'INX2;                         <<INDEXP>>             <<05.GEN>>13720000
TOS := @D'ANAME;                                              <<00.GEN>>13722000
TOS := @D'GNAME;                                              <<00.GEN>>13724000
TOS := @D'FNAME;                                              <<00.GEN>>13726000
IF RECIPPARMS(12)<0 THEN  <<LISTF ,-1>>                        <<U.RAO>>13728000
   TOS := DIRECSCAN(*,*,*,*,*,SYSLIST,RECIPPARMS)              <<U.RAO>>13730000
ELSE                                                           <<U.RAO>>13732000
   TOS := DIRECSCAN(*,*,*,*,*,LISTSAVEFILES,RECIPPARMS);       <<U.RAO>>13734000
                                                               <<04.KM>>13736000
PUSH(STATUS);                                                  <<04.KM>>13738000
IF LOGICAL(P'GOTENTRY) THEN FWRITE(FNUM,RECIPPARMS,0,0);       <<04.KM>>13740000
IF P'IMPMNTDST<>0 OR P'IMPMNTERR<>NOMNTERR THEN                <<04.KM>>13742000
  BEGIN                                                        <<04.KM>>13744000
  LISTFDISMNT(P'IMPMNTDST,P'IMPMNTERR,P'IMPMNTGRP,P'IMPMNTACCT,<<04.KM>>13746000
              ERRNUM);                                         <<04.KM>>13748000
  IF P'IMPMNTERR>NOMOUNT AND                                   <<04.KM>>13750000
     JOBSESSIONMAIN THEN GENMSG(CIERRMSGSET,LISTFSTOPPED);     <<04.KM>>13752000
  END;                                                         <<04.KM>>13754000
SET(STATUS);                                                   <<04.KM>>13756000
                                                               <<04.KM>>13758000
IF <> THEN   <<DIRECTORY ERROR>>                               <<U.RAO>>13760000
   BEGIN                                                       <<U.RAO>>13762000
   IF NOT STDLIST THEN   <<CLOSE USER DEFINED FILE>>           <<U.RAO>>13764000
      FCLOSE(FNUM, FCLOSE'FOPTIONS, 0);                        <<00852>>13766000
   CYDIRERR'(*,%120000,ERRNUM);                                <<U.RAO>>13768000
   RETURN;                                                     <<U.RAO>>13770000
   END;                                                        <<U.RAO>>13772000
DDEL;                                                          <<U.RAO>>13774000
IF RECIPPARMS(1) < 0 THEN                                      <<U.RAO>>13776000
   BEGIN                                                       <<U.RAO>>13778000
   FERROR'(FNUM,PARMNUM);                                      <<U.RAO>>13780000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>13782000
   RETURN                                                      <<U.RAO>>13784000
   END;                                                        <<U.RAO>>13786000
IF LOGICAL(P'GOTENTRY) THEN FWRITE(FNUM,RECIPPARMS,0,0)        <<03.KM>>13788000
ELSE CIERR(ERRNUM := -NOFILESLISTED);                          <<04785>>13790000
             <<XPARENT TO PROGRAMMATIC CALL FOR UPWARD COMPAT>><<03.KM>>13792000
IF NOT STDLIST THEN  <<CLOSE USER DEFINED FILE>>               <<U.RAO>>13794000
   FCLOSE(FNUM, FCLOSE'FOPTIONS, 0);                           <<00852>>13796000
IF CARRY THEN                                                  <<U.RAO>>13798000
   BEGIN                                                       <<U.RAO>>13800000
   FERROR'(FNUM,PARMNUM);                                      <<U.RAO>>13802000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>13804000
   END;                                                        <<U.RAO>>13806000
END;  <<CXLISTF>>                                              <<U.RAO>>13808000
                                                               <<01.KM>>13810000
                                                               <<01.KM>>13812000
$CONTROL SEGMENT = CIPREPRUN                                   <<U.RAO>>13814000
LOGICAL PROCEDURE CISUBSYSFINISH(MESSAGETYPE, ERRNUM, PARMNUM);<<U.RAO>>13816000
VALUE MESSAGETYPE;                                             <<U.RAO>>13818000
INTEGER MESSAGETYPE, ERRNUM, PARMNUM;                          <<U.RAO>>13820000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>13822000
<<This procedure is called by all subsystem executors and the>><<U.RAO>>13824000
<<executor for the RUN command.  It cleans up various job>>    <<U.RAO>>13826000
<<related parameters and put out any appropriate termination>> <<U.RAO>>13828000
<<message.>>                                                   <<U.RAO>>13830000
<<MESSAGETYPE = 0 => NO MESSAGE.                            >> <<U.RAO>>13832000
<<            = 1 => "END OF PROGRAM"                       >> <<U.RAO>>13834000
<<            = 2 => "END OF PREPARE"                       >> <<U.RAO>>13836000
<<            = 3 => "END OF SUBSYSTEM"                     >> <<U.RAO>>13838000
<<            = 4 => "END OF COMPILE"                       >> <<U.RAO>>13840000
<<            = 5 => "END OF REMOTE PROGRAM"                >> <<U.RAO>>13842000
BEGIN                                                          <<U.RAO>>13844000
LOGICAL RESULT = CISUBSYSFINISH;                               <<U.RAO>>13846000
LOGICAL LEN;                                                   <<U.RAO>>13848000
EQUATE JITJNUMOFFSET = 9;  <<OFFSET FROM START OF JIT>>        <<U.RAO>>13850000
INTEGER JITJNUM;  <<HOLDS VALUE OF JITJNUM>>                   <<U.RAO>>13852000
EQUATE JITEOFOFFSET = 11;                                      <<U.RAO>>13854000
INTEGER JITEOF;  <<HOLDS VALUE OF JITEOF>>                     <<U.RAO>>13856000
INTEGER JITDSTN;  <<HOLDS DATASEG NUMBER OF JIT>>              <<U.RAO>>13858000
INTEGER NEWJITEOF := 0;  <<ALMOST A DUMMY>>                    <<U.RAO>>13860000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>13862000
SUBROUTINE DEF'MOVETODSEG;                                     <<U.RAO>>13864000
                                                               <<U.RAO>>13866000
NEXTLINE;  <<LINE FEED>>                                       <<U.RAO>>13868000
<<FIRST DEAL WITH JIT, GETTING AND RESETING EOF AND JNUM>>     <<U.RAO>>13870000
SETJIT;                                                        <<U.RAO>>13872000
JITDSTN := TOS;  << SAVE JIT DST NUMBER>>                      <<U.RAO>>13874000
MOVEFROMDSEG(@JITJNUM, JITDSTN, JITJNUMOFFSET, 1);             <<U.RAO>>13876000
MOVEFROMDSEG(@JITEOF, JITDSTN, JITEOFOFFSET, 1);               <<U.RAO>>13878000
<<CLEAR OLD EOF FLAGS>>                                        <<U.RAO>>13880000
MOVETODSEG(JITDSTN, JITEOFOFFSET, @NEWJITEOF, 1);              <<U.RAO>>13882000
<<SET RETURN VALUE FOR SUBSYSFINISH>>                          <<U.RAO>>13884000
CISUBSYSFINISH := NOT GETJCW.(0:1);                            <<U.RAO>>13886000
<<FLUSH TO EOD AS NECESSARY>>                                  <<U.RAO>>13888000
IF (JITJNUM.(0:2)=2) <<JOB>> AND (JITEOF.(0:2)<>0)             <<02.RO>>13890000
   AND (CIS'UDCNESTLEVEL = 0) << NOT IN UDC >> THEN            << I.A >>13892000
   BEGIN   <<FLUSH REQUIRED - READ TO :>>                      <<U.RAO>>13894000
   DO LEN := FREAD( 1, CIS'WCOMIMAGE, CIS'WCOMBUFLEN )         << I.A >>13896000
      UNTIL <> OR CIS'BCOMIMAGE = ":";                         << I.A >>13898000
   <<CCE => FOUND SOMETHING, CCL/CCG => FREAD ERROR OR EOF>>   <<U.RAO>>13900000
   <<MPE USED TO LOOK FOR : IF $STDIN OR :EOD IF $STDINX, >>   <<U.RAO>>13902000
   <<BUT THE COMPLEXITY AND THE IMCOMPATIBILITY WITH THE  >>   <<U.RAO>>13904000
   <<SERIES I FORCED US TO LOOK FOR JUST A : IN COLUMN 1. >>   <<U.RAO>>13906000
   IF = AND LEN>1 THEN   <<SUCCESS>>                           <<U.RAO>>13908000
      CIS'PENDINGCOMLEN := LEN;  << FLAG COM ALREADY READ >>   << I.A >>13910000
   END;                                                        <<U.RAO>>13912000
<< RESET THE TERMINAL TO THE DESIRED STATE >>                  <<00851>>13914000
INTERACTIVETEST;                                               <<00851>>13916000
IF TOS THEN RESET'TERMINALMODE;                                <<00851>>13918000
<<IN ANY CASE, SEND MESSAGE ABOUT PROCESS TERMINATION>>        <<U.RAO>>13920000
IF (MESSAGETYPE <> 0) AND RESULT  <<PGM SUCCESSFUL>> THEN      <<U.RAO>>13922000
   GENMSG(CIGENERALMSGSET, ENDOFPROG + MESSAGETYPE -1);        <<U.RAO>>13924000
<<FINALLY, IF APPROPRIATE, RETURN ABNORMAL TERM MESSAGE>>      <<U.RAO>>13926000
IF NOT RESULT THEN   <<FATAL ERROR SOMEWHERE>>                 <<U.RAO>>13928000
   BEGIN                                                       <<U.RAO>>13930000
   PARMNUM := 0;                                               <<U.RAO>>13932000
   IF GETJCW = %140000 THEN  <<:ABORT>>                        <<U.RAO>>13934000
      CIERR(ERRNUM := PGMABORT)                                <<U.RAO>>13936000
   ELSE   <<REGULAR ERROR>>                                    <<U.RAO>>13938000
      CIERR(ERRNUM := ERRABTERM);                              <<04785>>13940000
   END;                                                        <<U.RAO>>13942000
END;   <<CISUBSYSFINISH>>                                      <<U.RAO>>13944000
PROCEDURE RESET'TERMINALMODE;                                  <<00851>>13946000
OPTION UNCALLABLE;                                             <<00851>>13948000
BEGIN                                                          <<00851>>13950000
   COMMENT:                                                    <<00851>>13952000
      THIS PROCEDURE RESETS THE TERMINAL TO THE STATE          <<00851>>13954000
      DESIRED BY THE CI.  IN PARTICULAR IT:                    <<00851>>13956000
         1) DISABLES BREAK IF IN A NOBREAK UDC ELSE            <<00851>>13958000
            ENABLES BREAK                                      <<00851>>13960000
         2) CANCELLS ANY PREVIOUSLY ESTABLISHED TIME-          <<00851>>13962000
            OUTS FOR FREADS.;                                  <<00851>>13964000
   LOGICAL                                                     <<00851>>13966000
      PARM;  << FCONTROL PARARMETER >>                         <<00851>>13968000
                                                               <<00851>>13970000
   IF CIS'UDCNOBREAKOPT                                        << I.A >>13972000
      THEN FCONTROL( 1, DISABLEBREAK, PARM )                   << I.A >>13974000
   ELSE FCONTROL(1,ENABLEBREAK,PARM);                          <<00851>>13976000
                                                               <<00851>>13978000
   << RESET TIMED READ >>                                      <<00851>>13980000
   PARM := 0;                                                  <<00851>>13982000
   FCONTROL(1,TIMEOUT,PARM);                                   <<00851>>13984000
                                                               <<00851>>13986000
END; << PROCEDURE RESET'TERMINALMODE >>                        <<00851>>13988000
                                                               <<00851>>13990000
                                                               <<00851>>13992000
PROCEDURE CXPREPRUN EXECUTORHEAD;                              <<U.RAO>>13994000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>13996000
BEGIN                                                          <<U.RAO>>13998000
  COMMENT                                                      <<U.RAO>>14000000
    HANDLES :PREP, :RUN, :PREPRUN.                             <<U.RAO>>14002000
                                                               <<U.RAO>>14004000
ALGORITHM: CRASH THROUGH IN OBVIOUS FASHION.  PRIMARILY DRIVEN <<U.RAO>>14006000
   BY "NEXT DELIMITER" AND SECONDARILY DRIVEN BY THE KEYWORDS; <<U.RAO>>14008000
                                                               <<U.RAO>>14010000
ENTRY CXPREP, CXRUN;                                           <<U.RAO>>14012000
                                                               <<U.RAO>>14014000
BYTE ARRAY PKEYLIST(*)=PB:=                                    <<U.RAO>>14016000
   5, 3, "LIB",                                                <<U.RAO>>14018000
   9, 7, "MAXDATA",                                            <<U.RAO>>14020000
   6, 4, "PARM",                                               <<U.RAO>>14022000
   6, 4, "PMAP",                                               <<U.RAO>>14024000
   7, 5, "DEBUG",                                              <<U.RAO>>14026000
   7, 5, "STACK",                                              <<U.RAO>>14028000
   4, 2, "RL",                                                 <<U.RAO>>14030000
   6, 4, "LMAP",                                               <<U.RAO>>14032000
   4, 2, "DL",                                                 <<U.RAO>>14034000
   8, 6, "ZERODB",                                             <<U.RAO>>14036000
   8, 6, "NOPRIV",                                             <<U.RAO>>14038000
   6, 4, "NOCB",                                               <<U.RAO>>14040000
   5, 3, "CAP",                                                <<U.RAO>>14042000
   7, 5, "PATCH",                                              <<00629>>14044000
   7, 5, "STDIN",                                              <<01200>>14046000
   9, 7, "STDLIST",                                            <<01200>>14048000
   6, 4, "INFO",                                               <<01200>>14050000
   7, 5, "NOSYM",                                              <<04103>>14052000
   7, 5, "FPMAP",                                              <<04103>>14054000
   9, 7, "NOFPMAP",                                            <<04103>>14056000
  10, 8, "CHECKSUM",                                           <<04103>>14058000
   0;                                                          <<U.RAO>>14060000
EQUATE PKEYLISTL = 144;                                        <<04103>>14062000
BYTE ARRAY KEYLIST(0:PKEYLISTL-1);                             <<U.RAO>>14064000
BYTE ARRAY PCAPLIST(0:24)=PB:=                                 <<U.RAO>>14066000
   4, 2, "PH",                                                 <<U.RAO>>14068000
   4, 2, "DS",                                                 <<U.RAO>>14070000
   4, 2, "MR",                                                 <<U.RAO>>14072000
   4, 2, "PM",                                                 <<U.RAO>>14074000
   4, 2, "IA",                                                 <<U.RAO>>14076000
   4, 2, "BA",                                                 <<U.RAO>>14078000
   0;                                                          <<U.RAO>>14080000
EQUATE PCAPLISTL = 25;                                         <<U.RAO>>14082000
BYTE ARRAY CAPLIST(0:PCAPLISTL-1);                             <<U.RAO>>14084000
                                                               <<U.RAO>>14086000
<<OPERATIONAL LOCAL VARIABLES>>                                <<U.RAO>>14088000
INTEGER PREPRUNFLAG;                                           <<U.RAO>>14090000
DEFINE PREPCOM = (PREPRUNFLAG>0)#,                             <<U.RAO>>14092000
       RUNCOM  = (PREPRUNFLAG<0)#,                             <<U.RAO>>14094000
       PREPRUNCOM = (PREPRUNFLAG=0)#;                          <<U.RAO>>14096000
EQUATE COMMA=0, EQUALSIGN=1, SEMICOLON=2, CR=3;  <<DELIMITERS>><<U.RAO>>14098000
                                                               <<01426>>14100000
<< MAX LENGTH FOR A STRING COMES AFTER A 'RUN X;INFO="' >>     <<01426>>14102000
EQUATE MAXSTRINGLEN = CIS'BCOMBUFLEN - 12;                     << I.A >>14104000
<< NOTE THAT THE CURRENT TRUE MAXIMUM ON STRING LENGTH IS   >> <<01709>>14106000
<< 253 CHARACTERS DUE TO THE LIMITATION OF MYCOMMAND.       >> <<01709>>14108000
                                                               <<01426>>14110000
INTEGER NUMPARMS;                                              <<U.RAO>>14112000
DOUBLE ARRAY PARMS(0:MAXSTRINGLEN+3-1);                        <<01426>>14114000
INTEGER ARRAY IPARMS(*)=PARMS;                                 <<U.RAO>>14116000
INTEGER DELIMITER;                                             <<U.RAO>>14118000
DOUBLE TEMPPARM,DUSERCAP;                                      <<04172>>14120000
LOGICAL USERCAP = DUSERCAP + 1;                                <<04172>>14122000
BYTE POINTER PPNTR=TEMPPARM;                                   <<U.RAO>>14124000
BYTE POINTER TEMPPARMPTR = TEMPPARM;                           <<02324>>14126000
LOGICAL DUMMY;                                                 <<02324>>14128000
BYTE POINTER ERRPTR;                                           <<02324>>14130000
LOGICAL LERRPTR' = ERRPTR;                                     <<02324>>14132000
LOGICAL PARMWORD2=TEMPPARM+1;                                  <<U.RAO>>14134000
LONG                                                           <<04172>>14136000
   IA := [16/"IA",48/0]L,                                      <<04172>>14138000
   BA := [16/"BA",48/0]L,                                      <<04172>>14140000
   IB := [16/"IA",16/",B",16/"A ",16/0]L;                      <<04172>>14142000
BYTE X1=PARMWORD2;  <<JUST A DUMMY FOR THE FOLLOWING DEFINE>>  <<U.RAO>>14144000
DEFINE PARMLEN = INTEGER(X1)#;                                 <<U.RAO>>14146000
INTEGER MAXPARAM;                                              <<U.RAO>>14148000
INTEGER ERR;                                                   <<U.RAO>>14150000
INTEGER NAMELEN;          << LENGTH OF FILE NAME >>            <<01200>>14152000
BYTE POINTER SPTR;        << TARGET STRING >>                  <<01200>>14154000
BYTE ARRAY STRING(0:MAXSTRINGLEN-1); << SOURCE STRING >>       <<01426>>14156000
BYTE ARRAY SAVEDCOMIMAGE(0:CIS'BCOMBUFLEN-1);                  << I.A >>14158000
INTEGER T'IX,             << OFFSET IN TARGET STR >>           <<01200>>14160000
        S'IX;             << OFFSET IN SOURCE STR >>           <<01200>>14162000
LOGICAL STOP := FALSE;    << FLAG TO STOP SCANNING >>          <<01200>>14164000
                          << IF 'CR' OR 'QUOTECHAR' >>         <<01200>>14166000
                          << IS ENCOUNTERED. >>                <<01200>>14168000
BYTE QUOTECHAR;<< CHOSEN STRING DELIMITER, CAN BE >>           << I.A >>14170000
               << SINGLE OR DOUBLE QUOTE.         >>           <<01200>>14172000
                                                               <<U.RAO>>14174000
EQUATE C'QUOTE = %47,                                          <<01200>>14176000
       C'DQUOTE = %42,                                         <<01200>>14178000
       C'COMMA =  %54,                                         <<01200>>14180000
       C'EQUAL =  %75,                                         <<01200>>14182000
       C'SEMICOLON = %73,                                      <<01200>>14184000
       C'CR = %15;                                             <<01200>>14186000
<<PARSED PARAMETER HOLDERS.  THE ACTUAL VALUES ARE    >>       <<U.RAO>>14188000
<<ENTERED IN THE SECTION WHERE THE KEYWORDS ARE PARSED>>       <<U.RAO>>14190000
BYTE ARRAY PROGNAME(0:35);  <<PROGRAM FILE NAME>>              <<U.RAO>>14192000
LOGICAL BLANK := "  ";                                         <<U.RAO>>14194000
BYTE ARRAY ENTRYNAME(0:35);    <<ENTRY POINT NAME>>            <<U.RAO>>14196000
BYTE POINTER RL := @BLANK;                                     <<U.RAO>>14198000
BYTE ARRAY TFILENAME(0:8);  <<HOLDS TEMP FILE NAMES>>          <<U.RAO>>14200000
BYTE ARRAY FULLFILENAME(*) = KEYLIST;                          <<U.RAO>>14202000
LOGICAL PARM := 0;                                             <<U.RAO>>14204000
INTEGER STACKSIZE := -1;                                       <<U.RAO>>14206000
INTEGER DLSIZE := -1;                                          <<U.RAO>>14208000
LOGICAL FLAGS := 1;                                            <<U.RAO>>14210000
LOGICAL FLAGS'EXT1 := 0;     << EXTENSION #1 TO FLAGS - FOR >> <<01200>>14212000
                             << NOTING DUPLICATE KEYWORDS   >> <<01200>>14214000
BYTE ARRAY STDIN(0:39);            << STDIN STRING >>          <<01200>>14216000
BYTE ARRAY STDLIST(0:70);          << STDLIST STRING >>        <<01200>>14218000
INTEGER MAXDATA := -1;                                         <<U.RAO>>14220000
INTEGER PATCHSIZE := -1;                                       <<00629>>14222000
BYTE LIB := "S";                                               <<U.RAO>>14224000
INTEGER ERROR;          << ERROR RETURN FROM CREATEPROCESS >>  <<01200>>14226000
INTEGER PIN := 0;       << PIN RETURNED FROM CREATEPROCESS >>  <<01200>>14228000
LOGICAL CAPWORD := 0;                                          <<U.RAO>>14230000
LOGICAL PFLAGS := 0;                                           <<U.RAO>>14232000
INTEGER ARRAY OPTNNUMS(0:12);   << OPTIONS FOR CREATEPROCESS >><<01200>>14234000
LOGICAL ARRAY OPTNS(0:12);                                     <<01200>>14236000
LOGICAL OPTIONS := 0;          << OPTIONS FOR PROCESS CREATE >><<01200>>14238000
                                                               <<U.RAO>>14240000
DEFINE                                                         <<01200>>14242000
  STACK'OPTION    = OPTIONS.(15:1)#,                           <<01200>>14244000
  DL'OPTION       = OPTIONS.(14:1)#,                           <<01200>>14246000
  MAXDATA'OPTION  = OPTIONS.(13:1)#,                           <<01200>>14248000
  STDIN'OPTION    = OPTIONS.(12:1)#,                           <<01200>>14250000
  STDLIST'OPTION  = OPTIONS.(11:1)#,                           <<01200>>14252000
  STRING'OPTION   = OPTIONS.(10:1)#;                           <<01200>>14254000
                                                               <<01200>>14256000
DEFINE                                                         <<U.RAO>>14258000
  CHECKRUNCOM=IF RUNCOM THEN ERRNUM:=CONTXTPRPNOTRUN#,         <<U.RAO>>14260000
  CHECKPREPCOM=IF PREPCOM THEN ERRNUM:=CONTXTRUNNOTPRP#,       <<U.RAO>>14262000
  CHECKEQSIGN=IF DELIMITER<>EQUALSIGN THEN                     <<U.RAO>>14264000
     BEGIN                                                     <<U.RAO>>14266000
     @PPNTR := @PPNTR+PARMLEN;                                 <<U.RAO>>14268000
     ERRNUM := REQEQUALSIGN;                                   <<U.RAO>>14270000
     END#,                                                     <<U.RAO>>14272000
  CHECKSEGERR=                                                 <<U.RAO>>14274000
     IF <> AND (ERR<>1) <<WARNING PRINTED>> THEN               <<U.RAO>>14276000
         BEGIN                                                 <<U.RAO>>14278000
         SEGMENTER(PIN,8,DELIMITER); <<EXIT>>                  <<U.RAO>>14280000
         ERRNUM := SEGMENTERERROR;                             <<U.RAO>>14282000
         PARMNUM := ERR;                                       <<U.RAO>>14284000
         CIERR(ERRNUM,,%10000,ERR);                            <<U.RAO>>14286000
         RETURN;                                               <<U.RAO>>14288000
         END #,                                                <<01200>>14290000
   CHECKNEW=                                                   <<01200>>14292000
      IF PARMLEN <> 3 OR PPNTR <> "NEW" THEN                   <<01200>>14294000
       ERRNUM := INVALIDSTDLIST#,                              <<01709>>14296000
                                                               <<01200>>14298000
   DELIM'CHAR=                                                 <<01709>>14300000
       IF DELIMITER = COMMA THEN C'COMMA                       <<01709>>14302000
       ELSE IF DELIMITER = EQUALSIGN THEN C'EQUAL              <<01709>>14304000
       ELSE IF DELIMITER = SEMICOLON THEN  C'SEMICOLON         <<01709>>14306000
       ELSE C'CR#;                                             <<01709>>14308000
EQUATE                                                         <<01200>>14310000
  FATHERWAIT      = 1,           << FOR CALLING AWAKE >>       <<01200>>14312000
  SONWAIT         = 2;           << FOR CALLING AWAKE >>       <<01200>>14314000
                                                               <<U.RAO>>14316000
EQUATE                                                         <<01452>>14318000
  UNKNOWN'PROG    =  6;   << CREATEPROC. CAN'T FIND PROGRAM >> <<01452>>14320000
                                                               <<01200>>14322000
INTEGER SUBROUTINE NEXT;                                       <<U.RAO>>14324000
BEGIN  <<GET NEXT PARAMETER>>                                  <<U.RAO>>14326000
TEMPPARM := PARMS(PARMNUM);                                    <<U.RAO>>14328000
NEXT := PARMWORD2.(13:3);  <<RETURN DELIMITER>>                <<U.RAO>>14330000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>14332000
END;  <<SUBROUTINE NEXT>>                                      <<U.RAO>>14334000
                                                               <<01200>>14336000
LOGICAL SUBROUTINE DELIM(CHAR);                                <<01200>>14338000
COMMENT                                                        <<01200>>14340000
   THE FOLLOWING SUBROUTINE DETERMINES IF CHAR IS              <<01200>>14342000
   A DELIMITER. ;                                              <<01200>>14344000
BYTE CHAR;                                                     <<01200>>14346000
BEGIN                                                          <<01200>>14348000
   DELIM := FALSE;                                             <<01200>>14350000
   IF CHAR = C'COMMA OR                                        <<01200>>14352000
      CHAR = C'EQUAL OR                                        <<01200>>14354000
      CHAR = C'SEMICOLON THEN                                  <<01200>>14356000
      DELIM := TRUE;                                           <<01200>>14358000
END;                                                           <<01200>>14360000
                                                               <<U.RAO>>14362000
<<*** MAIN BODY OF PROCEDURE ***>>                             <<U.RAO>>14364000
                                                               <<U.RAO>>14366000
PREPRUNFLAG := 0;                                              <<U.RAO>>14368000
MAXPARAM := 29;                                                <<U.RAO>>14370000
GO TO START;                                                   <<U.RAO>>14372000
                                                               <<U.RAO>>14374000
CXPREP:                                                        <<U.RAO>>14376000
PREPRUNFLAG := 1;                                              <<U.RAO>>14378000
MAXPARAM := 21;                                                <<U.RAO>>14380000
GO TO START;                                                   <<U.RAO>>14382000
                                                               <<U.RAO>>14384000
CXRUN:                                                         <<U.RAO>>14386000
PREPRUNFLAG := -1;                                             <<U.RAO>>14388000
<< MAKE MAXPARAM LARGE SO STRING OF DELIMITERS (I.E. ; , CR) >><<01426>>14390000
<< WILL BE ACCEPTED BY MYCOMMAND.                            >><<01426>>14392000
MAXPARAM := MAXSTRINGLEN + 3;                                  <<01426>>14394000
                                                               <<U.RAO>>14396000
START:                                                         <<U.RAO>>14398000
MOVE SAVEDCOMIMAGE := CIS'BCOMIMAGE, (CIS'BCOMBUFLEN);         << I.A >>14400000
MYCOMMAND(PARMSP,,MAXPARAM,NUMPARMS,PARMS);                    <<U.RAO>>14402000
IF CARRY THEN                                                  <<01709>>14404000
   BEGIN  << AN ERROR FROM MYCOMMAND >>                        <<01709>>14406000
   << SOME PARAMETER EXCEEDS 255 CHARACTERS >>                 <<01709>>14408000
   ERRNUM := PARAMTOOBIG;                                      <<01709>>14410000
   CIERR(ERRNUM);                                              <<01709>>14412000
   RETURN;                                                     <<01709>>14414000
   END;                                                        <<01709>>14416000
DELIMITER := NEXT;                                             <<U.RAO>>14418000
IF NUMPARMS=0 THEN  <<MISSING FIRST FILE NAME>>                <<U.RAO>>14420000
   BEGIN                                                       <<U.RAO>>14422000
   ERRNUM := IF RUNCOM THEN ERRNOPROGF                         <<U.RAO>>14424000
      ELSE IF PREPRUNCOM THEN ERRNOPORUF                       <<U.RAO>>14426000
      ELSE ERRNOUSLF;                                          <<U.RAO>>14428000
   CIERR(ERRNUM,PARMSP(1));                                    <<U.RAO>>14430000
   RETURN;                                                     <<U.RAO>>14432000
   END;                                                        <<U.RAO>>14434000
                                                               <<U.RAO>>14436000
<<CHECK FIRST FILE NAME>>                                      <<U.RAO>>14438000
ERRNUM := CHECKFILENAME'(TEMPPARM&LSR(8),DUMMY,DUMMY,LERRPTR');<<02324>>14440000
IF < THEN    <<CCL RETURNED , ERROR IN NAME >>                 <<02324>>14442000
    BEGIN                                                      <<02324>>14444000
    CIERR(ERRNUM,ERRPTR);   <<ERRPTR POINTING AT ERROR LOC. >> <<02324>>14446000
    RETURN;                                                    <<02324>>14448000
    END                                                        <<02324>>14450000
ELSE IF > AND ERRNUM <> 0 AND ERRNUM <> 3 THEN                 <<02324>>14452000
    BEGIN                                                      <<02324>>14454000
    CIERR(ERRNUM := INVALIDSYSDEFFL,TEMPPARMPTR);              <<02324>>14456000
    RETURN;                                                    <<02324>>14458000
    END                                                        <<02324>>14460000
ELSE                                                           <<02324>>14462000
    IF ERRNUM = 3 THEN <<  $OLDPASS IS ALLOWED  >>             <<02324>>14464000
        ERRNUM := 0;                                           <<02324>>14466000
MOVE PROGNAME := PPNTR,(PARMLEN);                              <<U.RAO>>14468000
PROGNAME(PARMLEN) := " ";                                      <<U.RAO>>14470000
                                                               <<U.RAO>>14472000
<<NEXT HANDLE SECOND FILE NAME, IF ANY>>                       <<U.RAO>>14474000
ENTRYNAME := " ";                                              <<U.RAO>>14476000
IF DELIMITER = COMMA THEN  <<ENTRY OR PROGFILE>>               <<U.RAO>>14478000
   BEGIN                                                       <<U.RAO>>14480000
   DELIMITER := NEXT;                                          <<U.RAO>>14482000
   IF PREPCOM THEN  <<CHECK PROGFILE NAME>>                    <<U.RAO>>14484000
      IF CIBADFILENAME(ERRNUM,TEMPPARM) THEN  <<BAD NAME!>>    <<U.RAO>>14486000
         BEGIN                                                 <<U.RAO>>14488000
         PARMNUM := 2;                                         <<U.RAO>>14490000
         RETURN;                                               <<U.RAO>>14492000
         END                                                   <<U.RAO>>14494000
      ELSE                                                     <<U.RAO>>14496000
   ELSE IF PARMLEN>15 THEN  <<ENTRY NAME TOO LONG>>            <<U.RAO>>14498000
      BEGIN                                                    <<U.RAO>>14500000
      CIERR(ERRNUM := ERRENTRYTOOBIG,PPNTR);                   <<U.RAO>>14502000
      PARMNUM := 2;                                            <<U.RAO>>14504000
      RETURN                                                   <<U.RAO>>14506000
      END;                                                     <<U.RAO>>14508000
   MOVE ENTRYNAME := PPNTR,(PARMLEN);                          <<U.RAO>>14510000
   ENTRYNAME(PARMLEN) := " ";                                  <<U.RAO>>14512000
   END                                                         <<U.RAO>>14514000
ELSE IF PREPCOM THEN  <<MISSING REQUIRED PROG FILE>>           <<U.RAO>>14516000
   BEGIN                                                       <<U.RAO>>14518000
   ERRNUM := ERRNOPREPTARGET;                                  <<U.RAO>>14520000
   PARMNUM := 2;                                               <<U.RAO>>14522000
   CIERR(ERRNUM,PPNTR(PARMLEN));                               <<U.RAO>>14524000
   RETURN                                                      <<U.RAO>>14526000
   END;                                                        <<U.RAO>>14528000
                                                               <<U.RAO>>14530000
<<NEXT WE DO A CASE ON THE DELIMITER FOLLOWING THE FILE>>      <<U.RAO>>14532000
<<NAMES.  CARRIAGE RETURN FALLS THROUGH>>                      <<U.RAO>>14534000
CASE DELIMITER OF                                              <<U.RAO>>14536000
   BEGIN                                                       <<U.RAO>>14538000
      BEGIN  <<COMMA, QUITE UNEXPECTED>>                       <<U.RAO>>14540000
         ERRNUM := CMAXPCTSEMIORCR;                            <<U.RAO>>14542000
         CIERR(ERRNUM,PPNTR(PARMLEN));                         <<U.RAO>>14544000
         RETURN;                                               <<U.RAO>>14546000
      END;                                                     <<U.RAO>>14548000
      BEGIN  <<EQUAL SIGN, SIMILARLY UNEXPECTED>>              <<U.RAO>>14550000
         ERRNUM := EQXPCTSEMIORCR;                             <<U.RAO>>14552000
         CIERR(ERRNUM,PPNTR(PARMLEN));                         <<U.RAO>>14554000
         RETURN;                                               <<U.RAO>>14556000
      END;                                                     <<U.RAO>>14558000
      BEGIN  <<SEMICOLON - KEYWORD(S) FOLLOW>>                 <<U.RAO>>14560000
      MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                    <<U.RAO>>14562000
      TOS := FLAGS;                                            <<U.RAO>>14564000
      DO    <<PARSE KEYWORD LIST>>                             <<U.RAO>>14566000
         BEGIN                                                 <<U.RAO>>14568000
         DELIMITER := NEXT;                                    <<U.RAO>>14570000
         IF PARMLEN=0 THEN                                     <<U.RAO>>14572000
               CIERR(ERRNUM := -EXTRNDELIMIGNRD,PPNTR(-1))     <<04785>>14574000
            ELSE                                               <<U.RAO>>14576000
               BEGIN   <<KEYWORD PROCESSING>>                  <<U.RAO>>14578000
               CASE SEARCH(PPNTR,PARMLEN,KEYLIST) OF           <<U.RAO>>14580000
                  BEGIN                                        <<U.RAO>>14582000
                                                               <<U.RAO>>14584000
                     <<THE TOMB OF THE UNKNOWN KEYWORD>>       <<U.RAO>>14586000
                  ERRNUM := (IF PREPCOM THEN UNKNOWNKEYPREP    <<U.RAO>>14588000
                     ELSE IF RUNCOM THEN UNKNOWNKEYRUN         <<U.RAO>>14590000
                     ELSE UNKNOWNKEYPRPRN);                    <<U.RAO>>14592000
                                                               <<U.RAO>>14594000
                     <<LIB = SL>>                              <<U.RAO>>14596000
                  CHECKPREPCOM                                 <<U.RAO>>14598000
                  ELSE CHECKEQSIGN                             <<U.RAO>>14600000
                  ELSE                                         <<U.RAO>>14602000
                     BEGIN  <<CHECK THE VALUE>>                <<U.RAO>>14604000
                     DELIMITER := NEXT;                        <<U.RAO>>14606000
                     IF (PARMLEN=1) AND ((PPNTR="G")           <<U.RAO>>14608000
                        OR (PPNTR="P") OR (PPNTR="S")) THEN    <<U.RAO>>14610000
                        BEGIN  <<VALID LIB>>                   <<U.RAO>>14612000
                        LIB := PPNTR;                          <<U.RAO>>14614000
                        ASSEMBLE(TSBC 4);                      <<U.RAO>>14616000
                        END                                    <<U.RAO>>14618000
                     ELSE                                      <<U.RAO>>14620000
                        ERRNUM := INVALIDLIB;                  <<U.RAO>>14622000
                     END;                                      <<U.RAO>>14624000
                                                               <<U.RAO>>14626000
                     <<MAXDATA = SEGSIZE>>                     <<U.RAO>>14628000
                  CHECKEQSIGN                                  <<U.RAO>>14630000
                  ELSE                                         <<U.RAO>>14632000
                     BEGIN                                     <<U.RAO>>14634000
                     DELIMITER := NEXT;                        <<U.RAO>>14636000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>14638000
                        BEGIN                                  <<U.RAO>>14640000
                        MAXDATA := BINARY(PPNTR,PARMLEN);      <<U.RAO>>14642000
                        IF <> THEN                             <<U.RAO>>14644000
                           ERRNUM := INVALIDMAXDATA            <<U.RAO>>14646000
                        ELSE                                   <<U.RAO>>14648000
                           BEGIN                               <<U.RAO>>14650000
                           MAXDATA'OPTION := 1;                <<01200>>14652000
                           ASSEMBLE(TSBC 0);                   <<U.RAO>>14654000
                           END;                                <<U.RAO>>14656000
                        END                                    <<U.RAO>>14658000
                     ELSE                                      <<U.RAO>>14660000
                        ERRNUM := INVALIDMAXDATA;              <<U.RAO>>14662000
                     END;                                      <<U.RAO>>14664000
                                                               <<U.RAO>>14666000
                     <<PARM = PARM>>                           <<U.RAO>>14668000
                  CHECKPREPCOM                                 <<U.RAO>>14670000
                  ELSE CHECKEQSIGN                             <<U.RAO>>14672000
                  ELSE                                         <<U.RAO>>14674000
                     BEGIN                                     <<U.RAO>>14676000
                     DELIMITER := NEXT;                        <<U.RAO>>14678000
                     IF PARMLEN>0 THEN                         <<U.RAO>>14680000
                        BEGIN                                  <<U.RAO>>14682000
                        PARM := BINARY(PPNTR,PARMLEN);         <<U.RAO>>14684000
                        IF <> THEN                             <<U.RAO>>14686000
                           ERRNUM := INVALIDPARM               <<U.RAO>>14688000
                        ELSE                                   <<U.RAO>>14690000
                           ASSEMBLE(TSBC 1);                   <<U.RAO>>14692000
                        END                                    <<U.RAO>>14694000
                     ELSE                                      <<U.RAO>>14696000
                        ERRNUM := INVALIDPARM;                 <<U.RAO>>14698000
                     END;                                      <<U.RAO>>14700000
                                                               <<U.RAO>>14702000
                     <<PMAP>>                                  <<U.RAO>>14704000
                  CHECKRUNCOM ELSE ASSEMBLE(TSBC 6);           <<U.RAO>>14706000
                                                               <<U.RAO>>14708000
                     <<DEBUG>>                                 <<U.RAO>>14710000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 13);         <<U.RAO>>14712000
                                                               <<U.RAO>>14714000
                     <<STACK = STACKSIZE>>                     <<U.RAO>>14716000
                  CHECKEQSIGN                                  <<U.RAO>>14718000
                  ELSE                                         <<U.RAO>>14720000
                     BEGIN                                     <<U.RAO>>14722000
                     DELIMITER := NEXT;                        <<U.RAO>>14724000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>14726000
                        BEGIN                                  <<U.RAO>>14728000
                        STACKSIZE := BINARY(PPNTR,PARMLEN);    <<U.RAO>>14730000
                        IF <> OR (STACKSIZE<511) THEN          <<U.RAO>>14732000
                           ERRNUM := INVALIDSTAKSIZE           <<U.RAO>>14734000
                        ELSE                                   <<U.RAO>>14736000
                           BEGIN                               <<U.RAO>>14738000
                           STACK'OPTION := 1;                  <<01200>>14740000
                           ASSEMBLE(TSBC 2);                   <<U.RAO>>14742000
                           END                                 <<U.RAO>>14744000
                        END                                    <<U.RAO>>14746000
                     ELSE                                      <<U.RAO>>14748000
                        ERRNUM := INVALIDSTAKSIZE;             <<U.RAO>>14750000
                  END;                                         <<U.RAO>>14752000
                                                               <<U.RAO>>14754000
                     <<RL = FILENAME>>                         <<U.RAO>>14756000
                  CHECKRUNCOM                                  <<U.RAO>>14758000
                  ELSE CHECKEQSIGN                             <<U.RAO>>14760000
                  ELSE                                         <<U.RAO>>14762000
                     BEGIN                                     <<U.RAO>>14764000
                     DELIMITER := NEXT;                        <<U.RAO>>14766000
                     TOS := CHECKFILENAME'(TEMPPARM&LSR(8),    <<U.RAO>>14768000
                        MAXPARAM,MAXPARAM,ERR);                <<U.RAO>>14770000
                     IF >= THEN                                <<U.RAO>>14772000
                        BEGIN                                  <<U.RAO>>14774000
                        DEL;                                   <<U.RAO>>14776000
                        @RL := @PPNTR;                         <<U.RAO>>14778000
                        ASSEMBLE(TSBC 8)                       <<U.RAO>>14780000
                        END                                    <<U.RAO>>14782000
                     ELSE  <<CORRECT CARET PTR FOR CIERR>>     <<U.RAO>>14784000
                        BEGIN                                  <<U.RAO>>14786000
                        @PPNTR := ERR;                         <<U.RAO>>14788000
                        ERRNUM := TOS;                         <<U.RAO>>14790000
                        END;                                   <<U.RAO>>14792000
                     END;                                      <<U.RAO>>14794000
                                                               <<U.RAO>>14796000
                     <<LMAP>>                                  <<U.RAO>>14798000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 14);         <<U.RAO>>14800000
                                                               <<U.RAO>>14802000
                     <<DL = DLSIZE>>                           <<U.RAO>>14804000
                  CHECKEQSIGN                                  <<U.RAO>>14806000
                  ELSE                                         <<U.RAO>>14808000
                     BEGIN                                     <<U.RAO>>14810000
                     DELIMITER := NEXT;                        <<U.RAO>>14812000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>14814000
                        BEGIN                                  <<U.RAO>>14816000
                        DLSIZE := BINARY(PPNTR,PARMLEN);       <<U.RAO>>14818000
                        IF <> THEN                             <<U.RAO>>14820000
                           ERRNUM := INVALIDDLSIZE             <<U.RAO>>14822000
                        ELSE                                   <<U.RAO>>14824000
                           BEGIN                               <<U.RAO>>14826000
                           DL'OPTION := 1;                     <<01200>>14828000
                           ASSEMBLE(TSBC 3);                   <<U.RAO>>14830000
                           END                                 <<U.RAO>>14832000
                        END                                    <<U.RAO>>14834000
                     ELSE                                      <<U.RAO>>14836000
                        ERRNUM := INVALIDDLSIZE;               <<U.RAO>>14838000
                     END;                                      <<U.RAO>>14840000
                                                               <<U.RAO>>14842000
                     <<ZERODB>>                                <<U.RAO>>14844000
                  CHECKRUNCOM ELSE ASSEMBLE(TSBC 11);          <<U.RAO>>14846000
                                                               <<U.RAO>>14848000
                     <<NOPRIV>>                                <<U.RAO>>14850000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 12);         <<U.RAO>>14852000
                                                               <<U.RAO>>14854000
                     <<NOCB>>                                  <<U.RAO>>14856000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 9);          <<U.RAO>>14858000
                                                               <<U.RAO>>14860000
                     <<CAP>>                                   <<U.RAO>>14862000
                  CHECKRUNCOM                                  <<U.RAO>>14864000
                  ELSE CHECKEQSIGN                             <<U.RAO>>14866000
                  ELSE                                         <<U.RAO>>14868000
                     BEGIN                                     <<U.RAO>>14870000
                     MOVE CAPLIST := PCAPLIST,(PCAPLISTL);     <<U.RAO>>14872000
                     TOS := 0;  <<FUTURE CAPABILITIES WORD>>   <<U.RAO>>14874000
                     DO BEGIN                                  <<U.RAO>>14876000
                        DELIMITER := NEXT;                     <<U.RAO>>14878000
                        IF PARMLEN = 0 THEN                    <<U.RAO>>14880000
                           ERRNUM := MISSINGCAP                <<U.RAO>>14882000
                        ELSE                                   <<U.RAO>>14884000
                           CASE SEARCH(PPNTR,PARMLEN,CAPLIST)OF<<U.RAO>>14886000
                              BEGIN                            <<U.RAO>>14888000
                              BEGIN ERRNUM := UNKNOWNCAP;      <<U.RAO>>14890000
                                 @PPNTR:=@PPNTR-1;END;         <<U.RAO>>14892000
                              ASSEMBLE(TSBC 15);  <<PH>>       <<U.RAO>>14894000
                              ASSEMBLE(TSBC 14);  <<DS>>       <<U.RAO>>14896000
                              ASSEMBLE(TSBC 12);  <<MR>>       <<U.RAO>>14898000
                              ASSEMBLE(TSBC 9);   <<PM>>       <<U.RAO>>14900000
                              ASSEMBLE(TSBC 8);   <<IA>>       <<U.RAO>>14902000
                              ASSEMBLE(TSBC 7);   <<BA>>       <<U.RAO>>14904000
                              END;                             <<U.RAO>>14906000
                        END                                    <<U.RAO>>14908000
                           UNTIL (DELIMITER <> COMMA) OR       <<U.RAO>>14910000
                              (ERRNUM <> 0);                   <<U.RAO>>14912000
                     CAPWORD := TOS;                           <<U.RAO>>14914000
                     IF (CAPWORD.(7:2)=0) AND (ERRNUM=0) THEN <<*alt*>> 14916000
                        BEGIN                                  <<04172>>14918000
                        WHO(,DUSERCAP);                        <<04172>>14920000
                        CAPWORD.(7:2) := USERCAP.(7:2);        <<04172>>14922000
                        CASE USERCAP.(7:2) OF                  <<04172>>14924000
                           BEGIN                               <<04172>>14926000
                           ;                                   <<04172>>14928000
                 CIERR(ERRNUM := -IMPIABA,,0,@IA&LSL(1));      <<04785>>14930000
                 CIERR(ERRNUM := -IMPIABA,,0,@BA&LSL(1));      <<04785>>14932000
                 CIERR(ERRNUM := -IMPIABA,,0,@IB&LSL(1));      <<04785>>14934000
                           END;                                <<04172>>14936000
                        END;                                   <<04172>>14938000
                     ASSEMBLE(TSBC 7);                         <<U.RAO>>14940000
                     END;                                      <<U.RAO>>14942000
                                                               <<00629>>14944000
                     <<PATCH = PATCHSIZE>>                     <<00629>>14946000
                  CHECKRUNCOM                                  <<00629>>14948000
                  ELSE CHECKEQSIGN                             <<00629>>14950000
                  ELSE                                         <<00629>>14952000
                     BEGIN                                     <<00629>>14954000
                     DELIMITER := NEXT;                        <<00629>>14956000
                     IF PARMLEN > 0 THEN                       <<00629>>14958000
                        BEGIN                                  <<00629>>14960000
                        PATCHSIZE := BINARY(PPNTR,PARMLEN);    <<00629>>14962000
                        IF <> THEN                             <<00629>>14964000
                           ERRNUM := INVALIDPATCH              <<00629>>14966000
                        ELSE                                   <<00629>>14968000
                           BEGIN                               <<00629>>14970000
                           IF NOT(-1<= PATCHSIZE <=16380) THEN <<00629>>14972000
                              ERRNUM := INVALIDPATCH;          <<00629>>14974000
                           ASSEMBLE(TSBC 5);                   <<00629>>14976000
                           END;                                <<00629>>14978000
                        END                                    <<00629>>14980000
                     ELSE                                      <<00629>>14982000
                        ERRNUM := INVALIDPATCH;                <<00629>>14984000
                     END;                                      <<00629>>14986000
                                                               <<00629>>14988000
                     << STDIN = FILE >>                        <<01200>>14990000
                  CHECKPREPCOM                                 <<01200>>14992000
                  ELSE CHECKEQSIGN                             <<01200>>14994000
                  ELSE                                         <<01200>>14996000
                     BEGIN                                     <<01200>>14998000
                     STDIN'OPTION := 0;                        <<01200>>15000000
                     DELIMITER := NEXT;                        <<01200>>15002000
                     IF PARMLEN > 0 THEN                       <<01200>>15004000
                        BEGIN  << STDIN REALLY SPECIFIED >>    <<01200>>15006000
                        STDIN'OPTION := 1;                     <<01200>>15008000
                        TOS := CHECKFILENAME'(TEMPPARM&LSR(8), <<01200>>15010000
                                              MAXPARAM,        <<01200>>15012000
                                              MAXPARAM,        <<01200>>15014000
                                              ERR);            <<01200>>15016000
                        IF = THEN                              <<01200>>15018000
                           BEGIN  << SIMPLE FILE NAME >>       <<01200>>15020000
                           DEL;   << RETURN VALUE >>           <<01200>>15022000
                           MOVE STDIN := PPNTR,(PARMLEN),2;    <<01200>>15024000
                           MOVE * := ",OLD";                   <<01200>>15026000
                           STDIN(PARMLEN+4) := C'CR;           <<01200>>15028000
                           END                                 <<01200>>15030000
                        ELSE IF > THEN                         <<01200>>15032000
                           BEGIN  << SPECIAL FILE >>           <<01200>>15034000
                           IF S0 = 0 OR S0 = 6 THEN            <<01200>>15036000
                              BEGIN  << BACKREF OR $NULL >>    <<01200>>15038000
                              DEL;   << RETURN VALUE >>        <<01200>>15040000
                              MOVE STDIN := PPNTR,(PARMLEN);   <<01200>>15042000
                              STDIN(PARMLEN) := C'CR;          <<01200>>15044000
                              END                              <<01200>>15046000
                           ELSE                                <<01200>>15048000
                              BEGIN  << NOT BACKREF/$NULL >>   <<01200>>15050000
                              DEL;   << RETURN VALUE >>        <<01200>>15052000
                              ERRNUM := INVALIDSTDIN;          <<01200>>15054000
                              END;                             <<01200>>15056000
                           END                                 <<01200>>15058000
                        ELSE                                   <<01200>>15060000
                           BEGIN  << BAD FILE NAME >>          <<01200>>15062000
                           @PPNTR := ERR;                      <<01200>>15064000
                           ERRNUM := TOS;                      <<01200>>15066000
                           END;                                <<01200>>15068000
                        END;                                   <<01200>>15070000
                     TOS := FLAGS'EXT1;                        <<01200>>15072000
                     ASSEMBLE (TSBC 15);                       <<01200>>15074000
                     FLAGS'EXT1 := TOS;                        <<01200>>15076000
                     END << STDIN = FILENAME >>;               <<01200>>15078000
                                                               <<01200>>15080000
                     << STDLIST = FILE >>                      <<01200>>15082000
                  CHECKPREPCOM                                 <<01200>>15084000
                  ELSE CHECKEQSIGN                             <<01200>>15086000
                  ELSE                                         <<01200>>15088000
                     BEGIN                                     <<01200>>15090000
                     STDLIST'OPTION := 0;                      <<01200>>15092000
                     DELIMITER := NEXT;                        <<01200>>15094000
                     IF PARMLEN > 0 THEN                       <<01200>>15096000
                        BEGIN  << STDLIST REALLY SPECIFIED >>  <<01200>>15098000
                        STDLIST'OPTION := 1;                   <<01200>>15100000
                        TOS := CHECKFILENAME'(TEMPPARM&LSR(8), <<01200>>15102000
                                              MAXPARAM,        <<01200>>15104000
                                              MAXPARAM,        <<01200>>15106000
                                              ERR);            <<01200>>15108000
                        IF < THEN                              <<01200>>15110000
                           BEGIN  << BAD FILE NAME >>          <<01200>>15112000
                           @PPNTR := ERR;                      <<01200>>15114000
                           ERRNUM := TOS;                      <<01200>>15116000
                           END                                 <<01200>>15118000
                        ELSE IF > THEN                         <<01200>>15120000
                           BEGIN  << SPECIAL FILE >>           <<01200>>15122000
                           IF S0 = 0 OR S0 = 6 THEN            <<01200>>15124000
                              BEGIN  << BACKREF OR $NULL >>    <<01200>>15126000
                              DEL;   << RETURN VALUE >>        <<01200>>15128000
                              MOVE STDLIST := PPNTR,(PARMLEN); <<01200>>15130000
                              STDLIST(PARMLEN) := C'CR;        <<01200>>15132000
                              END                              <<01200>>15134000
                           ELSE                                <<01200>>15136000
                              BEGIN  << NOT BACKREF/$NULL >>   <<01200>>15138000
                              DEL;   << RETURN VALUE >>        <<01200>>15140000
                              ERRNUM := INVALIDSTDLIST;        <<01200>>15142000
                              END;                             <<01200>>15144000
                           END                                 <<01200>>15146000
                        ELSE                                   <<01200>>15148000
                           BEGIN  << SIMPLE FILE NAME >>       <<01200>>15150000
                           DEL;   << RETURN VALUE >>           <<01200>>15152000
                           MOVE STDLIST := PPNTR,(PARMLEN),2;  <<01200>>15154000
                           IF DELIMITER <> COMMA THEN          <<01200>>15156000
                              BEGIN  << MUST BE OLD FILE >>    <<01200>>15158000
                              MOVE * := ",OLD";                <<01200>>15160000
                              STDLIST(PARMLEN+4) := C'CR;      <<01200>>15162000
                              END                              <<01200>>15164000
                           ELSE                                <<01200>>15166000
                              BEGIN  << POSSIBLY NEW FILE >>   <<01200>>15168000
                              NAMELEN := PARMLEN;              <<01200>>15170000
                              DELIMITER := NEXT;               <<01200>>15172000
                              CHECKNEW                         <<01200>>15174000
                              ELSE                             <<01200>>15176000
                                 BEGIN  << A NEW FILE >>       <<01200>>15178000
                                 MOVE * := (",NEW;REC=-132",   <<01200>>15180000
                                            ",,F,ASCII;",      <<01200>>15182000
                                            "ACC=OUT;TEMP");   <<01200>>15184000
                                 STDLIST(NAMELEN+35) := C'CR;  <<01200>>15186000
                                 END;                          <<01200>>15188000
                              END;                             <<01200>>15190000
                           END << VALID FILE NAME >>;          <<01200>>15192000
                        END << $STDLIST SPECIFIED >>;          <<01200>>15194000
                     TOS := FLAGS'EXT1;                        <<01200>>15196000
                     ASSEMBLE (TSBC 14);                       <<01200>>15198000
                     FLAGS'EXT1 := TOS;                        <<01200>>15200000
                     END << STDLIST = FILE >>;                 <<01200>>15202000
                                                               <<01200>>15204000
                     << INFO = STRING >>                       <<01200>>15206000
                  CHECKPREPCOM                                 <<01200>>15208000
                  ELSE CHECKEQSIGN                             <<01200>>15210000
                  ELSE                                         <<01200>>15212000
                     BEGIN                                     <<01200>>15214000
                     DELIMITER := NEXT;                        <<01200>>15216000
                     IF PPNTR<>C'QUOTE AND PPNTR<>C'DQUOTE     <<01200>>15218000
                        THEN ERRNUM := EXPCTQUOTE              <<01200>>15220000
                     ELSE                                      <<01200>>15222000
                        BEGIN                                  <<01200>>15224000
                        STRING'OPTION := 1;                    <<01200>>15226000
                        QUOTECHAR := PPNTR;                    <<01200>>15228000
                        X := @PPNTR - @CIS'BCOMIMAGE + 1;      << I.A >>15230000
                        @SPTR := @SAVEDCOMIMAGE(X);            <<01426>>15232000
                        T'IX := S'IX := -1;                    <<01200>>15234000
                        DO                                     <<01200>>15236000
                           BEGIN                               <<01200>>15238000
                           WHILE SPTR(S'IX:=S'IX+1)<>QUOTECHAR <<01200>>15240000
                               AND INTEGER(SPTR(S'IX))<>C'CR DO<<01200>>15242000
                              BEGIN                            <<01200>>15244000
                              IF DELIM(SPTR(S'IX)) THEN        <<01200>>15246000
                                 DELIMITER := NEXT;            <<01200>>15248000
                              STRING(T'IX:=T'IX+1):=SPTR(S'IX);<<01200>>15250000
                              END;                             <<01200>>15252000
                           IF SPTR(S'IX) = C'CR THEN           <<01200>>15254000
                              BEGIN                            <<01200>>15256000
                              << FORCE PTR TO END OF STRING >> <<01200>>15258000
                              @PPNTR := @PPNTR(PARMLEN);       <<01200>>15260000
                              ERRNUM := EXPCTCLOSEQUOTE;       <<01200>>15262000
                              STOP := TRUE;                    <<01200>>15264000
                              END                              <<01200>>15266000
                           ELSE IF SPTR(S'IX:=S'IX+1)=QUOTECHAR<<01709>>15268000
                              THEN STRING(T'IX:=T'IX+1):=      <<01709>>15270000
                                      QUOTECHAR                <<01709>>15272000
                           ELSE                                <<01709>>15274000
                              BEGIN  << SHOULD BE END OF STR >><<01709>>15276000
                              STOP := TRUE;                    <<01709>>15278000
                              << MAKE SURE THERE'S NOTHING  >> <<01709>>15280000
                              << BETWEEN QUOTE & DELIMITER  >> <<01709>>15282000
                              TOS := "  ";                     <<01709>>15284000
                              TOS.(0:8) := DELIM'CHAR;         <<01709>>15286000
                              SCAN SPTR(S'IX) WHILE *;         <<01709>>15288000
                              IF NOCARRY THEN                  <<01709>>15290000
                                 BEGIN  <<SOMETHING UNEXPCTD>> <<01709>>15292000
                                 ERRNUM := XPCTSEMIORCR;       <<01709>>15294000
                                 @PPNTR := @PPNTR(S'IX+1);     <<01709>>15296000
                                 END;                          <<01709>>15298000
                              END;                             <<01709>>15300000
                           END                                 <<01200>>15302000
                              UNTIL STOP;                      <<01200>>15304000
                        T'IX := T'IX + 1;                      <<01200>>15306000
                        IF T'IX > 253 AND ERRNUM = 0 THEN      <<01709>>15308000
                           ERRNUM := STRINGTOOBIG;             <<01709>>15310000
                        END;                                   <<01200>>15312000
                     TOS := FLAGS'EXT1;                        <<01200>>15314000
                     ASSEMBLE (TSBC 13);                       <<01200>>15316000
                     FLAGS'EXT1 := TOS;                        <<01200>>15318000
                     END << INFO = STRING >>;                  <<01200>>15320000
                     <<NOSYM>>                                 <<04103>>15322000
                  CHECKRUNCOM                                  <<04103>>15324000
                  ELSE                                         <<04103>>15326000
                     BEGIN                                     <<04103>>15328000
                     TOS := FLAGS'EXT1;                        <<04103>>15330000
                     ASSEMBLE (TSBC 12);                       <<04103>>15332000
                     FLAGS'EXT1 := TOS;                        <<04103>>15334000
                     END;                                      <<04103>>15336000
                                                               <<04103>>15338000
   <<**********   FPMAP   ******************>>                 <<04103>>15340000
                  CHECKRUNCOM                                  <<04103>>15342000
                  ELSE                                         <<04103>>15344000
                     BEGIN                                     <<04103>>15346000
                     TOS := FLAGS'EXT1;                        <<04103>>15348000
                     ASSEMBLE (TSBC 11);                       <<04103>>15350000
                     FLAGS'EXT1 := TOS;                        <<04103>>15352000
                     END;                                      <<04103>>15354000
    <<*********   NOFPMAP  *****************>>                 <<04103>>15356000
                  CHECKRUNCOM                                  <<04103>>15358000
                  ELSE                                         <<04103>>15360000
                     BEGIN                                     <<04103>>15362000
                     TOS := FLAGS'EXT1;                        <<04103>>15364000
                     ASSEMBLE (TSBC 10);                       <<04103>>15366000
                     FLAGS'EXT1 := TOS;                        <<04103>>15368000
                     END;                                      <<04103>>15370000
     <<**********  CHECKSUM   **************>>                 <<04103>>15372000
                  CHECKRUNCOM                                  <<04103>>15374000
                  ELSE                                         <<04103>>15376000
                     BEGIN                                     <<04103>>15378000
                     TOS := FLAGS'EXT1;                        <<04103>>15380000
                     ASSEMBLE (TSBC 9 );                       <<04103>>15382000
                     FLAGS'EXT1 := TOS;                        <<04103>>15384000
                     END;    <<CHECKSUM>>                      <<04103>>15386000
                  END;  <<OF CASE ON KEYWORDS>>                <<U.RAO>>15388000
               IF <> AND (ERRNUM=0) THEN                       <<U.RAO>>15390000
                  BEGIN                                        <<U.RAO>>15392000
                  TOS:=-WARNDUPLKEY;                           <<U.RAO>>15394000
                  TOS:=PARMS(PARMNUM-2);                       <<U.RAO>>15396000
                  IF TOS.(14:2)<>EQUALSIGN THEN                <<U.RAO>>15398000
                     BEGIN                                     <<U.RAO>>15400000
                     DEL;                                      <<U.RAO>>15402000
                     TOS := @PPNTR;                            <<U.RAO>>15404000
                     END;                                      <<U.RAO>>15406000
                  CIERR(*,*);                                  <<U.RAO>>15408000
                  END;                                         <<U.RAO>>15410000
               IF ERRNUM <> 0 THEN                             <<U.RAO>>15412000
                  BEGIN                                        <<U.RAO>>15414000
                  CIERR(ERRNUM,PPNTR);                         <<U.RAO>>15416000
                  RETURN                                       <<U.RAO>>15418000
                  END;                                         <<U.RAO>>15420000
               END                                             <<U.RAO>>15422000
            END                                                <<U.RAO>>15424000
               UNTIL DELIMITER <> SEMICOLON;                   <<U.RAO>>15426000
                                                               <<U.RAO>>15428000
         <<NOW CLEANUP AFTER KEYWORD PROCESSING>>              <<U.RAO>>15430000
         FLAGS := TOS;                                         <<U.RAO>>15432000
         IF DELIMITER <> CR THEN                               <<U.RAO>>15434000
            BEGIN                                              <<U.RAO>>15436000
            IF DELIMITER = COMMA THEN                          <<U.RAO>>15438000
               ERRNUM := CMAXPCTSEMIORCR                       <<U.RAO>>15440000
            ELSE                                               <<U.RAO>>15442000
               ERRNUM := EQXPCTSEMIORCR;                       <<U.RAO>>15444000
            CIERR(ERRNUM,PPNTR(PARMLEN));                      <<01426>>15446000
            RETURN                                             <<U.RAO>>15448000
            END;                                               <<U.RAO>>15450000
         END;  <<KEYWORD PROCESSING>>                          <<U.RAO>>15452000
      END;  <<CASE ON DELIMITERS>>                             <<U.RAO>>15454000
                                                               <<U.RAO>>15456000
                                                               <<U.RAO>>15458000
<<THE COMMAND HAS NOW BEEN ENTIRELY PARSED.  IT SIMPLY >>      <<U.RAO>>15460000
<<REMAINS TO EXECUTE IT IF POSSIBLE>>                          <<U.RAO>>15462000
                                                               <<00830>>15464000
IF PREPRUNCOM THEN  <<ESTABLISH PASSED FILE AS PROG FILE>>     <<U.RAO>>15466000
   MOVE TFILENAME := "$NEWPASS "                               <<U.RAO>>15468000
ELSE IF PREPCOM THEN                                           <<U.RAO>>15470000
   @TFILENAME := @ENTRYNAME;                                   <<U.RAO>>15472000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>15474000
IF NOT RUNCOM THEN  <<DO PREP STAGE>>                          <<U.RAO>>15476000
   BEGIN                                                       <<U.RAO>>15478000
   IF FLAGS'EXT1.(10:2) = 3 THEN <<FPMAP/NOFPMAP BOTH >>       <<04103>>15480000
   BEGIN                         <<HAVE BEEN SPECIFIED >>      <<04103>>15482000
      ERRNUM := BOTHFPMAPNOFPMAP;                              <<04103>>15484000
      CIERR(ERRNUM,PPNTR(PARMLEN));                            <<04103>>15486000
      RETURN;                                                  <<04103>>15488000
   END;                                                        <<04103>>15490000
   PFLAGS := FLAGS.(6:1); <<PMAP>>                             <<U.RAO>>15492000
   PFLAGS.(14:1) := FLAGS.(11:1);  <<ZERODB>>                  <<U.RAO>>15494000
   PFLAGS.(9:1) := FLAGS'EXT1.(12:1); <<NOSYM>>                <<04103>>15496000
   PFLAGS.(8:1) := FLAGS'EXT1.(11:1);  << FPMAP >>             <<04103>>15498000
   PFLAGS.(7:1) := FLAGS'EXT1.(10:1);  << NOFPMAP >>           <<04103>>15500000
   PFLAGS.(6:1) := FLAGS'EXT1.(9:1);   <<CHECKSUM >>           <<04103>>15502000
   ERR := 0;  <<REINITIALIZE>>                                 <<U.RAO>>15504000
   SEGMENTER(PIN,22,ERR,,,,,,,,,PROGNAME); <<CREATE SEGMENTER>><<00629>>15506000
   CHECKSEGERR;                                                <<U.RAO>>15508000
   SEGMENTER(PIN,14,ERR,STACKSIZE,DLSIZE,PFLAGS,MAXDATA,       <<00629>>15510000
      CAPWORD,PATCHSIZE,,,TFILENAME,RL);                       <<00629>>15512000
   CHECKSEGERR;                                                <<U.RAO>>15514000
   SEGMENTER(PIN,8,ERR);  <<EXIT>>                             <<U.RAO>>15516000
   IF PREPCOM THEN   <<JUST A PREPARE, EXIT>>                  <<U.RAO>>15518000
      BEGIN                                                    <<U.RAO>>15520000
      CISUBSYSFINISH(2, ERRNUM, PARMNUM);                      <<U.RAO>>15522000
      RETURN                                                   <<U.RAO>>15524000
      END;                                                     <<U.RAO>>15526000
                                                               <<U.RAO>>15528000
   <<NOW CLEAN UP AFTER SEGMENTER>>                            <<U.RAO>>15530000
   IF NOT CISUBSYSFINISH(2, ERRNUM, PARMNUM) THEN              <<U.RAO>>15532000
      RETURN;                                                  <<U.RAO>>15534000
   MOVE TFILENAME := "$OLD";                                   <<U.RAO>>15536000
   @PROGNAME := @TFILENAME;                                    <<U.RAO>>15538000
   END;  <<OF PREPARE PHASE>>                                  <<U.RAO>>15540000
                                                               <<U.RAO>>15542000
<<NOW DO RUN PHASE>>                                           <<U.RAO>>15544000
FLAGS := FLAGS LAND %117;  <<ELIMINATE PREP FLAGS>>            <<U.RAO>>15546000
IF LIB="P" THEN FLAGS.(11:1):=1                                <<U.RAO>>15548000
ELSE IF LIB="G" THEN FLAGS.(10:1):=1;                          <<U.RAO>>15550000
TOS := TOS+0;  <<CLEAR CARRY>>                                 <<U.RAO>>15552000
<< SET UP TO CREATE THE NEW PROCESS TO RUN THE PROGRAM >>      <<01200>>15554000
OPTNNUMS(0) := 1;   OPTNS(0) := @ENTRYNAME;                    <<01200>>15556000
OPTNNUMS(1) := 2;   OPTNS(1) := PARM;                          <<01200>>15558000
OPTNNUMS(2) := 3;   OPTNS(2) := FLAGS;                         <<01200>>15560000
X := 3;                                                        <<01200>>15562000
IF STACK'OPTION THEN                                           <<01200>>15564000
   BEGIN  << STACKSIZE WAS SPECIFIED >>                        <<01200>>15566000
   OPTNNUMS(X) := 4;   OPTNS(X) := STACKSIZE;                  <<01200>>15568000
   X := X + 1;                                                 <<01200>>15570000
   END;                                                        <<01200>>15572000
IF DL'OPTION THEN                                              <<01200>>15574000
   BEGIN  << DLSIZE WAS SPECIFIED >>                           <<01200>>15576000
   OPTNNUMS(X) := 5;   OPTNS(X) := DLSIZE;                     <<01200>>15578000
   X := X + 1;                                                 <<01200>>15580000
   END;                                                        <<01200>>15582000
IF MAXDATA'OPTION THEN                                         <<01200>>15584000
   BEGIN  << MAXDATA WAS SPECIFIED >>                          <<01200>>15586000
   OPTNNUMS(X) := 6;   OPTNS(X) := MAXDATA;                    <<01200>>15588000
   X := X + 1;                                                 <<01200>>15590000
   END;                                                        <<01200>>15592000
IF STDIN'OPTION THEN                                           <<01200>>15594000
   BEGIN  << STDIN WAS SPECIFIED >>                            <<01200>>15596000
   OPTNNUMS(X) := 8;   OPTNS(X) := @STDIN;                     <<01200>>15598000
   X := X + 1;                                                 <<01200>>15600000
   END;                                                        <<01200>>15602000
IF STDLIST'OPTION THEN                                         <<01200>>15604000
   BEGIN  << STDLIST WAS SPECIFIED >>                          <<01200>>15606000
   OPTNNUMS(X) := 9;   OPTNS(X) := @STDLIST;                   <<01200>>15608000
   X := X + 1;                                                 <<01200>>15610000
   END;                                                        <<01200>>15612000
IF STRING'OPTION THEN                                          <<01200>>15614000
   BEGIN  << A STRING TO PASS WAS SPECIFIED >>                 <<01200>>15616000
   OPTNNUMS(X) := 11;   OPTNS(X) := @STRING;                   <<01200>>15618000
   X := X + 1;                                                 <<01200>>15620000
   OPTNNUMS(X) := 12;   OPTNS(X) := T'IX;                      <<01200>>15622000
   X := X + 1;                                                 <<01200>>15624000
   END;                                                        <<01200>>15626000
OPTNNUMS(X) := 0;     << END OF OPTION LIST >>                 <<01200>>15628000
                                                               <<01200>>15630000
CREATEPROCESS (ERROR, PIN, PROGNAME, OPTNNUMS, OPTNS);         <<01200>>15632000
                                                               <<01452>>15634000
IF < THEN                                                      <<01452>>15636000
   BEGIN  << PROCESS CREATION FAILED - DETERMINE WHY >>        <<01452>>15638000
   IF ERROR = UNKNOWN'PROG THEN                                <<01452>>15640000
      BEGIN  << NON-EXISTENT PROGRAM FILE >>                   <<01452>>15642000
      QUALIFYFILENAME (PROGNAME, FULLFILENAME);                <<01452>>15644000
      ERRNUM := NOSUCHPROGFILE;                                <<01452>>15646000
      PARMNUM := 1;                                            <<01452>>15648000
      TOS := ERRNUM;                                           <<01452>>15650000
      TOS := IPARMS;                                           <<01452>>15652000
      CIERR (*, *, 0, @FULLFILENAME);                          <<01452>>15654000
      END                                                      <<01452>>15656000
   ELSE                                                        <<01452>>15658000
      IF NOT CREATEPROC'ERR( ERROR, ERRNUM )  THEN             <<01452>>15660000
         CIERR( ERRNUM := PRPRNNOLOAD );                       <<01452>>15662000
   END                                                         <<01452>>15664000
ELSE                                                           <<01452>>15666000
   BEGIN  << PROCESS CREATION SUCCEEDED >>                     <<01452>>15668000
                                                               <<01452>>15670000
   << CHECK FOR CREATEPROCESS WARNING. >>                      <<01452>>15672000
   IF > THEN CREATEPROC'ERR( -ERROR, ERRNUM );                 <<01452>>15674000
                                                               <<01452>>15676000
   NEXTLINE;                                                   <<01452>>15678000
   AWAKE (PIN * PCBSIZE, FATHERWAIT, SONWAIT);                 <<01452>>15680000
                                                               <<01452>>15682000
   CISUBSYSFINISH (1, ERRNUM, PARMNUM);                        <<01452>>15684000
   END;                                                        <<01452>>15686000
END;                                                           <<U.RAO>>15688000
$CONTROL SEGMENT = CISUBS                                      <<U.RAO>>15690000
      PROCEDURE CXSEGMENTER EXECUTORHEAD;                               15692000
      OPTION PRIVILEGED, UNCALLABLE;                                    15694000
      BEGIN                                                             15696000
      COMMENT                                                           15698000
      CXSEGMENTER IS THE EXECUTOR FOR THE SEGMENTER &EDITOR COMMANDS    15700000
      ;                                                                 15702000
      ENTRY CXEDITOR;                                                   15704000
      ENTRY CXVINIT;                                           <<RH.PV>>15706000
      BYTE ARRAY PROG(0:14),LISTFILE(0:7);                     <<U.RAO>>15708000
      LOGICAL PIN;                                             <<U.RAO>>15710000
      INTEGER NUMPARMS,FLAG:=0;                                <<U.RAO>>15712000
      DOUBLE DDL:=[8/";",8/",",8/%15,8/0]D;                    <<U.RAO>>15714000
      BYTE ARRAY DL(*)=DDL;                                    <<U.RAO>>15716000
      DOUBLE PARMS;                                            <<U.RAO>>15718000
      BYTE POINTER PPNTR=PARMS;                                <<U.RAO>>15720000
      BYTE SL=PARMS+1;                                         <<U.RAO>>15722000
      INTEGER PARMWORD2=PARMS+1;                               <<U.RAO>>15724000
      LOGICAL SEGFLAG := FALSE;                                <<U.RAO>>15726000
                                                               <<U.RAO>>15728000
      MOVE LISTFILE:="SEGLIST ";                               <<U.RAO>>15730000
      MOVE PROG:="SEGDVR.PUB.SYS ";                            <<U.RAO>>15732000
      SEGFLAG := TRUE;                                         <<U.RAO>>15734000
      GO TO PROCESS;                                           <<U.RAO>>15736000
CXVINIT:   <<PVINIT EXECUTOR>>                                 <<RH.PV>>15738000
      MOVE LISTFILE := "VINLIST ";                             <<RH.PV>>15740000
      MOVE PROG := "PVINIT.PUB.SYS ";                          <<RH.PV>>15742000
      GO TO PROCESS;                                           <<RH.PV>>15744000
CXEDITOR:                                                      <<U.RAO>>15746000
      MOVE LISTFILE:="EDTLIST ";                               <<U.RAO>>15748000
      MOVE PROG:="EDITOR.PUB.SYS ";                            <<U.RAO>>15750000
PROCESS:                                                       <<U.RAO>>15752000
      MYCOMMAND(PARMSP,DL,1,NUMPARMS,PARMS);<<CHECK COMMAND>>  <<U.RAO>>15754000
      IF <> THEN  <<BEGIN -- TOO MANY PARAMETERS>>             <<U.RAO>>15756000
         BEGIN                                                 <<U.RAO>>15758000
         ERRNUM := ERR2MPLISTONLY;  <<ONLY LIST FILE ALLOWED>> <<U.RAO>>15760000
         PARMNUM := 2;                                         <<U.RAO>>15762000
         TOS := ERRNUM;                                        <<U.RAO>>15764000
         TOS := @PPNTR(SL);  <<POINT TO DELIMITER>>            <<U.RAO>>15766000
         TOS := DL(PARMWORD2.(14:2));  <<GET DELIMITER>>       <<U.RAO>>15768000
         SCAN * UNTIL *,1;                                     <<U.RAO>>15770000
         TOS := TOS+1;                                         <<U.RAO>>15772000
         CIERR(*,*);                                           <<U.RAO>>15774000
         RETURN;                                               <<U.RAO>>15776000
         END;                                                  <<U.RAO>>15778000
      IF NUMPARMS <> 0 THEN                                    <<U.RAO>>15780000
         BEGIN<<PARAMETERS INPUTTED>>                          <<U.RAO>>15782000
         FLAG:=2;<<SET LISTFILE INDICATOR>>                    <<U.RAO>>15784000
         ERRNUM := CYIMPLCTFILE'(LISTFILE,PPNTR,SL);   <<ENTER <<U.RAO>>15786000
         IF <> THEN BEGIN PARMNUM:=1;RETURN END; <<FATAL ERROR<<U.RAO>> 15788000
         END;                                                  <<U.RAO>>15790000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>15792000
      TOS := TOS + 0;<<CLEAR CARRY>>                           <<U.RAO>>15794000
      CREATE(PROG,,PIN,FLAG,1); <<CREATE PROCESS>>             <<U.RAO>>15796000
      IF CARRY THEN                                            <<U.RAO>>15798000
         BEGIN                                                 <<U.RAO>>15800000
         DELIMPFILE(FLAG,LISTFILE); <<DELETE THE FILE>>        <<U.RAO>>15802000
         PROG(6) := 0;                                         <<U.RAO>>15804000
         IF CREATEERROR THEN                                   <<U.RAO>>15806000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@PROG)          <<U.RAO>>15808000
         ELSE                                                  <<U.RAO>>15810000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@PROG);           <<U.RAO>>15812000
         RETURN;                                               <<U.RAO>>15814000
         END;                                                  <<U.RAO>>15816000
      IF < THEN                                                <<U.RAO>>15818000
         BEGIN                                                 <<U.RAO>>15820000
         DELIMPFILE(FLAG,LISTFILE);  <<DELETE FILE>>           <<U.RAO>>15822000
         PROG(6) := 0;                                         <<U.RAO>>15824000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@PROG);               <<U.RAO>>15826000
         RETURN                                                <<U.RAO>>15828000
         END;                                                  <<U.RAO>>15830000
      AWAKE(PIN*PCBSIZE,1,2); <<START PROCESS >>               <<U.RAO>>15832000
      DELIMPFILE(FLAG,LISTFILE); <<DELETE THE FILE>>           <<U.RAO>>15834000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>15836000
      END ; <<CXSEGMENTER>>                                             15838000
                                                               <<01453>>15840000
PROCEDURE CXFCOPY EXECUTORHEAD;                                <<01453>>15842000
   OPTION PRIVILEGED, UNCALLABLE;                              <<01453>>15844000
                                                               <<01453>>15846000
<< This procedure creates the FCOPY "subsystem" and passes >>  <<01453>>15848000
<< any "INFO" specified with the FCOPY command with the    >>  <<01453>>15850000
<< INFO parameter in the CREATEPROCESS call.               >>  <<01453>>15852000
                                                               <<01453>>15854000
BEGIN                                                          <<01453>>15856000
                                                               <<01453>>15858000
   ARRAY NAME'(0:6);        << Holds name of process.      >>  <<01453>>15860000
   BYTE ARRAY NAME(*) = NAME';                                 <<01453>>15862000
   BYTE POINTER TEMPBP;                                        <<01453>>15864000
   INTEGER PIN,                                                <<01453>>15866000
           LEN,                                                <<01453>>15868000
           ERROR;                                              <<01453>>15870000
   ARRAY ITEMCODES(0:10);                                      <<01453>>15872000
   ARRAY ITEMS(0:10);                                          <<01453>>15874000
   DEFINE UNKNOWN'PROG'FILE = ( ERROR = 6 )#;                  <<01453>>15876000
                                                               <<01453>>15878000
   SCAN PARMSP WHILE %6440, 1;                                 <<01453>>15880000
   IF CARRY THEN   << Found nothing but blanks for parms.  >>  <<01453>>15882000
   BEGIN                                                       <<01453>>15884000
      LEN := 0;                                                <<01453>>15886000
      @TEMPBP := @PARMSP;                                      <<01453>>15888000
      DEL;                                                     <<01453>>15890000
   END                                                         <<01453>>15892000
   ELSE                                                        <<01453>>15894000
   BEGIN                                                       <<01453>>15896000
      @TEMPBP := TOS;                                          <<01453>>15898000
      SCAN TEMPBP UNTIL %15, 1;                                <<01453>>15900000
      LEN := TOS - @TEMPBP;                                    <<01453>>15902000
   END;                                                        <<01453>>15904000
   MOVE NAME := "FCOPY.PUB.SYS ";                              <<01453>>15906000
                                                               <<01453>>15908000
   MOVE ITEMCODES := (  3,   << FLAGS                      >>  <<01453>>15910000
                       11,   << INFO STRING ADDRESS.       >>  <<01453>>15912000
                       12,   << INFO STRING LENGTH.        >>  <<01453>>15914000
                        0  );                                  <<01453>>15916000
                                                               <<01453>>15918000
   ITEMS    := 1;                                              <<01453>>15920000
   ITEMS(1) := @TEMPBP;                                        <<01453>>15922000
   ITEMS(2) := LEN;                                            <<01453>>15924000
   ITEMS(3) := 0;                                              <<01453>>15926000
                                                               <<01453>>15928000
   SETJCW( GETJCW LAND %37777 );                               <<01453>>15930000
   CREATEPROCESS( ERROR, PIN, NAME, ITEMCODES, ITEMS );        <<01453>>15932000
   IF < THEN                                                   <<01453>>15934000
   BEGIN                                                       <<01453>>15936000
      NAME(5) := 0;                                            <<01453>>15938000
      IF UNKNOWN'PROG'FILE THEN                                <<01453>>15940000
         CIERR( ERRNUM := SUBSNOTFOUND, , 0, @NAME )           <<01453>>15942000
      ELSE                                                     <<01453>>15944000
      BEGIN                                                    <<01453>>15946000
         CREATEPROC'ERR( ERROR,ERRNUM );                       <<01453>>15948000
         CIERR( ERRNUM := SUBSNOTCREATE, , 0, @NAME );         <<01453>>15950000
      END;                                                     <<01453>>15952000
   END                                                         <<01453>>15954000
   ELSE                                                        <<01453>>15956000
   BEGIN                                                       <<01453>>15958000
      IF > THEN CREATEPROC'ERR( -ERROR, ERRNUM );              <<01453>>15960000
      AWAKE( PIN * PCBSIZE, 1, 2 );                            <<01453>>15962000
      CISUBSYSFINISH( 3, ERRNUM, PARMNUM );                    <<01453>>15964000
   END;                                                        <<01453>>15966000
                                                               <<01453>>15968000
                                                               <<01453>>15970000
END;  << CXFCOPY >>                                            <<01453>>15972000
                                                               <<01453>>15974000
                                                               <<01453>>15976000
PROCEDURE CXSPL EXECUTORHEAD;                                           15978000
   OPTION PRIVILEGED, UNCALLABLE;                                       15980000
BEGIN ENTRY CXSPLPREP, CXSPLGO;                                         15982000
      ENTRY CXFORTRAN, CXFORTPREP, CXFORTGO;                            15984000
      ENTRY CXCOBOL, CXCOBOLPREP, CXCOBOLGO;                            15986000
      ENTRY CXBASICOMP,CXBASICPREP,CXBASICGO;                           15988000
      ENTRY CXRPG,CXRPGPREP,CXRPGGO;                                    15990000
      ENTRY CXPASCAL,CXPASCALPREP,CXPASCALGO;                  <<02844>>15992000
      INTEGER WHICHFLG,X,NEXTDELIM,ERROR,                      <<02844>>15994000
              PARMLEN,STRINGLEN := 0;                          <<02844>>15996000
      EQUATE MAXSTRINGLEN = CIS'BCOMBUFLEN - 12,               << I.A >>15998000
             PKEYLISTL = 7,                                    <<02844>>16000000
             EQUALS = 1,                                       <<02844>>16002000
             CR = 3;                                           <<02844>>16004000
      DEFINE DELIMTYPE = (13:3)#,                              <<02844>>16006000
             UNKNOWN'PROG'FILE = (ERROR = 6)#;                 <<02844>>16008000
      LOGICAL PROGFLAG := FALSE;                                        16010000
      BYTE ARRAY SPLNAME(0:2) = PB := "SPL";                            16012000
      BYTE ARRAY FTNNAME(0:2) = PB := "FTN";                            16014000
      BYTE ARRAY COBNAME(0:2) = PB := "COB";                            16016000
      BYTE ARRAY BSCNAME(0:2) = PB := "BSC";                            16018000
      BYTE ARRAY RPGNAME(0:2) = PB := "RPG";                            16020000
      BYTE ARRAY PASCNAME(0:2) = PB := "PAS";                  <<02844>>16022000
      BYTE ARRAY TEXT(0:4) = PB := "TEXT ";                             16024000
      BYTE ARRAY LIST(0:4) = PB := "LIST ";                             16026000
      BYTE ARRAY USL(0:3) = PB := "USL ";                               16028000
      BYTE ARRAY PROG(0:35);                                  <<A01.01>>16030000
      BYTE ARRAY MAST(0:4) = PB := "MAST ";                             16032000
      BYTE ARRAY NEW(0:3)  = PB := "NEW ";                              16034000
      BYTE ARRAY SYSFILENAME(0:16);                                     16036000
      BYTE ARRAY BUILDNAME(0:8);                               <<02844>>16038000
      INTEGER NUMPARMS,MAXPARMS := 6;                          <<02844>>16040000
      INTEGER ARRAY OPTNUMS(0:12);                             <<02844>>16042000
      LOGICAL ARRAY OPTNS(0:12);                               <<02844>>16044000
      DOUBLE ARRAY PARMS(0:MAXSTRINGLEN);                      <<02844>>16046000
      LBPARMDECS;                                                       16048000
      LOGICAL COMCR := %26015;                                          16050000
      BYTE POINTER FNAME,SPTR,PARMPTR;                         <<02844>>16052000
      LOGICAL T2,T3;                                           <<U.RAO>>16054000
      LOGICAL PARM := 0;                                                16056000
      LOGICAL PIN,STOP,SCAN'STOP'TEST := %6400,INFO := FALSE;  <<02844>>16058000
      INTEGER PCNT := 0;                                                16060000
      SWITCH USLPROGLIST := US,PR,LT;                                   16062000
      BYTE ARRAY STRING(0:MAXSTRINGLEN - 1);                   << I.A >>16064000
      BYTE ARRAY SAVEDCOMIMAGE(0:CIS'BCOMBUFLEN - 1);          << I.A >>16066000
      BYTE ARRAY PKEYLIST(0:PKEYLISTL - 1) = PB :=             <<02844>>16068000
         6,4,"INFO",                                           <<02844>>16070000
         0;                                                    <<02844>>16072000
      BYTE ARRAY KEYLIST(0:PKEYLISTL - 1);                     <<02844>>16074000
DEFINE CHECKSEGERR =                                           <<U.RAO>>16076000
   IF <> AND (T2<>1) THEN   <<WARNING WAS PRINTED>>            <<U.RAO>>16078000
      BEGIN                                                    <<U.RAO>>16080000
      SEGMENTER(PIN,8,T3);  <<EXIT SEGMENTER>>                 <<U.RAO>>16082000
      PARMNUM := T2;                                           <<U.RAO>>16084000
      DELIMPFILE(PARM,BUILDNAME);                              <<U.RAO>>16086000
      CIERR(ERRNUM := SEGMENTERERROR);                         <<U.RAO>>16088000
      RETURN;                                                  <<U.RAO>>16090000
      END#;                                                    <<U.RAO>>16092000
                                                               <<U.RAO>>16094000
SUBROUTINE BLDIMPFILE;                                         <<U.RAO>>16096000
BEGIN                                                          <<U.RAO>>16098000
ERRNUM := CYIMPLCTFILE'(BUILDNAME,FNAME,T3);                   <<U.RAO>>16100000
IF <> THEN  <<ERROR OCCURRED>>                                 <<U.RAO>>16102000
   BEGIN                                                       <<U.RAO>>16104000
   DELIMPFILE(PARM,BUILDNAME);                                 <<U.RAO>>16106000
   PARMNUM := PCNT+1;                                          <<U.RAO>>16108000
   ASSEMBLE(EXIT 3);                                           <<U.RAO>>16110000
   END;                                                        <<U.RAO>>16112000
END;                                                           <<U.RAO>>16114000
SUBROUTINE GETNEXT;                                            <<02844>>16116000
<< Sets PARMPTR to current parameter, gets parameter length >> <<02844>>16118000
<< establishes the delimiter type, and advances parameter   >> <<02844>>16120000
<< count.                                                   >> <<02844>>16122000
   BEGIN                                                       <<02844>>16124000
   TOS := PARMS(PARMNUM);                                      <<02844>>16126000
   NEXTDELIM := S0.DELIMTYPE;                                  <<02844>>16128000
   PARMLEN := TOS&LSR(8);                                      <<02844>>16130000
   @PARMPTR := LOGICAL(TOS);                                   <<02844>>16132000
   PARMNUM := PARMNUM + 1;                                     <<02844>>16134000
   END; << GETNEXT >>                                          <<02844>>16136000
LOGICAL SUBROUTINE PROCINFO;                                   <<02844>>16138000
<< processing for the INFO parameter >>                                 16140000
   BEGIN                                                       <<02844>>16142000
   PROCINFO := FALSE;                                          <<02844>>16144000
   IF NEXTDELIM <> EQUALS THEN                                 <<02844>>16146000
      BEGIN                                                    <<02844>>16148000
      CIERR(ERRNUM := REQEQUALSIGN,PARMPTR);                   <<02844>>16150000
      RETURN;                                                  <<02844>>16152000
      END;                                                     <<02844>>16154000
   IF INFO THEN << specified more than once >>                 <<02844>>16156000
      CIERR(ERRNUM := -INFOOVERIDE,PARMPTR);                   <<02844>>16158000
   INFO := TRUE;                                               <<02844>>16160000
   STRINGLEN := 0;                                             <<02844>>16162000
   GETNEXT;                                                    <<02844>>16164000
   IF PARMPTR <> """" AND PARMPTR <> "'" THEN                  <<02844>>16166000
      BEGIN                                                    <<02844>>16168000
      CIERR(ERRNUM := EXPCTQUOTE,PARMPTR);                     <<02844>>16170000
      RETURN;                                                  <<02844>>16172000
      END;                                                     <<02844>>16174000
   SCAN'STOP'TEST.(8:8) := PARMPTR; << set up word for scan >> <<02844>>16176000
   << set up SPTR to point into the string copy, >>            <<02844>>16178000
   << because MYCOMMAND upshifts.                >>            <<02844>>16180000
   X := LOGICAL(@PARMPTR) - LOGICAL(@CIS'BCOMIMAGE) + 1;       << I.A >>16182000
   @SPTR := LOGICAL(@SAVEDCOMIMAGE(X));                        <<02844>>16184000
   STOP := FALSE;                                              <<02844>>16186000
   WHILE NOT STOP DO                                           <<02844>>16188000
      BEGIN                                                    <<02844>>16190000
      SCAN SPTR UNTIL SCAN'STOP'TEST,1;                        <<02844>>16192000
      IF CARRY THEN << missing closing quote, found CR >>      <<02844>>16194000
         BEGIN                                                 <<02844>>16196000
         X := TOS - LOGICAL(@SAVEDCOMIMAGE);                   <<02844>>16198000
         @PARMPTR := LOGICAL(@CIS'BCOMIMAGE(X));               << I.A >>16200000
         CIERR(ERRNUM := EXPCTCLOSEQUOTE,PARMPTR);             <<02844>>16202000
         STOP := TRUE;                                         <<02844>>16204000
         END                                                   <<02844>>16206000
      ELSE                                                     <<02844>>16208000
         BEGIN                                                 <<02844>>16210000
         X := LS0 - LOGICAL(@SPTR);                            <<02844>>16212000
         @SPTR := LOGICAL(TOS);                                <<02844>>16214000
         IF SPTR = SPTR(1) THEN << found double qoute >>       <<02844>>16216000
            BEGIN                                              <<02844>>16218000
            X := X + 1;                                        <<02844>>16220000
            @SPTR := LOGICAL(@SPTR) + 1;                       <<02844>>16222000
            END                                                <<02844>>16224000
         ELSE << found closing quote >>                        <<02844>>16226000
            STOP := TRUE;                                      <<02844>>16228000
         << move into STRING, note that if we had >>           <<02844>>16230000
         << a double qoute, one is moved in.      >>           <<02844>>16232000
         MOVE STRING(STRINGLEN) := SPTR(-X),(X);               <<02844>>16234000
         STRINGLEN := STRINGLEN + X;                           <<02844>>16236000
         << set SPTR to next character after    >>             <<02844>>16238000
         << quote or double quote.              >>             <<02844>>16240000
         @SPTR := LOGICAL(@SPTR) + 1;                          <<02844>>16242000
         END;                                                  <<02844>>16244000
      END; << WHILE LOOP >>                                    <<02844>>16246000
   << since string can contain delimiters and    >>            <<02844>>16248000
   << MYCOMMAND will parse them, advance PARMPTR >>            <<02844>>16250000
   << to the right place.                        >>            <<02844>>16252000
   X := STRINGLEN;                                             <<02844>>16254000
   WHILE (X := X - 1) >= 0 DO                                  <<02844>>16256000
      IF STRING(X) = ";" OR STRING(X) = "," OR                 <<02844>>16258000
         STRING(X) = "=" THEN                                  <<02844>>16260000
         GETNEXT;                                              <<02844>>16262000
   << check for extra chars. between closing qoute >>          <<02844>>16264000
   << and next delimiter which can be semi or cr.  >>          <<02844>>16266000
   IF ERRNUM <= 0 THEN                                         <<02844>>16268000
      BEGIN                                                    <<02844>>16270000
      SCAN SPTR WHILE %6440,1;                                 <<02844>>16272000
      IF CARRY THEN << FOUND CR >>                             <<02844>>16274000
         DEL                                                   <<02844>>16276000
      ELSE                                                     <<02844>>16278000
         BEGIN                                                 <<02844>>16280000
         IF BPS0 <> ";" THEN                                   <<02844>>16282000
            BEGIN                                              <<02844>>16284000
            X := TOS - LOGICAL(@SAVEDCOMIMAGE);                <<02844>>16286000
            @PARMPTR := LOGICAL(@CIS'BCOMIMAGE(X));            << I.A >>16288000
            CIERR(ERRNUM := XPCTSEMIORCR,PARMPTR);             <<02844>>16290000
            END                                                <<02844>>16292000
         ELSE                                                  <<02844>>16294000
            DEL;                                               <<02844>>16296000
         END;                                                  <<02844>>16298000
      END;                                                     <<02844>>16300000
   IF ERRNUM <= 0 THEN                                         <<02844>>16302000
      PROCINFO := TRUE;                                        <<02844>>16304000
   END; << PROCINFO >>                                         <<02844>>16306000
                                                               <<U.RAO>>16308000
      TOS := 0;                                                         16310000
      GO TO PRESPL;                                                     16312000
CXSPLPREP:                                                              16314000
      TOS := 1;                                                         16316000
      GO TO PRESPL;                                                     16318000
CXSPLGO:                                                                16320000
      TOS := 2;                                                         16322000
PRESPL:                                                                 16324000
      MOVE SYSFILENAME := "SPL.PUB.SYS ";                               16326000
      MOVE BUILDNAME := SPLNAME , (3);                                  16328000
      GO TO PROCESS;                                                    16330000
CXRPG:                                                                  16332000
      TOS:=0;                                                           16334000
      GO TO PRERPG;                                                     16336000
CXRPGPREP:                                                              16338000
      TOS:=1;                                                           16340000
      GO TO PRERPG;                                                     16342000
CXRPGGO:                                                                16344000
      TOS:=2;                                                           16346000
PRERPG:                                                                 16348000
      MOVE SYSFILENAME:="RPG.PUB.SYS ";                                 16350000
      MOVE BUILDNAME:=RPGNAME,(3);                                      16352000
      GO TO PROCESS;                                                    16354000
CXFORTRAN:                                                              16356000
      TOS := 0;                                                         16358000
      GO TO PREFORT;                                                    16360000
CXFORTPREP:                                                             16362000
      TOS := 1;                                                         16364000
      GO TO PREFORT;                                                    16366000
CXFORTGO:                                                               16368000
      TOS := 2;                                                         16370000
PREFORT:                                                                16372000
      MOVE SYSFILENAME := "FORTRAN.PUB.SYS ";                           16374000
      MOVE BUILDNAME := FTNNAME , (3);                                  16376000
      GO TO PROCESS;                                                    16378000
CXBASICOMP:                                                             16380000
      TOS:=0;                                                           16382000
      GO TO PREBSC;                                                     16384000
CXBASICPREP:                                                            16386000
      TOS:=1;                                                           16388000
      GO TO PREBSC;                                                     16390000
CXBASICGO:                                                              16392000
      TOS:=2;                                                           16394000
PREBSC:                                                                 16396000
      MOVE SYSFILENAME:="BASICOMP.PUB.SYS ";                            16398000
      MOVE BUILDNAME:=BSCNAME,(3);                                      16400000
      MAXPARMS := 4;  <<BASIC COMPILER HAS NO NEW OR MASTER>>  <<U.RAO>>16402000
      GO TO PROCESS;                                                    16404000
CXCOBOL:                                                                16406000
      TOS := 0;                                                         16408000
      GO TO PRECOB;                                                     16410000
CXCOBOLPREP:                                                            16412000
      TOS := 1;                                                         16414000
      GO TO PRECOB;                                                     16416000
CXCOBOLGO:                                                              16418000
      TOS := 2;                                                         16420000
PRECOB:                                                                 16422000
      MOVE SYSFILENAME := "COBOL.PUB.SYS ";                             16424000
      MOVE BUILDNAME := COBNAME , (3);                                  16426000
      GO TO PROCESS;                                           <<02844>>16428000
CXPASCAL:                                                      <<02844>>16430000
      TOS := 0;                                                <<02844>>16432000
      GO TO PREPASC;                                           <<02844>>16434000
CXPASCALPREP:                                                  <<02844>>16436000
      TOS := 1;                                                <<02844>>16438000
      GO TO PREPASC;                                           <<02844>>16440000
CXPASCALGO:                                                    <<02844>>16442000
      TOS := 2;                                                <<02844>>16444000
PREPASC:                                                       <<02844>>16446000
      MOVE SYSFILENAME := "PASCAL.PUB.SYS ";                   <<02844>>16448000
      MOVE BUILDNAME := PASCNAME,(3);                          <<02844>>16450000
      MAXPARMS := 4; << NO NEW, NO MASTER >>                   <<02844>>16452000
PROCESS:                                                                16454000
      WHICHFLG := TOS;                                                  16456000
      << check for parameters, semi marks start >>             <<02844>>16458000
      << keywords and positional parameters are >>             <<02844>>16460000
      << parsed separately.                     >>             <<02844>>16462000
      SCAN PARMSP UNTIL %6473,1; << cr,semicolon >>            <<02844>>16464000
      IF CARRY THEN                                            <<02844>>16466000
         DEL                                                   <<02844>>16468000
      ELSE                                                     <<02844>>16470000
         BEGIN << FOUND KEYWORD >>                             <<02844>>16472000
         BPS0 := %15;                                          <<02844>>16474000
         @SPTR := LOGICAL(TOS) + 1;                            <<02844>>16476000
         MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                 <<02844>>16478000
         << save string's original form >>                     <<02844>>16480000
         MOVE SAVEDCOMIMAGE := CIS'BCOMIMAGE,(CIS'BCOMBUFLEN); << I.A >>16482000
         MYCOMMAND(SPTR,,MAXSTRINGLEN + 1,NUMPARMS,PARMS);     <<02844>>16484000
         IF CARRY THEN << too many parameters in string >>     <<02844>>16486000
            BEGIN                                              <<02844>>16488000
            CIERR(ERRNUM := PARAMTOOBIG);                      <<02844>>16490000
            RETURN;                                            <<02844>>16492000
            END;                                               <<02844>>16494000
         IF NUMPARMS = 0 THEN                                  <<02844>>16496000
            CIERR(-EXTRNDELIMIGNRD,SPTR)                       <<02844>>16498000
         ELSE                                                  <<02844>>16500000
         DO << loop on keywords >>                             <<02844>>16502000
            BEGIN                                              <<02844>>16504000
            GETNEXT;                                           <<02844>>16506000
            IF PARMLEN = 0 THEN                                <<02844>>16508000
               CIERR(ERRNUM := -EXTRNDELIMIGNRD,PARMPTR)       <<02844>>16510000
            ELSE                                               <<02844>>16512000
               BEGIN                                           <<02844>>16514000
               TOS := SEARCH(PARMPTR,PARMLEN,KEYLIST);         <<02844>>16516000
               CASE *TOS OF                                    <<02844>>16518000
                  BEGIN                                        <<02844>>16520000
                  << 0 >> << NO SUCH KEYWORD >>                <<02844>>16522000
                  BEGIN                                        <<02844>>16524000
                  CIERR(ERRNUM := UNKNWNKWRD,PARMPTR);         <<02844>>16526000
                  RETURN;                                      <<02844>>16528000
                  END;                                         <<02844>>16530000
                  << 1 >> << INFO >>                           <<02844>>16532000
                  IF NOT PROCINFO THEN                         <<02844>>16534000
                     RETURN;                                   <<02844>>16536000
                  END; << CASE >>                              <<02844>>16538000
               END;                                            <<02844>>16540000
            END                                                <<02844>>16542000
         UNTIL NEXTDELIM = CR                                  <<02844>>16544000
         END;                                                  <<02844>>16546000
      T3 := 1;                                                          16548000
      IF WHICHFLG=2 THEN MAXPARMS := MAXPARMS-1; <<XXXGO>>     <<U.RAO>>16550000
      MYCOMMAND(PARMSP,COMCR,MAXPARMS,NUMPARMS,PARMS);                  16552000
      IF NUMPARMS = MAXPARMS THEN   <<TOO MANY PARAMETERS>>    <<U.RAO>>16554000
         BEGIN                                                 <<U.RAO>>16556000
         PARMNUM := MAXPARMS;                                  <<U.RAO>>16558000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>16560000
         TOS := PARMS(MAXPARMS-1);                             <<U.RAO>>16562000
         DEL;                                                  <<U.RAO>>16564000
         CIERR(*,*,%10000,MAXPARMS-1);                         <<U.RAO>>16566000
         RETURN;                                               <<U.RAO>>16568000
         END;                                                  <<U.RAO>>16570000
      IF NUMPARMS = 0 THEN GO TO DOIT;                                  16572000
      IF (T3 := BPARM(2)) = 0 THEN GO TO NEXT;                          16574000
      @FNAME := LPARM;                                                  16576000
      MOVE BUILDNAME(3) := TEXT , (5);                                  16578000
      BLDIMPFILE;                                              <<U.RAO>>16580000
      PARM := PARM + 1;                                                 16582000
NEXT:                                                                   16584000
      PCNT := PCNT + 1;                                                 16586000
      IF NUMPARMS = 1 THEN GO TO DOIT;                                  16588000
      IF (T3 := BPARM (6)) = 0 THEN                                     16590000
         IF WHICHFLG = 2 THEN GOTO NEXT2                                16592000
         ELSE GOTO NEXT1;                                               16594000
      @FNAME := LPARM(2);                                               16596000
      TOS := @BUILDNAME(3);                                             16598000
      GO TO USLPROGLIST(WHICHFLG);                                      16600000
US:   TOS := @USL;                                                      16602000
      PARM := PARM + 4;                                                 16604000
      TOS := 4;                                                         16606000
      GO TO PACK;                                                       16608000
PR:     <<PROGRAM FILE NAME>>                                 <<A01.01>>16610000
      IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN                   <<U.RAO>>16612000
         BEGIN  <<PROGFILE NAME IS BAD>>                       <<U.RAO>>16614000
         PARMNUM := 2;                                         <<U.RAO>>16616000
         RETURN                                                <<U.RAO>>16618000
         END;                                                  <<U.RAO>>16620000
      PROG := " ";                                            <<A01.01>>16622000
      MOVE PROG(1) := PROG,(35);                              <<A01.01>>16624000
      TOS := @PROG;                                           <<A01.01>>16626000
      TOS := PARMS(1)&LSR(8);  <<STACK ADDRESS AND LENGTH>>   <<A01.01>>16628000
      MOVE * := *,(TOS);                                      <<A01.01>>16630000
      PROGFLAG := TRUE;                                                 16632000
      GOTO NEXT1;                                                       16634000
PACK:                                                                   16636000
      ASSEMBLE(MVB PB);                                                 16638000
      BLDIMPFILE;                                              <<U.RAO>>16640000
NEXT1:                                                                  16642000
      PCNT := PCNT + 1;                                                 16644000
      IF NUMPARMS = 2 THEN GO TO DOIT;                                  16646000
      IF (T3 := BPARM(10)) = 0 THEN GO TO NEXT2;                        16648000
      @FNAME := LPARM(4);                                               16650000
      TOS := @BUILDNAME(3);                                             16652000
LT:   TOS := @LIST;                                                     16654000
      TOS := 5;                                                         16656000
      ASSEMBLE(MVB PB);                                                 16658000
      BLDIMPFILE;                                              <<U.RAO>>16660000
      PARM := PARM + 2;                                                 16662000
NEXT2:                                                                  16664000
      PCNT := PCNT + 1;                                                 16666000
      IF NUMPARMS = PCNT THEN GO TO DOIT;                               16668000
      IF (T3 := BPARM(4*PCNT + 2))= 0 THEN GO TO NEXT3;                 16670000
      @FNAME := LPARM(2*PCNT);                                          16672000
      MOVE BUILDNAME(3) := MAST ,(5);                                   16674000
      BLDIMPFILE;                                              <<U.RAO>>16676000
      PARM := PARM LOR %10;                                             16678000
NEXT3:                                                                  16680000
      PCNT := PCNT + 1;                                                 16682000
      IF NUMPARMS = PCNT THEN GO TO DOIT;                               16684000
      IF (T3 := BPARM(4*PCNT+2)) = 0 THEN GO TO DOIT;          <<U.RAO>>16686000
      @FNAME := LPARM(2*PCNT);                                          16688000
      MOVE BUILDNAME(3) := NEW , (4);                                   16690000
      BLDIMPFILE;                                              <<U.RAO>>16692000
      PARM := PARM LOR %20;                                             16694000
DOIT:                                                                   16696000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>16698000
      OPTNUMS(0) := 3; OPTNS(0) := 1; << FLAGS >>              <<02844>>16700000
      OPTNUMS(1) := 2; OPTNS(1) := PARM; << PARM WORD >>       <<02844>>16702000
      X := 1;                                                  <<02844>>16704000
      IF INFO THEN                                             <<02844>>16706000
         BEGIN                                                 <<02844>>16708000
         OPTNUMS(X := X + 1) := 11;                            <<02844>>16710000
         OPTNS(X) := @STRING;                                  <<02844>>16712000
         OPTNUMS(X := X + 1) := 12;                            <<02844>>16714000
         OPTNS(X) := STRINGLEN;                                <<02844>>16716000
         END;                                                  <<02844>>16718000
      OPTNUMS(X := X + 1) := 0;                                <<02844>>16720000
      OPTNS(X) := 0;                                           <<02844>>16722000
      CREATEPROCESS(ERROR,PIN,SYSFILENAME,OPTNUMS,OPTNS);      <<02844>>16724000
      IF < THEN                                                <<02844>>16726000
      BEGIN                                                    <<U.RAO>>16728000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>16730000
         SCAN SYSFILENAME UNTIL "..",1;                        <<U.RAO>>16732000
         BPS0 := 0;                                            <<U.RAO>>16734000
         DEL;                                                  <<U.RAO>>16736000
         IF UNKNOWN'PROG'FILE THEN                             <<02844>>16738000
            CIERR(ERRNUM :=SUBSNOTFOUND,,0,@SYSFILENAME)       <<02844>>16740000
         ELSE                                                  <<02844>>16742000
            BEGIN                                              <<02844>>16744000
            CREATEPROC'ERR(ERROR,ERRNUM);                      <<02844>>16746000
            CIERR(ERRNUM := SUBSNOTCREATE,,0,@SYSFILENAME);    <<02844>>16748000
            END;                                               <<02844>>16750000
         RETURN;                                               <<U.RAO>>16752000
      END;                                                              16754000
      IF > THEN                                                <<02844>>16756000
         CREATEPROC'ERR(-ERROR,ERRNUM);                        <<02844>>16758000
      NEXTLINE;                                                         16760000
      AWAKE(PIN*PCBSIZE,1,2);                                           16762000
      IF WHICHFLG = 0 THEN                                              16764000
         BEGIN    <<JUST COMPILE>>                                      16766000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>16768000
         CISUBSYSFINISH(4, ERRNUM, PARMNUM);                   <<U.RAO>>16770000
         RETURN;                                               <<U.RAO>>16772000
         END;                                                           16774000
      IF NOT CISUBSYSFINISH(4, ERRNUM, PARMNUM) THEN           <<U.RAO>>16776000
         BEGIN    <<ERROR IN COMPILE OF MULTI-STEP>>                    16778000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>16780000
         CIERR(ERRNUM := COMPFAILEDNOPRP);                     <<U.RAO>>16782000
         RETURN;                                               <<U.RAO>>16784000
         END;                                                           16786000
      PIN := 0;                                                         16788000
      MOVE SYSFILENAME := "$OLDPASS ";                                  16790000
      SEGMENTER(PIN,22,T2,,,,,,,,,SYSFILENAME);                <<00629>>16792000
      CHECKSEGERR;                                             <<U.RAO>>16794000
      IF (WHICHFLG = 2)  OR NOT (PROGFLAG)  THEN                        16796000
         MOVE PROG := "$NEWPASS ";                                      16798000
      SEGMENTER (PIN, 14, T2, -1, -1, 0, -1, 0, -1, , , PROG); <<00629>>16800000
      CHECKSEGERR;                                             <<U.RAO>>16802000
      SEGMENTER (PIN, 8, T2);                                           16804000
      DELIMPFILE(PARM,BUILDNAME);                              <<U.RAO>>16806000
      IF WHICHFLG = 1 THEN   <<JUST COMPILE & PREP>>           <<U.RAO>>16808000
         BEGIN                                                 <<U.RAO>>16810000
         CISUBSYSFINISH(2, ERRNUM, PARMNUM);                   <<U.RAO>>16812000
         RETURN                                                <<U.RAO>>16814000
         END;                                                  <<U.RAO>>16816000
      IF NOT CISUBSYSFINISH(2, ERRNUM, PARMNUM) THEN           <<U.RAO>>16818000
         BEGIN                                                 <<U.RAO>>16820000
         CIERR(ERRNUM := PREPFAILEDNORUN);                     <<U.RAO>>16822000
         RETURN;                                               <<U.RAO>>16824000
         END;                                                  <<U.RAO>>16826000
      TOS := TOS + 0;            <<CLEAR CARRY>>                        16828000
      CREATE(SYSFILENAME,,PIN,,1);                                      16830000
      IF CARRY THEN   <<CREATE FAILED>>                        <<U.RAO>>16832000
         BEGIN                                                 <<U.RAO>>16834000
         IF CREATEERROR THEN                                   <<U.RAO>>16836000
            CIERR(ERRNUM := COMPILEDCREATE)                    <<U.RAO>>16838000
         ELSE                                                  <<U.RAO>>16840000
            CIERR(ERRNUM := COMPILEDLOAD);                     <<U.RAO>>16842000
         RETURN                                                <<U.RAO>>16844000
         END;                                                  <<U.RAO>>16846000
      IF < THEN                                                <<U.RAO>>16848000
         BEGIN                                                 <<U.RAO>>16850000
         CIERR(ERRNUM := INVALIDPROGFILE);                     <<U.RAO>>16852000
         RETURN                                                <<U.RAO>>16854000
         END;                                                  <<U.RAO>>16856000
      IF > THEN CIERR(ERRNUM := -DEFVAL);                      <<04785>>16858000
      NEXTLINE;                                                         16860000
      AWAKE(PIN*PCBSIZE,1,2);                                           16862000
      CISUBSYSFINISH(1, ERRNUM, PARMNUM);                      <<U.RAO>>16864000
END;  <<CXSPL ET AL>>                                          <<U.RAO>>16866000
PROCEDURE CXBASIC EXECUTORHEAD;                                         16868000
   OPTION PRIVILEGED, UNCALLABLE;                                       16870000
BEGIN LOGICAL X1 := %26015;                                             16872000
      INTEGER NUMPARMS;                                                 16874000
      DOUBLE ARRAY PARMS(0:3);                                 <<U.RAO>>16876000
      LBPARMDECS;                                                       16878000
      BYTE ARRAY BASINPT(0:6) = PB := "BASIN ";                         16880000
      BYTE ARRAY BLIST(0:7) = PB := "BASLIST ";                         16882000
      BYTE ARRAY BCOM (0:6) = PB := "BASCOM ";                          16884000
      BYTE ARRAY FNAME(0:7);                                            16886000
      BYTE POINTER FREF;                                                16888000
      LOGICAL T3;                                              <<U.RAO>>16890000
      LOGICAL PIN , PARM := 0;                                          16892000
      BYTE ARRAY SYSFILENAME(0:14);                                     16894000
      BYTE BLANK := " ";                                                16896000
      INTEGER PCNT := 1;                                                16898000
SUBROUTINE CLEANUP;                                                     16900000
BEGIN                                                                   16902000
      TOS := PARM;                                                      16904000
      IF < THEN                                                         16906000
      BEGIN MOVE FNAME := BCOM , (7);                                   16908000
            XREMJTENTRY(FNAME,BLANK,BLANK,3)                            16910000
      END;                                                              16912000
      ASSEMBLE(TBC 1);                                                  16914000
      IF <> THEN                                                        16916000
      BEGIN MOVE FNAME := BASINPT , (7);                                16918000
            XREMJTENTRY(FNAME,BLANK,BLANK,3)                            16920000
      END;                                                              16922000
      DELIMPFILE(*,FNAME);                                              16924000
END;                                                                    16926000
                                                               <<U.RAO>>16928000
SUBROUTINE BLDIMPFILE;                                         <<U.RAO>>16930000
BEGIN                                                          <<U.RAO>>16932000
ERRNUM := CYIMPLCTFILE'(FNAME,FREF,T3);                        <<U.RAO>>16934000
IF <> THEN  <<ERROR OCCURRED>>                                 <<U.RAO>>16936000
   BEGIN                                                       <<U.RAO>>16938000
   CLEANUP;                                                    <<U.RAO>>16940000
   PARMNUM := PCNT;                                            <<U.RAO>>16942000
   ASSEMBLE(EXIT 3);                                           <<U.RAO>>16944000
   END;                                                        <<U.RAO>>16946000
END;                                                           <<U.RAO>>16948000
                                                               <<U.RAO>>16950000
      MOVE SYSFILENAME := "BASIC.PUB.SYS ";                             16952000
      T3 := 1;                                                          16954000
      MYCOMMAND(PARMSP,X1,4,NUMPARMS,PARMS);                   <<U.RAO>>16956000
      IF NUMPARMS >= 4 THEN  <<T00 MANY PARAMETERS>>           <<U.RAO>>16958000
         BEGIN                                                 <<U.RAO>>16960000
         PARMNUM := 4;                                         <<U.RAO>>16962000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>16964000
         TOS := LPARM(6);                                      <<U.RAO>>16966000
         CIERR(*,*,%10000,3);                                  <<U.RAO>>16968000
         RETURN;                                               <<U.RAO>>16970000
         END;                                                  <<U.RAO>>16972000
      IF NUMPARMS = 0 THEN GO TO DOIT;                                  16974000
      IF (T3 := BPARM(2)) = 0 THEN GO TO TFILE;                         16976000
      MOVE FNAME := BCOM , (7);                                         16978000
      @FREF := LPARM;                                                   16980000
      BLDIMPFILE;                                              <<U.RAO>>16982000
      PARM.(0:1) := 1;   <<COMMAND FILE PRESENT>>              <<U.RAO>>16984000
TFILE:                                                                  16986000
      IF NUMPARMS = 1 THEN GO TO DOIT;                                  16988000
      PCNT := PCNT + 1;                                                 16990000
      IF (T3 := BPARM(6)) = 0 THEN GO TO LFILE;                         16992000
      MOVE FNAME := BASINPT , (7);                                      16994000
      @FREF := LPARM(2);                                                16996000
      BLDIMPFILE;                                              <<U.RAO>>16998000
      PARM.(1:1) := 1;  <<BASIC INPUT FILE PRESENT>>           <<U.RAO>>17000000
LFILE:                                                                  17002000
      IF NUMPARMS = 2 THEN GO TO DOIT;                                  17004000
      PCNT := PCNT + 1;                                                 17006000
      IF (T3 := BPARM(10)) = 0 THEN GO TO DOIT;                <<U.RAO>>17008000
      MOVE FNAME := BLIST , (8);                                        17010000
      @FREF := LPARM(4);                                                17012000
      BLDIMPFILE;                                              <<U.RAO>>17014000
      PARM := PARM + 2;                                                 17016000
DOIT:                                                                   17018000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>17020000
      TOS := TOS + 0;            <<CLEAR CARRY>>                        17022000
      CREATE(SYSFILENAME,,PIN,PARM,1);                                  17024000
      IF CARRY THEN                                                     17026000
      BEGIN CLEANUP;                                                    17028000
            IF CREATEERROR THEN                                <<U.RAO>>17030000
               CIERR(ERRNUM := BASICCREATEERR)                 <<U.RAO>>17032000
            ELSE                                               <<U.RAO>>17034000
               CIERR(ERRNUM := BASICLOADERR);                  <<U.RAO>>17036000
            RETURN;                                            <<U.RAO>>17038000
      END;                                                              17040000
      IF < THEN                                                         17042000
      BEGIN CLEANUP;                                                    17044000
         SYSFILENAME(5) := 0;                                  <<U.RAO>>17046000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@SYSFILENAME);        <<U.RAO>>17048000
         RETURN;                                               <<U.RAO>>17050000
      END;                                                              17052000
      NEXTLINE;                                                         17054000
      AWAKE(PIN*PCBSIZE,1,2);                                           17056000
                                                                        17058000
      CLEANUP;                                                          17060000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>17062000
END;  <<CXBASIC>>                                              <<U.RAO>>17064000
$CONTROL SEGMENT = CIPREPRUN                                   <<U.RAO>>17066000
PROCEDURE CXAPL EXECUTORHEAD;                                 <<A00.04>>17068000
   OPTION PRIVILEGED, UNCALLABLE;                             <<A00.04>>17070000
BEGIN                                                         <<A00.04>>17072000
BYTE ARRAY SYSFILENAME(0:11);                                 <<A00.04>>17074000
DOUBLE ARRAY PARMS(0:1) = Q;  <<FOR MYCOMMAND RESULTS>>        <<02.RO>>17076000
BYTE POINTER APLWSFNAME = PARMS;  <<NAME OF WORKSPACE>>        <<02.RO>>17078000
BYTE WSFNAMELEN = PARMS+1;                                     <<02.RO>>17080000
BYTE POINTER EXTRAPARM = PARMS+2; <<EXTRANEOUS PARM>>          <<02.RO>>17082000
INTEGER NUMPARMS;                                              <<02.RO>>17084000
LOGICAL PIN;  <<PIN OF CREATED APL PROCESS>>                   <<02.RO>>17086000
BYTE ARRAY FORMALDES(0:5);  << "APLWS ">>                      <<02.RO>>17088000
                                                               <<02.RO>>17090000
MYCOMMAND(PARMSP, , 2, NUMPARMS, PARMS);                       <<02.RO>>17092000
IF NUMPARMS >= 2 THEN  <<TOO MANY PARMS>>                      <<02.RO>>17094000
   BEGIN                                                       <<02.RO>>17096000
   PARMNUM := 2;                                               <<02.RO>>17098000
   CIERR(ERRNUM := APLXPCTJUSTWS, EXTRAPARM);                  <<02.RO>>17100000
   END                                                         <<02.RO>>17102000
ELSE   <<LEGAL NUMBER OF PARMS>>                               <<02.RO>>17104000
   BEGIN                                                       <<02.RO>>17106000
   IF NUMPARMS = 1 THEN  <<SET UP FILE EQUATE>>                <<02.RO>>17108000
      BEGIN                                                    <<02.RO>>17110000
      PARMNUM.(7:1) := 1;  <<SET FLAG FOR APL>>                <<02.RO>>17112000
      MOVE FORMALDES := "APLWS ";                              <<02.RO>>17114000
      ERRNUM := CYIMPLCTFILE'(FORMALDES, APLWSFNAME,           <<02.RO>>17116000
                    WSFNAMELEN);  <<DO EQUATE>>                <<02.RO>>17118000
      IF <> THEN PARMNUM := 1;  <<NAME PROBLEM>>               <<02.RO>>17120000
      END;  <<HANDLING OF FILE NAME, IF ANY>>                  <<02.RO>>17122000
   IF ERRNUM = 0 THEN  <<GOOD SO FAR, TRY LAUNCH>>            <<02.RO>>17124000
      BEGIN                                                    <<02.RO>>17126000
      MOVE SYSFILENAME := "APL.PUB.SYS ";                      <<02.RO>>17128000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>17130000
      CREATE(SYSFILENAME, , PIN, PARMNUM, 1);                  <<02.RO>>17132000
      IF CARRY THEN   <<CREATE FAILED>>                        <<02.RO>>17134000
         BEGIN                                                 <<02.RO>>17136000
         SYSFILENAME(3) := 0;                                  <<02.RO>>17138000
         IF CREATEERROR THEN                                   <<02.RO>>17140000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)   <<02.RO>>17142000
         ELSE   <<LOADER ERROR>>                               <<02.RO>>17144000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);    <<02.RO>>17146000
         END                                                   <<02.RO>>17148000
      ELSE IF < THEN  <<APL.PUB.SYS NOT FOUND>>                <<02.RO>>17150000
         BEGIN                                                 <<02.RO>>17152000
         SYSFILENAME(3) := 0;                                  <<02.RO>>17154000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@SYSFILENAME);        <<02.RO>>17156000
         END                                                   <<02.RO>>17158000
      ELSE   <<CREATE WENT F	INE>>                             <<02.RO>>17160000
         BEGIN                                                 <<02.RO>>17162000
         AWAKE(PIN*PCBSIZE, 1, 2);  <<FIRE UP SUBSYSTEM>>      <<02.RO>>17164000
         CISUBSYSFINISH(0, ERRNUM, PARMNUM);                   <<02.RO>>17166000
         END;                                                  <<02.RO>>17168000
      END;                                                     <<02.RO>>17170000
   END;                                                        <<02.RO>>17172000
END;   <<CXAPL>>                                               <<02.RO>>17174000
PROCEDURE APLTRANSLATEOUT(MESSAGE,LENGTH,TRANSTYPE);          <<A00.04>>17176000
  VALUE LENGTH,TRANSTYPE;                                     <<A00.04>>17178000
  INTEGER LENGTH,TRANSTYPE;                                   <<A00.04>>17180000
  BYTE ARRAY MESSAGE;                                         <<A00.04>>17182000
  <<TRANSTYPE = 2 => APL-ASCII BIT PAIRING CODES                        17184000
    TRANSTYPE = 3 => APL-ASCII TYPEWRITER PAIRING CODES                 17186000
                                                                        17188000
    LENGTH IS THE LENGTH IN BYTES OF ARRAY MESSAGE                      17190000
    MESSAGE IS A BYTE ARRAY CONTAINING THE MESSAGE TO BE TRANSLATED.    17192000
       THIS ARRAY WILL BE ENTIRELY CONVERTED.                           17194000
>>                                                            <<A00.04>>17196000
BEGIN                                                         <<A00.04>>17198000
ENTRY APLTRANSLATEIN;  <<ENTRY POINT FOR EXTERNAL TO INTERNAL><<A00.04>>17200000
EQUATE FIRSTCHAR = %41,  <<ALL PRECEEDING CHARS ARE THE SAME>><<A00.04>>17202000
       LASTCHAR = %176,                                       <<A00.04>>17204000
       NUMCHARS = LASTCHAR-FIRSTCHAR+1;  <<94 IN THIS INSTANCE<<A00.04>>17206000
BYTE ARRAY TRANSARRAY(FIRSTCHAR:LASTCHAR);  <<HOLDS TRANS CODE<<A00.04>>17208000
BYTE ARRAY BITPAIROUT(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY><<A00.04>>17210000
   %131, %41, " ",%174, " ",%120,%113,                        <<A00.04>>17212000
    %53, %52,%120, %55, ",", %75, ".", "/",                   <<A00.04>>17214000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>17216000
    "8", "9", %76, %74, %43, %45, %47,%121,                   <<A00.04>>17218000
   %101, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>17220000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>17222000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>17224000
    "x", "y", "z", %73, %77, %72,%137,%106,                   <<A00.04>>17226000
   %113, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>17228000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>17230000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>17232000
    "x", "y", "z",%135,%115, "}",%124;                        <<A00.04>>17234000
BYTE ARRAY TYPEWRITEROUT(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>      17236000
   %131, %41, " ",%176, " ",%120,%113,                        <<A00.04>>17238000
    %72, %42,%120, %55, ",",%137, ".", "/",                   <<A00.04>>17240000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>17242000
    "8", "9", %76, %74, %43, %45, %46,%121,                   <<A00.04>>17244000
   %101, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>17246000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>17248000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>17250000
    "x", "y", "z", %73, %77, %47, %51,%106,                   <<A00.04>>17252000
   %113, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>17254000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>17256000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>17258000
    "x", "y", "z", "{",%115, "}",%124;                        <<A00.04>>17260000
BYTE ARRAY BITPAIRIN(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>          17262000
    %42, %42, "<", %44, "=", %46, ">",                        <<A00.04>>17264000
    %50, %51, ")", "(", ",", "+", ".", "/",                   <<A00.04>>17266000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>17268000
    "8", "9", "]", "[", ";", "-", ":", "\",                   <<A00.04>>17270000
    "_", "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>17272000
    "H", "I", "J", "'", "L",%174, "N", "O",                   <<A00.04>>17274000
    "*", "?", "R", "S", %176, "U", "V", "W",                  <<A00.04>>17276000
    "X", "^", "Z",%133,%134,%173,%136,%137,                   <<A00.04>>17278000
   %140, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>17280000
    "H", "I", "J", "K", "L", "M", "N", "O",                   <<A00.04>>17282000
    "P", "Q", "R", "S", "T", "U", "V", "W",                   <<A00.04>>17284000
    "X", "Y", "Z",%173, "$",%175,%176;                        <<A00.04>>17286000
BYTE ARRAY TYPEWRITERIN(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>       17288000
    %42, ")", "<", %44, "=", ">", "]",                        <<A00.04>>17290000
    %50, %51, %52, %53, ",", "+", ".", "/",                   <<A00.04>>17292000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>17294000
    "8", "9", "(", "[", ";", %75, ":", "\",                   <<A00.04>>17296000
   %100, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>17298000
    "H", "I", "J", "'", "L",%174, "N", "O",                   <<A00.04>>17300000
    "*", "?", "R", "S", %176, "U", "V", "W",                  <<A00.04>>17302000
    "X", "^", "Z", "_",%134,%135,%136, "-",                   <<A00.04>>17304000
   %140, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>17306000
    "H", "I", "J", "K", "L", "M", "N", "O",                   <<A00.04>>17308000
    "P", "Q", "R", "S", "T", "U", "V", "W",                   <<A00.04>>17310000
    "X", "Y", "Z",%173,%174,%175, "$";                        <<A00.04>>17312000
IF NOT(2<=TRANSTYPE<=3) THEN RETURN;                          <<A00.04>>17314000
TRANSTYPE := TRANSTYPE-2;                                     <<A00.04>>17316000
GO TO DOIT;                                                   <<A00.04>>17318000
APLTRANSLATEIN:                                               <<A00.04>>17320000
  IF NOT(2<=TRANSTYPE<=3) THEN RETURN;                        <<A00.04>>17322000
DOIT:                                                         <<A00.04>>17324000
  CASE TRANSTYPE OF                                           <<A00.04>>17326000
    BEGIN                                                     <<A00.04>>17328000
    MOVE TRANSARRAY(FIRSTCHAR):=BITPAIROUT,(NUMCHARS);        <<A00.04>>17330000
    MOVE TRANSARRAY(FIRSTCHAR):=TYPEWRITEROUT,(NUMCHARS);     <<A00.04>>17332000
    MOVE TRANSARRAY(FIRSTCHAR):=BITPAIRIN,(NUMCHARS);         <<A00.04>>17334000
    MOVE TRANSARRAY(FIRSTCHAR):=TYPEWRITERIN,(NUMCHARS);      <<A00.04>>17336000
    END;                                                      <<A00.04>>17338000
WHILE (LENGTH:=LENGTH-1) >= 0 DO  <<WORK FROM END TO BEGINNING>>        17340000
   IF FIRSTCHAR<=INTEGER(MESSAGE(LENGTH))<=LASTCHAR THEN  <<IN RANGE>>  17342000
      MESSAGE(LENGTH):=TRANSARRAY(INTEGER(MESSAGE(LENGTH)));  <<A00.04>>17344000
END;                                                          <<A00.04>>17346000
PROCEDURE CXMRJE EXECUTORHEAD;                                <<<<MRJE>>17348000
   OPTION PRIVILEGED,UNCALLABLE;                              <<<<MRJE>>17350000
BEGIN                                                         <<<<MRJE>>17352000
BYTE ARRAY SYSFILENAME(0:13);                                  <<03058>>17354000
DOUBLE PARMS;  <<DUMMY FOR ERRORS FOUND BY MYCOMMAND>>        <<<<MRJE>>17356000
BYTE POINTER BPARM = PARMS;   <<POINTER FOR ERROR>>             <<MRJE>>17358000
INTEGER NUMPARMS;  <<LIKEWISE>>                               <<<<MRJE>>17360000
LOGICAL PIN;  <<PIN FROM CREATE OF MRJE SUBSYS>>              <<<<MRJE>>17362000
MOVE SYSFILENAME:="MRJE.PUB.SYS ";                            <<<<MRJE>>17364000
MYCOMMAND(PARMSP,,1,NUMPARMS,PARMS);  <<CHECK FOR PARMS>>     <<<<MRJE>>17366000
IF NUMPARMS > 0 THEN   <<EXTRANEOUS PARAMETER>>                 <<MRJE>>17368000
   CIERR(ERRNUM := -WARNXPARMSIGNORED, BPARM);                 <<04785>>17370000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>17372000
CREATE(SYSFILENAME,,PIN,PARMNUM,1);                           <<<<MRJE>>17374000
IF CARRY THEN   <<CREATE OF MRJE FAILED>>                       <<MRJE>>17376000
   BEGIN                                                        <<MRJE>>17378000
   SYSFILENAME(4) := 0;   <<FOR ERROR MESSAGE>>                 <<MRJE>>17380000
   IF CREATEERROR THEN                                          <<MRJE>>17382000
      CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)          <<MRJE>>17384000
   ELSE   <<LOAD FAILED>>                                       <<MRJE>>17386000
      CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);           <<MRJE>>17388000
   END                                                          <<MRJE>>17390000
ELSE IF < THEN   <<MRJE.PUB.SYS NOT FOUND>>                     <<MRJE>>17392000
   BEGIN                                                        <<MRJE>>17394000
   SYSFILENAME(4) := 0;   <<FOR ERROR MESSAGE>>                 <<MRJE>>17396000
   CIERR(ERRNUM := SUBSNOTFOUND, , 0,@SYSFILENAME);             <<MRJE>>17398000
   END                                                          <<MRJE>>17400000
ELSE   <<EVERYTHING OK, DO IT>>                                 <<MRJE>>17402000
   BEGIN                                                        <<MRJE>>17404000
   AWAKE(PIN*PCBSIZE,1,2);   <<FIRE UP SUBSYSTEM>>              <<MRJE>>17406000
   CISUBSYSFINISH(0, ERRNUM, PARMNUM);                          <<MRJE>>17408000
   END;                                                         <<MRJE>>17410000
END;   <<CXMRJE>>                                               <<MRJE>>17412000
PROCEDURE CX3270 EXECUTORHEAD;                                 <<00184>>17414000
   OPTION PRIVILEGED,UNCALLABLE;                               <<00184>>17416000
BEGIN                                                          <<00184>>17418000
<< Fire up the IML/3000 subsystem (also known in   >>          <<01165>>17420000
<< some circles as the IBM 3270).                  >>          <<01165>>17422000
<<                                                 >>          <<01165>>17424000
<< The IML subsystem can now be invoked via four  >>           <<02845>>17426000
<< commands, IML and IMF for regular use, and     >>           <<02845>>17428000
<< IMLMGR or IMFMGR for manager. The syntax was   >>           <<02845>>17430000
<< changed to include the FORMAT and PRIORITY key->>           <<02845>>17432000
<< words. The complete syntax is as follows:      >>           <<02845>>17434000
<<                                                >>           <<02845>>17436000
<< IMF [;][E[NHANCE] = 0|1|2|3] [;][B[LANKS]]     >>           <<02845>>17438000
<<     [;][F[ORMAT] = 1|2|3|4]                    >>           <<02845>>17440000
<<     [;][P[RIORITY] =1|2|3|4|5|6|7|8|9|11|12|13]>>           <<02845>>17442000
<<                                                >>           <<02845>>17444000
<<                                                >>           <<02845>>17446000
<<  The parameters may be in either sequence or    >>          <<01165>>17448000
<<  may be omitted entirely.                       >>          <<01165>>17450000
                                                               <<01165>>17452000
LOGICAL MANAGER;                                               <<00184>>17454000
BYTE ARRAY SYSFILENAME(0:17),ENTRYNAME(0:9);                   <<00184>>17456000
LOGICAL FLAG := 0,PROG'PARM := [4/0,3/2,1/0,4/8,4/0];          <<02845>>17458000
EQUATE                                                         <<02845>>17460000
   PKEYLISTL = 56,                                             <<02845>>17462000
   MAXPARMS = 7,                                               <<02845>>17464000
   EQUALS = 1,                                                 <<02845>>17466000
   SEMICOLON = 0,                                              <<02845>>17468000
   CR = 2;                                                     <<02845>>17470000
BYTE ARRAY PKEYLIST(0:PKEYLISTL - 1) = PB :=                   <<02845>>17472000
   10,7,"ENHANCE",0,                                           <<02845>>17474000
   9,6,"FORMAT",1,                                             <<02845>>17476000
   11,8,"PRIORITY",2,                                          <<02845>>17478000
   9,6,"BLANKS",3,                                             <<02845>>17480000
   4,1,"E",0,                                                  <<02845>>17482000
   4,1,"F",1,                                                  <<02845>>17484000
   4,1,"P",2,                                                  <<02845>>17486000
   4,1,"B",3,                                                  <<02845>>17488000
   0;                                                          <<02845>>17490000
BYTE ARRAY KEYLIST(0:PKEYLISTL - 1);                           <<02845>>17492000
DOUBLE DELIM := [8/";",8/"=",8/%15,8/0]D;                      <<02845>>17494000
BYTE ARRAY DELIMS(*) = DELIM;                                  <<02845>>17496000
INTEGER PARMLEN,NEXTDELIM,NUMPARMS,RESULT;                     <<02845>>17498000
DOUBLE ARRAY PARMS(0:MAXPARMS - 1);                            <<02845>>17500000
BYTE POINTER PARMPTR,DICTPTR;                                  <<02845>>17502000
DEFINE                                                         <<02845>>17504000
   ENHANCE = (12:4)#,                                          <<02845>>17506000
   FORMAT = (4:3)#,                                            <<02845>>17508000
   PRIORITY = (8:4)#,                                          <<02845>>17510000
   BLANKS = (7:1)#,                                            <<02845>>17512000
   ENH = (0:1)#,                                               <<02845>>17514000
   FMT = (1:1)#,                                               <<02845>>17516000
   PRI = (2:1)#,                                               <<02845>>17518000
   DELIMTYPE = (13:3)#;                                        <<02845>>17520000
                                                               <<01165>>17522000
LOGICAL PIN;  <<PIN FROM CREATE OF 3270 SUBSYS>>               <<00184>>17524000
ENTRY CX3270MGR;                                               <<01165>>17526000
                                                               <<00184>>17528000
                                                               <<01165>>17530000
SUBROUTINE GETNEXT;                                            <<02845>>17532000
<< Sets PARMPTR to appropriate parameter, gets parameter >>    <<02845>>17534000
<< length and delimiter type. Called upon advancing to   >>    <<02845>>17536000
<< next parameter.                                       >>    <<02845>>17538000
BEGIN                                                          <<02845>>17540000
   TOS := PARMS(PARMNUM);                                      <<02845>>17542000
   NEXTDELIM := S0.DELIMTYPE;                                  <<02845>>17544000
   PARMLEN := TOS&LSR(8);                                      <<02845>>17546000
   @PARMPTR := TOS;                                            <<02845>>17548000
   PARMNUM := PARMNUM + 1;                                     <<02845>>17550000
END; << SUBROUTINE GETNEXT >>                                  <<02845>>17552000
                                                               <<02845>>17554000
                                                               <<02845>>17556000
LOGICAL SUBROUTINE PROCENHANCE;                                <<02845>>17558000
BEGIN                                                          <<02845>>17560000
   PROCENHANCE := FALSE;                                       <<02845>>17562000
   IF FLAG.ENH THEN                                            <<02845>>17564000
      CIERR(ERRNUM := -REDNDENH,PARMPTR);                      <<02845>>17566000
   FLAG.ENH := TRUE;                                           <<02845>>17568000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>17570000
      BEGIN                                                    <<02845>>17572000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>17574000
         RETURN;                                               <<02845>>17576000
      END;                                                     <<02845>>17578000
   GETNEXT;                                                    <<02845>>17580000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>17582000
   IF <> OR NOT (0 <= RESULT <= 3) THEN                        <<02845>>17584000
      CIERR(ERRNUM := ILLVALENH,PARMPTR)                       <<02845>>17586000
   ELSE                                                        <<02845>>17588000
      BEGIN                                                    <<02845>>17590000
         PROG'PARM.ENHANCE := RESULT;                          <<02845>>17592000
         PROCENHANCE := TRUE;                                  <<02845>>17594000
      END;                                                     <<02845>>17596000
END; << SUBROUTINE PROCENHANCE >>                              <<02845>>17598000
                                                               <<02845>>17600000
                                                               <<02845>>17602000
LOGICAL SUBROUTINE PROCFORMAT;                                 <<02845>>17604000
BEGIN                                                          <<02845>>17606000
   PROCFORMAT := FALSE;                                        <<02845>>17608000
   IF FLAG.FMT THEN                                            <<02845>>17610000
      CIERR(ERRNUM := -REDNDFMT,PARMPTR);                      <<02845>>17612000
   FLAG.FMT := TRUE;                                           <<02845>>17614000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>17616000
      BEGIN                                                    <<02845>>17618000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>17620000
         RETURN;                                               <<02845>>17622000
      END;                                                     <<02845>>17624000
   GETNEXT;                                                    <<02845>>17626000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>17628000
   IF <> OR NOT (1 <= RESULT <= 4) THEN                        <<02845>>17630000
      CIERR(ERRNUM := ILLVALFMT,PARMPTR)                       <<02845>>17632000
   ELSE                                                        <<02845>>17634000
      BEGIN                                                    <<02845>>17636000
         PROG'PARM.FORMAT := RESULT;                           <<02845>>17638000
         PROCFORMAT := TRUE;                                   <<02845>>17640000
      END;                                                     <<02845>>17642000
END; << SUBROUTINE PROCFORMAT >>                               <<02845>>17644000
                                                               <<02845>>17646000
                                                               <<02845>>17648000
LOGICAL SUBROUTINE PROCPRIORITY;                               <<02845>>17650000
BEGIN                                                          <<02845>>17652000
   PROCPRIORITY := FALSE;                                      <<02845>>17654000
   IF FLAG.PRI THEN                                            <<02845>>17656000
      CIERR(ERRNUM := -REDNDPRI,PARMPTR);                      <<02845>>17658000
   FLAG.PRI := TRUE;                                           <<02845>>17660000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>17662000
      BEGIN                                                    <<02845>>17664000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>17666000
         RETURN;                                               <<02845>>17668000
      END;                                                     <<02845>>17670000
   GETNEXT;                                                    <<02845>>17672000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>17674000
   IF <> OR NOT (1 <= RESULT <= 13) THEN                       <<02845>>17676000
      CIERR(ERRNUM := ILLVALPRI,PARMPTR)                       <<02845>>17678000
   ELSE                                                        <<02845>>17680000
      BEGIN                                                    <<02845>>17682000
         PROG'PARM.PRIORITY := RESULT;                         <<02845>>17684000
         PROCPRIORITY := TRUE;                                 <<02845>>17686000
      END;                                                     <<02845>>17688000
END; << SUBROUTINE PROCPRIORITY >>                             <<02845>>17690000
                                                               <<02845>>17692000
                                                               <<02845>>17694000
IF (MANAGER := FALSE) THEN                                     <<02845>>17696000
CX3270MGR: MANAGER := TRUE;                                    <<02845>>17698000
MYCOMMAND(PARMSP,DELIMS,MAXPARMS,NUMPARMS,PARMS);              <<02845>>17700000
IF <> THEN                                                     <<02845>>17702000
   BEGIN                                                       <<02845>>17704000
      CIERR(ERRNUM := TOOMANYPARMS);                           <<02845>>17706000
      RETURN;                                                  <<02845>>17708000
   END;                                                        <<02845>>17710000
IF NUMPARMS <> 0 THEN << evidently found some >>               <<02845>>17712000
   BEGIN                                                       <<02845>>17714000
      MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                    <<02845>>17716000
      DO                                                       <<02845>>17718000
         BEGIN                                                 <<02845>>17720000
            GETNEXT;                                           <<02845>>17722000
            IF PARMLEN = 0 THEN << empty parameter >>          <<02845>>17724000
               CIERR(ERRNUM := -FILEEXTRANDELIM,PARMPTR)       <<02845>>17726000
            ELSE                                               <<02845>>17728000
               BEGIN << look for a keyword >>                  <<02845>>17730000
                  TOS := SEARCH(PARMPTR,PARMLEN,KEYLIST        <<02845>>17732000
                                ,DICTPTR);                     <<02845>>17734000
                  IF TOS <> 0 THEN                             <<02845>>17736000
                     CASE INTEGER(DICTPTR) OF                  <<02845>>17738000
                        BEGIN                                  <<02845>>17740000
                           << 0 >>                             <<02845>>17742000
                           IF NOT PROCENHANCE THEN             <<02845>>17744000
                              RETURN;                          <<02845>>17746000
                           << 1 >>                             <<02845>>17748000
                           IF NOT PROCFORMAT THEN              <<02845>>17750000
                              RETURN;                          <<02845>>17752000
                           << 2 >>                             <<02845>>17754000
                           IF NOT PROCPRIORITY THEN            <<02845>>17756000
                              RETURN;                          <<02845>>17758000
                           << 3 >>                             <<02845>>17760000
                           PROG'PARM.BLANKS := 1;              <<02845>>17762000
                        END                                    <<02845>>17764000
                  ELSE << unknown keyword >>                   <<02845>>17766000
                     BEGIN                                     <<02845>>17768000
                        CIERR(ERRNUM := UNKNOWNKEY,PARMPTR);   <<02845>>17770000
                        RETURN;                                <<02845>>17772000
                     END;                                      <<02845>>17774000
               END;                                            <<02845>>17776000
         END << keyword loop >>                                <<02845>>17778000
      UNTIL NEXTDELIM <> SEMICOLON;                            <<02845>>17780000
      IF NEXTDELIM <> CR THEN                                  <<02845>>17782000
         BEGIN                                                 <<02845>>17784000
            CIERR(ERRNUM := EXPECTSEMIC,PARMPTR(PARMLEN));     <<02845>>17786000
            RETURN;                                            <<02845>>17788000
         END;                                                  <<02845>>17790000
   END; << PARAMETERS EXIST >>                                 <<02845>>17792000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>17794000
                                                               <<00184>>17796000
IF MANAGER                                                     <<00184>>17798000
  THEN MOVE ENTRYNAME := "TTSMGR "                             <<00184>>17800000
  ELSE MOVE ENTRYNAME := "  ";                                 <<00184>>17802000
                                                               <<00184>>17804000
MOVE SYSFILENAME := "TTSUSER.PUB.SYS ";                        <<01165>>17806000
CREATE(SYSFILENAME,ENTRYNAME,PIN,PROG'PARM,1);                 <<02845>>17808000
IF CARRY THEN   <<CREATE OF IML SUBSYSTEM FAILED>>             <<01424>>17810000
   BEGIN                                                       <<00184>>17812000
   SCAN SYSFILENAME UNTIL "..",1;                              <<00184>>17814000
   BPS0 := 0;       << DELIMIT STRING >>                       <<00184>>17816000
   DEL;                                                        <<00184>>17818000
   IF CREATEERROR THEN                                         <<00184>>17820000
      CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)         <<00184>>17822000
   ELSE   <<LOAD FAILED>>                                      <<00184>>17824000
      CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);          <<00184>>17826000
   END                                                         <<00184>>17828000
ELSE IF < THEN   <<TTSUSER.PUB.SYS NOT FOUND>>                 <<00184>>17830000
   BEGIN                                                       <<00184>>17832000
   SCAN SYSFILENAME UNTIL "..",1;                              <<00184>>17834000
   BPS0 := 0;       << DELIMIT STRING >>                       <<00184>>17836000
   DEL;                                                        <<00184>>17838000
   CIERR(ERRNUM := SUBSNOTFOUND, , 0,@SYSFILENAME);            <<00184>>17840000
   END                                                         <<00184>>17842000
ELSE   <<EVERYTHING OK, DO IT>>                                <<00184>>17844000
   BEGIN                                                       <<00184>>17846000
   AWAKE(PIN*PCBSIZE,1,2);   <<FIRE UP SUBSYSTEM>>             <<00184>>17848000
   CISUBSYSFINISH(0, ERRNUM, PARMNUM);                         <<00184>>17850000
   END;                                                        <<00184>>17852000
END;   <<CX3270, CX3270MGR>>                                   <<00184>>17854000
PROCEDURE CX3270CONTROL EXECUTORHEAD;                          <<01165>>17856000
  OPTION PRIVILEGED,UNCALLABLE;                                <<01165>>17858000
BEGIN                                                          <<01165>>17860000
  BYTE ARRAY PROC'NAME(0:17);                                  <<01424>>17862000
  BYTE ARRAY ERRMSG(0:4);                                      <<01538>>17864000
  INTEGER MSG'LEN;                                             <<01538>>17866000
  INTEGER PROC'ID, PLABEL, X=X;                                <<01424>>17868000
  DEFINE ASMB = ASSEMBLE#;                                     <<01424>>17870000
  INTRINSIC LOADPROC,UNLOADPROC;                               <<01424>>17872000
                                                               <<01424>>17874000
  SUBROUTINE CXIMLCONTROL EXECUTORHEAD;                        <<01424>>17876000
    BEGIN                                                      <<01424>>17878000
    X := TOS;  << SAVE RETURN ADDRESS >>                       <<01424>>17880000
    TOS := PLABEL;                                             <<01424>>17882000
    ASMB( PCAL 0 );                                            <<01424>>17884000
    TOS := X;                                                  <<01424>>17886000
    RETURN 0;  << PROCEDURE DELETED PARMS >>                   <<01424>>17888000
    END;                                                       <<01424>>17890000
                                                               <<01424>>17892000
  MOVE PROC'NAME := "CXIMLCONTROL ";                           <<01424>>17894000
  PROC'ID := LOADPROC(PROC'NAME,0,PLABEL);                     <<01424>>17896000
  IF <> THEN                                                   <<01424>>17898000
    BEGIN                                                      <<01424>>17900000
    MOVE ERRMSG := "IML",2;                                    <<01538>>17902000
    MSG'LEN :=TOS - @ERRMSG;                                   <<01538>>17904000
    ERRMSG(MSG'LEN) := 0;                                      <<01538>>17906000
    CIERR(ERRNUM := SUBSNOTFOUND,,0,@ERRMSG);                  <<01538>>17908000
    RETURN;                                                    <<01424>>17910000
    END;                                                       <<01424>>17912000
                                                               <<01424>>17914000
  CXIMLCONTROL(PARMSP,ERRNUM,PARMNUM);                         <<01424>>17916000
                                                               <<01424>>17918000
  UNLOADPROC(PROC'ID);                                         <<01424>>17920000
                                                               <<01424>>17922000
END;  <<CX3270CONTROL>>                                        <<01424>>17924000
$CONTROL SEGMENT = CISUBS                                      <<U.RAO>>17926000
      PROCEDURE CXRJE EXECUTORHEAD;                                     17928000
      OPTION PRIVILEGED,UNCALLABLE;                                     17930000
      BEGIN                                                             17932000
      BYTE ARRAY PROGFILE(0:11);                                        17934000
      BYTE ARRAY BUILDNAME(0:7);                                        17936000
      INTEGER NUMPARMS,PCNT:=-1;                                        17938000
      DOUBLE ARRAY PARMS(0:4);                                 <<U.RAO>>17940000
      LBPARMDECS;                                                       17942000
      LOGICAL COMCR:=%26015,T:=1,PARM:=0,PIN;                           17944000
      BYTE POINTER FNAME;                                               17946000
      SUBROUTINE CLEANUP;                                               17948000
         BEGIN                                                          17950000
         DELIMPFILE(PARM,BUILDNAME);                                    17952000
         END;<<CLEAN UP>>                                               17954000
      MOVE PROGFILE:="RJE.PUB.SYS ";                                    17956000
      MOVE BUILDNAME:="RJE";                                            17958000
      MYCOMMAND(PARMSP,COMCR,5,NUMPARMS,PARMS);                <<U.RAO>>17960000
      IF NUMPARMS>4 THEN  <<TOO MANY PARAMETERS FOR RJE>>      <<U.RAO>>17962000
         BEGIN                                                 <<U.RAO>>17964000
         PARMNUM := 5;                                         <<U.RAO>>17966000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>17968000
         TOS := LPARM(8);                                      <<U.RAO>>17970000
         CIERR(*,*,%10000,4);                                  <<U.RAO>>17972000
         RETURN                                                <<U.RAO>>17974000
         END;                                                  <<U.RAO>>17976000
      WHILE(PCNT:=PCNT+1)<NUMPARMS DO                                   17978000
      IF (T:=BPARM(2+PCNT&ASL(2)))<>0 THEN                              17980000
         BEGIN                                                          17982000
         @FNAME:=LPARM(PCNT&ASL(1));                                    17984000
         CASE PCNT OF                                                   17986000
            BEGIN                                                       17988000
               BEGIN<<COMMAND>>                                         17990000
               MOVE BUILDNAME(3):="COM ";                               17992000
               PARM.(15:1):=1;                                          17994000
               END;                                                     17996000
               BEGIN<<INPUT>>                                           17998000
               MOVE BUILDNAME(3):="IN ";                                18000000
               PARM.(13:1):=1;                                          18002000
               END;                                                     18004000
               BEGIN<<LIST>>                                            18006000
               MOVE BUILDNAME(3):="LIST ";                              18008000
               PARM.(14:1):=1;                                          18010000
               END;                                                     18012000
               BEGIN<<PUNCH>>                                           18014000
               MOVE BUILDNAME(3):="PUNCH ";                             18016000
               PARM.(12:1):=1;                                          18018000
               END;                                                     18020000
           END;                                                         18022000
           ERRNUM := CYIMPLCTFILE'(BUILDNAME,FNAME,T);         <<U.RAO>>18024000
           IF <> THEN   <<ERROR IN NAME>>                      <<U.RAO>>18026000
              BEGIN                                            <<U.RAO>>18028000
              CLEANUP;                                         <<U.RAO>>18030000
              PARMNUM :=2;                                     <<U.RAO>>18032000
              RETURN                                           <<U.RAO>>18034000
              END;                                             <<U.RAO>>18036000
         END;                                                  <<U.RAO>>18038000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>18040000
      TOS := TOS+0;  <<CLEAR CARRY BEFORE CREATE>>             <<U.RAO>>18042000
      CREATE(PROGFILE,,PIN,PARM,1);                                     18044000
      IF CARRY THEN                                                     18046000
         BEGIN                                                          18048000
         CLEANUP;                                                       18050000
         PROGFILE(3) := 0;  <<SET UP RJE AS PARM TO GENMSG>>   <<U.RAO>>18052000
         IF CREATEERROR THEN                                   <<U.RAO>>18054000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@PROGFILE)      <<U.RAO>>18056000
         ELSE                                                  <<U.RAO>>18058000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@PROGFILE);       <<U.RAO>>18060000
         RETURN;                                               <<U.RAO>>18062000
         END;                                                           18064000
      IF< THEN                                                          18066000
         BEGIN                                                          18068000
         CLEANUP;                                                       18070000
         PROGFILE(3) := 0;                                     <<U.RAO>>18072000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@PROGFILE);           <<04785>>18074000
         RETURN;                                               <<U.RAO>>18076000
         END;                                                           18078000
      NEXTLINE;                                                         18080000
      AWAKE(PIN*PCBSIZE,1,2);                                           18082000
      CLEANUP;                                                          18084000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>18086000
END;   <<CXRJE>>                                               <<U.RAO>>18088000
   INTEGER PROCEDURE CYIMPLCTFILE'(LHS,RHS,LENR);              <<U.RAO>>18090000
   VALUE LENR;                                                 <<U.RAO>>18092000
   INTEGER LENR;                                               <<U.RAO>>18094000
   BYTE ARRAY LHS, RHS;                                        <<U.RAO>>18096000
   OPTION PRIVILEGED, UNCALLABLE;                              <<U.RAO>>18098000
                                                               <<U.RAO>>18100000
BEGIN                                                          <<U.RAO>>18102000
<< This procedure does implicit file equates for >>            <<U.RAO>>18104000
<< the subsystem commands.  For example, it does >>            <<U.RAO>>18106000
<< an equate SPLTEXT = <user supplied file name> >>            <<U.RAO>>18108000
<< for the SPL compiler, if required.  File      >>            <<U.RAO>>18110000
<< equates should only be done if the user       >>            <<U.RAO>>18112000
<< explicitly provided a file name.  The usual   >>            <<U.RAO>>18114000
<< communication path to the compilers is through>>            <<U.RAO>>18116000
<< the PARM parameter in the CREATE intrinsic.   >>            <<U.RAO>>18118000
<< See the individual subsystem for specifics.   >>            <<U.RAO>>18120000
<< Incidentally, the reader should note that     >>            <<U.RAO>>18122000
<< this routine is responsible for parsing the   >>            <<U.RAO>>18124000
<< user supplied file name and for reporting     >>            <<U.RAO>>18126000
<< errors related to the procedure's inability   >>            <<U.RAO>>18128000
<< to add the equate to the JDT.  A companion    >>            <<U.RAO>>18130000
<< procedure, DELIMPFILE, deletes the file equate>>            <<U.RAO>>18132000
<< on termination of the compiler.               >>            <<U.RAO>>18134000
                                                               <<U.RAO>>18136000
INTEGER RESULTSPACE=CYIMPLCTFILE';                             <<U.RAO>>18138000
BYTE BLANK := " ";                                             <<U.RAO>>18140000
      LOGICAL ARRAY FENTRY(0:31);                              <<U.RAO>>18142000
BYTE ARRAY BFENTRY(*) = FENTRY;                                <<U.RAO>>18144000
BYTE POINTER BGPTR := @BLANK,                                  <<U.RAO>>18146000
             BAPTR := @BLANK,                                  <<U.RAO>>18148000
             BERRPTR;                                          <<U.RAO>>18150000
LOGICAL GPTR = BGPTR,                                          <<U.RAO>>18152000
        APTR = BAPTR,                                          <<U.RAO>>18154000
        ERRPTR = BERRPTR;                                      <<U.RAO>>18156000
LOGICAL SYSFLAG := FALSE;                                      <<U.RAO>>18158000
                                                               <<U.RAO>>18160000
CC := CCE;                                                     <<U.RAO>>18162000
<<FIRST TASK IS TO CHECK VALIDITY OF FILE NAME>>               <<U.RAO>>18164000
TOS := 0;                                                      <<U.RAO>>18166000
TOS := @RHS;                                                   <<U.RAO>>18168000
TOS := LENR;                                                   <<U.RAO>>18170000
TOS := CHECKFILENAME'(*,GPTR,APTR,ERRPTR);                     <<U.RAO>>18172000
IF < THEN  <<ERROR IN PARSING NAME>>                           <<U.RAO>>18174000
   BEGIN                                                       <<U.RAO>>18176000
   CYIMPLCTFILE' := S0;                                        <<U.RAO>>18178000
   CC := CCG;                                                  <<U.RAO>>18180000
   CIERR(*,BERRPTR);                                           <<U.RAO>>18182000
   RETURN                                                      <<U.RAO>>18184000
   END                                                         <<U.RAO>>18186000
ELSE IF > THEN                                                 <<U.RAO>>18188000
   IF S0=0 THEN  <<BACK REFERENCED FILE NAME>>                 <<U.RAO>>18190000
      BEGIN                                                    <<U.RAO>>18192000
      DEL;                                                     <<U.RAO>>18194000
      FENTRY := 1;  <<NAME PRESENT BIT IN PMASK>>              <<U.RAO>>18196000
      FENTRY(1) := %1000;  <<SET POINTER BIT>>                 <<U.RAO>>18198000
      FENTRY(2) := (LENR-1)&LSL(8);  <<NAME LENGTH>>           <<U.RAO>>18200000
      MOVE BFENTRY(6) := RHS(1),(LENR-1);                      <<U.RAO>>18202000
      TOS := XADDJTENTRY(LHS,BLANK,BLANK,-3,(14+LENR&LSR(1)),  <<U.RAO>>18204000
                 FENTRY,RHS(1),BGPTR,BAPTR);                   <<U.RAO>>18206000
      CASE TOS OF                                              <<U.RAO>>18208000
         BEGIN                                                 <<U.RAO>>18210000
         ;  <<OK RETURN>>                                      <<U.RAO>>18212000
         BEGIN                                                 <<U.RAO>>18214000
            CC := CCL;                                         <<U.RAO>>18216000
            CIERR(RESULTSPACE := FEQTABFULL);                  <<U.RAO>>18218000
         END;                                                  <<U.RAO>>18220000
         ;  <<DUPLICATE NAME - CAN'T HAPPEN>>                  <<U.RAO>>18222000
         BEGIN   <<ACTUAL DESIGNATOR NOT FOUND>>               <<U.RAO>>18224000
            CC := CCL;                                         <<U.RAO>>18226000
            QUALIFYFILENAME(RHS(1),BFENTRY);                   <<U.RAO>>18228000
            CIERR(RESULTSPACE := FILEBREFMISADES,,0,@BFENTRY); <<U.RAO>>18230000
         END;                                                  <<U.RAO>>18232000
         BEGIN  <<TOO MANY BACK REFERENCES TO THIS ADESIGNATOR><<U.RAO>>18234000
            CC := CCL;                                         <<U.RAO>>18236000
            QUALIFYFILENAME(RHS(1),BFENTRY);                   <<U.RAO>>18238000
            CIERR(RESULTSPACE := TOOMANYFEQBREF,,0,@BFENTRY);  <<U.RAO>>18240000
         END;                                                  <<U.RAO>>18242000
         BEGIN  << CIRCULAR FILE EQUATION >>                   <<00834>>18244000
            CC := CCL;                                         <<00834>>18246000
            CIERR(RESULTSPACE := CIRCULARFEQ);                 <<00834>>18248000
         END;                                                  <<00834>>18250000
         END;  <<OF CASE>>                                     <<U.RAO>>18252000
      END                                                      <<U.RAO>>18254000
   ELSE                                                        <<U.RAO>>18256000
      BEGIN  <<SYSTEM DEFINED FILE>>                           <<U.RAO>>18258000
      SYSFLAG := TRUE;                                         <<U.RAO>>18260000
      FENTRY := %20;  <<DEFAULT DESIGNATOR BIT>>               <<U.RAO>>18262000
      FENTRY(1) := 0;  <<PMASK WORD 2>>                        <<U.RAO>>18264000
      FENTRY(2) := 0;  <<NAME LENGTH>>                         <<U.RAO>>18266000
      FENTRY(3) := TOS&LSL(3);  <<FOPTIONS WORD>>              <<U.RAO>>18268000
      TOS := ADDJTENTRY(LHS,BLANK,BLANK,-3,4,FENTRY);          <<U.RAO>>18270000
      IF TOS <> 0 THEN   <<ERROR RETURN FROM DIRECTORY>>       <<U.RAO>>18272000
         BEGIN                                                 <<U.RAO>>18274000
         CC := CCL;                                            <<U.RAO>>18276000
         CIERR(RESULTSPACE := FEQTABFULL);                     <<U.RAO>>18278000
         END;                                                  <<U.RAO>>18280000
      END                                                      <<U.RAO>>18282000
ELSE   <<REGULAR FILE NAME>>                                   <<U.RAO>>18284000
   BEGIN                                                       <<U.RAO>>18286000
   FENTRY := 1;  <<NAME PRESENT>>                              <<U.RAO>>18288000
   FENTRY(1) := 0;                                             <<U.RAO>>18290000
   FENTRY(2) := LENR&LSL(8); <<NAME LENGTH IN UPPER BYTE>>     <<U.RAO>>18292000
   MOVE BFENTRY(6) := RHS,(LENR);                              <<U.RAO>>18294000
   TOS := ADDJTENTRY(LHS,BLANK,BLANK,-3,(3+(LENR+1)&LSR(1)),   <<U.RAO>>18296000
                                    FENTRY);                   <<U.RAO>>18298000
   IF TOS <> 0 THEN   <<ERROR RETURN FROM DIRECTORY>>          <<U.RAO>>18300000
      BEGIN                                                    <<U.RAO>>18302000
      CC := CCL;                                               <<U.RAO>>18304000
      CIERR(RESULTSPACE := FEQTABFULL);                        <<U.RAO>>18306000
      END;                                                     <<U.RAO>>18308000
   END;                                                        <<U.RAO>>18310000
END;                                                           <<U.RAO>>18312000
PROCEDURE DELIMPFILE(PARM,FNAME);                                       18314000
   VALUE PARM;                                                          18316000
   LOGICAL PARM;                                                        18318000
   BYTE ARRAY FNAME;                                                    18320000
   OPTION PRIVILEGED, UNCALLABLE;                                       18322000
BEGIN LOGICAL BLANK := "  ";                                            18324000
      BYTE POINTER GPNTR := @BLANK;                                     18326000
      INTEGER I := 0;                                                   18328000
      BYTE ARRAY FTYPES(0:29) = PB :=                                   18330000
         "TEXT LIST USL  MAST NEW  ";                                   18332000
LOOP:                                                                   18334000
      IF PARM THEN                                                      18336000
      BEGIN MOVE FNAME(3) := FTYPES(5*I) , (5);                         18338000
            XREMJTENTRY(FNAME,GPNTR,GPNTR,3)                            18340000
      END;                                                              18342000
      PARM := PARM & LSR(1);                                            18344000
      I := I + 1;                                                       18346000
      IF I < 5 THEN GO TO LOOP;                                         18348000
END   <<DELIMPFILE>>;                                                   18350000
$PAGE   "MISC. COMMAND EXECUTORS -- JOB, HELLO,BYE ETC."                18352000
$CONTROL SEGMENT=CIPREPRUN                                     <<04786>>18354000
PROCEDURE SETSTDLIST(PARMPOINT,ERRPTR,ERRORNUM,PARMNUM);       <<04786>>18356000
<<********************************************************>>   <<04786>>18358000
<<                                                        >>   <<04786>>18360000
<<  PROCEDURE NAME: SETSTDLIST                            >>   <<04786>>18362000
<<  PROGRAMMER: MARIE WESTON                              >>   <<04786>>18364000
<<  DATE: JUNE 30, 1982                                   >>   <<04786>>18366000
<<                                                        >>   <<04786>>18368000
<<  PARAMETERS                                            >>   <<04786>>18370000
<<        PARMPOINT--ON INPUT, THIS IS A POINTER TO THE   >>   <<04786>>18372000
<<                   FIRST CHARACTER OF THE INVOKING SUB- >>   <<04786>>18374000
<<                   STRING.  ON OUTPUT, THIS POINTS TO   >>   <<04786>>18376000
<<                   THE DELIMITER FOLLOWING THE INVOKING >>   <<04786>>18378000
<<                   SUBSTRING.                           >>   <<04786>>18380000
<<                                                        >>   <<04786>>18382000
<<        ERRPTR   --THIS POINTER IS UNDEFINED ON INPUT.  >>   <<04786>>18384000
<<                   IN CASE OF AN ERROR, THIS POINTS TO  >>   <<04786>>18386000
<<                   THE OFFENDING BYTE IN THE PARAMETER  >>   <<04786>>18388000
<<                   STRING ON OUTPUT.                    >>   <<04786>>18390000
<<                                                        >>   <<04786>>18392000
<<        ERRNUM   --THIS INTEGER IS UNDEFINED ON INPUT.  >>   <<04786>>18394000
<<                   IN CASE OF AN ERROR, ON OUTPUT, THIS >>   <<04786>>18396000
<<                   WILL CONTAIN THE CI ERROR NUMBER, OR,>>   <<04786>>18398000
<<                   IF THERE IS NO ERROR, IT WILL CONTAIN>>   <<04786>>18400000
<<                   A ZERO.                              >>   <<04786>>18402000
<<                                                        >>   <<04786>>18404000
<<        PARMNUM  --THIS INTEGER IS INCREMENTED BY TWO   >>   <<04786>>18406000
<<                   EVERY TIME SETSTDLIST IS CALLED TO   >>   <<04786>>18408000
<<                   INDICATE THAT TWO PARAMETERS WERE    >>   <<04786>>18410000
<<                   PROCESSED.                           >>   <<04786>>18412000
<<                                                        >>   <<04786>>18414000
<<                                                        >>   <<04786>>18416000
<<  DESCRIPTION:  THIS PROCEDURE EXECUTES THE "STDLIST"   >>   <<04786>>18418000
<<    OPTION OF THE "SET" COMMAND WHICH IS USED TO FLAG   >>   <<04786>>18420000
<<    THE STDLIST SPOOLFILE FOR DELETION OR SALVATION     >>   <<04786>>18422000
<<    DEPENDING ON THE OPTION SPECIFIED.  THE ACCOUNT     >>   <<04786>>18424000
<<    PASSWORD BIT IN THE FIRST WORD OF THE JMAT ENTRY IS >>   <<04786>>18426000
<<    USED AS THE FLAG BIT.                               >>   <<04786>>18428000
<<                                                        >>   <<04786>>18430000
<<********************************************************>>   <<04786>>18432000
                                                               <<04786>>18434000
                                                               <<04786>>18436000
  BYTE POINTER PARMPOINT;                                      <<04786>>18438000
  BYTE POINTER ERRPTR;                                         <<04786>>18440000
  INTEGER ERRORNUM,PARMNUM;                                    <<04786>>18442000
                                                               <<04786>>18444000
BEGIN                                                          <<04786>>18446000
  DEFINE                                                       <<04786>>18448000
    STDLIST'SAVEFLAG=ARRDB0(JMATIND*JMATLEN).(9:1)#;           <<04786>>18450000
                                                               <<04786>>18452000
  EQUATE                                                       <<04786>>18454000
    EQUALS=0,                 <<  DELIMITER NUMBER         >>  <<04786>>18456000
    SAVE=2,                                                    <<04786>>18458000
    DELETE=1,                                                  <<04786>>18460000
    JMATSIR=15,               <<  CODE TO LOCK JMAT        >>  <<04786>>18462000
    REQPARMS=2;               <<  REQUIRED NUMBER OF PARMS >>  <<04786>>18464000
    INTRINSIC FFILEINFO;                                       <<04786>>18466000
                                                               <<04786>>18468000
  INTEGER                                                      <<04786>>18470000
    JMATIND,                  <<  INDEX TO JMAT TABLE      >>  <<04786>>18472000
    ENTRYNO,                  <<  DICTIONARY ENTRY NUMBER  >>  <<04786>>18474000
    TEMPERR,                  <<  ERROR DURING DB EXCHANGE >>  <<04786>>18476000
    NUMPARMS,                 <<  FOR MYCOMMAND RESULTS    >>  <<04786>>18478000
    OPTIONLEN;                <<  LENGTH OF STDLIST OPTION >>  <<04786>>18480000
                                                               <<04786>>18482000
  LOGICAL                                                      <<04786>>18484000
    OK,                       <<  FLAG FOR SPOOLED STATUS  >>  <<04786>>18486000
    STATUS,                   <<  SPOOLED STATUS RETURNED  >>  <<04786>>18488000
    SAVESIR;                  <<  FOR RETURN FROM GETSIR   >>  <<04786>>18490000
                                                               <<04786>>18492000
  <<          SET UP OPTION DICTIONARY                     >>  <<04786>>18494000
                                                               <<04786>>18496000
  BYTE ARRAY DICT(0:1)=PB:=                                    <<04786>>18498000
    8,6,"DELETE",                                              <<04786>>18500000
    6,4,"SAVE",                                                <<04786>>18502000
    0;                                                         <<04786>>18504000
  EQUATE DICTLEN=15;                                           <<04786>>18506000
  BYTE ARRAY LOCALDICT(0:DICTLEN-1);                           <<04786>>18508000
                                                               <<04786>>18510000
  <<          SET UP MYCOMMAND PARAMETERS                  >>  <<04786>>18512000
                                                               <<04786>>18514000
  DOUBLE                                                       <<04786>>18516000
    DUMMY1,                                                    <<04786>>18518000
    DUMMY2,                                                    <<04786>>18520000
    DUMMY3;                                                    <<04786>>18522000
  DOUBLE ARRAY NEWPARMS(*)=DUMMY1;                             <<04786>>18524000
  LOGICAL DELIMWORD=DUMMY1+1;                                  <<04786>>18526000
  LOGICAL OPTWORD=DUMMY2+1;                                    <<04786>>18528000
  DEFINE                                                       <<04786>>18530000
    DELIM=DELIMWORD.(11:5)#,                                   <<04786>>18532000
    PARMLEN=OPTWORD.(0:8)#;                                    <<04786>>18534000
  BYTE POINTER OPTIONPTR=DUMMY2;                               <<04786>>18536000
  DOUBLE DDL:=[8/"=",8/";",16/%6400]D;                         <<04786>>18538000
  BYTE ARRAY DL(*)=DDL;                                        <<04786>>18540000
                                                               <<04786>>18542000
                                                               <<04786>>18544000
<<                 SET STDLIST MAINLINE                    >>  <<04786>>18546000
                                                               <<04786>>18548000
OK:=FALSE;                                                     <<04786>>18550000
MOVE LOCALDICT:=DICT,(DICTLEN);                                <<04786>>18552000
MYCOMMAND(PARMPOINT,DL,REQPARMS,NUMPARMS,NEWPARMS);            <<04786>>18554000
OPTIONLEN:=PARMLEN;                                            <<04786>>18556000
ENTRYNO:=SEARCH(OPTIONPTR,OPTIONLEN,LOCALDICT);                <<04786>>18558000
                                                               <<04786>>18560000
<<           DO SYNTAX CHECKING ON PARM STRING             >>  <<04786>>18562000
                                                               <<04786>>18564000
IF DELIM<>EQUALS THEN                                          <<04786>>18566000
  BEGIN                                                        <<04786>>18568000
    @ERRPTR:=@PARMPOINT+7;                                     <<04786>>18570000
    ERRORNUM:=NO'EQUALS;                                       <<04786>>18572000
  END                                                          <<04786>>18574000
ELSE IF ENTRYNO=0 THEN                                         <<04786>>18576000
  BEGIN                                                        <<04786>>18578000
    @ERRPTR:=@OPTIONPTR;                                       <<04786>>18580000
    ERRORNUM:=BAD'OPTION;                                      <<04786>>18582000
  END                                                          <<04786>>18584000
ELSE                                                           <<04786>>18586000
                                                               <<04786>>18588000
<<    NOW CHECK IF PROCESS IS A JOB WITH A SPOOLED STDLIST  >> <<04786>>18590000
                                                               <<04786>>18592000
  BEGIN                                                        <<04786>>18594000
    TEMPERR:=0;                                                <<04786>>18596000
    FFILEINFO(2,38,STATUS);                                    <<04786>>18598000
    IF STATUS <> 0 THEN                                        <<04786>>18600000
       OK:=TRUE;                                               <<04786>>18602000
                                                               <<04786>>18604000
<<    GET JMAT INDEX AND LOCK THE JMAT                     >>  <<04786>>18606000
                                                               <<04786>>18608000
    SETXPXGLOB;                                                <<04786>>18610000
    JMATIND:=ARRDB3(X).(0:8);                                  <<04786>>18612000
    SAVESIR := GETSIR(JMATSIR);                                <<04786>>18614000
    EXCHANGEDB(JMATDST);                                       <<04786>>18616000
    IF OK THEN                                                 <<04786>>18618000
                                                               <<04786>>18620000
<<   NOW CHECK IF THE OPTION IS ALREADY IN EFFECT. IF IT   >>  <<04786>>18622000
<<   ISN'T THEN CHANGE THE FLAG BY COMPLEMENTING THE BIT.   >> <<04786>>18624000
                                                               <<04786>>18626000
      IF (STDLIST'SAVEFLAG=0 LAND ENTRYNO=SAVE)                <<04786>>18628000
                      LOR                                      <<04786>>18630000
         (STDLIST'SAVEFLAG=1 LAND ENTRYNO=DELETE) THEN         <<04786>>18632000
         TEMPERR:=-ALREADY                                     <<04786>>18634000
      ELSE                                                     <<04786>>18636000
         STDLIST'SAVEFLAG:=STDLIST'SAVEFLAG+1                  <<04786>>18638000
    ELSE                                                       <<04786>>18640000
      TEMPERR:=NOT'SPOOLED;                                    <<04786>>18642000
                                                               <<04786>>18644000
<<  RESTORE THE OLD DB AND RELEASE THE JMATSIR        >>       <<04786>>18646000
                                                               <<04786>>18648000
    EXCHANGEDB(0);                                             <<04786>>18650000
    RELSIR(JMATSIR,SAVESIR);                                   <<04786>>18652000
    ERRORNUM:=TEMPERR;                                         <<04786>>18654000
    @ERRPTR:=@PARMPOINT;                                       <<04786>>18656000
  END;                                                         <<04786>>18658000
                                                               <<04786>>18660000
<<     MOVE PARMPOINT TO COMMAND DELIMITER                   >><<04786>>18662000
                                                               <<04786>>18664000
  @PARMPOINT:=@OPTIONPTR+OPTIONLEN;                            <<04786>>18666000
  SCAN PARMPOINT WHILE "  ",1;                                 <<04786>>18668000
  @PARMPOINT:=TOS;                                             <<04786>>18670000
                                                               <<04786>>18672000
<<     INCREMENT BY NUMBER OF PARAMETERS PROCESSED    >>       <<04786>>18674000
                                                               <<04786>>18676000
  PARMNUM:=PARMNUM+2;                                          <<04786>>18678000
END;                                                           <<04786>>18680000
                                                               <<04786>>18682000
$CONTROL SEGMENT=CIPREPRUN                                     <<04786>>18684000
PROCEDURE CXSET EXECUTORHEAD;                                  <<04786>>18686000
<<*********************************************************>>  <<04786>>18688000
<<                                                         >>  <<04786>>18690000
<<  PROCEDURE NAME: CXSET                                  >>  <<04786>>18692000
<<  PROGRAMMER: MARIE WESTON                               >>  <<04786>>18694000
<<  DATE: JUNE 30, 1982                                    >>  <<04786>>18696000
<<                                                         >>  <<04786>>18698000
<<  DESCRIPTION:  THIS PROCEDURE PARSES THE "SET" COMMAND  >>  <<04786>>18700000
<<    PARAMETER THEN CALLS THE PROCEDURE NEEDED TO EXECUTE >>  <<04786>>18702000
<<    THAT COMMAND.  TO ADD A NEW OPTION TO THE COMMAND,   >>  <<04786>>18704000
<<    YOU MUST:                                            >>  <<04786>>18706000
<<       (1)  PUT THE OPTION NAME INTO THE DICTIONARY      >>  <<04786>>18708000
<<       (2)  INCREASE THE VALUE OF "DICTLEN" ACCORDINGLY  >>  <<04786>>18710000
<<       (3)  PUT THE PROCEDURE CALL INTO THE CASE STMT    >>  <<04786>>18712000
<<                                                         >>  <<04786>>18714000
<<*********************************************************>>  <<04786>>18716000
                                                               <<04786>>18718000
  BEGIN                                                        <<04786>>18720000
                                                               <<04786>>18722000
  BYTE ARRAY DICT(0:1)=PB:=                                    <<04786>>18724000
    9,7,"STDLIST",                                             <<04786>>18726000
    0;                                                         <<04786>>18728000
  EQUATE DICTLEN=10;                                           <<04786>>18730000
  BYTE ARRAY LOCALDICT(0:DICTLEN-1);                           <<04786>>18732000
  BYTE POINTER                                                 <<04786>>18734000
    PARMPOINT,                    << POINTS TO CURRENT PARM  >><<04786>>18736000
    ERRPTR;                                                    <<04786>>18738000
                                                               <<04786>>18740000
  INTEGER                                                      <<04786>>18742000
    ENTRYNO,                      << DICTIONARY ENTRY NUMBER >><<04786>>18744000
    ERRORNUM,                                                  <<04786>>18746000
    PARMLEN;                      << PARAMETER LENGTH        >><<04786>>18748000
                                                               <<04786>>18750000
  LOGICAL                                                      <<04786>>18752000
    STILLPARSE;                   << CONTINUE PARSING FLAG   >><<04786>>18754000
                                                               <<04786>>18756000
  EQUATE                                                       <<04786>>18758000
    CR=%15,                       << CARRIAGE RETURN         >><<04786>>18760000
    SEMICOL=";";                                               <<04786>>18762000
                                                               <<04786>>18764000
                                                               <<04786>>18766000
                                                               <<04786>>18768000
MOVE LOCALDICT:=DICT,(DICTLEN);                                <<04786>>18770000
@PARMPOINT:=@PARMSP(0);                                        <<04786>>18772000
ERRORNUM:=0;                                                   <<04786>>18774000
STILLPARSE:=TRUE;                                              <<04786>>18776000
                                                               <<04786>>18778000
WHILE STILLPARSE DO                                            <<04786>>18780000
  BEGIN                                                        <<04786>>18782000
    PARMNUM:=PARMNUM+1;                                        <<04786>>18784000
    SCAN PARMPOINT WHILE "  ",1;                               <<04786>>18786000
    @PARMPOINT := TOS;                                         <<04786>>18788000
    IF PARMPOINT<>ALPHA THEN                                   <<04786>>18790000
      BEGIN                                                    <<04786>>18792000
        @ERRPTR:=@PARMPOINT;                                   <<04786>>18794000
        ERRORNUM:=NONALPHA;                                    <<04786>>18796000
      END                                                      <<04786>>18798000
    ELSE                                                       <<04786>>18800000
      BEGIN                                                    <<04786>>18802000
        MOVE PARMPOINT:=PARMPOINT WHILE ANS,1;                 <<04786>>18804000
        PARMLEN:=TOS-@PARMPOINT;                               <<04786>>18806000
        ENTRYNO:=SEARCH(PARMPOINT,PARMLEN,LOCALDICT);          <<04786>>18808000
        CASE ENTRYNO OF                                        <<04786>>18810000
         BEGIN                                                 <<04786>>18812000
                                                               <<04786>>18814000
           BEGIN                     <<  OPTION NOT FOUND  >>  <<04786>>18816000
             @ERRPTR:=@PARMPOINT;                              <<04786>>18818000
             ERRORNUM:=INVALID'PARM;                           <<04786>>18820000
           END;                                                <<04786>>18822000
                                                               <<04786>>18824000
           SETSTDLIST(PARMPOINT,ERRPTR,ERRORNUM,PARMNUM);      <<04786>>18826000
                                                               <<04786>>18828000
         END;                                                  <<04786>>18830000
                                                               <<04786>>18832000
<<    IF COMMAND DELIMITER IS A SEMICOLON--CONTINUE PARSING,>> <<04786>>18834000
<<    A CR: THEN STOP PARSING;  ANYTHING ELSE IS AN ERROR   >> <<04786>>18836000
                                                               <<04786>>18838000
        IF (PARMPOINT=SEMICOL) AND (ERRORNUM=0)  THEN          <<04786>>18840000
           @PARMPOINT:=@PARMPOINT+1                            <<04786>>18842000
        ELSE                                                   <<04786>>18844000
          IF (PARMPOINT<>CR) AND (ERRORNUM=0)  THEN            <<04786>>18846000
            BEGIN                                              <<04786>>18848000
              @ERRPTR:=@PARMPOINT;                             <<04786>>18850000
              ERRORNUM:=-UNEXP'DELIM;                          <<04786>>18852000
            END                                                <<04786>>18854000
          ELSE                                                 <<04786>>18856000
            STILLPARSE:=FALSE;                                 <<04786>>18858000
      END;                                                     <<04786>>18860000
                                                               <<04786>>18862000
<<      TAKE CARE OF ANY ERRORS                      >>        <<04786>>18864000
                                                               <<04786>>18866000
      IF ERRORNUM<>0 THEN                                      <<04786>>18868000
        BEGIN                                                  <<04786>>18870000
          ERRNUM:=ERRORNUM;                                    <<04786>>18872000
          CIERR(ERRNUM,ERRPTR);                                <<04786>>18874000
          IF ERRNUM>0 THEN                                     <<04786>>18876000
             RETURN;                                           <<04786>>18878000
        END;                                                   <<04786>>18880000
                                                               <<04786>>18882000
  END;                                                         <<04786>>18884000
END;                                                           <<04786>>18886000
$CONTROL SEGMENT=CIPREPRUN                                     <<U.RAO>>18888000
      PROCEDURE CXSETMSG EXECUTORHEAD;                                  18890000
      OPTION PRIVILEGED,UNCALLABLE;                                     18892000
      BEGIN                                                             18894000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>18896000
BYTE POINTER BPARM = PARMS;  <<POINTER TO ARGUMENT>>           <<U.RAO>>18898000
BYTE BPARMLEN = PARMS+1;     <<ARGUMENT LENGTH>>               <<U.RAO>>18900000
BYTE POINTER EXTRAPARM = PARMS+2;                              <<U.RAO>>18902000
DOUBLE DDL := [8/",",8/";",16/%6400]D;                         <<U.RAO>>18904000
BYTE ARRAY DL(*)=DDL;                                          <<U.RAO>>18906000
INTEGER NUMPARMS;                                              <<U.RAO>>18908000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>18910000
IF NUMPARMS = 0 THEN   <<NOT ENOUGH PARMS>>                    <<U.RAO>>18912000
   BEGIN                                                       <<U.RAO>>18914000
   CIERR(ERRNUM := SETMSGPARMPROB, PARMSP(1));                 <<U.RAO>>18916000
   PARMNUM := 1;                                               <<U.RAO>>18918000
   END                                                         <<U.RAO>>18920000
ELSE IF NUMPARMS > 1 THEN  <<TOO MANY PARMS>>                  <<U.RAO>>18922000
   BEGIN                                                       <<U.RAO>>18924000
   CIERR(ERRNUM := SETMSGEXTRAPARM, EXTRAPARM);                <<U.RAO>>18926000
   PARMNUM := 2;                                               <<U.RAO>>18928000
   END                                                         <<U.RAO>>18930000
ELSE IF (BPARMLEN=2) AND (BPARM="ON")                          <<U.RAO>>18932000
     OR (BPARMLEN=3) AND (BPARM="OFF") THEN                    <<U.RAO>>18934000
   BEGIN  <<HAVE LEGAL ARGUMENT>>                              <<U.RAO>>18936000
   SETXPXGLOB;                                                 <<U.RAO>>18938000
   TOS := ARRDB3(X).(0:8);  <<GET JMAT INDEX>>                 <<U.RAO>>18940000
   EXCHANGEDB(JMATDST);                                        <<U.RAO>>18942000
   ARRDB0(TOS*JMATLEN).(8:1) := BPARMLEN;  <<TRICKY, THIS>>    <<U.RAO>>18944000
   EXCHANGEDB(0);                                              <<U.RAO>>18946000
   END                                                         <<U.RAO>>18948000
ELSE  <<UNKNOWN ARGUMENT>>                                     <<U.RAO>>18950000
   BEGIN                                                       <<U.RAO>>18952000
   PARMNUM := 1;                                               <<U.RAO>>18954000
   CIERR(ERRNUM := SETMSGPARMPROB, BPARM);                     <<U.RAO>>18956000
   END;                                                        <<U.RAO>>18958000
END;  <<CXSETMSG>>                                             <<U.RAO>>18960000
      PROCEDURE SETDUMP(FLAGS);                                         18962000
      VALUE FLAGS;                                                      18964000
      LOGICAL FLAGS;                                                    18966000
      BEGIN                                                             18968000
      ERRORON;                                                          18970000
      SETXPXGLOB;                                                       18972000
      FLAGS.(10:1):=1;<<ARM>>                                           18974000
      TOS:=IF ARRDB5(X).(0:6)<>0 THEN 0 ELSE 2;                         18976000
      ARRDB5(X).(0:6):=FLAGS;                                           18978000
      STATUS.(6:2):=TOS;<<SET CONDITION CODE>>                          18980000
      ERROREXIT(1,0,0);                                                 18982000
      END;<<SET DUMP>>                                                  18984000
      PROCEDURE RESETDUMP;                                              18986000
      OPTION PRIVILEGED;                                                18988000
      BEGIN                                                             18990000
      ERRORON;                                                          18992000
      SETXPXGLOB;                                                       18994000
      TOS := IF ARRDB5(X).(0:6) = 0 THEN 0 ELSE 2;             <<04177>>18996000
      ARRDB5(X).(0:6):=0;                                               18998000
      STATUS.(6:2):=TOS;                                                19000000
      ERROREXIT(0,0,0);                                                 19002000
      END;<<RESET DUMP>>                                                19004000
PROCEDURE CXSETDUMP EXECUTORHEAD;                              <<U.RAO>>19006000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>19008000
BEGIN                                                          <<U.RAO>>19010000
INTEGER PCNT:=0,  <<PARM COUNT>>                               <<U.RAO>>19012000
        NUMPARMS,                                              <<U.RAO>>19014000
        NEXTDELIM,  <<DELIMITER FOUND AFTER CURRENT TOKEN>>    <<U.RAO>>19016000
        PLEN;   <<LENGTH OF CURRENT PARM>>                     <<U.RAO>>19018000
LOGICAL FLAGS := %20;  <<TEMPLATE FOR DUMP FLAGS>>             <<U.RAO>>19020000
DOUBLE ARRAY PARMS(0:4) = Q;                                   <<U.RAO>>19022000
BYTE POINTER BADPARM = PARMS+8;                                <<U.RAO>>19024000
BYTE POINTER PPNTR;  <<POINTER TO PRESENT TOKEN>>              <<U.RAO>>19026000
DOUBLE DDL := [8/",",8/";",16/%6400]D;                         <<U.RAO>>19028000
BYTE ARRAY DL(*)=DDL;                                          <<U.RAO>>19030000
EQUATE DLEN = 20;  <<LENGTH OF DUMPTYPE ARRAY>>                <<U.RAO>>19032000
BYTE ARRAY DUMPTYPESL(0:DLEN-1) = PB :=                        <<U.RAO>>19034000
   4,2,"ST",                                                   <<U.RAO>>19036000
   4,2,"DB",                                                   <<U.RAO>>19038000
   4,2,"QS",                                                   <<U.RAO>>19040000
   7,5,"ASCII",                                                <<U.RAO>>19042000
   0;                                                          <<U.RAO>>19044000
BYTE ARRAY DUMPTYPES(0:DLEN-1);                                <<U.RAO>>19046000
                                                               <<U.RAO>>19048000
SUBROUTINE GETNEXTPARM;                                        <<U.RAO>>19050000
BEGIN                                                          <<U.RAO>>19052000
TOS := PARMS(PCNT);                                            <<U.RAO>>19054000
NEXTDELIM := S0.(14:2);                                        <<U.RAO>>19056000
PLEN := TOS&LSR(8);                                            <<U.RAO>>19058000
@PPNTR := TOS;                                                 <<U.RAO>>19060000
END;                                                           <<U.RAO>>19062000
                                                               <<U.RAO>>19064000
SUBROUTINE SYNERR;  <<SYNTAX ERROR>>                           <<U.RAO>>19066000
BEGIN                                                          <<U.RAO>>19068000
PARMNUM := PCNT+1;                                             <<U.RAO>>19070000
PPNTR(PLEN) := 0;                                              <<U.RAO>>19072000
CIERR(ERRNUM := SETDUMPUNKNOWN,PPNTR,0,@PPNTR);                <<U.RAO>>19074000
ASSEMBLE(EXIT 3);  <<RETURN>>                                  <<U.RAO>>19076000
END;                                                           <<U.RAO>>19078000
                                                               <<U.RAO>>19080000
MYCOMMAND(PARMSP,DL,5,NUMPARMS,PARMS);                         <<U.RAO>>19082000
PARMNUM := 5;  <<MAX NUMBER OF PARMS>>                         <<U.RAO>>19084000
IF NUMPARMS > 4 THEN                                           <<U.RAO>>19086000
   CIERR(ERRNUM := SETDUMP2MP,BADPARM)                         <<U.RAO>>19088000
ELSE  <<LEGAL NUMBER OF PARMS>>                                <<U.RAO>>19090000
   BEGIN                                                       <<U.RAO>>19092000
   IF NUMPARMS > 0 THEN                                        <<U.RAO>>19094000
      BEGIN  <<PARSE PARMS>>                                   <<U.RAO>>19096000
      MOVE DUMPTYPES := DUMPTYPESL, (DLEN);  <<INIT SEARCH ARRA<<U.RAO>>19098000
      DO   <<LOOP THROUGH PARMS, IDENTIFYING DUMP TYPES>>      <<U.RAO>>19100000
         BEGIN                                                 <<U.RAO>>19102000
         GETNEXTPARM;                                          <<U.RAO>>19104000
         IF PLEN <> 0 THEN  <<PARM IS PRESENT>>                <<U.RAO>>19106000
            CASE SEARCH(PPNTR, PLEN, DUMPTYPES) OF             <<U.RAO>>19108000
               BEGIN                                           <<U.RAO>>19110000
               SYNERR;  <<NON-EXISTANT TYPE>>                  <<U.RAO>>19112000
               FLAGS.(14:1) := 1;  <<ST>>                      <<U.RAO>>19114000
               FLAGS.(15:1) := 1;  <<DB>>                      <<U.RAO>>19116000
               FLAGS.(13:1) := 1;  <<QS>>                      <<U.RAO>>19118000
               FLAGS.(11:1) := 0;  <<ASCII>>                   <<U.RAO>>19120000
               END;                                            <<U.RAO>>19122000
         PCNT := PCNT+1;                                       <<U.RAO>>19124000
         END                                                   <<U.RAO>>19126000
      UNTIL NEXTDELIM=2;  <<UNTIL FIND CR DELIMITER>>          <<U.RAO>>19128000
      END;                                                     <<U.RAO>>19130000
   SETDUMP(FLAGS);                                             <<U.RAO>>19132000
   END;                                                        <<U.RAO>>19134000
END;  <<CXSETDUMP>>                                            <<U.RAO>>19136000
PROCEDURE CXRESETDUMP EXECUTORHEAD;                            <<U.RAO>>19138000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>19140000
BEGIN                                                          <<U.RAO>>19142000
MYCOMMAND(PARMSP,,0);                                          <<U.RAO>>19144000
IF <> THEN CIERR(ERRNUM := -WARNXPARMSIGNORED,PARMSP);         <<04785>>19146000
RESETDUMP;                                                     <<U.RAO>>19148000
END;                                                           <<U.RAO>>19150000
$CONTROL SEGMENT=MAIN                                                   19152000
END.                                                                    19154000
