$CONTROL USLINIT,CODE,MAP                                      <<01549>>00010000
<< CIFILES of the Command Interpreter.  Module 5A >>           <<04848>>00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$THIRTY                                                                 00055000
$TITLE "IMS"                                                            00060000
$CONTROL NOLIST                                                         00065000
<<*****************  Command Interpreter IMS  *****************<<U.RAO>>00070000
<<*************************************************************<<U.RAO>>00075000
<<                                                             <<U.RAO>>00080000
<<*************************************************************<<U.RAO>>00085000
<<************************  OVERVIEW  *************************<<U.RAO>>00090000
<<*************************************************************<<U.RAO>>00095000
<<                                                             <<U.RAO>>00100000
<<WHO:                                                         <<U.RAO>>00105000
<<   Larry Birenbaum designed the basic structures of the      <<U.RAO>>00110000
<<Command Interpreter for VERSION A of MPE.  Work was begun in <<U.RAO>>00115000
<<1970 or 1971.                                                <<U.RAO>>00120000
<<   Bob Olson substantially redesigned the parsers of the     <<U.RAO>>00125000
<<Command Interpreter for VERSION B of MPE II.  Work was begun <<U.RAO>>00130000
<<in November 1976 and completed in late 1977.  The basic      <<U.RAO>>00135000
<<algorithms for executing the commands remained essentially   <<U.RAO>>00140000
<<the same even though the parsers were rewritten.  Several    <<U.RAO>>00145000
<<new commands were added at this time, as were User Defined   <<U.RAO>>00150000
<<Commands.                                                    <<U.RAO>>00155000
<<   Other people who have added commands or modified existing <<U.RAO>>00160000
<<commands for MPE IIB are Ron Hoyt and Bob Vannucci (Private  <<U.RAO>>00165000
<<Volumes, including modification of the accounting commands   <<U.RAO>>00170000
<<and STORE/RESTORE), Neal Mack (Transaction Logging user      <<U.RAO>>00175000
<<commands), Mike Philben (revision of DS commands), Ed Basart <<U.RAO>>00180000
<<(revision of HELLO, JOB, and DATA and the addition of User   <<U.RAO>>00185000
<<Defined Commands), and Bob Gerstmeyer (CLINE command).       <<U.RAO>>00190000
<<                                                             <<U.RAO>>00195000
<<WHERE:                                                       <<U.RAO>>00200000
<<   Pieces of the Command Interpreter are scattered all over  <<U.RAO>>00205000
<<the system.  This module contains the bulk of the executors. <<U.RAO>>00210000
<<The spooling commands (SHOWJOB, SHOWOUT, STREAM, and SHOWIN) <<U.RAO>>00215000
<<may be found in the SPOOLCOMS module.  The DS commands       <<U.RAO>>00220000
<<(RFA, DSLINE, REMOTE) will be found in the DS code.  STORE   <<U.RAO>>00225000
<<and RESTORE have a module of their own.  The bulk of the work<<U.RAO>>00230000
<<for User Defined Commands is done in a module called UDC.    <<U.RAO>>00235000
<<HELP resides in module HELPUSER.  JOB, HELLO and DATA are    <<U.RAO>>00240000
<<parsed by code in module NURSERY.  In general, it is better  <<U.RAO>>00245000
<<to put the executors in the same module as the routines which<<U.RAO>>00250000
<<do the work.  This will reduce confusion and simplify        <<U.RAO>>00255000
<<maintenance.  There is no inherent benefit to accumulating   <<U.RAO>>00260000
<<executors in common segments, assuming that there is         <<U.RAO>>00265000
<<non-trivial work to do.                                      <<U.RAO>>00270000
<<                                                             <<U.RAO>>00275000
<<WHY:                                                         <<U.RAO>>00280000
<<   The purpose served by the Command Interpreter is to       <<U.RAO>>00285000
<<provide the user access to the operating system functions    <<U.RAO>>00290000
<<without requiring him/her to go through the irritation of    <<U.RAO>>00295000
<<writing a program to do so.  There are three primary function<<U.RAO>>00300000
<<provided by the commands.  Most important is the ability to  <<U.RAO>>00305000
<<execute programs, evidenced by the RUN command and the variou<<U.RAO>>00310000
<<compiler commands.  Second is the ability to manage one's    <<U.RAO>>00315000
<<resources, such as files.  Finally there are a large number o<<U.RAO>>00320000
<<utility functions, primarily for status checking.  When a new<<U.RAO>>00325000
<<capability is added to the system, the user should be given  <<U.RAO>>00330000
<<commands which allow him to manipulate the capability and to <<U.RAO>>00335000
<<determine the status of the new resource created by the      <<U.RAO>>00340000
<<capability.                                                  <<U.RAO>>00345000
<<                                                             <<U.RAO>>00350000
$PAGE                                                                   00355000
<<*************************************************************<<U.RAO>>00360000
<<****************  ADDING A COMMAND TO THE CI  ***************<<U.RAO>>00365000
<<*************************************************************<<U.RAO>>00370000
<<                                                             <<U.RAO>>00375000
<<Step 1:  Designing the command.                              <<U.RAO>>00380000
<<   A reasonable and parseable command syntax is one of the   <<U.RAO>>00385000
<<important parts of designing a good command.  Your goal is   <<U.RAO>>00390000
<<to minimize user irritation when using the command.  Always  <<U.RAO>>00395000
<<remember that for most users the problem for which they are  <<U.RAO>>00400000
<<using a computer is probably solved within an application    <<U.RAO>>00405000
<<program of some sort and the Command Interpreter in general  <<U.RAO>>00410000
<<and your command in particular are necessary annoyances.     <<U.RAO>>00415000
<<You must strive to limit that annoyance to the unavoidable.  <<U.RAO>>00420000
<<   Unfortunately, there are a wide variety of ways in which  <<U.RAO>>00425000
<<you can annoy people.  Some of the solutions are mutually    <<U.RAO>>00430000
<<incompatible.  The following is a list of the issues you     <<U.RAO>>00435000
<<should consider.                                             <<U.RAO>>00440000
<<   1)  Verbose versus terse command names                    <<U.RAO>>00445000
<<       In general it is desireable to have command names     <<U.RAO>>00450000
<<       which accurately reflect the function of the          <<U.RAO>>00455000
<<       command.  The tradeoff is that verbose command        <<U.RAO>>00460000
<<       names which describe the command are easier to        <<U.RAO>>00465000
<<       pick out in documentation whereas terse names are     <<U.RAO>>00470000
<<       easier to type.  Thus the deciding factor should      <<U.RAO>>00475000
<<       be how often the user will use the command.  A        <<U.RAO>>00480000
<<       side consideration is that the use of archaic         <<U.RAO>>00485000
<<       English or bizarre abbreviations will work a          <<U.RAO>>00490000
<<       hardship on our users who are not native English      <<U.RAO>>00495000
<<       speakers.                                             <<U.RAO>>00500000
<<   2)  Keyword versus positional parameters                  <<U.RAO>>00505000
<<       Positional parameters can be dangerous, especially    <<U.RAO>>00510000
<<       when the parameters can be similar data types.        <<U.RAO>>00515000
<<       For example, a positional string of numbers can       <<U.RAO>>00520000
<<       result in erroneous operation due to the accidental   <<U.RAO>>00525000
<<       omission of a delimiter.  Keyworded parameters        <<U.RAO>>00530000
<<       can be very verbose, especially on complex commands.  <<U.RAO>>00535000
<<       They can also work a hardship when a user uses a      <<U.RAO>>00540000
<<       particular command heavily, since it drastically      <<U.RAO>>00545000
<<       enlarges the amount of typing.  This last objection   <<U.RAO>>00550000
<<       can be gotten around through the agency of User       <<U.RAO>>00555000
<<       Defined Commands.  Another major objection to         <<U.RAO>>00560000
<<       keywords is that it requires several different        <<U.RAO>>00565000
<<       delimiters, often leading to typing errors and        <<U.RAO>>00570000
<<       mental confusion.                                     <<U.RAO>>00575000
<<   3)  Delimiters & other special characters                 <<U.RAO>>00580000
<<       The typical delimiters in commands are commas to      <<U.RAO>>00585000
<<       separate positional parameters and semicolons to      <<U.RAO>>00590000
<<       separate keywords.  The file command shows this       <<U.RAO>>00595000
<<       in full generality.  Periods are sometimes            <<U.RAO>>00600000
<<       terminators (as in the LABEL option on the FILE       <<U.RAO>>00605000
<<       command) and sometimes separators, as in the logon    <<U.RAO>>00610000
<<       user ID and file names.  Blanks are tough to deal     <<U.RAO>>00615000
<<       with and should be avoided as delimiters.             <<U.RAO>>00620000
<<       Non-printing characters should be avoided at all      <<U.RAO>>00625000
<<       costs.  All commands will be terminated with a        <<U.RAO>>00630000
<<       carriage return when passed to the command parser.    <<U.RAO>>00635000
<<   4)  Hardware/software peculiarities                       <<U.RAO>>00640000
<<       Too frequently the command syntax reflects some       <<U.RAO>>00645000
<<       strange and unpleasant aspect of the mechanism        <<U.RAO>>00650000
<<       underlying the command.  We should not require the    <<U.RAO>>00655000
<<       user to be cognizant of our design problems.  To      <<U.RAO>>00660000
<<       do so violates the principle of lowering the          <<U.RAO>>00665000
<<       annoyance factor.                                     <<U.RAO>>00670000
<<   5)  Extensibility                                         <<U.RAO>>00675000
<<       No matter how well your command does its job, one     <<U.RAO>>00680000
<<       of these days someone will want to modify or          <<U.RAO>>00685000
<<       extend it.  In particular, one should be careful      <<U.RAO>>00690000
<<       about the use of delimiters in ways other than the    <<U.RAO>>00695000
<<       "traditional" way.  For example, periods, commas,     <<U.RAO>>00700000
<<       semicolons and others have fairly standardized        <<U.RAO>>00705000
<<       meanings, and to use them in a different way reduces  <<U.RAO>>00710000
<<       the options of your successor to extend your command. <<U.RAO>>00715000
<<       Another related issue is that listing formats should  <<U.RAO>>00720000
<<       be extensible.                                        <<U.RAO>>00725000
<<   6)  Defaults                                              <<U.RAO>>00730000
<<       Defaults are vital, dangerous and difficult to choose.<<U.RAO>>00735000
<<       The design goal is that the command should be simple  <<U.RAO>>00740000
<<       for simple minded users.  This implies restraint in   <<U.RAO>>00745000
<<       the use of defaults which vary depending on some other<<U.RAO>>00750000
<<       parameter to the command.  Too smart defaults can be  <<U.RAO>>00755000
<<       just as bad as no defaults, since many users will     <<U.RAO>>00760000
<<       use the command defensively to avoid surprises from   <<U.RAO>>00765000
<<       the default mechanism.  Good luck.                    <<U.RAO>>00770000
<<   7)  Ambiguity                                             <<U.RAO>>00775000
<<       Careful design will avoid the need for lookahead to   <<U.RAO>>00780000
<<       resolve abiguous situations.  Lookahead should be     <<U.RAO>>00785000
<<       avoided if at all possible, as it results in          <<U.RAO>>00790000
<<       much code with complicated data structures.           <<U.RAO>>00795000
<<   8)  Computerese                                           <<U.RAO>>00800000
<<       Keywords should be couched in English, not computerese<<U.RAO>>00805000
<<                                                             <<U.RAO>>00810000
<<In summary, the user of your command will probably not be a  <<U.RAO>>00815000
<<computer professional and probably will be annoyed at the nee<<U.RAO>>00820000
<<to use your command at all.  Simplicity, understandability an<<U.RAO>>00825000
<<regularity are the keys to good command syntax.              <<U.RAO>>00830000
<<                                                             <<U.RAO>>00835000
<<Step 2: Code the Executor.                                   <<U.RAO>>00840000
<<   For the most part this is quite straightforward.  Most of <<U.RAO>>00845000
<<the existing executors can be used as models.  There are a fe<<U.RAO>>00850000
<<good concepts to keep in mind, however.                      <<U.RAO>>00855000
<<   Generating good error messages is just as important as    <<U.RAO>>00860000
<<executing the command.  The whole error message issue is deal<<U.RAO>>00865000
<<with below.                                                  <<U.RAO>>00870000
<<   The code of the command should be easily extensible.  This<<U.RAO>>00875000
<<implies the use of a simple parsing scheme with very obvious <<U.RAO>>00880000
<<techniques.  Probably more often than any other part of the  <<U.RAO>>00885000
<<system, the CI is modified by people who have no proprietary <<U.RAO>>00890000
<<interest in it.  In the interests of reliability and         <<U.RAO>>00895000
<<maintainability, it is desireable to start with as clean code<<U.RAO>>00900000
<<as possible.  Unfortunately, no universal parsing scheme has <<U.RAO>>00905000
<<yet been developed for the CI.                               <<U.RAO>>00910000
<<   A trap to avoid is called the "parse a little, execute a  <<U.RAO>>00915000
<<little" syndrome.  It results in the need to back out of a   <<U.RAO>>00920000
<<situation when an error is detected further down stream.  A  <<U.RAO>>00925000
<<secondary problem is that it tends to result in the          <<U.RAO>>00930000
<<partial destruction of the context of the error.  A command  <<U.RAO>>00935000
<<should be parsed completely before being executed at all.    <<U.RAO>>00940000
<<   Don't worry about having particularly efficient code.  The<<U.RAO>>00945000
<<CI's execution time is trivial compared to the time it takes <<U.RAO>>00950000
<<for the user to recover from a poorly designed error message <<U.RAO>>00955000
<<or even from a poorly designed syntax.  The customer always  <<U.RAO>>00960000
<<comes first.                                                 <<U.RAO>>00965000
<<   The use of global storage is discouraged.  Most important <<U.RAO>>00970000
<<is the fact that there are some performance consequences     <<U.RAO>>00975000
<<related to the need to constantly enlarge the CI's stack.    <<U.RAO>>00980000
<<If you find you do need global storage, be sure to initialize<<U.RAO>>00985000
<<it in procedure COMMANDINTERP, as the CI is procreated and   <<U.RAO>>00990000
<<thus has no global initialization capability.  Be careful    <<U.RAO>>00995000
<<about where you put new globals.  Certain other modules such <<U.RAO>>01000000
<<as UDC know about the CI global space.                       <<U.RAO>>01005000
<<   In general, the execution part of the command should simpl<<U.RAO>>01010000
<<be a call to the appropriate user callable intrinsic.  The   <<U.RAO>>01015000
<<CI usually should not provide the user any special services  <<U.RAO>>01020000
<<that are not available programmatically.  In this way we avoi<<U.RAO>>01025000
<<such undesireable situations as users getting their accountin<<U.RAO>>01030000
<<information through a call to the REPORT command and setting <<U.RAO>>01035000
<<up their files through a call to the FILE command through the<<U.RAO>>01040000
<<COMMAND intrinsic.  See the SETJCW command for an example of <<U.RAO>>01045000
<<this.                                                        <<U.RAO>>01050000
<<   EXCHANGEDB is to be avoided if at all possible, even if   <<U.RAO>>01055000
<<you have to do data segment moves iteratively.  The speed cos<<U.RAO>>01060000
<<is nothing compared to the cost of the crash which is        <<U.RAO>>01065000
<<inevitable when doing split stack operations.  All of the CI <<U.RAO>>01070000
<<utility routines assume no split stack operation.            <<U.RAO>>01075000
<<   Similarly there is rarely any valid reason for accessing  <<U.RAO>>01080000
<<system primitives directly from the CI.  The CI should be a  <<U.RAO>>01085000
<<very high level module.  It rarely has any business rooting  <<U.RAO>>01090000
<<around in some system table.  This principle unfortunately ha<<U.RAO>>01095000
<<been rather imperfectly adhered to.                          <<U.RAO>>01100000
<<   These almost random thoughts about writing executors hardl<<U.RAO>>01105000
<<provide a good framework for writing code.  Cursory          <<U.RAO>>01110000
<<examination of some of the executors currently in the module <<U.RAO>>01115000
<<probably will give you a better idea of the tricks of the    <<U.RAO>>01120000
<<trade.  A few ideas stand out.                               <<U.RAO>>01125000
<<                                                             <<U.RAO>>01130000
<<      Code assuming someone else will be changing it.        <<U.RAO>>01135000
<<                                                             <<U.RAO>>01140000
<<      Code for good error messages, not speed.               <<U.RAO>>01145000
<<                                                             <<U.RAO>>01150000
<<      It is far better to detect a problem at the            <<U.RAO>>01155000
<<      time the command is put in than when it is             <<U.RAO>>01160000
<<      executed.  That is, at parse time as opposed           <<U.RAO>>01165000
<<      to execution time.                                     <<U.RAO>>01170000
<<                                                             <<U.RAO>>01175000
<<      Cleverness will get you in trouble, usually for        <<U.RAO>>01180000
<<      no good reason.                                        <<U.RAO>>01185000
<<                                                             <<U.RAO>>01190000
<<Step 3:  Add the command to the Command Interpreter.         <<U.RAO>>01195000
<<   Other than physically adding the executor to the system,  <<U.RAO>>01200000
<<the only task is to add the command name to the list in      <<U.RAO>>01205000
<<procedure COMSEARCH.  This procedure is called for each      <<U.RAO>>01210000
<<command to determine if it is one of the ones known to the   <<U.RAO>>01215000
<<system.  The mechanics of this process are described in that <<U.RAO>>01220000
<<procedure.  If the executor is physically outside the CI     <<U.RAO>>01225000
<<module, don't forget to add the OPTION EXTERNAL declaration. <<U.RAO>>01230000
<<Congratulations.  Now all you need to do is make sure it     <<U.RAO>>01235000
<<works.                                                       <<U.RAO>>01240000
<<                                                             <<U.RAO>>01245000
$PAGE                                                                   01250000
<<*************************************************************<<U.RAO>>01255000
<<**************  ERROR MESSAGES FROM THE CI  **************** <<U.RAO>>01260000
<<*************************************************************<<U.RAO>>01265000
<<                                                             <<U.RAO>>01270000
<<Philosophical aspects:                                       <<U.RAO>>01275000
<<     The essential goal of an error message from the CI is to<<U.RAO>>01280000
<<help the user quickly recover from his problem.  In general, <<U.RAO>>01285000
<<a good error message should indicate:                        <<U.RAO>>01290000
<<    1)  What the CI did not like.  On syntax errors this     <<U.RAO>>01295000
<<        typically is done with a caret underneath where the  <<U.RAO>>01300000
<<        problem was detected.  If the caret isn't sufficient <<U.RAO>>01305000
<<        to identify the problem then some of the text of the <<U.RAO>>01310000
<<        message should further elaborate.  On semantic errors<<U.RAO>>01315000
<<        this usually is done with the text of the message.   <<U.RAO>>01320000
<<    2)  How to recover.  This usually will take the form of  <<U.RAO>>01325000
<<        telling the user what the valid input might be.  For <<U.RAO>>01330000
<<        example, on an invalid record type in the :FILE      <<U.RAO>>01335000
<<        command, the CI will put out a message something like<<U.RAO>>01340000
<<        EXPECTED RECORD TYPE TO BE F, V OR U.                <<U.RAO>>01345000
<<        This serves to identify to the user very quickly what<<U.RAO>>01350000
<<        the valid syntax is and thus how to get on with his  <<U.RAO>>01355000
<<        business.  Sometimes it is hard to figure out what th<<U.RAO>>01360000
<<        user had in mind.  For example, it isn't really      <<U.RAO>>01365000
<<        possible to second guess the user on an unknown      <<U.RAO>>01370000
<<        command name.  In these relatively rare cases, it is <<U.RAO>>01375000
<<        sufficient to tell the user just what was wrong.     <<U.RAO>>01380000
<<        In general, if it is a syntax error of any sort, it  <<U.RAO>>01385000
<<        is possible to give a good error message outlining   <<U.RAO>>01390000
<<        what was expected.  A cop-out on this is really      <<U.RAO>>01395000
<<        sloppy workmanship.                                  <<U.RAO>>01400000
<<    3)  In many cases it is desireable to tell the user what <<U.RAO>>01405000
<<        was done about the error.  This is particularly true <<U.RAO>>01410000
<<        in the case of warnings, where the user may be left  <<U.RAO>>01415000
<<        wondering whether some default was taken.  For exampl<<U.RAO>>01420000
<<        in the accounting structure commands we ignore many  <<U.RAO>>01425000
<<        errors.  In each case it is necessary to tell the use<<U.RAO>>01430000
<<        what default we took so that he can then do an ALTxxx<<U.RAO>>01435000
<<        to fix up the particular error, if necessary.  Of    <<U.RAO>>01440000
<<        course, in each case we try to pick a reasonable     <<U.RAO>>01445000
<<        default so that he doesn't have to do any recovery.  <<U.RAO>>01450000
<<                                                             <<U.RAO>>01455000
<<In any case, messages should be very specific.  Given the    <<U.RAO>>01460000
<<very simple mechanism for generating error and warning       <<U.RAO>>01465000
<<messages, there is no acceptable excuse for generic messages.<<U.RAO>>01470000
<<Examples:                                                    <<U.RAO>>01475000
<<   "INVALID NUMBER" is unacceptable.  Such messages should be<<U.RAO>>01480000
<<of the form "EXPECTED <item> TO BE BETWEEN <n1> AND <n2>."   <<U.RAO>>01485000
<<This message should be used only once in the CI.             <<U.RAO>>01490000
<<   "UNKNOWN KEYWORD" is unacceptable.  The proper form is    <<U.RAO>>01495000
<<"EXPECTED ONE OF <item1>, <item2>....".                      <<U.RAO>>01500000
<<   In general, "<item>", "<n1>" and so forth should not be   <<U.RAO>>01505000
<<passed to CIERR as parameters but rather be embedded as part <<U.RAO>>01510000
<<of the error message.  The reason for this is that you will  <<U.RAO>>01515000
<<need to give a fuller description of the error in the Error  <<U.RAO>>01520000
<<Messages part of the MPE manual.  It is awkward at best and  <<U.RAO>>01525000
<<embarrassing at worst to have to tell the manual writer "Well<<U.RAO>>01530000
<<it could be this, or it could be that, or even this third    <<U.RAO>>01535000
<<thing."  The one exception is where truly dynamic information<<U.RAO>>01540000
<<is involved.  Examples might include configuration data and  <<U.RAO>>01545000
<<user supplied information like file names.>>                 <<U.RAO>>01550000
<<   In most cases, redundantly specified parameters should    <<U.RAO>>01555000
<<result not in a fatal error but in a warning.  If a value is <<U.RAO>>01560000
<<associated with the redundant keyword then the message should<<U.RAO>>01565000
<<specify that the last value found was used.                  <<U.RAO>>01570000
<<   Similarly unacceptable messages are                       <<U.RAO>>01575000
<<   "INSUFFICIENT PARAMETERS" - what is missing?              <<U.RAO>>01580000
<<   "INSUFFICIENT CAPABILITY" should say what capability is   <<U.RAO>>01585000
<<missing.                                                     <<U.RAO>>01590000
<<   "INSUFFICIENT RESOURCES" should say what resources are    <<U.RAO>>01595000
<<lacking.                                                     <<U.RAO>>01600000
<<And so forth for all messages.                               <<U.RAO>>01605000
<<                                                             <<U.RAO>>01610000
<<Mechanical aspects of adding error messages:                 <<U.RAO>>01615000
<<                                                             <<U.RAO>>01620000
<<1)  Numbering                                                <<U.RAO>>01625000
<<    The number chosen for a message is largely irrelevant.  I<<U.RAO>>01630000
<<    is nice, however, if it is near the other messages       <<U.RAO>>01635000
<<    associated with the same command.  Be sure to declare it <<U.RAO>>01640000
<<    as an equate in the CI globals (or SPOOLCOMS or whatever)<<U.RAO>>01645000
<<    Note that the message should be tagged as to whether it i<<U.RAO>>01650000
<<    a CIERR or CIWARN or whatever.  Put it in message set 2. <<U.RAO>>01655000
<<2)  Generation                                               <<U.RAO>>01660000
<<    There is a procedure called CIERR which is responsible fo<<U.RAO>>01665000
<<    processing related to the handling of errors.  In        <<U.RAO>>01670000
<<    particular this procedure decides whether to print the   <<U.RAO>>01675000
<<    message, abort the job, and other related cleanup        <<U.RAO>>01680000
<<    problems.  Note that it always returns to the caller if  <<U.RAO>>01685000
<<    the job is not aborted.  It is the responsibility of the <<U.RAO>>01690000
<<    caller to assure that the job is clean enough to be      <<U.RAO>>01695000
<<    aborted at the time of the call.  CIERR cannot be called <<U.RAO>>01700000
<<    in split stack mode.  See the listing of CIERR for the   <<U.RAO>>01705000
<<    details of the call.                                     <<U.RAO>>01710000
<<3)  Errors detected by other parts of the system.            <<U.RAO>>01715000
<<    Errors such as file system errors, loader errors, DS     <<U.RAO>>01720000
<<    runtime errors and private volume errors are really of   <<U.RAO>>01725000
<<    little meaning in the context of the CI.  Accordingly,   <<U.RAO>>01730000
<<    when such errors are detected, several messages may be   <<U.RAO>>01735000
<<    displayed.  This is done through the agency of routines  <<U.RAO>>01740000
<<    like FERROR', CYDIRERR', LOADERROR, and CREATEERROR.     <<U.RAO>>01745000
<<    The development of such routines is encouraged whenever  <<U.RAO>>01750000
<<    message sets outside the CI error message set is         <<U.RAO>>01755000
<<    involved.  When such a message is output, the CI should  <<U.RAO>>01760000
<<    also print a message translating the error into the      <<U.RAO>>01765000
<<    context of the command which failed.  For example, when  <<U.RAO>>01770000
<<    a purge fails for an unusual reason, we print the file   <<U.RAO>>01775000
<<    system error message as well as a message saying that the<<U.RAO>>01780000
<<    purge was not done.                                      <<U.RAO>>01785000
<<4)  General purpose parsing routines                         <<U.RAO>>01790000
<<    Some parses, such as file names, are done so often that  <<U.RAO>>01795000
<<    generalized routines exist.  Usually these will be found <<U.RAO>>01800000
<<    in the neighborhood of the error handling routines.      <<U.RAO>>01805000
<<5)  Programmatically callable commands                       <<U.RAO>>01810000
<<    For errors in programmatically callable commands you must<<U.RAO>>01815000
<<    also return the error number to the caller of the COMMAND<<U.RAO>>01820000
<<    intrinsic.  This is done by returning the number through <<U.RAO>>01825000
<<    the ERRNUM parameter to all executors.  Also it is       <<U.RAO>>01830000
<<    required that you return the parameter number in the     <<U.RAO>>01835000
<<    PARMNUM parameter.  Parameter number is roughly defined  <<U.RAO>>01840000
<<    as one for each entity such as a keyword or value past   <<U.RAO>>01845000
<<    the command name.  In other words, 1 is the first        <<U.RAO>>01850000
<<    parameter past the command name, 2 might be the value to <<U.RAO>>01855000
<<    be associated with the keyword which was parameter 1.    <<U.RAO>>01860000
<<                                                             <<U.RAO>>01865000
<<   Error message generation is one of the most important     <<U.RAO>>01870000
<<tasks to be performed by the Command Interpreter.  The best  <<U.RAO>>01875000
<<error messages are generated when the coder tries to envision<<U.RAO>>01880000
<<the user's perception of the error.  For example, in many    <<U.RAO>>01885000
<<cases it seems to the user that it was obvious what he meant <<U.RAO>>01890000
<<even though it was not expressed in correct form.  This      <<U.RAO>>01895000
<<includes redundantly specified keywords like NOCCTL in the   <<U.RAO>>01900000
<<file command.  The user does not think highly of a command   <<U.RAO>>01905000
<<parser which gives him an error message on something like tha<<U.RAO>>01910000
<<which is obviously non-fatal.  The key to success with error <<U.RAO>>01915000
<<messages is to identify errors in the user's frame of        <<U.RAO>>01920000
<<reference, not the system programmer's.                      <<U.RAO>>01925000
<<                                                             <<U.RAO>>01930000
$TITLE "GLOBAL DECLARATIONS"                                            01935000
$PAGE "GLOBAL DECLARATIONS"                                             01940000
$CONTROL MAIN=COMMAND'INTERP                                   <<06.EB>>01945000
BEGIN                                                                   01950000
      <<MISCELLANEOUS DECLARATIONS >>                                   01955000
      INTEGER                                                           01960000
      DELTAQ=Q-0,                                                       01965000
      S0=S-0,                                                           01970000
      S4=S-4,                                                           01975000
      XREG = X,                                                         01980000
      X=X;                                                              01985000
                                                                        01990000
      LOGICAL                                                           01995000
      LS0=S-0,                                                          02000000
      STATUS=Q-1;                                                       02005000
                                                                        02010000
      DOUBLE                                                            02015000
      DS1=S-1,                                                          02020000
      DS3=S-3;                                                 << I.A >>02025000
                                                                        02030000
      BYTE POINTER                                                      02035000
      BPS0=S-0,                                                         02040000
      BPS1=S-1;                                                         02045000
                                                                        02050000
      INTEGER POINTER                                                   02055000
      PS0=S-0;                                                 << I.A >>02060000
                                                                        02065000
      DOUBLE POINTER                                                    02070000
      DPS1 = S-1;                                              <<U.RAO>>02075000
                                                                        02080000
      INTEGER ARRAY ARRDB0(*)=DB+0;                                     02085000
      INTEGER ARRAY ARRDB2(*)=DB+2;                                     02090000
      INTEGER ARRAY ARRDB3(*)=DB+3;                                     02095000
      INTEGER ARRAY ARRDB5(*)=DB+5;                                     02100000
      INTEGER ARRAY ARRDB6(*)=DB+6;                                     02105000
      INTEGER ARRAY ARRQ0(*)=Q-0;                                       02110000
      INTEGER ARRAY ARRS7(*)=S-7;                                       02115000
$INCLUDE INCLPXG                                               <<06567>>02120000
$SET X8=OFF                                                    <<06571>>02125000
$INCLUDE INCLJMAT                                              <<06571>>02130000
$INCLUDE INCLCIS                                               << I.A >>02135000
$PAGE "GLOBAL DECLARATIONS"                                    << I.A >>02140000
$INCLUDE INCLJIT                                               <<06840>>02145000
                                                               <<09.EB>>02150000
      <<EQUATES USED THROUGHOUT>>                                       02155000
                                                                        02160000
      EQUATE                                                            02165000
      << SERIES 33 CPU NUMBER RETURNED FROM 'THISCPU' >>       <<00492>>02170000
      <<CONDITION CODES>>                                               02175000
      CCE=2,                                                            02180000
      CCL=1,                                                            02185000
      CCG=0,                                                            02190000
      <<CI MESSAGE SET NUMBERS>>                               <<U.RAO>>02195000
      CIERRMSGSET=2,                                           <<U.RAO>>02200000
      CIGENERALMSGSET=7,                                       <<U.RAO>>02205000
      PVERRMSGSET = 15,                                        <<RH.PV>>02210000
   <<EQUATES FOR GENERAL MESSAGES (NOT ERROR MESSAGES)>>       <<U.RAO>>02215000
   ENDOFPROG       = 50,  <<END OF PROGRAM MESSAGE>>           <<U.RAO>>02220000
   << END OF PREPARE = 51, >>                                  <<U.RAO>>02225000
   << END OF SUBSYSTEM = 52, >>                                <<U.RAO>>02230000
   << END OF COMPILE = 53, >>                                  <<U.RAO>>02235000
   << END OF REMOTE PROGRAM = 54>>                             <<U.RAO>>02240000
   <<JCW = WARN, MSG 56>>                                      <<U.RAO>>02245000
   <<JCW = FATAL, MSG 57>>                                     <<U.RAO>>02250000
   <<JCW = SYSTEM, MSG 58>>                                    <<U.RAO>>02255000
   <<DS MESSAGE, MSG 59>>                                      <<U.RAO>>02260000
   <<DS MESSAGE, MSG 60>>                                      <<U.RAO>>02265000
      <<ERROR EQUATES REFER TO C.I. ERROR NUMBER>>                      02270000
                                                                        02275000
                                                                        02280000
                                                                        02285000
      <<COMMAND RELATED ERRORS>>                                        02290000
   PARAMTOOBIG     =  14,  <<PARAMETER EXCEEDS 255 CHARS>>     <<01709>>02295000
   <<FILE AND BUILD COMMANDS>>                                 <<U.RAO>>02300000
   FDESGNOLOCK     = 199  ,  <<No lockword in formal desgn.>>  <<04848>>02305000
   BLD2MP          = 200  ,  <<MORE THAN 30 PARMS TO BUILD>>   <<U.RAO>>02310000
   BLDREQFILENAME  = 201  ,  <<NAME IS REQUIRED PARM>>         <<U.RAO>>02315000
   FILEFCODEDEFALT = 202  ,  <<FILE CODE MISSING - 0 DEFAULT>> <<U.RAO>>02320000
   FILE2MP         = 203  ,  <<MORE THAN 30 PARMS TO BUILD>>   <<U.RAO>>02325000
   FILEREQFDESIG   = 204  ,  <<REQUIRES FORMAL DESIGNATOR>>    <<U.RAO>>02330000
   FILEFDSGNOBACK  = 205  ,  <<FDESIG MAY NOT BE BACKREF>>     <<U.RAO>>02335000
   FILEFDSGNOSYS   = 206  ,  <<FDESIG MAY NOT BE SYSDEF FILE>> <<U.RAO>>02340000
   FILEREQSOMEPARM = 207  ,  <<NEEDS AT LEAST 2 PARMS>>        <<U.RAO>>02345000
   FILEADESIGBR2MP = 208  ,  <<BACK REF MAY NOT HAVE PARMS>>   <<U.RAO>>02350000
   FILEBREFMISADES = 209  ,  <<UNABLE TO FIND BACK REF'D FILE>><<U.RAO>>02355000
   FILEADESNULL2MP = 210  ,  <<$NULL ADES CANNOT HAVE PARMS>>  <<U.RAO>>02360000
   FILEDOMAINSYSDF = 211  ,  <<CANNOT SPEC FILE DOMAIN>>       <<U.RAO>>02365000
   FILEXPCTDOMAIN  = 212  ,  <<EXPECTED A FILE DOMAIN>>        <<U.RAO>>02370000
   FILEINVLDDOMAIN = 213  ,  <<UNKNOWN DOMAIN TYPE>>           <<U.RAO>>02375000
   FILEXSTRTPARMCR = 214  ,  <<EXPECTED START OF PARMS>>       <<U.RAO>>02380000
   FILEEXTRANDELIM = 215  ,  <<EXTRANEOUS PARM DELIMITER>>     <<U.RAO>>02385000
   FILECONTXTBLD   = 216  ,  <<NOT APPROPRIATE FOR BUILD>>     <<U.RAO>>02390000
   FILECONTXTSYSDF = 217  ,  <<NOT APPROPRIATE FOR SYSDEF FILE><<U.RAO>>02395000
   FILECONTXTOLD   = 218  ,  <<NOT APPROPRIATE FOR OLD FILE>>  <<U.RAO>>02400000
   FILECONTXTNEW   = 219  ,  <<NOT APPROPRIATE FOR NEW FILE>>  <<U.RAO>>02405000
   FILEUNKNOWNKEY  = 220  ,  <<UNKNOWN KEYWORD FOR COMMAND>>   <<U.RAO>>02410000
   FILENOCCTLCCTL  = 221  ,  <<CCTL OVERRIDES NOCCTL>>         <<U.RAO>>02415000
   FILECCTLNOCCTL  = 222  ,  <<NOCCTL OVERRIDES CCTL>>         <<U.RAO>>02420000
   FILEDELTEMP     = 223  ,  <<TEMP OVERRIDES DEL>>            <<U.RAO>>02425000
   FILESAVETEMP    = 224  ,  <<TEMP OVERRIDES SAVE>>           <<U.RAO>>02430000
   FILEDELSAVE     = 225  ,  <<SAVE OVERRIDES DEL>>            <<U.RAO>>02435000
   FILETEMPSAVE    = 226  ,  <<SAVE OVERRIDES TEMP>>           <<U.RAO>>02440000
   FILETEMPDEL     = 227  ,  <<DEL OVERRIDES TEMP>>            <<U.RAO>>02445000
   FILESAVEDEL     = 228  ,  <<DEL OVERRIDES SAVE>>            <<U.RAO>>02450000
   FILEEXCLSHARE   = 229  ,  <<SHR OVERRIDES EXCLUSIVE>>       <<U.RAO>>02455000
   FILEEXCLEAR     = 231  ,  <<EAR OVERRIDES EXC>>             <<U.RAO>>02460000
   FILESHAREEAR    = 232  ,  <<EAR OVERRIDES SHARE>>           <<U.RAO>>02465000
   FILEEAREXCL     = 233  ,  <<EXC OVERRIDES EAR>>             <<U.RAO>>02470000
   FILESHAREEXCL   = 234  ,  <<EXC OVERRIDES SHARE>>           <<U.RAO>>02475000
   FILEBUFNOBUF    = 235  ,  <<NOBUF OVERRIDES BUF>>           <<U.RAO>>02480000
   FILENOMRMR      = 236  ,  <<MR OVERRIDES NOMR>>             <<U.RAO>>02485000
   FILEMRNOMR      = 237  ,  <<NOMR OVERRIDES MR>>             <<U.RAO>>02490000
   FILENOMULTIMULTI= 238  ,  <<MULTI OVERRIDES NOMULTI>>       <<U.RAO>>02495000
   FILEMULTINOMULTI= 239  ,  <<NOMULTI OVERRIDES MULTI>>       <<U.RAO>>02500000
   FILENOWAITWAIT  = 240 ,  <<WAIT OVERRIDES NOWAIT>>          <<U.RAO>>02505000
   FILEWAITNOWAIT  = 241 ,  <<NOWAIT OVERRIDES WAIT>>          <<U.RAO>>02510000
   FILENOXPCTSPARM = 242 ,  <<NO SUBPARMS FOR THIS KEY>>       <<U.RAO>>02515000
   FILEREQEQSIGN   = 243 ,  <<EXPECTED EQUALS SIGN>>           <<U.RAO>>02520000
   FILEACCESSREDND = 244 ,  <<ACCESS REDUNDANTLY SPECIFIED>>   <<U.RAO>>02525000
   FILEACCREQVALUE = 245 ,  <<ACCESS TYPE REQUIRED>>           <<U.RAO>>02530000
   FILEACCINVALID  = 246 ,  <<UNKNOWN ACCESS TYPE>>            <<U.RAO>>02535000
   FILEACCXTRNPARM = 247 ,  <<EXTRANEOUS PARM TO ACCESS>>      <<U.RAO>>02540000
   FILENOBUFBUF    = 248 ,  <<BUF OVERRIDES NOBUF>>            <<U.RAO>>02545000
   FILEBUFOVERRIDE = 249 ,  <<BUF OVERRIDES PREVIOUS BUF>>     <<U.RAO>>02550000
   FILEINVLDBUFNUM = 250 ,  <<INVALID NUMBER OF BUFFERS>>      <<U.RAO>>02555000
   FILEBUFXTRANDEL = 251 ,  <<EXTRANEOUS PARM TO BUF>>         <<U.RAO>>02560000
   FILEFCODEREDUND = 252 ,  <<FILE CODE OVERRIDES PREVIOUS>>   <<U.RAO>>02565000
   FILEUNKFCODE    = 253 ,  <<UNKNOWN FILE CODE>>              <<U.RAO>>02570000
   FILEFCODEVALUE  = 254 ,  <<FILE CODE MUST BE A POSITIVE INT><<U.RAO>>02575000
   FILECODEXTRNDEL = 255 ,  <<EXTRANEOUS PARM TO CODE>>        <<U.RAO>>02580000
   FILEDEVOVERRIDE = 256 ,  <<OVERRIDES PREVIOUS DEV>>         <<U.RAO>>02585000
   FILESYSDEFDEV   = 257 ,  <<SYSDEF FILE DEV FORCED>>         <<U.RAO>>02590000
   FILEDSNAME2LONG = 259 ,  <<DS NAME > 8 CHARACTERS>>         <<U.RAO>>02595000
   FILEDEVNAME2LNG = 260 ,  <<DEVICE NAME > 8 CHARACTERS>>     <<U.RAO>>02600000
   FILEOUTPRINOT   = 261 ,  <<OUTPRI LEGAL ONLY FOR OUTPUT FILES>>      02605000
   FILEOUTPRIINVLD = 262 ,  <<UNACCEPTABLE OUTPRI>>            <<U.RAO>>02610000
   FILENUMCOPINVLD = 263 ,  <<UNACCEPTABLE NUMBER OF COPIES>>  <<U.RAO>>02615000
   FILEDEVXPARMS   = 264 ,  <<UNKNOWN SUBPARAMETER>>           <<U.RAO>>02620000
   FILEDISCOVERIDE = 265 ,  <<OVERRIDE PREVIOUS DISC PARM>>    <<U.RAO>>02625000
   FILEFILESIZE    = 266 ,  <<ILLEGAL NUMBER OF RECORDS>>      <<U.RAO>>02630000
   FILEEXTENTSPROB = 267 ,  <<ILLEGAL NUMBER OF EXTENTS>>      <<U.RAO>>02635000
   FILEINITALLOCBD = 268 ,  <<UNACCEPTABLE INIT ALLOCATION>>   <<U.RAO>>02640000
   FILEDISCXPARMS  = 269 ,  <<UNKNOWN DISC SUBPARAMETER>>      <<U.RAO>>02645000
   FILERECOVERRIDE = 270 ,  <<OVERRIDE PREVIOUS REC =  >>      <<U.RAO>>02650000
   FILEBADRECSIZE  = 271 ,  <<DISALLOW RECSIZE OF 0>>          <<U.RAO>>02655000
   FILEBADBLOCKING = 272 ,  <<ILLEGAL BLOCK FACTOR>>           <<U.RAO>>02660000
   FILEUNKRECFMT   = 273 ,  <<UNKNOWN RECORD FORMAT>>          <<U.RAO>>02665000
   FILEASCIIINVALD = 274 ,  <<NEITHER ASCII NOR BINARY>>       <<U.RAO>>02670000
   FILERECXTRANPRM = 275 ,  <<UNKNOWN PARM TO REC PARM>>       <<U.RAO>>02675000
   FEQTABFULLXPLCT = 276 ,  <<FILE EQUATE TABLE FULL>>         <<U.RAO>>02680000
   BLDDOMAINNOT    = 277 ,  <<DOMAIN NOT ALLOWED ON BUILD>>    <<U.RAO>>02685000
   BLDNOTADES      = 278 ,  <<ACTUAL DESIGNATOR NOT ALLOWED ON BUILD>>  02690000
   BLDFAILED       = 279 ,  <<BUILD OF FILE FAILED>>           <<U.RAO>>02695000
   FILEXPINVMONTH  = 280 ,  <<BAD NO. FOR MONTH>>              <<U.RAO>>02700000
   FILEXPNOSLASHMD = 281 ,  <<NO SLASH BETWEEN MONTH & DAY>>   <<U.RAO>>02705000
   FILEXPINVDAY    = 282 ,  <<INVALID NO. FOR DAY OF MONTH>>   <<U.RAO>>02710000
   FILEXPDAYZERO   = 283 ,  <<00 FOR MONTH, NOT FOR DAY>>      <<U.RAO>>02715000
   FILEXPNOSLASHDY = 284 ,  <<NO SLASH BETWEEN DAY & YEAR>>    <<U.RAO>>02720000
   FILEXPNONZERO   = 285 ,  <<IF MONTH, DAY = 00, NOT YEAR>>   <<U.RAO>>02725000
   FILEXPXTRNDATA  = 286 ,  <<EXTRANEOUS PARM TO EXP DATE>>    <<U.RAO>>02730000
   FILEREDUNDLABEL = 287 ,  <<LABEL REDUNDANTLY SPECIFIED>>    <<U.RAO>>02735000
   FILEVOLID2LONG  = 288 ,  <<VOLID > 6 CHARACTERS>>           <<U.RAO>>02740000
   FILEVOLIDSPECAL = 289 ,  <<EMBEDDED SPECIAL IN VOLID>>      <<U.RAO>>02745000
   FILEINVVOLTYPE  = 290 ,  <<BAD VOLUME TYPE>>                <<U.RAO>>02750000
   FILEXPINVSEQ    = 291 ,  <<INVALID SEQUENCE FIELD>>         <<U.RAO>>02755000
   FILEXTRNLABEL   = 292 ,  <<EXTRANEOUS PARM TO LABEL>>       <<U.RAO>>02760000
   FILEFORMOVERRID = 293 ,  <<REDUNDANTLY SPECIFIED FORMS MSG>><<U.RAO>>02765000
   FILEFMSNOPERIOD = 294 ,  <<NO PERIOD ON FORMS MESSAGE>>     <<U.RAO>>02770000
   FILEFMSTOOLONG  = 295 ,  <<TRUNCATED TO 49 CHARACTERS>>     <<U.RAO>>02775000
   FILELABELNOLABEL= 296 ,  <<LABEL OVERRIDEN BY NOLABEL>>     <<U.RAO>>02780000
   FILENOLOCKLOCK  = 297 ,  <<NOLOCK OVERRIDES LOCK>>          <<U.RAO>>02785000
   FILELOCKNOLOCK  = 298 ,  <<LOCK OVERRIDES NOLOCK>>          <<U.RAO>>02790000
   BLDUNKNOWNKEY   = 299 ,  <<UNKNOWN KEYWORD TO BUILD>>       <<U.RAO>>02795000
   BLDNOSYSFILES   = 300,  <<ONLY $NEWPASS TO :BUILD>>         <<U.RAO>>02800000
   FILEINVALDEVNAME= 301,  <<INVALID DEV NAME>>                <<00579>>02805000
   CIRCULARFEQ     = 304,  <<CIRCULAR FILE EQUATIONS>>         <<00834>>02810000
   FILEADESSYS     = 305,  <<ENVIRONMENT NOT SYSFILE>>         <<01549>>02815000
   FILEENVOVERRIDE = 306,  <<OVERRIDE PREVIOUS ENV PARAMETER>> <<01549>>02820000
   FILEENVXPARMS   = 307,  <<ENV HAS NO SUBPARAMETERS>>        <<01549>>02825000
   FILEOUTQOVERRIDE= 308,  <<OVERRIDE PREVIOUS OUTQ PARM>>     <<01549>>02830000
   OUTQNAMEALPHNUM = 309,  <<OUTQ NAME NOT ALPHANUMERIC>>      <<01549>>02835000
   OUTQNAME2LNG    = 310,  <<OUTQ NAME > 8 CHARACTERS>>        <<01549>>02840000
   OUTQNAMENOTALPH = 311,  <<OUTQ NAME BEGINS WITH ALPHA>>     <<01549>>02845000
   FILEOUTQXPARMS  = 312,  <<OUTQ HAS NO SUBPARAMETERS>>       <<01549>>02850000
   FILESHARESEMI   = 313,  <<SEMI OVERRIDES SHR>>              <<01549>>02855000
   FILEEXCLSEMI    = 314,  <<SEMI OVERRIDES EXC>>              <<01549>>02860000
   FILENOCOPYCOPY  = 315,  <<COPY OVERRIDES NOCOPY>>           <<01549>>02865000
   FILECOPYNOCOPY  = 316,  <<NOCOPY OVERRIDES COPY>>           <<01549>>02870000
   FILENOMULTGMULT = 317,  <<GMULTI OVERRIDES NOMULTI>>        <<01549>>02875000
   FILEMULTIGMULTI = 318,  <<GMULTI OVERRIDES MULTI>>          <<01549>>02880000
   FILEGMULTIMULTI = 319,  <<MULTI OVERRIDES GMULTI>>          <<01549>>02885000
   FILEGMULTNOMULT = 320,  <<NOMULTI OVERRIDES GMULTI>>        <<01549>>02890000
   FILERIOSTD      = 321,  <<STD OVERRIDES RIO>>               <<01549>>02895000
   FILEMSGSTD      = 322,  <<STD OVERRIDES MSG>>               <<01549>>02900000
   FILECIRSTD      = 323,  <<STD OVERRIDES CIR>>               <<01549>>02905000
   FILESTDRIO      = 324,  <<RIO OVERRIDES STD>>               <<01549>>02910000
   FILEMSGRIO      = 325,  <<RIO OVERRIDES MSG>>               <<01549>>02915000
   FILECIRRIO      = 326,  <<RIO OVERRIDES CIR>>               <<01549>>02920000
   FILESTDMSG      = 327,  <<MSG OVERRIDES STD>>               <<01549>>02925000
   FILERIOMSG      = 328,  <<MSG OVERRIDES RIO>>               <<01549>>02930000
   FILECIRMSG      = 329,  <<MSG OVERRIDES CIR>>               <<01549>>02935000
   FILESTDCIR      = 330,  <<CIR OVERRIDES STD>>               <<01549>>02940000
   FILERIOCIR      = 331,  <<CIR OVERRIDES RIO>>               <<01549>>02945000
   FILEMSGCIR      = 332,  <<CIR OVERRIDES MSG>>               <<01549>>02950000
   FILECONTENV     = 333,  <<BACK REF. FILE CONTAINS ENV.>>    <<02554>>02955000
   FILEDENSOVERRID = 334,  <<OVERRIDE PREVIOUS DENS PARM>>     <<02569>>02960000
   FILEDENSXPARM   = 335,  <<EXTRANEOUS PARM TO DENS>>         <<02569>>02965000
   FILEDENSINVAL   = 336,  <<DENS PARM NOT VALID>>             <<02569>>02970000
   FILEMISSQUOTE   = 337,  << MISSING QUOTE ON VOLID >>        <<02663>>02975000
   FILENONPRINTCHAR= 338,  << VOLID HAS NON PRINT CHARS >>     <<02663>>02980000
   FILECOMMASEMINOK= 339,  << VOLID CAN'T HAVE COMMA,SEMI >>   <<02663>>02985000
   FILEVIRTUALDEV  = 342,  << virtual device not allowed >>    <<04171>>02990000
   FILEINVLDCLASPEC= 343,  << invalid device class >>          <<04171>>02995000
   FILEUNKNOWNDEV  = 344,  << unknown device class >>          <<04171>>03000000
   FILEDONTKNOWLDEV= 345,  << unknown logical device >>        <<04171>>03005000
                                                                        03010000
<< SECURE COMMAND>>                                            <<U.RAO>>03015000
   NOTCREATOR      = 351,  <<NOT CREATOR OF FILE>>             <<U.RAO>>03020000
   DISCIOERR       = 353, <<DISC IO ERROR WHEN ACCESSING FILE L<<U.RAO>>03025000
   SECURE2MP       = 354, <<ONLY FILE NAME ALLOWED>>           <<U.RAO>>03030000
   SECURENOTENUF   = 355, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>03035000
   GETFLABOPEN     = 356,  <<OPEN FAILED IN GETFLABEL>>        <<04.RO>>03040000
<< RESET AND CRESET COMMANDS>>                                 <<U.RAO>>03045000
   RESETPARMERR    = 360,                                      <<U.RAO>>03050000
   CRESETPARMERR   = 361,                                      <<U.RAO>>03055000
   FEQNOTFOUND     = 362, <<FILE EQUATE NOT FOUND>>            <<U.RAO>>03060000
<< RENAME COMMAND>>                                            <<U.RAO>>03065000
   RENAME2MP       = 370,                                      <<U.RAO>>03070000
   RENAMEEXPECTTEMP= 371,                                      <<U.RAO>>03075000
   RENAMEOLDFFSERR = 372,  <<RENAME OLD FILE ERROR>>           <<U.RAO>>03080000
   RENAMEFAILED    = 373,  <<CALL TO FRENAME FAILED>>          <<U.RAO>>03085000
   RENAMECLSFAILED = 374,  <<CLOSE OF RENAMED FILE FAILED>>    <<U.RAO>>03090000
   RENAMEREQOLDNAME= 375  ,  <<EXPECTED OLD FILE NAME>>        <<U.RAO>>03095000
   RENAMEREQNEWNAME= 376  ,  <<EXPECTED NEW FILE NAME>>        <<U.RAO>>03100000
<< PURGE COMMAND>>                                             <<U.RAO>>03105000
   PURGE2MP        = 380,                                      <<U.RAO>>03110000
   PURGEREQFNAME   = 381,                                      <<U.RAO>>03115000
   PURGEEXPECTTEMP = 382,                                      <<U.RAO>>03120000
   PURGEFNOTFOUND  = 383,                                      <<U.RAO>>03125000
   PURGEFOPENFAILD = 384,  <<OPEN OF FILE TO BE PURGED FAILED>><<U.RAO>>03130000
   PURGECLOSEFAILD = 385,  <<UNABLE TO PURGE FILE>>            <<U.RAO>>03135000
   PURGESEMICOLON  = 386  ,  <<FOUND ";", EXPECTED ",">>       <<U.RAO>>03140000
<< SAVE COMMAND >>                                             <<U.RAO>>03145000
   SAVE2MP         = 390,                                      <<U.RAO>>03150000
   SAVEREQFNAME    = 391,                                      <<U.RAO>>03155000
   SAVEEXPECTOLDPASS=392,                                      <<U.RAO>>03160000
   SAVEOPENOLDPASS = 393,  <<UNABLE TO OPEN $OLDPASS>>         <<U.RAO>>03165000
   SAVECLOSOLDPASS = 394,  <<UNABLE TO CLOSE $OLDPASS>>        <<U.RAO>>03170000
   SAVETEMPOPEN    = 395,  <<UNABLE TO OPEN TEMP FILE>>        <<U.RAO>>03175000
   SAVETEMPCLOSE   = 396,  <<UNABLE TO SAVE TEMP FILE>>        <<U.RAO>>03180000
   SAVESEMICOLON   = 397  ,  <<FOUND ";", EXPECTED ",">>       <<U.RAO>>03185000
   SAVETEMPFAIL    = 398,   <<COULDN'T OPEN STEMPFILE>>        <<04784>>03190000
<< RELEASE COMMAND >>                                          <<U.RAO>>03195000
   RELEASE2MP      = 400, <<ONLY FILE NAME ALLOWED>>           <<U.RAO>>03200000
   RELEASENOTENUF  = 401, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>03205000
<< ALTSEC COMMAND >>                                           <<U.RAO>>03210000
   ALTSECNOTENUF   = 410, <<REQUIRES AN ACTUAL FILE DESIGNATOR><<U.RAO>>03215000
   ALTSEC2MP       = 411, <<EXTRANEOUS DATA ON ALTSEC COMMAND>><<U.RAO>>03220000
<< LISTF COMMAND >>                                            <<U.RAO>>03225000
   LISTFBADLEVEL    = 420, <<BAD LEVEL # IN LISTF>>            <<U.RAO>>03230000
   LISTFSMCAP       = 422, <<NEED SM CAPABILITY>>              <<U.RAO>>03235000
   LISTFAMCAP       = 423, <<NEED AM CAPABILITY>>              <<U.RAO>>03240000
   LISTFEXPECTFILE  = 424, <<EXPECTED FILE NAME>>              <<U.RAO>>03245000
   LISTFFSERR       = 425, <<LISTF FILE SYS ERROR>>            <<U.RAO>>03250000
   LISTFEXTRANEOUS = 426,  <<UNIDENTIFIED FILESET NAME>>       <<U.RAO>>03255000
   LISTF2MP        = 427,  <<2 MANY PARMS TO LISTF>>           <<U.RAO>>03260000
   LISTFFLABIOERR  = 428,  <<IO ERROR READING FILE LABEL>>     <<U.RAO>>03265000
   LISTFHVSNOTMTD  = 429,  <<HOME VOLUME SET NOT MOUNTED>>     <<RV.PV>>03270000
   LISTFSTOPPED    = 430,                                      <<03.KM>>03275000
   NOXXXLISTED     = 431,                                      <<03.KM>>03280000
   NOFILESLISTED   = NOXXXLISTED,                              <<03.KM>>03285000
<< FILE ACCESS MASK ERRORS (PROCEDURE FORMACCESS, MOSTLY)>>    <<U.RAO>>03290000
   ACCESSEXPECTLPAREN= 500, <<EXPECTED LEADING "(">>           <<U.RAO>>03295000
   ACCESSEXPECTRPAREN=501,<<EXPECTED TRAILING ")">>            <<U.RAO>>03300000
   ACCESSUNKNOWNFMODE=502,<<EXPECTED FILE ACCESS MODE TYPE>>   <<U.RAO>>03305000
   ACCESSUNKNOWNGMODE=503,<<DITTO FOR GROUP>>                  <<U.RAO>>03310000
   ACCESSUNKNOWNAMODE=504,<<DITTO FOR ACCOUNT>>                <<U.RAO>>03315000
   ACCESSFSNOTPERMIT=505, <<SAVE NOT PERMITTED FOR FILE>>      <<U.RAO>>03320000
   ACCESSASNOTPERMIT=506, <<SAVE NOT PERMITTED FOR ACCOUNT>>   <<U.RAO>>03325000
   ACCESSEXPECTCOLON=507, << (X:XX), DIDN'T FIND COLON>>       <<U.RAO>>03330000
   ACCESSUNKNOWNFUSER=508,<<UNKNOWN FILE USER TYPE>>           <<U.RAO>>03335000
   ACCESSUNKNOWNGUSER=509,<<UNKNOWN GROUP USER TYPE>>          <<U.RAO>>03340000
   ACCESSUNKNOWNAUSER=510,<<UNKNOWN ACCOUNT USER TYPE>>        <<U.RAO>>03345000
   ACCESSCRNOTPERMIT=511, <<CREATOR NOT PERMITTED IN GROUP>>   <<U.RAO>>03350000
   ACCESSUSNOTPERMIT=512, <<NOT PERMITTED AT ACCOUNT LEVEL>>   <<U.RAO>>03355000
   ACCESSRREDUND   = 513, <<READ REDUNDANTLY SPECIFIED>>       <<U.RAO>>03360000
   ACCESSAREDUND   = 514, <<APPEND REDUNDANTLY SPECIFIED>>     <<U.RAO>>03365000
   ACCESSWREDUND   = 515, <<WRITE  "               "   >>      <<U.RAO>>03370000
   ACCESSLREDUND   = 516, <<LOCK      "            "   >>      <<U.RAO>>03375000
   ACCESSXREDUND   = 517, <<EXECUTE   "            "   >>      <<U.RAO>>03380000
   ACCESSSREDUND   = 518, <<SAVE      "            "   >>      <<U.RAO>>03385000
   ACCESSREDUNDMODE= 519, <<REDUNDANT IN THIS LIST>>           <<U.RAO>>03390000
<< FILE NAME ERRORS>>                                          <<U.RAO>>03395000
   FILEEXPECTALPHA = 530  ,                                    <<U.RAO>>03400000
   FFNAMEBASE=FILEEXPECTALPHA-1,                               <<U.RAO>>03405000
   FILENAMEMISSING = 531  ,                                    <<U.RAO>>03410000
   FILENAMETOOLONG = 532  ,                                    <<U.RAO>>03415000
   FILEMISSINGDELIM= 535,                                     <<00.GEN>>03420000
   FILENOGENNAME   = 536,                                     <<00.GEN>>03425000
<< GROUP NAME ERRORS >>                                        <<U.RAO>>03430000
   GRPEXPECTALPHA  = 540  ,                                    <<U.RAO>>03435000
   FGNAMEBASE=GRPEXPECTALPHA-1,                                <<U.RAO>>03440000
<< ACCOUNT NAME ERRORS >>                                      <<U.RAO>>03445000
   ACCTEXPECTALPHA = 550  ,                                    <<U.RAO>>03450000
   FANAMEBASE=ACCTEXPECTALPHA-1,                               <<U.RAO>>03455000
<< LOCKWORD NAME ERRORS >>                                     <<U.RAO>>03460000
   LWDEXPECTALPHA  = 560  ,                                    <<U.RAO>>03465000
   FLWORDBASE=LWDEXPECTALPHA-1,                                <<U.RAO>>03470000
<< VOLUME SET DEFINITION NAME ERRORS >>                        <<U.RAO>>03475000
   VSDEXPECTALPHA  = 570  ,                                    <<U.RAO>>03480000
   VSDNAMEBASE     = VSDEXPECTALPHA-1,                         <<U.RAO>>03485000
   VSDNOLOCKWORD   = 579,                                     <<00.GEN>>03490000
<< MISCELLANEOUS NAMING ERRORS >>                              <<U.RAO>>03495000
<< USER NAME ERRORS >>                                         <<U.RAO>>03500000
   USEREXPECTALPHA = 590,                                      <<U.RAO>>03505000
   USERNAMEBASE    = USEREXPECTALPHA-1,                        <<U.RAO>>03510000
<< PREPRUN, PREP, RUN COMMANDS >>                              <<U.RAO>>03515000
   ERRNOPROGF      = 600  ,  <<NO PROGRAM FILE SPECIFIED>>     <<U.RAO>>03520000
   ERRNOUSLF       = 601  ,  <<NO USL FILE SPECIFIED>>         <<U.RAO>>03525000
   ERRNOPORUF      = 602  ,  <<NEITHER SPECIFIED>>             <<U.RAO>>03530000
   ERRNOPREPTARGET = 603  ,  <<NO PROGRAM FILE SPECIFIED>>     <<U.RAO>>03535000
   CMAXPCTSEMIORCR = 604  ,  <<FOUND COMMA, NEEDED ; OR CR>>   <<U.RAO>>03540000
   EQXPCTSEMIORCR  = 605  ,  <<FOUND =, NEEDED ; OR CR>>       <<U.RAO>>03545000
   EXTRNDELIMIGNRD = 606  ,  <<IGNORED EXTRANEOUS DELIMITER>>  <<U.RAO>>03550000
   CONTXTRUNNOTPRP = 607  ,  <<ALLOWED IN RUN, NOT PREP>>      <<U.RAO>>03555000
   CONTXTPRPNOTRUN = 608  ,  <<ALLOWED IN PREP, NOT RUN>>      <<U.RAO>>03560000
   UNKNOWNKEYPREP  = 609  ,                                    <<U.RAO>>03565000
   UNKNOWNKEYRUN   = 610  ,                                    <<U.RAO>>03570000
   UNKNOWNKEYPRPRN = 611  ,                                    <<U.RAO>>03575000
   REQEQUALSIGN    = 612  ,  <<NEED EQUALS SIGN>>              <<U.RAO>>03580000
   INVALIDLIB      = 613  ,  <<NEED ONE OF S,P, OR G>>         <<U.RAO>>03585000
   INVALIDMAXDATA  = 614  ,                                    <<U.RAO>>03590000
   INVALIDPARM     = 615  ,                                    <<U.RAO>>03595000
   INVALIDSTAKSIZE = 616  ,                                    <<U.RAO>>03600000
   INVALIDDLSIZE   = 617  ,                                    <<U.RAO>>03605000
   MISSINGCAP      = 618  ,  <<A SYNTAX PROBLEM WITH CAPABILITY<<U.RAO>>03610000
   UNKNOWNCAP      = 619  ,  <<NOT RECOGNIZED CAPABILITY>>     <<U.RAO>>03615000
   WARNDUPLKEY     = 620  ,  <<A WARNING ONLY>>                <<U.RAO>>03620000
   SEGMENTERERROR  = 621  ,  <<SEGMENTER RETURN TO CXPREPRUN>> <<U.RAO>>03625000
   NOSUCHPROGFILE  = 622  ,  <<THE CREATE FAILED.>>            <<U.RAO>>03630000
   DEFVAL          = 623,  <<DEFAULT MAXDATA TAKEN>>           <<U.RAO>>03635000
   PRPRNNOLOAD     = 625,  <<UNABLE TO LOAD PROGRAM>>          <<U.RAO>>03640000
   INVALIDPROGFILE = 626,   <<INVALID PROGRAM FILE>>           <<U.RAO>>03645000
   ERRENTRYTOOBIG  = 627,  <<ENTRY POINT NAME > 15 CHAR LONG>> <<U.RAO>>03650000
   INVALIDPATCH    = 628,                                      <<00629>>03655000
<< OTHER SUBSYSTEM ERRORS (BASIC, SPL, RJE, ETC. >>            <<U.RAO>>03660000
   ERR2MPLISTONLY  = 640,                                      <<U.RAO>>03665000
   SUBSNOTFOUND    = 641,                                      <<U.RAO>>03670000
   SUBS2MP         = 642,                                      <<U.RAO>>03675000
   COMPFAILEDNOPRP = 643,                                      <<U.RAO>>03680000
   PREPFAILEDNORUN = 644,                                      <<U.RAO>>03685000
   BASICCREATEERR  = 648,  <<UNABLE TO CREATE BASIC INTERP.>>  <<U.RAO>>03690000
   BASICLOADERR    = 649,  <<UNABLE TO LOAD BASIC INTERPRETER>><<U.RAO>>03695000
   SUBSYSCREATEERR = 650,  <<UNABLE TO CREATE SUBSYSTEM>>      <<U.RAO>>03700000
   SUBSYSLOADERR   = 651,  <<UNABLE TO LOAD SUBSYSTEM>>        <<U.RAO>>03705000
   COMPILEDCREATE  = 654,  <<UNABLE TO CREATE USER PROG>>      <<U.RAO>>03710000
   COMPILEDLOAD    = 655,   <<UNABLE TO LOAD USER PROG>>       <<U.RAO>>03715000
   FEQTABFULL      = 656,  <<FILE EQUATE TABLE FULL>>          <<U.RAO>>03720000
   TOOMANYFEQBREF  = 657,  <<TOO MANY BACK REF'S>>             <<U.RAO>>03725000
   APLXPCTJUSTWS   = 659,  <<TOO MANY PARMS TO APL COMMAND>>   <<02.RO>>03730000
   SUBSNOTCREATE   = 660,  <<CREATEPROCESS FAILED ON SUBSYS.>> <<01452>>03735000
   INFOOVERIDE     = 661,  <<MULTIPLE INFO PARMS >>            <<02844>>03740000
   UNKNWNKWRD      = 662,  << UNKNOWN KEYWORD >>               <<02844>>03745000
   WKSPALREADYFND  = 663,  << WKSP specified more than once >> <<06130>>03750000
<< ADDITIONAL ERRORS FOR :RUN COMMAND >>                       <<01200>>03755000
   INVALIDSTDIN    = 680,  <<INCORRECT STDIN SPECIFICATION>>   <<01200>>03760000
   INVALIDSTDLIST  = 681,  <<INCORRECT STDLIST SPECIFICATION>> <<01200>>03765000
   EXPCTQUOTE      = 682,  <<EXPECTED ' OR " TO START STRING>> <<01200>>03770000
   EXPCTCLOSEQUOTE = 683,  <<EXPECTED ' OR " TO END STRING>>   <<01200>>03775000
                           << TO TRAP INTERNAL PROBLEMS.>>     <<01452>>03780000
   XPCTSEMIORCR    = 687,  <<EXPECTED ; OR CR>>                <<01709>>03785000
   STRINGTOOBIG    = 688,  <<INFO STRING > 255 CHARS>>         <<01709>>03790000
   INVALIDSYSDEFFL = 689, <<INVALID SYSTEM DEFINED FILE >>     <<02324>>03795000
   IMPIABA         = 690,                                      <<02369>>03800000
   BOTHFPMAPNOFPMAP= 691, <<BOTH FPMAP/NOFPMAP SPECIFIED>>     <<04103>>03805000
<<ORGANIZATIONAL MANAGEMENT COMMAND ERROR MESSAGES>>           <<U.RAO>>03810000
   ERRABTERM       = 976, <<ABNORMAL PROGRAM TERMINATION>>     <<U.RAO>>03815000
   REQFORMALFDESIG = 984,                                      <<U.RAO>>03820000
   PGMABORT        = 989,  <<PROGRAM ABORTED BY USER>>         <<U.RAO>>03825000
<< 1000'S RESERVED FOR STORE/RESTORE >>                        <<U.RAO>>03830000
<< 1100'S RESERVED FOR PRIVATE VOLUMES MESSAGES >>             <<U.RAO>>03835000
   <<1126-1135 RESERVED FOR IMPLICITMNT ERRORS>>               <<03.KM>>03840000
   IM'MNTERR       = 1126,   <<MOUNT ERROR RECORDED IN DST>>   <<03.KM>>03845000
<< 1200'S RESERVED FOR USER LOGGING >>                         <<U.RAO>>03850000
<< 1300'S RESERVED FOR DS >>                                   <<U.RAO>>03855000
<< 1400'S RESERVED FOR STARTDEVICE (HELLO, JOB, DATA)>>        <<U.RAO>>03860000
<< 1500 - 1529 RESERVED FOR SHOWJOB >>                         <<U.RAO>>03865000
<< 1530 - 1579 RESERVED FOR SHOWIN AND SHOWOUT >>              <<U.RAO>>03870000
<< 1580 - 1589 RESERVED FOR SHOWDEV >>                         <<U.RAO>>03875000
<< 1590 - 1609 RESERVED FOR STREAM >>                          <<U.RAO>>03880000
<< TELL COMMAND >>                                             <<U.RAO>>03885000
<< SHOWQ COMMAND >>                                            <<U.RAO>>03890000
   WARNXPARMSIGNORED=1670, <<COMMAND HAS NO PARMS, PARMS IGNORE<<U.RAO>>03895000
<< SETMSG COMMAND >>                                           <<U.RAO>>03900000
   SETMSGPARMPROB  = 1675, <<MISSING OR UNKNOWN PARM>>         <<U.RAO>>03905000
   SETMSGEXTRAPARM = 1676, <<TOO MANY PARMS TO SETMSG>>        <<U.RAO>>03910000
<< SETDUMP COMMAND >>                                          <<U.RAO>>03915000
   SETDUMPUNKNOWN  = 1680, <<UNKNOWN OPTION TO SETDUMP>>       <<U.RAO>>03920000
   SETDUMP2MP      = 1681, <<MORE THAN 4 PARMS TO SETDUMP>>    <<U.RAO>>03925000
<< CLINE COMMAND >>                                            <<U.RAO>>03930000
   ERRLNOTFOUND    = 1764, <<CLINE EQUATION NOT FOUND>>        <<U.RAO>>03935000
<< 1900 - 1999 RESERVED FOR USER DEFINED COMMANDS (UDC) >>     <<09.EB>>03940000
<< 3000-4000 ARE RESERVED FOR OPERATOR COMMANDS>>              <<00552>>03945000
                                                               <<00552>>03950000
<< IML/3000 ERROR MESSAGES >>                                  <<02845>>03955000
   TOOMANYPARMS    = 3820, << TOO MANY PARMS FOR IML CMND >>   <<02845>>03960000
   EXPECTSEMIC     = 3821, << EXPECT SEMICOLON DELIM >>        <<02845>>03965000
   UNKNOWNKEY      = 3822, << INVALID KEYWORD >>               <<02845>>03970000
   REDNDENH        = 3823, << ENHANCE REDUNDANTLY SPECD. >>    <<02845>>03975000
   EXPCTEQUAL      = 3824, << EXPECTED EQUAL AS DELMITER >>    <<02845>>03980000
   ILLVALENH       = 3825, << ILLEGAL VALUE FOR ENHANCE >>     <<02845>>03985000
   REDNDFMT        = 3826, << FORMAT REDUNDANTLY SPECD. >>     <<02845>>03990000
   ILLVALFMT       = 3827, << ILLEGAL VALUE FOR FORMAT >>      <<02845>>03995000
   REDNDPRI        = 3828, << PRI. REDUNDANTLY SPECD. >>       <<02845>>04000000
   ILLVALPRI       = 3829, << ILLEGAL VALUE FOR PRI. >>        <<02845>>04005000
<< SET COMMAND ERROR MESSAGES >>                               <<04786>>04010000
   NONALPHA        = 4400, << EXPECTS ALPHANUMERIC PARM >>     <<04786>>04015000
   INVALID'PARM    = 4401, << INVALID PARAMETER         >>     <<04786>>04020000
   NO'EQUALS       = 4402, << EXPECTED AN EQUAL SIGN    >>     <<04786>>04025000
   BAD'OPTION      = 4403, << UNKNOWN OPTION GIVEN      >>     <<04786>>04030000
   ALREADY         = 4404, << OPTION ALREADY IN EFFECT  >>     <<04786>>04035000
   NOT'SPOOLED     = 4405, << $STDLIST NOT SPOOLED      >>     <<04786>>04040000
   UNEXP'DELIM     = 4406, << EXTRANEOUS CHARACTERS     >>     <<04786>>04045000
<< LISTEQ AND LISTFTEMP ERROR MESSAGES >>                      << 8499>>04050000
                                                               <<04786>>04055000
   LEQ'NO'FEQS     = 3282, << NO FEQ FOUND              >>     << 8499>>04060000
   LEQ'FEQS        = 3283, << THE HEADING               >>     << 8499>>04065000
LISTFTEMPNOTFEQS       = 3284,                                 << 8500>>04070000
LISTFTEMPBADLEVEL      = 3285,                                 << 8500>>04075000
LISTFTEMPSMORAM        = 3286,                                 << 8500>>04080000
LISTFTEMPEXPECTFILE    = 3287,                                 << 8500>>04085000
LISTFTEMP2MP           = 3288,                                 << 8500>>04090000
LISTFTEMP'PV'NOT'MNTED = 1,                                    << 8921>>04095000
LISTFTEMP'FILE'GONE    = 2,                                    << 8921>>04100000
LISTFTEMPNOTFOUND      = 3289,                                 << 8500>>04105000
      <<FILE SYSTEM DEFINITIONS >>                                      04110000
                                                                        04115000
      FILE'SECURE = 22,                                        << 8500>>04120000
      FLSECMATRIX=10,                                                   04125000
                                                                        04130000
                                                               <<00851>>04135000
      <<Definitions for finding the PLABEL for SHOWCOM>>                04140000
                                                                        04145000
      << FCONTROL DEFINITIONS >>                               <<00851>>04150000
                                                               <<00851>>04155000
      TIMEOUT      = 4,                                        <<00851>>04160000
      DISABLEBREAK = 14,                                       <<00851>>04165000
      ENABLEBREAK  = 15,                                       <<00851>>04170000
                                                                        04175000
      <<SIRS USED THROUGHOUT>>                                          04180000
                                                                        04185000
     FILESIR=37,                                                        04190000
                                                                        04195000
      <<WORDS/FLAGS>>                                                   04200000
                                                                        04205000
      COLDLOADID=%1075,                                                 04210000
      PXGWJIT = 6;                                             <<06568>>04215000
$INCLUDE INCLPCB5                                              <<06568>>04220000
LOGICAL POINTER PCB = SYSPCBINDEX;                             <<06568>>04225000
      <<DEFINES USED THROUGHOUT>>                                       04230000
                                                                        04235000
      <<CODE DEFINITIONS>>                                              04240000
                                                                        04245000
      DEFINE                                                            04250000
      CC = STATUS . (6:2)#,                                             04255000
      LBPARMDECS=ARRAY LPARM (*) = PARMS;                               04260000
                 BYTE ARRAY BPARM (*) = PARMS #,                        04265000
      NEXTLINE=ASSEMBLE (ZERO,DZRO);                           <<01881>>04270000
               PRINT (*, *, *)#,                               <<01881>>04275000
                                                               <<01709>>04280000
<<        DEF'MOVEFROMDSEG          >>                         <<U.RAO>>04285000
<< To use, declare SUBROUTINE DEF'MOVEFROMDSEG >>              <<U.RAO>>04290000
   DEF'MOVEFROMDSEG =                                          <<U.RAO>>04295000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                  <<U.RAO>>04300000
         VALUE TARGET,DSTN,OFFSET,COUNT;                       <<U.RAO>>04305000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                     <<U.RAO>>04310000
      BEGIN                                                    <<U.RAO>>04315000
         X := TOS; << SAVE RETURN ADDRESS >>                   <<U.RAO>>04320000
         ASSEMBLE(MFDS 0);                                     <<U.RAO>>04325000
         TOS := X; << RESTORE RETURN ADDRESS >>                <<U.RAO>>04330000
      END #,                                                   <<U.RAO>>04335000
                                                               <<U.RAO>>04340000
<<        DEF'MOVETODSEG            >>                         <<U.RAO>>04345000
<< To use, declare SUBROUTINE DEF'MOVETODSEG >>                <<U.RAO>>04350000
   DEF'MOVETODSEG =                                            <<U.RAO>>04355000
      MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                    <<U.RAO>>04360000
         VALUE DSTN,OFFSET,SOURCE,COUNT;                       <<U.RAO>>04365000
         LOGICAL DSTN,OFFSET,SOURCE,COUNT;                     <<U.RAO>>04370000
      BEGIN                                                    <<U.RAO>>04375000
         X := TOS;                                             <<U.RAO>>04380000
         ASSEMBLE(MTDS 0);                                     <<U.RAO>>04385000
         TOS := X;                                             <<U.RAO>>04390000
      END #,                                                   <<U.RAO>>04395000
                                                               <<U.RAO>>04400000
                                                                        04405000
      << FIELDS/FLAGS>>                                                 04410000
                                                                        04415000
                                                               <<02.RO>>04420000
<<DELIMITER ARRAY DECLARATIONS>>                               <<U.RAO>>04425000
                                                               <<U.RAO>>04430000
SEMICR  = [8/";",8/%15]#,                                      <<U.RAO>>04435000
COMMASEMICR = [8/",",8/";",8/%15,8/0]D#,                       <<U.RAO>>04440000
                                                               <<U.RAO>>04445000
      <<EXECUTOR PROCEDURE HEADING>>                                    04450000
                                                                        04455000
      EXECUTORHEAD =                                                    04460000
      (PARMSP,ERRNUM,PARMNUM);                                          04465000
      BYTE ARRAY PARMSP;                                                04470000
      INTEGER ERRNUM,PARMNUM#;                                 <<06567>>04475000
                                                               << 8765>>04480000
<< DST data segment pointer and definitions >>                 << 8765>>04485000
                                                               << 8765>>04490000
LOGICAL POINTER DST = 2;                                       << 8765>>04495000
                                                               << 8765>>04500000
EQUATE  DST'ENTRY'SIZE = 4;                                    << 8765>>04505000
                                                               << 8765>>04510000
DEFINE  DST'DSEG'SIZE  = (3:13)#;                              << 8765>>04515000
                                                                        04520000
                                                                        04525000
EQUATE   WSIDTOOLONG        =   4431,                          <<06842>>04530000
         BADWSID            =   4432,                          <<06842>>04535000
         WSIDNOTCONF        =   4433,                          <<06842>>04540000
         NRJENOTFOUND       =   4434,                          <<06842>>04545000
         BADCONFACCESS      =   4435;                          <<06842>>04550000
                                                               <<06842>>04555000
                                                              <<00.GEN>>04560000
                                                              <<00.GEN>>04565000
<<  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>>04570000
                                                              <<00.GEN>>04575000
DEFINE D'INX=      DPPRESULT #,        <<"PPRESULT" FMT>>     <<00.GEN>>04580000
       D'INX1=     PPRESULT #,                                <<00.GEN>>04585000
       D'INX2=     PPRESULT(1) #,                             <<04.GEN>>04590000
       D'TYPE=     PPRESULT(2) #,                             <<00.GEN>>04595000
       D'FNAME=    PPRESULT(3) #,                             <<00.GEN>>04600000
       D'GNAME=    PPRESULT(7) #,                             <<00.GEN>>04605000
       D'ANAME=    PPRESULT(11) #,                            <<00.GEN>>04610000
       D'LOCKWORD= PPRESULT(15) #,                            <<00.GEN>>04615000
       G'FNAME=    PPRESULT(19) #,                            <<00.GEN>>04620000
       G'GNAME=    PPRESULT(23) #,                            <<00.GEN>>04625000
       G'ANAME=    PPRESULT(27) #;                             << I.A >>04630000
                                                               <<01.PV>>04635000
                                                               <<01.PV>>04640000
<<  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>>04645000
EQUATE                                                         <<01.PV>>04650000
   NAMESIZE        = 4,                  <<UNPACKED REP>>      <<01.PV>>04655000
                   <<ENTRY EQUATES>>                           <<01.PV>>04660000
                                                               <<01.PV>>04665000
                                                               <<01.PV>>04670000
<< ACCOUNT ENTRY >>                                            <<01.PV>>04675000
   ANAME           = 0,                  <<NAME>>              <<01.PV>>04680000
   AGIPNTR         = ANAME+NAMESIZE,     <<GROUP INDEX PNTR>>  <<01.PV>>04685000
   AUIPNTR         = AGIPNTR+1,          <<USER INDEX PNTR>>   <<01.PV>>04690000
   ACAP            = AUIPNTR+1,          <<CAPABILITY>>        <<01.PV>>04695000
   ALATTR          = ACAP+2,                                   <<01.PV>>04700000
   APASS           = ALATTR+2,                                 <<01.PV>>04705000
   ADFSCOUNT       = APASS+NAMESIZE,     <<DISC FILE SPACE>>   <<01.PV>>04710000
   ADFSLIMIT       = ADFSCOUNT+2,                              <<01.PV>>04715000
   ACPUCOUNT       = ADFSLIMIT+2,        <<CPU TIME>>          <<01.PV>>04720000
   ACPULIMIT       = ACPUCOUNT+2,                              <<01.PV>>04725000
   ACONTIMECOUNT   = ACPULIMIT+2,        <<CONNECT TIME>>      <<01.PV>>04730000
   ACONTIMELIMIT   = ACONTIMECOUNT+2,                          <<01.PV>>04735000
   ASECW           = ACONTIMELIMIT+2,                          <<01.PV>>04740000
   AMAXJOBW        = ASECW+1,            <<MAX. JOB PRIORITY>> <<01.PV>>04745000
   ASPARE1         = AMAXJOBW+1,                               <<RV.PV>>04750000
   ASPARE2         = ASPARE1 +1,                               <<RV.PV>>04755000
   ASIZE           = ASPARE2 +1,                               <<RV.PV>>04760000
                                                               <<01.PV>>04765000
<<GROUP ENTRY>>                                                <<01.PV>>04770000
   GNAME           = 0,                  <<NAME>>              <<01.PV>>04775000
   GFIPNTR         = GNAME+NAMESIZE,     <<FILE INDEX>>        <<01.PV>>04780000
   GPASS           = GFIPNTR+1,          <<PASSWORD>>          <<01.PV>>04785000
   GDFSCOUNT       = GPASS+NAMESIZE,     <<DISC FILE SPACE>>   <<01.PV>>04790000
   GDFSLIMIT       = GDFSCOUNT+2,                              <<01.PV>>04795000
   GCPUCOUNT       = GDFSLIMIT+2,        <<CPU TIME>>          <<01.PV>>04800000
   GCPULIMIT       = GCPUCOUNT+2,                              <<01.PV>>04805000
   GCONTIMECOUNT   = GCPULIMIT+2,                              <<01.PV>>04810000
   GCONTIMELIMIT   = GCONTIMECOUNT+2,                          <<01.PV>>04815000
   GSEC            = GCONTIMELIMIT+2,                          <<01.PV>>04820000
   GCAP            = GSEC +2,                                  <<01.PV>>04825000
   GLINKAGE        = GCAP+1,                                   <<01.PV>>04830000
   GVSDIPNTR       = GLINKAGE+1,         <<VS DEF INDEX PNTR>> <<01.PV>>04835000
   GHVSNAME        = GVSDIPNTR+1,        <<HOME VS NAME>>      <<01.PV>>04840000
   GHVSANAME       = GHVSNAME,           << "   "  ACCT NAME>> <<01.PV>>04845000
   GHVSGNAME       = GHVSANAME+NAMESIZE, << "   "  GRP  NAME>> <<01.PV>>04850000
   GHVSVSNAME      = GHVSGNAME+NAMESIZE, << "   "  VS   NAME>> <<01.PV>>04855000
   GSAVEFIPNTR     = GHVSVSNAME+NAMESIZE,                      <<13.PV>>04860000
   GMOUNTREFCNTR   = GSAVEFIPNTR+1,                            <<13.PV>>04865000
   GSPARE          = GMOUNTREFCNTR+1,                          <<13.PV>>04870000
   GSIZE           = GSPARE +1;                                <<01.PV>>04875000
<<GLINKAGE DEFINITIONS>>                                       <<01.PV>>04880000
DEFINE                                                         <<01.PV>>04885000
   PVF             = 0:1 #,                                    <<01.PV>>04890000
   MVTABXF         = 8:8 #;                                    <<01.PV>>04895000
DEFINE                                                         <<10.KM>>04900000
   PVMVTABXF= 4:4 #;                   <<PVINFO FIELD>>        <<10.KM>>04905000
EQUATE                                                         <<01.PV>>04910000
<<ENTRY TYPES>>                                                <<01.PV>>04915000
   GROUPLEVEL      = 1,                                        <<01.PV>>04920000
   ACCOUNTLEVEL    = 2,                                        <<01.PV>>04925000
   USERLEVEL       = 3,                                        <<01.PV>>04930000
   VSDEFLEVEL      = 4;                                        <<RV.PV>>04935000
                                                               <<01.PV>>04940000
<<DIRECTORY SEARCH TYPE WORD DEFINITIONS>>                     <<01.PV>>04945000
DEFINE                                                         <<01.PV>>04950000
   STARTLEVELF     = 13:3 #,                                   <<01.PV>>04955000
   ALLFLAG         =  9:1 #,                                   <<01.PV>>04960000
   ENDLEVELFX      =  9:4 #,                                   <<01.PV>>04965000
   TOLEVELF        =  6:3 #,                                   <<01.PV>>04970000
   HITFLAG         =  5:1 #;                                   <<01.PV>>04975000
EQUATE                                                         <<01.PV>>04980000
   ALLXXX          = %(2)1000,                                 <<04.PV>>04985000
   ALLACCTS        = ALLXXX + ACCOUNTLEVEL,                    <<04.PV>>04990000
   ALLGROUPS       = ALLXXX + GROUPLEVEL,                      <<04.PV>>04995000
   ALLUSERS        = ALLXXX + USERLEVEL,                       <<04.PV>>05000000
   PPR'LEN         = 31 +    << "ppresult" size >>             <<04178>>05005000
                     ASIZE+1+<< account entry size >>          <<04178>>05010000
                     GSIZE+1,<< group entry size   >>          <<04178>>05015000
   SYSL'PARMLEN    = 35 + PPR'LEN,<< "syslist" parm >>         <<04178>>05020000
   SYSL'PPRINX     = SYSL'PARMLEN - PPR'LEN,                   <<04178>>05025000
   SAVEBUFFINDEX = SYSL'PPRINX + 31;                           <<04178>>05030000
                                                               <<03.KM>>05035000
<<DIRECTORY SEARCH STATES (RETURNED BY RECIP)>>                <<03.KM>>05040000
EQUATE GOTSIR=          1,                                     <<03.KM>>05045000
       NEXTSON=         0,                                     <<03.KM>>05050000
       NEXTBROTHER=     2,                                     <<03.KM>>05055000
       NEXTUNCLE=       NEXTBROTHER,   <<NOT IMPLEMENTED>>     <<03.KM>>05060000
       REVISIT=         %100000,                               <<03.KM>>05065000
       ABORTSCAN=       4,                                     <<03.KM>>05070000
       NEXTSON'SIR=     NEXTSON+GOTSIR,                        <<03.KM>>05075000
       NEXTBROTHER'SIR= NEXTBROTHER+GOTSIR,                    <<03.KM>>05080000
       NEXTUNCLE'SIR=   NEXTUNCLE+GOTSIR,                      <<03.KM>>05085000
       ABORTSCAN'SIR=   ABORTSCAN+GOTSIR;                      << I.A >>05090000
$INCLUDE INCLJDT                                               << 8499>>05095000
$PAGE   "EXTERNAL DECLARATIONS"                                         05100000
                                                               << I.A >>05105000
<< EXTERNAL/FORWARD MPE INTRINSICS >>                          << I.A >>05110000
                                                               << I.A >>05115000
   PROCEDURE DATE'LINE(STRING);                                <<0U.EB>>05120000
      BYTE ARRAY STRING; OPTION EXTERNAL;                      <<0U.EB>>05125000
                                                               <<0U.EB>>05130000
                                                               <<00.EB>>05135000
INTRINSIC SETJCW,GETJCW,FCONTROL;                              <<00851>>05140000
   LOGICAL PROCEDURE BINARY (STRING, LENGTH);                           05145000
   VALUE LENGTH;                                                        05150000
   BYTE ARRAY STRING;                                                   05155000
   INTEGER LENGTH;                                                      05160000
   OPTION EXTERNAL;                                                     05165000
                                                                        05170000
   INTEGER PROCEDURE EXCHANGEDB(DSTNO);                                 05175000
   VALUE DSTNO;                                                         05180000
   INTEGER DSTNO;                                                       05185000
   OPTION EXTERNAL;                                                     05190000
                                                                        05195000
   DOUBLE PROCEDURE DBINARY(STRING,LENGTH);                             05200000
   VALUE LENGTH;                                                        05205000
   BYTE ARRAY STRING;  INTEGER LENGTH;                                  05210000
   OPTION EXTERNAL;                                                     05215000
                                                                        05220000
   INTEGER PROCEDURE ASCII (WORD, BASE, STRING);                        05225000
   VALUE WORD, BASE;                                                    05230000
   LOGICAL WORD;                                                        05235000
   INTEGER BASE;                                                        05240000
   BYTE ARRAY STRING;                                                   05245000
   OPTION EXTERNAL;                                                     05250000
                                                                        05255000
   INTEGER PROCEDURE DASCII(WORD,BASE,STRING);                          05260000
   VALUE WORD,BASE;                                                     05265000
   DOUBLE WORD;                                                         05270000
   INTEGER BASE;                                                        05275000
   BYTE ARRAY STRING;                                                   05280000
   OPTION EXTERNAL;                                                     05285000
                                                                        05290000
   PROCEDURE PRINT (STRING, LENGTH, TYPE);                              05295000
   VALUE LENGTH, TYPE;                                                  05300000
   ARRAY STRING;                                                        05305000
   INTEGER LENGTH;                                                      05310000
   LOGICAL TYPE;                                                        05315000
   OPTION EXTERNAL;                                                     05320000
                                                                        05325000
   INTEGER PROCEDURE SEARCH (TARGET, LENGTH, DICT, DEFN);               05330000
   VALUE LENGTH;                                                        05335000
   BYTE ARRAY TARGET, DICT;                                             05340000
   INTEGER LENGTH;                                                      05345000
   BYTE POINTER DEFN;                                                   05350000
   OPTION EXTERNAL, VARIABLE;                                           05355000
                                                               <<01.01>>05360000
   INTEGER PROCEDURE MYCOMMAND                                          05365000
   (COMIMAGE,DELIMS,MAXPARMS,NUMPARMS,PARMS,DICT,DEFN);                 05370000
   VALUE MAXPARMS;                                                      05375000
   BYTE ARRAY COMIMAGE,DELIMS,DICT;                                     05380000
   INTEGER MAXPARMS, NUMPARMS;                                          05385000
   DOUBLE ARRAY PARMS;                                                  05390000
   BYTE POINTER DEFN;                                                   05395000
   OPTION VARIABLE,EXTERNAL;                                            05400000
                                                                        05405000
   PROCEDURE WHO(MODE,CAP,LATTR,USERN,GROUPN,ACCTN,HOMEN,TERMNUM);      05410000
   LOGICAL MODE;                                                        05415000
   DOUBLE CAP,LATTR;                                                    05420000
   BYTE ARRAY USERN,GROUPN,ACCTN,HOMEN;                                 05425000
   LOGICAL TERMNUM;                                                     05430000
   OPTION VARIABLE,EXTERNAL;                                            05435000
                                                                        05440000
   LOGICAL PROCEDURE PARSE'DENSITY(PARM,PARMLEN,DEN'VALUE);    <<02569>>05445000
   VALUE PARMLEN;                                              <<02569>>05450000
   INTEGER DEN'VALUE,PARMLEN;                                  <<02569>>05455000
   BYTE ARRAY PARM;                                            <<02569>>05460000
   OPTION EXTERNAL;                                            <<02569>>05465000
                                                               <<02569>>05470000
   INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS, AOPTIONS, RECSIZE, 05475000
   DEVICE, FORMMSG, RECMODE, BLOCKFACTOR, NUMBUFFERS, FILESIZE,         05480000
   NUMEXTENTS, INITALLOC, FILECODE);                                    05485000
   VALUE FOPTIONS, AOPTIONS, RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, 05490000
   FILESIZE, NUMEXTENTS, INITALLOC, FILECODE;                           05495000
   BYTE ARRAY FILEDESIGNATOR,  DEVICE, FORMMSG;                         05500000
   LOGICAL FOPTIONS, AOPTIONS;                                          05505000
   INTEGER RECSIZE, RECMODE, BLOCKFACTOR, NUMBUFFERS, NUMEXTENTS,       05510000
   INITALLOC, FILECODE;                                                 05515000
   DOUBLE FILESIZE;                                                     05520000
   OPTION VARIABLE, EXTERNAL;                                           05525000
                                                               <<00098>>05530000
   INTEGER PROCEDURE DFOPEN                                    <<00200>>05535000
     (FNAME,FOPS,AOPS,RECSIZE,DEV,FORMMSG,NUMLABS,BLKFACT,     <<00200>>05540000
      NUMBUFS,FSIZE,NUMEXTS,INITEXTS,FCODE);                   <<00200>>05545000
     VALUE FOPS,AOPS,RECSIZE,NUMLABS,BLKFACT,NUMBUFS,FSIZE,    <<00200>>05550000
           NUMEXTS,INITEXTS,FCODE;                             <<00200>>05555000
     BYTE ARRAY FNAME,DEV,FORMMSG;                             <<00200>>05560000
     LOGICAL FOPS,AOPS;                                        <<00200>>05565000
     INTEGER RECSIZE,NUMLABS,BLKFACT,NUMBUFS,NUMEXTS,INITEXTS, <<00200>>05570000
             FCODE;                                            <<00200>>05575000
     DOUBLE FSIZE; OPTION VARIABLE,EXTERNAL;                   <<00200>>05580000
                                                                        05585000
   PROCEDURE FCLOSE (FILENUM, DISPOSITION, SECCODE);                    05590000
   VALUE FILENUM, DISPOSITION, SECCODE;                                 05595000
   INTEGER FILENUM, DISPOSITION, SECCODE;                               05600000
   OPTION EXTERNAL;                                                     05605000
                                                                        05610000
   INTEGER PROCEDURE FREAD (FNUM, BUF, COUNT);                          05615000
      VALUE FNUM, COUNT;                                                05620000
      INTEGER FNUM, COUNT;                                              05625000
      ARRAY BUF;                                                        05630000
      OPTION EXTERNAL;                                                  05635000
                                                                        05640000
   PROCEDURE FWRITE(FNUM,TARGET,COUNT,CONT);                            05645000
   VALUE FNUM,COUNT,CONT;                                               05650000
   INTEGER FNUM,COUNT,CONT;                                             05655000
   ARRAY TARGET;                                                        05660000
   OPTION EXTERNAL;                                                     05665000
                                                                        05670000
   PROCEDURE FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);             05675000
   VALUE FILENUM;                                                       05680000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              05685000
   DOUBLE BLKNUM;                                                       05690000
   OPTION VARIABLE,EXTERNAL;                                            05695000
                                                                        05700000
   PROCEDURE FGETINFO                                                   05705000
   (FNUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,DEVTYPE,LDNUM,HDADDR,       05710000
    FILECODE,RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,BLKSIZE,EXTSIZE,       05715000
    NUMEXTENTS,USERLABELS,CREATORID,LABADDR);                           05720000
   VALUE FNUM;                                                          05725000
   INTEGER FNUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,USERLABELS; 05730000
   BYTE ARRAY FILENAME,CREATORID;                                       05735000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      05740000
   DOUBLE RECPTR,EOF,LIMIT,LOGCOUNT,PHYSCOUNT,LABADDR;                  05745000
   OPTION VARIABLE,EXTERNAL;                                            05750000
                                                                        05755000
INTEGER PROCEDURE FLABIO (LDEV,ADDR,FUNC,FLAB);                         05760000
    VALUE   LDEV,FUNC,ADDR;                                             05765000
    INTEGER LDEV,FUNC;                                                  05770000
    LOGICAL ARRAY FLAB;                                                 05775000
    DOUBLE ADDR;                                                        05780000
    OPTION EXTERNAL;                                                    05785000
                                                                        05790000
   PROCEDURE FRENAME(FILENUM,FNAME);                                    05795000
   VALUE FILENUM;                                                       05800000
   INTEGER FILENUM;                                                     05805000
   BYTE ARRAY FNAME;                                                    05810000
   OPTION EXTERNAL;                                                     05815000
                                                                        05820000
   PROCEDURE SEGMENTER                                                  05825000
   (PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6,           <<00629>>05830000
    STR1,STR2,FNAME1,FNAME2);                                  <<00629>>05835000
   VALUE COMMAND,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;                <<00629>>05840000
   INTEGER PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;    <<00629>>05845000
   BYTE ARRAY STR1,STR2,FNAME1,FNAME2;                                  05850000
   OPTION VARIABLE, EXTERNAL;                                           05855000
                                                                        05860000
   PROCEDURE CREATEPROCESS (ERROR,PIN,PROGNAME,OPTNUMS,OPTS);  <<01200>>05865000
   INTEGER ERROR,PIN;                                          <<01200>>05870000
   BYTE ARRAY PROGNAME;                                        <<01200>>05875000
   INTEGER ARRAY OPTNUMS;                                      <<01200>>05880000
   LOGICAL ARRAY OPTS;                                         <<01200>>05885000
   OPTION VARIABLE, EXTERNAL;                                  <<01200>>05890000
                                                               <<01200>>05895000
   PROCEDURE CREATE(PROGNAME,ENTRYNAME,PIN,PARM,FLAGS,                  05900000
   STACK,DL,MAXDATA,PRI,RANK);                                          05905000
   VALUE PARM,STACK,DL,PRI,FLAGS,MAXDATA,RANK;                          05910000
   LOGICAL PIN,PARM,FLAGS,PRI;                                          05915000
   INTEGER STACK,DL,MAXDATA,RANK;                                       05920000
   BYTE ARRAY PROGNAME, ENTRYNAME;                                      05925000
   OPTION EXTERNAL, VARIABLE;                                           05930000
                                                                        05935000
   PROCEDURE AWAKE(PCBPT,N,WTFLG);                                      05940000
   VALUE PCBPT,N,WTFLG;                                                 05945000
   INTEGER PCBPT,N,WTFLG;                                               05950000
   OPTION EXTERNAL;                                                     05955000
                                                               <<02318>>05960000
LOGICAL PROCEDURE SETCRITICAL;                                 <<02318>>05965000
OPTION EXTERNAL;                                               <<02318>>05970000
                                                                        05975000
   LOGICAL PROCEDURE CALENDAR;                                          05980000
   OPTION EXTERNAL;                                                     05985000
                                                                        05990000
   DOUBLE PROCEDURE CLOCK;                                              05995000
   OPTION EXTERNAL;                                                     06000000
                                                                        06005000
   LOGICAL PROCEDURE GETSIR (N);                                        06010000
   VALUE N;                                                             06015000
   LOGICAL N;                                                           06020000
   OPTION EXTERNAL;                                                     06025000
                                                                        06030000
   PROCEDURE RELSIR (N,T);                                              06035000
   VALUE N, T;                                                          06040000
   LOGICAL N, T;                                                        06045000
   OPTION EXTERNAL;                                                     06050000
                                                                        06055000
   DOUBLE PROCEDURE DIRECSCAN (TYPE,LINKAGE'INDEXP,ANAME,      <<38.PV>>06060000
                               GUNAME,FNAME,RECIP,LDN,MVTABX); <<38.PV>>06065000
   VALUE TYPE,LINKAGE'INDEXP,MVTABX;                           <<38.PV>>06070000
   INTEGER TYPE,MVTABX;                                        <<38.PV>>06075000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>06080000
   ARRAY ANAME,GUNAME,FNAME,LDN;                                        06085000
   INTEGER PROCEDURE RECIP;                                             06090000
   OPTION EXTERNAL,VARIABLE;                                   <<35.PV>>06095000
                                                                        06100000
   INTEGER PROCEDURE ADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO);                06105000
   VALUE SIZE,TNO;                                                      06110000
   INTEGER SIZE,TNO;                                                    06115000
   BYTE ARRAY N1,N2,N3;                                                 06120000
   INTEGER ARRAY INFO;                                                  06125000
   OPTION EXTERNAL;                                                     06130000
                                                                        06135000
   INTEGER PROCEDURE XADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO,XN1,XN2,XN3);   06140000
   VALUE SIZE,TNO;                                                      06145000
   INTEGER SIZE,TNO;                                                    06150000
   BYTE ARRAY N1,N2,N3,XN1,XN2,XN3;                                     06155000
   INTEGER ARRAY INFO;                                                  06160000
   OPTION EXTERNAL;                                                     06165000
                                                                        06170000
   INTEGER PROCEDURE XREMJTENTRY(N1,N2,N3,TNO);                         06175000
   VALUE TNO;                                                           06180000
   INTEGER TNO;                                                         06185000
   BYTE ARRAY N1,N2,N3;                                                 06190000
   OPTION EXTERNAL;                                                     06195000
                                                                        06200000
   LOGICAL PROCEDURE LOCKJIR;                                           06205000
   OPTION EXTERNAL;                                                     06210000
                                                                        06215000
   PROCEDURE UNLOCKJIR (A);                                             06220000
   VALUE A;                                                             06225000
   INTEGER A;                                                           06230000
   OPTION EXTERNAL;                                                     06235000
                                                                        06240000
   DOUBLE PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);06245000
   VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     06250000
   INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                   06255000
   OPTION EXTERNAL;                                                     06260000
                                                                        06265000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<0U.EB>>06270000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>06275000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<0U.EB>>06280000
      DST,IOTYPE;                                              <<0U.EB>>06285000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<0U.EB>>06290000
      DST,IOTYPE;                                              <<0U.EB>>06295000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>06300000
                                                               <<U.RAO>>06305000
   PROCEDURE ERRORON;                                                   06310000
   OPTION EXTERNAL;                                                     06315000
                                                                        06320000
   PROCEDURE ERROREXIT(INTRINEXIT,ERRBYTES,PARAM);                      06325000
   VALUE INTRINEXIT,ERRBYTES,PARAM;                                     06330000
   LOGICAL INTRINEXIT,ERRBYTES,PARAM;                                   06335000
   OPTION EXTERNAL;                                                     06340000
                                                                        06345000
INTEGER PROCEDURE FORMNAME(TYPE,TARGET,BA1,BA2,BA3,BA4);       <<02.EB>>06350000
   VALUE TYPE; INTEGER TYPE;                                   <<02.EB>>06355000
   BYTE ARRAY TARGET,BA1,BA2,BA3,BA4; OPTION EXTERNAL;         <<02.EB>>06360000
                                                               <<02.EB>>06365000
INTEGER PROCEDURE GETDEVINFO(DEVICE,DEVINFO);                  <<00579>>06370000
   BYTE ARRAY DEVICE;                                          <<00579>>06375000
   INTEGER ARRAY DEVINFO;                                      <<00579>>06380000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<00579>>06385000
                                                               <<00579>>06390000
INTEGER PROCEDURE GET'DSDEVICE( LDEV );                        <<02848>>06395000
   VALUE   LDEV;                                               <<02848>>06400000
   INTEGER LDEV;                                               <<02848>>06405000
   OPTION  PRIVILEGED, UNCALLABLE, EXTERNAL;                   <<02848>>06410000
                                                               <<02848>>06415000
PROCEDURE DISMOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,            <<00211>>06420000
                    MVTABX,SOME'OTHER'PIN);                    <<00211>>06425000
   VALUE MVTABX,SOME'OTHER'PIN;                                <<00211>>06430000
   INTEGER REQTYPE,MVTABX,SOME'OTHER'PIN;                      <<00211>>06435000
   BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                          <<RH.PV>>06440000
   OPTION VARIABLE,EXTERNAL;                                   <<RH.PV>>06445000
                                                               <<RH.PV>>06450000
INTEGER PROCEDURE LUN (VTABINX,MVTABX);                        <<RV.PV>>06455000
    VALUE   VTABINX,MVTABX;                                    <<RV.PV>>06460000
    INTEGER VTABINX,MVTABX;                                    <<RV.PV>>06465000
    OPTION EXTERNAL;                                           <<RV.PV>>06470000
                                                               <<RV.PV>>06475000
PROCEDURE INITUDC( SHOW, COMFN );                              <<03737>>06480000
   VALUE    SHOW, COMFN;                                       <<03737>>06485000
   LOGICAL  SHOW;                                              <<03737>>06490000
   INTEGER  COMFN;                                             <<03737>>06495000
   OPTION   VARIABLE, EXTERNAL;                                <<03737>>06500000
PROCEDURE QUALIFYFILENAME(OLDFNAME,NEWFNAME);                  <<03.EB>>06505000
   BYTE ARRAY OLDFNAME,NEWFNAME; OPTION EXTERNAL;              <<03.EB>>06510000
                                                               <<03.EB>>06515000
PROCEDURE CRUNCH(N1,N2,N3,DEST,NWORDS);                        <<02554>>06520000
   INTEGER NWORDS;                                             <<02554>>06525000
   INTEGER ARRAY DEST;                                         <<02554>>06530000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>06535000
   OPTION EXTERNAL;                                            <<02554>>06540000
INTEGER PROCEDURE XRETJTENTRY(N1,N2,N3,SIZE,INFO);             <<02554>>06545000
   BYTE ARRAY N1,N2,N3;                                        <<02554>>06550000
   INTEGER SIZE;                                               <<02554>>06555000
   INTEGER ARRAY INFO;                                         <<02554>>06560000
   OPTION EXTERNAL;                                            <<02554>>06565000
   INTEGER PROCEDURE CYIMPLCTFILE'(LHS,RHS,LENR);              <<U.RAO>>06570000
   VALUE LENR;                                                 <<U.RAO>>06575000
   INTEGER LENR;                                               <<U.RAO>>06580000
   BYTE ARRAY LHS, RHS;                                        <<U.RAO>>06585000
   OPTION PRIVILEGED, UNCALLABLE, FORWARD;                     <<U.RAO>>06590000
                                                               <<U.RAO>>06595000
   PROCEDURE DELIMPFILE(PARM,FNAME);                                    06600000
   VALUE PARM;                                                          06605000
   LOGICAL PARM;                                                        06610000
   BYTE ARRAY FNAME;                                                    06615000
   OPTION PRIVILEGED, UNCALLABLE, FORWARD;                              06620000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<U.RAO>>06625000
VALUE FNUM;                                                    <<U.RAO>>06630000
INTEGER FNUM,PARMNUM;                                          <<U.RAO>>06635000
OPTION PRIVILEGED, UNCALLABLE,EXTERNAL;                        << I.A >>06640000
                                                                        06645000
   PROCEDURE CIERR(ERRNUM,ERRADR,PARMMASK,PARM);               <<U.RAO>>06650000
   VALUE ERRNUM,PARMMASK,PARM;                                 <<U.RAO>>06655000
   INTEGER ERRNUM,PARMMASK,PARM;                               <<U.RAO>>06660000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>06665000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE,EXTERNAL;             << I.A >>06670000
                                                               <<U.RAO>>06675000
   INTEGER PROCEDURE SYSLIST (ELEMENT, LEVEL, PARMS, SIRS);             06680000
   VALUE LEVEL, PARMS, SIRS;                                            06685000
   ARRAY ELEMENT;                                                       06690000
   INTEGER LEVEL, PARMS;                                                06695000
   DOUBLE SIRS;                                                         06700000
   OPTION EXTERNAL, PRIVILEGED, UNCALLABLE;                    << I.A >>06705000
                                                                        06710000
PROCEDURE CYDIRERR'(DIRECRETURN,OKMASK,ERRNUM);                <<U.RAO>>06715000
VALUE DIRECRETURN,OKMASK;                                      <<U.RAO>>06720000
DOUBLE DIRECRETURN;                                            <<U.RAO>>06725000
INTEGER ERRNUM;                                                <<U.RAO>>06730000
LOGICAL OKMASK;                                                <<U.RAO>>06735000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         << I.A >>06740000
                                                                        06745000
   PROCEDURE GET'FILECODE(FILECODE,MNEMONIC,MNEMONIC'LENGTH);  <<01454>>06750000
   INTEGER FILECODE,MNEMONIC'LENGTH;                           <<01454>>06755000
   BYTE ARRAY MNEMONIC;                                        <<01454>>06760000
   OPTION UNCALLABLE,PRIVILEGED,FORWARD;                       <<01454>>06765000
                                                               <<01454>>06770000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>06775000
VALUE PDEF; DOUBLE PDEF;                                       <<U.RAO>>06780000
LOGICAL GPTR,APTR,ERRPTR;                                      <<U.RAO>>06785000
OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                       << I.A >>06790000
                                                               <<U.RAO>>06795000
<< CHK'DESCRIBE'FNAME is an entry point to CHECKFILENAME'. >>  <<04848>>06800000
INTEGER PROCEDURE CHK'DESCRIBE'FNAME( P, G, A, E );            <<04848>>06805000
VALUE P;  DOUBLE P;                                            <<04848>>06810000
LOGICAL G, A, E;                                               <<04848>>06815000
OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                       <<04848>>06820000
                                                               <<04848>>06825000
LOGICAL PROCEDURE CIBADFILENAME(ERRNUM,PARM);                  <<U.RAO>>06830000
VALUE PARM;                                                    <<U.RAO>>06835000
INTEGER ERRNUM;                                                <<U.RAO>>06840000
DOUBLE PARM;                                                   <<U.RAO>>06845000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         << I.A >>06850000
                                                               <<U.RAO>>06855000
INTEGER PROCEDURE CHECKHOMEACCT(PPRESULT);                     <<U.RAO>>06860000
INTEGER ARRAY PPRESULT;                                        <<U.RAO>>06865000
OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                       << I.A >>06870000
                                                                        06875000
PROCEDURE RESET'TERMINALMODE;                                  <<00851>>06880000
OPTION UNCALLABLE,FORWARD;                                     <<00851>>06885000
LOGICAL PROCEDURE CREATEERROR;                                 <<U.RAO>>06890000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         << I.A >>06895000
                                                               <<U.RAO>>06900000
   INTEGER PROCEDURE GETFLABEL(FILEREF,LEN,FLABEL,FLDN,                 06905000
   FADDR,FNUM,SIRINFO);                                        <<04.RO>>06910000
   VALUE LEN;                                                           06915000
   INTEGER LEN,FLDN;                                                    06920000
   INTEGER FNUM;                                               <<04.RO>>06925000
   ARRAY FLABEL;                                                        06930000
   BYTE ARRAY FILEREF;                                                  06935000
   DOUBLE FADDR,SIRINFO;                                                06940000
   OPTION FORWARD,VARIABLE,PRIVILEGED,UNCALLABLE;                       06945000
                                                                        06950000
   PROCEDURE RESETDUMP;                                                 06955000
   OPTION FORWARD,PRIVILEGED;                                           06960000
                                                                        06965000
   PROCEDURE SETDUMP(FLAGS);                                            06970000
   VALUE FLAGS;                                                         06975000
   LOGICAL FLAGS;                                                       06980000
   OPTION PRIVILEGED,FORWARD;                                           06985000
                                                                        06990000
   LOGICAL PROCEDURE REQUESTSERVICE;                                    06995000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      << I.A >>07000000
                                                                        07005000
   LOGICAL PROCEDURE CREATEPROC'ERR(ERROR,ERRNUM);             <<01452>>07010000
   VALUE ERROR; INTEGER ERROR,ERRNUM;                          <<01452>>07015000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      << I.A >>07020000
                                                               <<01452>>07025000
LOGICAL PROCEDURE CISUBSYSFINISH(MESSGTYPE,ERRNUM,PARMNUM);    <<01452>>07030000
   VALUE MESSGTYPE;                                            <<01452>>07035000
   INTEGER MESSGTYPE,ERRNUM,PARMNUM;                           <<01452>>07040000
   OPTION UNCALLABLE,PRIVILEGED,FORWARD;                       <<01452>>07045000
                                                                        07050000
LOGICAL PROCEDURE JOBSESSIONMAIN; OPTION EXTERNAL;             << I.A >>07055000
                                                               <<14.EB>>07060000
LOGICAL PROCEDURE IMPLICITMNT(GROUP,ACCT,MOUNTDST,PV'ERROR);   << I.A >>07065000
  ARRAY GROUP,ACCT;                                            << I.A >>07070000
  INTEGER MOUNTDST,PV'ERROR;                                   << I.A >>07075000
  OPTION PRIVILEGED,UNCALLABLE,                                << I.A >>07080000
         EXTERNAL;                                             << I.A >>07085000
                                                               << I.A >>07090000
DOUBLE PROCEDURE DIRECFINDFILE( TYPE, LINKAGE'INDEXP,          << 8921>>07095000
                                ACCT'NAME, GRP'NAME, FILE'NAME,<< 8921>>07100000
                                PRETURN, MVTABX );             << 8921>>07105000
VALUE TYPE, LINKAGE'INDEXP, MVTABX;                            << 8921>>07110000
LOGICAL TYPE, MVTABX;                                          << 8921>>07115000
DOUBLE LINKAGE'INDEXP;                                         << 8921>>07120000
LOGICAL ARRAY ACCT'NAME, GRP'NAME, FILE'NAME, PRETURN;         << 8921>>07125000
OPTION PRIVILEGED, UNCALLABLE, VARIABLE, EXTERNAL;             << 8921>>07130000
                                                               << 8921>>07135000
DOUBLE PROCEDURE DIRECFIND( TYPE, LINKAGE'INDEXP,              << 8921>>07140000
                                ACCT'NAME, GRP'NAME, FILE'NAME,<< 8921>>07145000
                                PRETURN );                     << 8921>>07150000
VALUE TYPE, LINKAGE'INDEXP;                                    << 8921>>07155000
LOGICAL TYPE;                                                  << 8921>>07160000
DOUBLE LINKAGE'INDEXP;                                         << 8921>>07165000
LOGICAL ARRAY ACCT'NAME, GRP'NAME, FILE'NAME, PRETURN;         << 8921>>07170000
OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                       << 8921>>07175000
                                                               << 8921>>07180000
PROCEDURE MOUNT( VSNAME, VSGROUP, VSACCT, REQ'TYPE,            << 8921>>07185000
                 GEN,    PVINFO,  DIFFERENT'PIN     );         << 8921>>07190000
VALUE GEN, DIFFERENT'PIN;                                      << 8921>>07195000
INTEGER REQ'TYPE, GEN, PVINFO, DIFFERENT'PIN;                  << 8921>>07200000
BYTE ARRAY VSNAME, VSGROUP, VSACCT;                            << 8921>>07205000
OPTION PRIVILEGED, UNCALLABLE, VARIABLE, EXTERNAL;             << 8921>>07210000
                                                               << 8921>>07215000
$PAGE    "FILE AND BUILD COMMAND EXECUTORS"                             07220000
$CONTROL   SEGMENT  =  CIFILEB                                          07225000
                                                                        07230000
LOGICAL PROCEDURE CHECKEXPDATE(ERRNUM, FIELDLEN, DATASOURCE,   <<U.RAO>>07235000
    DATATARGET);                                               <<U.RAO>>07240000
VALUE FIELDLEN;                                                <<U.RAO>>07245000
INTEGER ERRNUM, FIELDLEN;                                      <<U.RAO>>07250000
BYTE ARRAY DATASOURCE, DATATARGET;                             <<U.RAO>>07255000
OPTION INTERNAL;                                               <<04.RO>>07260000
<<This procedure checks the expiration date field for labeled>><<U.RAO>>07265000
<<tapes.  The format for this field is MM/DD/YY.  They may all><<U.RAO>>07270000
<<be zero.  The procedure calls CIERR directly.  ERRNUM is the><<U.RAO>>07275000
<<usual CI error parameter.  FIELDLEN is the length of the >>  <<U.RAO>>07280000
<<expiration date field as determined in the FILE command by>> <<U.RAO>>07285000
<<MYCOMMAND.  It is used to check for extraneous data.  >>     <<U.RAO>>07290000
<<DATASOURCE and DATATARGET are just what they seem.    >>     <<U.RAO>>07295000
BEGIN                                                          <<U.RAO>>07300000
INTEGER MONTH;                                                 <<U.RAO>>07305000
INTEGER DAY;                                                   <<U.RAO>>07310000
INTEGER YEAR;                                                  <<U.RAO>>07315000
INTEGER NUMLEN;  <<LENGTH OF THE INDIVIDUAL DATA FIELD>>       <<U.RAO>>07320000
INTEGER MAXDAYS;  <<USED TO COPE WITH LEAP YEAR COMPLICATIONS>><<U.RAO>>07325000
BYTE POINTER SOURCEPTR;   <<CURRENT LOCATION IN SOURCE>>       <<U.RAO>>07330000
INTEGER ARRAY MONTHARR(0:1) = PB :=    <<DAYS OF EACH MONTH>>  <<U.RAO>>07335000
   0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31;          <<U.RAO>>07340000
SUBROUTINE GETTOKEN(TARGET);                                   <<U.RAO>>07345000
INTEGER TARGET;                                                <<U.RAO>>07350000
<<FINDS AND COMPUTES EACH PART OF THE DATE FIELD>>             <<U.RAO>>07355000
BEGIN                                                          <<U.RAO>>07360000
SCAN SOURCEPTR WHILE [8/%15,8/" "],1;                          <<U.RAO>>07365000
@SOURCEPTR := TOS;                                             <<U.RAO>>07370000
MOVE SOURCEPTR := SOURCEPTR WHILE N,1;                         <<U.RAO>>07375000
NUMLEN := TOS-@SOURCEPTR;                                      <<U.RAO>>07380000
TARGET := BINARY(SOURCEPTR, NUMLEN);  <<CONVERT TO BINARY>>    <<U.RAO>>07385000
END;                                                           <<U.RAO>>07390000
@SOURCEPTR := @DATASOURCE;                                     <<U.RAO>>07395000
MOVE DATATARGET := "00/00/0";  <<INITIALIZE RETURN SPACE>>     <<U.RAO>>07400000
GETTOKEN(MONTH);   <<COMPUTE MONTH VALUE>>                     <<U.RAO>>07405000
IF NOT(1<=NUMLEN<=2) OR NOT(0<=MONTH<=12) THEN   <<INVALID MONT<<U.RAO>>07410000
   CIERR(ERRNUM := FILEXPINVMONTH, SOURCEPTR)                  <<U.RAO>>07415000
ELSE                                                           <<U.RAO>>07420000
   BEGIN   <<MONTH CHECKED OUT OK, DO DAY>>                    <<U.RAO>>07425000
   ASCII(MONTH, -10, DATATARGET(1));  <<PUT IN RESULT FIELD>>  <<U.RAO>>07430000
   SCAN SOURCEPTR(NUMLEN) WHILE [8/%15,8/" "],1;               <<U.RAO>>07435000
   IF BPS0 <> "/" THEN                                         <<U.RAO>>07440000
      CIERR(ERRNUM := FILEXPNOSLASHMD, BPS0)                   <<U.RAO>>07445000
   ELSE   <<FOUND SLASH, LOOK FOR DAY>>                        <<U.RAO>>07450000
      BEGIN                                                    <<U.RAO>>07455000
      @SOURCEPTR := TOS+1;                                     <<U.RAO>>07460000
      GETTOKEN(DAY);                                           <<U.RAO>>07465000
      IF MONTH=0 AND DAY<>0 THEN  <<00/00/00 BAD>>             <<U.RAO>>07470000
         CIERR(ERRNUM := FILEXPDAYZERO, SOURCEPTR)             <<U.RAO>>07475000
      ELSE IF NOT(1<=NUMLEN<=2) THEN                           <<00617>>07480000
         CIERR(ERRNUM := FILEXPINVDAY,SOURCEPTR,%10000,MAXDAYS)<<U.RAO>>07485000
      ELSE   <<DAY CHECKED OUT>>                               <<U.RAO>>07490000
         BEGIN                                                 <<U.RAO>>07495000
         ASCII(DAY, -10, DATATARGET(4));                       <<U.RAO>>07500000
         SCAN SOURCEPTR(NUMLEN) WHILE [8/%15,8/" "],1;         <<U.RAO>>07505000
         IF BPS0 <> "/" THEN                                   <<U.RAO>>07510000
            CIERR(ERRNUM := FILEXPNOSLASHDY, BPS0)             <<U.RAO>>07515000
         ELSE                                                  <<U.RAO>>07520000
            BEGIN                                              <<U.RAO>>07525000
            @SOURCEPTR := TOS+1;                               <<U.RAO>>07530000
            GETTOKEN(YEAR);                                    <<U.RAO>>07535000
            MAXDAYS:=MONTHARR(MONTH) + <<LEAP YEAR CORRECTION>><<00617>>07540000
               (IF YEAR MOD 4 = 0 AND MONTH=2 THEN 1 ELSE 0);  <<00617>>07545000
            IF MONTH <> 0 AND NOT(1<=DAY<=MAXDAYS) THEN        <<00617>>07550000
               CIERR(ERRNUM:=FILEXPINVDAY,,%10000,MAXDAYS)     <<00617>>07555000
            ELSE                                               <<00617>>07560000
            IF MONTH=0 AND YEAR<>0 THEN  <<EXPECTED 00/00/00>> <<U.RAO>>07565000
               CIERR(ERRNUM := FILEXPNONZERO, SOURCEPTR)       <<U.RAO>>07570000
            ELSE                                               <<U.RAO>>07575000
               IF @SOURCEPTR(NUMLEN)-@DATASOURCE <> FIELDLEN THEN       07580000
                  CIERR(ERRNUM := FILEXPXTRNDATA, SOURCEPTR(NUMLEN))    07585000
            ELSE   <<ALL CHECKED OUT, DO IT>>                  <<U.RAO>>07590000
               BEGIN                                           <<U.RAO>>07595000
               ASCII(YEAR, -10, DATATARGET(7));                <<U.RAO>>07600000
               CHECKEXPDATE := TRUE;                           <<U.RAO>>07605000
               END;                                            <<U.RAO>>07610000
            END;                                               <<U.RAO>>07615000
         END;                                                  <<U.RAO>>07620000
      END;                                                     <<U.RAO>>07625000
   END;                                                        <<U.RAO>>07630000
END;   <<PROCEDURE CHECKEXPDATE>>                              <<U.RAO>>07635000
PROCEDURE CXFILE EXECUTORHEAD;                                 <<U.RAO>>07640000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>07645000
BEGIN                                                          <<U.RAO>>07650000
BYTE ARRAY PKEYLIST (0:1) = PB :=                              <<U.RAO>>07655000
   << FLAGS-BYTE (FOLLOWING WORD) = DISALLOW NEW/OLD/SYS($)/BUIL>>      07660000
   6,3, "DEV", 0,                                              <<U.RAO>>07665000
   7,4, "DISC", 6,                                             <<U.RAO>>07670000
   6,3, "REC", 0,                                              <<U.RAO>>07675000
   7,4, "CODE", 2,                                             <<U.RAO>>07680000
   7,4, "CCTL", 0,                                             <<U.RAO>>07685000
   9,6, "NOCCTL", 0,                                           <<U.RAO>>07690000
   7,4, "TEMP", 2,                                             <<U.RAO>>07695000
   7,4, "SAVE", 3,                                             <<U.RAO>>07700000
   6,3, "DEL", 3,                                              <<U.RAO>>07705000
   6,3, "ACC", 1,                                              <<U.RAO>>07710000
   6,3, "SHR", 1,                                              <<U.RAO>>07715000
   6,3, "EAR", 1,                                              <<U.RAO>>07720000
   7,4, "SEMI", 1,                                             <<01549>>07725000
   6,3, "EXC", 1,                                              <<U.RAO>>07730000
   6,3, "BUF", 1,                                              <<U.RAO>>07735000
   8,5, "NOBUF", 1,                                            <<U.RAO>>07740000
   7,4, "COPY", 1,                                             <<01549>>07745000
   9,6, "NOCOPY", 1,                                           <<01549>>07750000
   5,2, "MR", 1,                                               <<U.RAO>>07755000
   7,4, "NOMR", 1,                                             <<U.RAO>>07760000
   9,6, "GMULTI", 1,                                           <<01549>>07765000
   8,5, "MULTI", 1,                                            <<U.RAO>>07770000
   10,7, "NOMULTI", 1,                                         <<U.RAO>>07775000
   10,7, "NOLABEL", 3,                                         <<U.RAO>>07780000
   8,5, "FORMS", 1,                                            <<U.RAO>>07785000
   8,5, "LABEL", 3,                                            <<U.RAO>>07790000
   7,4, "LOCK", 1,                                             <<U.RAO>>07795000
   9,6, "NOLOCK", 1,                                           <<U.RAO>>07800000
   7,4, "WAIT", 1,                                             <<U.RAO>>07805000
   9,6, "NOWAIT", 1,                                           <<U.RAO>>07810000
   6,3, "STD", 3,                                              <<01724>>07815000
   6,3, "RIO",2,                                               <<00634>>07820000
   8,5, "NORIO",2,                                             <<00634>>07825000
   6,3,"ENV",1,                                                <<01549>>07830000
   7,4,"OUTQ", 1,                                              <<01549>>07835000
   6,3, "MSG", 2,                                              <<01549>>07840000
   6,3, "CIR", 2,                                              <<01549>>07845000
   6,3, "DEN", 3,                                              <<02569>>07850000
   0;                                                          <<U.RAO>>07855000
EQUATE PKEYLISTL = 272;                                        <<02569>>07860000
BYTE ARRAY KEYLIST (0:PKEYLISTL-1);                            <<U.RAO>>07865000
BYTE ARRAY PACCTYPES(0:1) = PB :=                              <<U.RAO>>07870000
   4,2, "IN",                                                  <<U.RAO>>07875000
   5,3, "OUT",                                                 <<U.RAO>>07880000
   9,7, "OUTKEEP",                                             <<U.RAO>>07885000
   8,6, "APPEND",                                              <<U.RAO>>07890000
   7,5, "INOUT",                                               <<U.RAO>>07895000
   8,6, "UPDATE",                                              <<U.RAO>>07900000
   0;                                                          <<U.RAO>>07905000
EQUATE ACCTYPEL = 42;                                          <<U.RAO>>07910000
BYTE ARRAY ACCTYPES(0:ACCTYPEL-1);                             <<U.RAO>>07915000
ENTRY CXBUILD, PARSE'FILE'EQ;                                  <<01200>>07920000
LABEL STARTPARSE;          << COMMOM CODE TO BOTH ENTRY PTS >> <<01200>>07925000
                                                               <<U.RAO>>07930000
<<VARIABLES FOR THE PARSE>>                                    <<U.RAO>>07935000
LOGICAL BUILDFLAG := FALSE;                                    <<U.RAO>>07940000
INTEGER NUMPARMS;                                              <<U.RAO>>07945000
EQUATE MAXPARMS = 32;                                          <<01549>>07950000
BYTE POINTER PARMPTR;  <<POINTER TO CURRENT PARAMETER>>        <<U.RAO>>07955000
INTEGER PARMLEN;  <<LENGTH OF CURRENT PARAMETER>>              <<U.RAO>>07960000
BYTE SAVEDELIM;                                                <<02053>>07965000
INTEGER NEXTDELIM;  <<DELIMITER FOLLOWING CURRENT PARAMETER>>  <<U.RAO>>07970000
DOUBLE DELIMS := [8/",",8/"=",8/";",8/%15]D;                   <<01117>>07975000
BYTE ARRAY BDELIMS (*) = DELIMS;                               <<01117>>07980000
DEFINE DELIMTYPE = (13:3)#;                                    <<U.RAO>>07985000
EQUATE COMMA = 0,  <<EQUATES FOR INDEX IN DELIMITER ARRAY>>    <<U.RAO>>07990000
       EQUALS = 1,                                             <<U.RAO>>07995000
       SEMICOLON = 2,                                          <<U.RAO>>08000000
       CR = 3;                                                 <<U.RAO>>08005000
INTEGER COMTYPE;  <<HOLDS TYPE OF COMMAND WHILE IN PROCKEY>>   <<U.RAO>>08010000
EQUATE BUILD = 0,  <<EQUATES FOR VALUES OF COMTYPE>>           <<U.RAO>>08015000
       SYSDEF = 1,                                             <<U.RAO>>08020000
       OLD = 2,                                                <<U.RAO>>08025000
       NEW = 3;                                                <<U.RAO>>08030000
LOGICAL GPNTR := 0,   <<HOLD BYTE POINTERS TO APPROPRIATE ENTRY<<U.RAO>>08035000
        APNTR := 0,                                            <<U.RAO>>08040000
        GPNTR2 := 0,                                           <<U.RAO>>08045000
        APNTR2 := 0,                                           <<U.RAO>>08050000
        APNTRENV := 0,   <<"ENV=FILENAME">>                    <<01549>>08055000
        GPNTRENV := 0,                                         <<01549>>08060000
        ERRPNTR := 0;                                          <<U.RAO>>08065000
BYTE POINTER GROUP = GPNTR,                                    <<U.RAO>>08070000
             ACCT = APNTR,                                     <<U.RAO>>08075000
             GROUP2 = GPNTR2,                                  <<U.RAO>>08080000
             ACCT2 = APNTR2,                                   <<U.RAO>>08085000
             GROUPENV = GPNTRENV,                              <<02554>>08090000
             ACCTENV  = APNTRENV,                              <<02554>>08095000
             ERRADR = ERRPNTR;                                 <<U.RAO>>08100000
                                                               <<U.RAO>>08105000
<<VARIABLES FOR THE EXECUTION PHASE>>                          <<U.RAO>>08110000
BYTE POINTER DICTPTR;  <<DICTIONARY POINTER FOR SEARCH INTRINSIC>>      08115000
ARRAY WENTRY(0:71);   <<HOLDS PROTOTYPE ENTRY FOR JDT>>        <<U.RAO>>08120000
BYTE ARRAY BENTRY(*)=WENTRY;                                   <<U.RAO>>08125000
INTEGER ARRAY                                                  <<02554>>08130000
   FILE'ENTRY(0:71),      << HOLDS FILE ENTRY FROM JDT >>      <<02554>>08135000
   DEST(0:14);            << HOLDS OUTPUT OF CRUNCH    >>      <<02554>>08140000
INTEGER                                                        <<02554>>08145000
   SIZE,                  << FOR CRUNCH CALL           >>      <<02554>>08150000
   INDEX;                 << GENERAL LOOP VARIABLE     >>      <<02554>>08155000
BYTE ARRAY                                                     <<02554>>08160000
   BFILE'ENTRY(*) = FILE'ENTRY;                                <<02554>>08165000
INTEGER NEXTENTRYX := 6;  <<USED IN SETTING UP WENTRY>>        <<U.RAO>>08170000
BYTE BLANK := " ";                                             <<U.RAO>>08175000
                                                               <<U.RAO>>08180000
<<DATA VARIABLES>>                                             <<U.RAO>>08185000
BYTE ARRAY FORMSMSG(0:73);                                     <<U.RAO>>08190000
BYTE ARRAY TAPELABEL(*)=FORMSMSG(49);                          <<U.RAO>>08195000
BYTE ARRAY SAVEDCOMIMAGE(0:CIS'BCOMBUFLEN - 1);                << I.A >>08200000
INTEGER FORMSMSGLEN := 0;                                      <<U.RAO>>08205000
INTEGER TAPELABELLEN := 0;                                     <<U.RAO>>08210000
EQUATE                                                         <<04171>>08215000
   MAXDEVLEN      = 63,   << Contains extra space for       >> <<06552>>08220000
                          << chaning DS nodes together.     >> <<06552>>08225000
                          << Note that FOPEN's buffer is    >> <<06552>>08230000
                          << slightly smaller.              >> <<06552>>08235000
   MAXDEVCLASSLEN = 8;  << maximum device class name >>        <<04171>>08240000
INTEGER DEVLEN := 0;                                           <<U.RAO>>08245000
DOUBLE DISC := "DISC";                                         <<U.RAO>>08250000
BYTE POINTER DEV := @DISC;                                     <<U.RAO>>08255000
INTEGER ARRAY DEVINFO(0:12);                                   <<06841>>08260000
BYTE POINTER BPTR;                                             <<01117>>08265000
DEFINE                                                         <<04171>>08270000
   FLUSH'COMMAND =                                             <<04171>>08275000
      BEGIN                                                    <<04171>>08280000
         PARSE'ERR(ERRNUM,BPTR);                               <<04171>>08285000
         RETURN;                                               <<04171>>08290000
      END;#;                                                   <<04171>>08295000
LOGICAL FOPTIONS := 0;                                         <<U.RAO>>08300000
LOGICAL AOPTIONS := 0;                                         <<U.RAO>>08305000
LOGICAL FLAGS1 := 0;  <<PROTOTYPE PARAMETER PRESENT MASK>>     <<U.RAO>>08310000
LOGICAL FLAGS2 := 0;  <<WORD 2 OF FLAGS>>                      <<U.RAO>>08315000
EQUATE DELETE = 4,   <<EQUATES FOR DISPOSITION PARAMETERS>>    <<U.RAO>>08320000
       TEMP = 2,                                               <<U.RAO>>08325000
       SAVE = 1;                                               <<U.RAO>>08330000
EQUATE STD = 0,  <<EQUATES FOR FILE TYPE>>                     <<01549>>08335000
       RIO = 2,                                                <<01549>>08340000
       CIR = 4,                                                <<01549>>08345000
       MSG = 6;                                                <<01549>>08350000
EQUATE NOMULTI     = 0,  <<EQUATES FOR MULTIACCESS>>           <<01549>>08355000
       LOCALMULTI  = 1,                                        <<01549>>08360000
       GLOBALMULTI = 2;                                        <<01549>>08365000
INTEGER DISPOSITION := SAVE;  <<DISPOSITION OF FILE AT CLOSE>> <<U.RAO>>08370000
INTEGER RECSIZE := 0;                                          <<U.RAO>>08375000
INTEGER BLOCKFACTOR := 0;                                      <<U.RAO>>08380000
DOUBLE FILESIZE := 0D;                                         <<U.RAO>>08385000
INTEGER NUMEXTENTS := 0;                                       <<U.RAO>>08390000
INTEGER INITALLOC := 0;                                        <<U.RAO>>08395000
INTEGER OUTPRI := 0;                                           <<U.RAO>>08400000
INTEGER NUMCOPIES := 0;                                        <<U.RAO>>08405000
INTEGER FILECODE := 0;                                         <<U.RAO>>08410000
INTEGER NUMBUFFERS := 0;                                       <<U.RAO>>08415000
EQUATE EXCLUSIVE     = 1,                                      << I.A >>08420000
       EXCLUSIVEREAD = 2,                                      <<U.RAO>>08425000
       SHARE         = 3;                                      <<U.RAO>>08430000
LOGICAL PARSE'ONLY;          << TRUE IF ONLY DOING PARSE >>    <<01200>>08435000
LOGICAL STOP;                                                  <<02663>>08440000
<< Variables for FOPEN device parameter keywords >>            <<02569>>08445000
BYTE POINTER                                                   <<01851>>08450000
   DENS,                                                       <<02569>>08455000
   OUTQ,                                                       <<01851>>08460000
   ENV;                                                        <<01851>>08465000
INTEGER                                                        <<01851>>08470000
   DUMMY,          << Dummy for procedure call >>              <<02569>>08475000
   DENSLEN := 0,                                               <<02569>>08480000
   ENVLEN := 0,                                                <<01851>>08485000
   OUTQLEN := 0,                                               <<01851>>08490000
   KEYS'LEN := 0;  << Total length of device parms >>          <<02569>>08495000
LOGICAL FLAGS3 := FALSE;                                       <<01549>>08500000
DEFINE                                                         <<01549>>08505000
   FLAGDENS = FLAGS3.(12:1)#,                                  <<02569>>08510000
   FLAGADEV = FLAGS3.(15:1)#,                                  <<01549>>08515000
   FLAGENV = FLAGS3.(14:1)#,                                   <<01549>>08520000
   FLAGOUTQ = FLAGS3.(13:1)#;                                  <<01549>>08525000
INTEGER                                                        <<04843>>08530000
   ERRLOC;     << Local error number copy. >>                  <<04843>>08535000
                                                               <<04843>>08540000
                                                               <<U.RAO>>08545000
                                                               <<02569>>08550000
<< The PARMS array (and its equivalences) MUST be the last >>  <<02569>>08555000
<< Q-relative variable defined in the procedure because it >>  <<02569>>08560000
<< is a direct array.  Otherwise, the procedure will run   >>  <<02569>>08565000
<< out of Primary Q space. >>                                  <<02569>>08570000
                                                               <<02569>>08575000
DOUBLE ARRAY PARMS(0:MAXPARMS) = Q;                            <<02569>>08580000
BYTE POINTER FORMALDES = PARMS;                                <<02569>>08585000
BYTE POINTER ACTUALDES = PARMS + 2;                            <<02569>>08590000
BYTE ACTUALDESLEN = PARMS + 3;                                 <<02569>>08595000
                                                               <<02569>>08600000
<<FOPTIONS DEFINES>>                                           <<U.RAO>>08605000
DEFINE                                                         <<U.RAO>>08610000
   FILETYPE    = (2:3) #,                                      <<01549>>08615000
   TAPELABELF  = (6:1)#,                                       <<U.RAO>>08620000
   CCTL        = (7:1)#,                                       <<U.RAO>>08625000
   RECORDFMT   = (8:2)#,                                       <<U.RAO>>08630000
   DEFAULTDES  = (10:3)#,                                      <<U.RAO>>08635000
   ASCIIBINARY = (13:1)#,                                      <<U.RAO>>08640000
   DOMAIN      = (14:2)#;                                      <<U.RAO>>08645000
                                                               <<U.RAO>>08650000
<<AOPTIONS DEFINES>>                                           <<U.RAO>>08655000
DEFINE                                                         <<U.RAO>>08660000
   COPY        = (3:1)#,                                       <<01549>>08665000
   NOWAIT      = (4:1)#,                                       <<U.RAO>>08670000
   MULTIACCESS = (5:2)#,                                       <<01549>>08675000
   NOBUF       = (7:1)#,                                       <<U.RAO>>08680000
   EXCLACCESS  = (8:2)#,                                       <<U.RAO>>08685000
   LOCKING     = (10:1)#,                                      <<U.RAO>>08690000
   MULTIRECORD = (11:1)#,                                      <<U.RAO>>08695000
   ACCESSTYPE  = (12:4)#;                                      <<U.RAO>>08700000
                                                               <<U.RAO>>08705000
<<PARAMETER BIT MASK DEFINES - SEE JDT DESCRIPTION>>           <<U.RAO>>08710000
DEFINE                                                         <<U.RAO>>08715000
   FLAGANAME       = FLAGS1.(15:1)#,                           <<U.RAO>>08720000
   FLAGDEV         = FLAGS1.(14:1)#,                           <<U.RAO>>08725000
   FLAGDOMAIN      = FLAGS1.(13:1)#,                           <<U.RAO>>08730000
   FLAGASCII       = FLAGS1.(12:1)#,                           <<U.RAO>>08735000
   FLAGDEFDESIG    = FLAGS1.(11:1)#,                           <<U.RAO>>08740000
   FLAGRECFMT      = FLAGS1.(10:1)#,                           <<U.RAO>>08745000
   FLAGCCTL        = FLAGS1.(9:1)#,                            <<U.RAO>>08750000
   FLAGCOPY        = FLAGS1.(8:1) #,                           <<01549>>08755000
   FLAGACCESSTYPE  = FLAGS1.(7:1)#,                            <<U.RAO>>08760000
   FLAGMULTIREC    = FLAGS1.(6:1)#,                            <<U.RAO>>08765000
   FLAGEXCLUSIVE   = FLAGS1.(5:1)#,                            <<U.RAO>>08770000
   FLAGBUFINHIBIT  = FLAGS1.(4:1)#,                            <<U.RAO>>08775000
   FLAGNUMBUFS     = FLAGS1.(3:1)#,                            <<U.RAO>>08780000
   FLAGDISP        = FLAGS1.(2:1)#,                            <<U.RAO>>08785000
   FLAGRECSIZE     = FLAGS1.(1:1)#,                            <<U.RAO>>08790000
   FLAGBLOCKFACTOR = FLAGS1.(0:1)#,                            <<U.RAO>>08795000
   FLAGINITALLOC   = FLAGS2.(15:1)#,                           <<U.RAO>>08800000
   FLAGNUMEXTS     = FLAGS2.(14:1)#,                           <<U.RAO>>08805000
   FLAGFILESIZE    = FLAGS2.(13:1)#,                           <<U.RAO>>08810000
   FLAGFILECODE    = FLAGS2.(12:1)#,                           <<U.RAO>>08815000
   FLAGOUTPRI      = FLAGS2.(11:1)#,                           <<U.RAO>>08820000
   FLAGNUMCOPIES   = FLAGS2.(10:1)#,                           <<U.RAO>>08825000
   FLAGMULTIACCESS = FLAGS2.(9:1)#,                            <<U.RAO>>08830000
   FLAGWAIT        = FLAGS2.(8:1)#,                            <<U.RAO>>08835000
   FLAGDYNLOCKING = FLAGS2.(7:1)#,                             <<U.RAO>>08840000
   FLAGVTERM       = FLAGS2.(5:1)#,  << virtual terminal >>             08845000
   FLAGLANG        = FLAGS2.(4:1)#,  << native language  >>             08850000
   FLAGUSERLABELS  = FLAGS2.(3:1)#,                                     08855000
   FLAGFORMS      = FLAGS2.(2:1)#,                             <<U.RAO>>08860000
   FLAGLABELEDTAPE= FLAGS2.(1:1)#,                             <<U.RAO>>08865000
   FLAGFTYPE      = FLAGS2.(0:1)#;                             <<01549>>08870000
<< JDT FILE ENTRY DEFINES - SEE JDT DESCRIPTION >>             <<02554>>08875000
DEFINE                                                         <<02554>>08880000
   FORMAL'DES'LEN        = FILE'ENTRY.(8:8)#,                  <<02554>>08885000
   FORMAL'DES'NAME       = BFILE'ENTRY(2)#,                    <<02554>>08890000
   ACTUAL'DES'LEN        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>08895000
                                       3).(0:8)#,              <<02554>>08900000
   DEVICE'DES'LEN        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>08905000
                                       3).(8:8)#,              <<02554>>08910000
   DEVICE'DES'NAME       = BFILE'ENTRY(FORMAL'DES'LEN * 2 +    <<02554>>08915000
                                      ACTUAL'DES'LEN +         <<02554>>08920000
                                       8)#,                    <<02554>>08925000
   DEVICE'PRESENT        = FILE'ENTRY(FORMAL'DES'LEN +         <<02554>>08930000
                                       1).(14:1)#;             <<02554>>08935000
                                                               <<U.RAO>>08940000
                                                               <<04848>>08945000
DEFINE      << Lockword found by CHK'DESCRIBE'FNAME. >>        <<04848>>08950000
   GOTLOCK     = ( ERRLOC.(0:1) = 1 ) #;                       <<04843>>08955000
                                                               <<04843>>08960000
                                                               <<01200>>08965000
<<                 *********************                   >>  <<01200>>08970000
<<                 *     PARSE'ERR     *                   >>  <<01200>>08975000
<<                 *********************                   >>  <<01200>>08980000
                                                               <<01200>>08985000
SUBROUTINE PARSE'ERR (ERROR, ERRADR);                          <<01200>>08990000
 VALUE ERROR;                                                  <<01200>>08995000
  INTEGER ERROR;                                               <<01200>>09000000
  BYTE ARRAY ERRADR;                                           <<01200>>09005000
<< SUBROUTINE TO HANDLE ERRORS ENCOUNTERED DURING FILE      >> <<01200>>09010000
<< EQUATION PARSING.  IF A SPECIAL PARSE IS IN PROGRESS     >> <<01200>>09015000
<< (I.E. PARSE'ONLY = TRUE) THEN SIMPLY SET THE ERROR       >> <<01200>>09020000
<< RETURN.  IF A CI COMMAND IS BEING EXECUTED (I.E. :FILE   >> <<01200>>09025000
<< :BUILD) THEN CALL CIERR.                                 >> <<01200>>09030000
BEGIN                                                          <<01200>>09035000
ERRNUM := ERROR;                                               <<04843>>09040000
IF NOT PARSE'ONLY THEN                                         <<01200>>09045000
  CIERR (ERROR, ERRADR);                                       <<01200>>09050000
END << PARSE'ERR >>;                                           <<01200>>09055000
                                                               <<U.RAO>>09060000
<<                 *********************                   >>  <<U.RAO>>09065000
<<                 *      GETNEXT      *                   >>  <<U.RAO>>09070000
<<                 *********************                   >>  <<U.RAO>>09075000
                                                               <<U.RAO>>09080000
SUBROUTINE GETNEXT;                                            <<U.RAO>>09085000
<<THIS SUBROUTINE EXTRACTS THE NEXT PARAMETER FROM PARMS>>     <<U.RAO>>09090000
<<AND DECOMPOSES THE MYCOMMAND RETURNED ENTRY.  IT ALSO CHECKS><<U.RAO>>09095000
<<FOR THE TOO MANY PARAMETERS CASE.  >>                        <<U.RAO>>09100000
BEGIN                                                          <<U.RAO>>09105000
TOS := PARMS(PARMNUM);  <<GET NEXT ENTRY>>                     <<U.RAO>>09110000
NEXTDELIM := S0.DELIMTYPE;  <<GET TRAILING DELIMITER>>         <<U.RAO>>09115000
PARMLEN := TOS&LSR(8);  <<LENGTH OF ENTRY>>                    <<U.RAO>>09120000
@PARMPTR := TOS;  <<FIRST WORD OF MYCOMMAND ENTRY>>            <<U.RAO>>09125000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>09130000
IF PARMNUM > MAXPARMS THEN  <<TOO MANY PARAMETERS>>            <<U.RAO>>09135000
   BEGIN                                                       <<U.RAO>>09140000
   IF BUILDFLAG THEN                                           <<U.RAO>>09145000
      PARSE'ERR(ERRNUM := BLD2MP,PARMPTR)                      <<01200>>09150000
   ELSE                                                        <<U.RAO>>09155000
      PARSE'ERR(ERRNUM := FILE2MP,PARMPTR);                    <<01200>>09160000
   ASSEMBLE(EXIT 3);  <<BAIL OUT OF CXFILE>>                   <<U.RAO>>09165000
   END;                                                        <<U.RAO>>09170000
END;  <<SUBROUTINE GETNEXT>>                                   <<U.RAO>>09175000
                                                               <<U.RAO>>09180000
<<                 *********************                   >>  <<U.RAO>>09185000
<<                 *    CHECKFDESIG    *                   >>  <<U.RAO>>09190000
<<                 *********************                   >>  <<U.RAO>>09195000
                                                               <<U.RAO>>09200000
LOGICAL SUBROUTINE CHECKFDESIG;                                <<U.RAO>>09205000
BEGIN                                                          <<U.RAO>>09210000
<<NOTE:  A FORMAL FILE DESIGNATOR MUST HAVE THE SAME FORMAT>>  <<U.RAO>>09215000
<<AS AN ACTUAL FILE DESIGNATOR, BUT IT MAY NOT BE A SYSTEM>>   <<U.RAO>>09220000
<<DEFINED FILE OR A BACK REFERENCED FILE.>>                    <<U.RAO>>09225000
CHECKFDESIG := FALSE;                                          <<U.RAO>>09230000
GETNEXT;  <<EXPLODE PARMS ENTRY FOR FILE NAME>>                <<U.RAO>>09235000
ERRLOC := CHK'DESCRIBE'FNAME(PARMS&LSR(8),GPNTR,APNTR,ERRPNTR);<<04843>>09240000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>09245000
   PARSE'ERR( ERRLOC, ERRADR )                                 <<04843>>09250000
ELSE IF > THEN  <<NOT STANDARD FILE NAME>>                     <<U.RAO>>09255000
   IF ERRLOC.(8:8) = 0 THEN  << Back-ref'd file. >>            <<04843>>09260000
      PARSE'ERR(ERRNUM := FILEFDSGNOBACK, FORMALDES)           <<01200>>09265000
   ELSE                                                        <<U.RAO>>09270000
      PARSE'ERR(ERRNUM := FILEFDSGNOSYS, FORMALDES)            <<01200>>09275000
ELSE  <<OK - REGULAR FORMAL DESIGNATOR>>                       <<U.RAO>>09280000
   BEGIN                                                       <<U.RAO>>09285000
   IF GOTLOCK THEN                                             <<04848>>09290000
   BEGIN                                                       <<04848>>09295000
      PARSE'ERR( ERRNUM := FDESGNOLOCK, FORMALDES );           <<04848>>09300000
      RETURN;                                                  <<04848>>09305000
   END;                                                        <<04848>>09310000
   CHECKFDESIG := TRUE;                                        <<U.RAO>>09315000
   IF GPNTR = 0 THEN GPNTR := @BLANK;                          <<U.RAO>>09320000
   IF APNTR = 0 THEN APNTR := @BLANK;                          <<U.RAO>>09325000
   END                                                         <<U.RAO>>09330000
END;                                                           <<U.RAO>>09335000
                                                               <<U.RAO>>09340000
<<                 *********************                   >>  <<U.RAO>>09345000
<<                 *  BLDCHECKFDESIG   *                   >>  <<U.RAO>>09350000
<<                 *********************                   >>  <<U.RAO>>09355000
                                                               <<U.RAO>>09360000
LOGICAL SUBROUTINE BLDCHECKFDESIG;                             <<U.RAO>>09365000
BEGIN                                                          <<U.RAO>>09370000
<<NOTE:  A FORMAL FILE DESIGNATOR MUST HAVE THE SAME FORMAT>>  <<U.RAO>>09375000
<<AS AN ACTUAL FILE DESIGNATOR, BUT IT MAY NOT BE A SYSTEM>>   <<U.RAO>>09380000
<<DEFINED FILE>>                                               <<U.RAO>>09385000
BLDCHECKFDESIG := FALSE;                                       <<U.RAO>>09390000
GETNEXT;  <<EXPLODE PARMS ENTRY FOR FILE NAME>>                <<U.RAO>>09395000
ERRNUM := CHECKFILENAME'(PARMS&LSR(8),GPNTR,APNTR,ERRPNTR);    <<U.RAO>>09400000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>09405000
   PARSE'ERR(ERRNUM,ERRADR)                                    <<01200>>09410000
ELSE IF > AND ERRNUM<>0 AND ERRNUM<>2 THEN  <<NOT STD FILE NAME<<U.RAO>>09415000
   PARSE'ERR(ERRNUM := BLDNOSYSFILES, FORMALDES)               <<01200>>09420000
ELSE IF ERRNUM=2 THEN   <<IS $NEWPASS, ALLOW>>                 <<U.RAO>>09425000
   BEGIN                                                       <<00449>>09430000
   BLDCHECKFDESIG := TRUE;                                     <<00449>>09435000
   ERRNUM := 0;                                                <<00449>>09440000
   END                                                         <<00449>>09445000
ELSE  <<OK - REGULAR FORMAL DESIGNATOR>>                       <<U.RAO>>09450000
   BEGIN                                                       <<U.RAO>>09455000
   BLDCHECKFDESIG := TRUE;                                     <<U.RAO>>09460000
   IF GPNTR = 0 THEN GPNTR := @BLANK;                          <<U.RAO>>09465000
   IF APNTR = 0 THEN APNTR := @BLANK;                          <<U.RAO>>09470000
   END                                                         <<U.RAO>>09475000
END;                                                           <<U.RAO>>09480000
                                                               <<U.RAO>>09485000
<<                 *********************                   >>  <<U.RAO>>09490000
<<                 *   CHECKADESIG     *                   >>  <<U.RAO>>09495000
<<                 *********************                   >>  <<U.RAO>>09500000
                                                               <<U.RAO>>09505000
LOGICAL SUBROUTINE CHECKADESIG;                                <<U.RAO>>09510000
<<CHECK FORM OF ACTUAL DESIGNATOR.  MAY BE ANY SORT OF FILE NAM<<U.RAO>>09515000
<<IF IT IS A BACK REFERENCED FILE, WE GO AHEAD AND DO THE FILE <<U.RAO>>09520000
<<EQUATE NOW, SINCE IT SHOULD NOT HAVE ANY PARAMETERS.>>       <<U.RAO>>09525000
BEGIN                                                          <<U.RAO>>09530000
GETNEXT;                                                       <<U.RAO>>09535000
CHECKADESIG := TRUE;                                           <<U.RAO>>09540000
ERRLOC := CHK'DESCRIBE'FNAME( PARMS(1)&LSR(8), GPNTR2,         <<04843>>09545000
                              APNTR2, ERRPNTR           );     <<04848>>09550000
IF < THEN  <<ERROR IN NAME>>                                   <<U.RAO>>09555000
   BEGIN                                                       <<U.RAO>>09560000
   PARSE'ERR( ERRLOC, ERRADR );                                <<04843>>09565000
   CHECKADESIG := FALSE                                        <<U.RAO>>09570000
   END                                                         <<U.RAO>>09575000
ELSE IF = THEN  <<ORDINARY ACTUAL FILE DESIGNATOR>>            <<U.RAO>>09580000
   BEGIN                                                       <<U.RAO>>09585000
   FLAGANAME := TRUE                                           <<U.RAO>>09590000
   END                                                         <<U.RAO>>09595000
ELSE IF > AND (ERRLOC.(8:8) <> 0) THEN                         <<04843>>09600000
   BEGIN  <<SYSTEM DEFINED FILE NAME>>                         <<U.RAO>>09605000
   FOPTIONS.DEFAULTDES := ERRLOC.(8:8);                        <<04843>>09610000
   IF (FOPTIONS.DEFAULTDES=6) AND (NUMPARMS>PARMNUM) THEN  <<PARMS>>    09615000
      BEGIN  <<WITH $NULL, WHICH IS ILLEGAL>>                  <<U.RAO>>09620000
      CHECKADESIG := FALSE;                                    <<U.RAO>>09625000
      GETNEXT;                                                 <<U.RAO>>09630000
      PARSE'ERR(ERRNUM := FILEADESNULL2MP, PARMPTR);           <<01200>>09635000
      END;                                                     <<U.RAO>>09640000
   FLAGDEFDESIG := TRUE;                                       <<U.RAO>>09645000
   END                                                         <<U.RAO>>09650000
ELSE   <<MUST BE BACK REFERENCED FILE>>                        <<U.RAO>>09655000
   BEGIN                                                       <<U.RAO>>09660000
   <<THIS IS THE END OF THE LINE FOR A BACK REFERENCE.  EITHER><<U.RAO>>09665000
   <<WE WILL DETECT AN ERROR AND REPORT IT OR WE WILL INSERT THE>>      09670000
   <<ENTRY INTO THE JOB DIRECTORY TABLE (JDT).>>               <<U.RAO>>09675000
   IF GOTLOCK THEN                                             <<04848>>09680000
   BEGIN                                                       <<04848>>09685000
      PARSE'ERR( ERRNUM := FDESGNOLOCK, ACTUALDES );           <<04848>>09690000
      CHECKADESIG := FALSE;                                    <<04848>>09695000
      RETURN;                                                  <<04848>>09700000
   END;                                                        <<04848>>09705000
   CHECKADESIG := FALSE;                                       <<U.RAO>>09710000
   IF NUMPARMS > 2 THEN  <<TOO MANY PARAMETERS>>               <<U.RAO>>09715000
      BEGIN                                                    <<U.RAO>>09720000
      GETNEXT;  <<TO FORCE PARMPTR TO THE OFFENDING ITEM>>     <<U.RAO>>09725000
      PARSE'ERR(ERRNUM := FILEADESIGBR2MP, PARMPTR)            <<01200>>09730000
      END                                                      <<U.RAO>>09735000
   ELSE                                                        <<U.RAO>>09740000
      BEGIN                                                    <<U.RAO>>09745000
      <<CREATE ENTRY, ATTEMPT TO INSERT IT>>                   <<U.RAO>>09750000
      IF GPNTR2 = 0 THEN GPNTR2 := @BLANK;                     <<U.RAO>>09755000
      IF APNTR2 = 0 THEN APNTR2 := @BLANK;                     <<U.RAO>>09760000
      @ACTUALDES := @ACTUALDES+1;  <<MOVE PAST "*">>           <<U.RAO>>09765000
      ACTUALDESLEN := ACTUALDESLEN-1;                          <<U.RAO>>09770000
      PARMNUM := 0;  <<CLEAN UP RETURN PARAMETER>>             <<U.RAO>>09775000
      <<NOW FORMAT WENTRY>>                                    <<U.RAO>>09780000
      WENTRY := 1;   <<SET PMASK - NAME ONLY PARM PRESENT>>    <<U.RAO>>09785000
      WENTRY(1) := %1000;  <<SET PMASK WORD 2 - POINTER WENTRY><<U.RAO>>09790000
      BENTRY(4) := ACTUALDESLEN;                               <<U.RAO>>09795000
      BENTRY(5):=0;  <<CLEAR DEVLEN>>                          <<00080>>09800000
      MOVE BENTRY(6) := ACTUALDES,(ACTUALDESLEN);              <<U.RAO>>09805000
      NEXTENTRYX := (ACTUALDESLEN+29)&LSR(1); <<LENGTH IN WORDS<<U.RAO>>09810000
      IF PARSE'ONLY THEN                                       <<01200>>09815000
         BEGIN                                                 <<01200>>09820000
         << COPY LOCAL TABLE ENTRY OVER STRING PASSED TO   >>  <<01200>>09825000
         << PARSE'FILE'EQ.  THIS RETURNS THE PARSED FILE   >>  <<01200>>09830000
         << EQUATION INFO TO THE CALLER.                   >>  <<01200>>09835000
         MOVE PARMSP := BENTRY, (ACTUALDESLEN+8);              <<01200>>09840000
         END                                                   <<01200>>09845000
      ELSE                                                     <<01200>>09850000
      CASE XADDJTENTRY(FORMALDES,GROUP,ACCT,-3,NEXTENTRYX,WENTRY,       09855000
               ACTUALDES,GROUP2,ACCT2) OF                      <<U.RAO>>09860000
         BEGIN                                                 <<U.RAO>>09865000
            ;  <<0 - NO PROBLEM>>                              <<U.RAO>>09870000
            CIERR(ERRNUM := FEQTABFULLXPLCT);                  <<U.RAO>>09875000
            ;  <<DUPLICATE NAME CAN'T HAPPEN>>                 <<U.RAO>>09880000
            BEGIN  <<ACTUAL DESIGNATOR NOT FOUND>>             <<U.RAO>>09885000
               QUALIFYFILENAME(ACTUALDES,BENTRY);              <<U.RAO>>09890000
               CIERR(ERRNUM := FILEBREFMISADES,,0,@BENTRY);    <<U.RAO>>09895000
            END;                                               <<U.RAO>>09900000
            BEGIN  <<TOO MANY BACK REFERENCES>>                <<U.RAO>>09905000
               QUALIFYFILENAME(ACTUALDES,BENTRY);              <<U.RAO>>09910000
               CIERR(ERRNUM := TOOMANYFEQBREF,,0,@BENTRY);     <<U.RAO>>09915000
            END;                                               <<U.RAO>>09920000
            BEGIN  << CIRCULAR CLINE EQUATIONS >>              <<00834>>09925000
               CIERR(ERRNUM := CIRCULARFEQ);                   <<00834>>09930000
            END;                                               <<00834>>09935000
         END; <<OF CASE>>                                      <<U.RAO>>09940000
      END;                                                     <<U.RAO>>09945000
   END;  << BACK REFERENCE CASE>>                              <<U.RAO>>09950000
END;  <<CHECKADESIG>>                                          <<U.RAO>>09955000
                                                               <<U.RAO>>09960000
                                                               <<01549>>09965000
<<                 *********************                   >>  <<01549>>09970000
<<                 * CHECKENVFILEDESIG *                   >>  <<02523>>09975000
<<                 *********************                   >>  <<01549>>09980000
                                                               <<01549>>09985000
LOGICAL SUBROUTINE CHECKENVFILEDESIG;                          <<02523>>09990000
<< CHECK FORM OF THE ACTUAL FILE DESIGNATOR PARAMETER      >>  <<02523>>09995000
<< FOR THE "ENV=" KEYWORD.  NO SYSTEM FILES ALLOWED,       >>  <<02523>>10000000
<< EXCEPT $OLDPASS.                                        >>  <<02523>>10005000
<<                                                         >>  <<02523>>10010000
BEGIN                                                          <<01549>>10015000
CHECKENVFILEDESIG := FALSE;                                    <<02554>>10020000
TOS := CHECKFILENAME'(PARMS(PARMNUM-1)&LSR(8),GPNTRENV,        <<01549>>10025000
           APNTRENV,ERRPNTR);                                  <<01549>>10030000
IF < THEN  <<ERROR IN NAME>>                                   <<01549>>10035000
   BEGIN                                                       <<01549>>10040000
   ERRNUM := TOS;                                              <<01549>>10045000
   PARSE'ERR(ERRNUM, ERRADR);                                  <<01549>>10050000
   RETURN;                                                     <<02554>>10055000
   END                                                         <<01549>>10060000
ELSE IF = THEN  <<ORDINARY ACTUAL FILE DESIGNATOR>>            <<01549>>10065000
   BEGIN                                                       <<01549>>10070000
   DEL;                                                        <<01549>>10075000
   END                                                         <<01549>>10080000
ELSE IF > AND (S0<>0) THEN                                     <<01549>>10085000
   BEGIN  <<CHECK FOR $OLDPASS>>                               <<01549>>10090000
   IF S0 <> 3 <<NOT $OLDPASS>> THEN                            <<01549>>10095000
   BEGIN  <<SYSTEM DEFINED FILE NAME>>                         <<01549>>10100000
      DEL;                                                     <<01851>>10105000
      PARSE'ERR(ERRNUM := FILEADESSYS, PARMPTR);               <<01549>>10110000
      RETURN;                                                  <<02554>>10115000
   END                                                         <<01851>>10120000
   ELSE DEL;                                                   <<01851>>10125000
   END                                                         <<01549>>10130000
ELSE   <<MUST BE BACK REFERENCED FILE>>                        <<01549>>10135000
   BEGIN                                                       <<01549>>10140000
   DEL;  <<POP ZERO FROM CHECKFILENAME'>>                      <<01549>>10145000
      <<IT IS A VALID FILENAME>>                               <<01549>>10150000
   IF GPNTRENV = 0 THEN GPNTRENV := @BLANK;                    <<02554>>10155000
   IF APNTRENV = 0 THEN APNTRENV := @BLANK;                    <<02554>>10160000
   IF PARMPTR(1) = FORMALDES,(PARMLEN - 1) THEN                <<02554>>10165000
      PARSE'ERR(ERRNUM := CIRCULARFEQ,PARMPTR);                <<02554>>10170000
                                                               <<02554>>10175000
   IF ERRNUM > 0 THEN RETURN;                                  <<06021>>10180000
   CASE XRETJTENTRY(PARMPTR(1),GROUPENV,ACCTENV                <<02554>>10185000
                    ,SIZE,FILE'ENTRY) OF                       <<02554>>10190000
      BEGIN                                                    <<02554>>10195000
         BEGIN                                                 <<02554>>10200000
            IF LOGICAL(DEVICE'PRESENT) THEN                    <<02554>>10205000
               BEGIN                                           <<02554>>10210000
                  INDEX := -1;                                 <<02554>>10215000
                  @BPTR := @DEVICE'DES'NAME;                   <<02554>>10220000
                  WHILE (INDEX := INDEX + 1) <=                <<02554>>10225000
                        (DEVICE'DES'LEN - 5) DO                <<02554>>10230000
                     IF BPTR(INDEX) = ";ENV=" THEN             <<02554>>10235000
                     PARSE'ERR(ERRNUM:=FILECONTENV,PARMPTR);   <<02554>>10240000
               END;                                            <<02554>>10245000
            IF ERRNUM > 0 THEN RETURN;                         <<06021>>10250000
            CRUNCH(FORMALDES,GROUP,ACCT,DEST,SIZE);            <<02554>>10255000
            @BPTR := @DEST&LSL(1);                             <<02554>>10260000
            IF BPTR = FORMAL'DES'NAME,                         <<02554>>10265000
                      (FORMAL'DES'LEN * 2) THEN                <<02554>>10270000
               PARSE'ERR(ERRNUM := CIRCULARFEQ,PARMPTR);       <<02554>>10275000
         END;                                                  <<02554>>10280000
         BEGIN                                                 <<02554>>10285000
            QUALIFYFILENAME(PARMPTR(1),BFILE'ENTRY);           <<02554>>10290000
            IF PARSE'ONLY THEN                                 <<02554>>10295000
               ERRNUM := FILEBREFMISADES                       <<02554>>10300000
            ELSE                                               <<02554>>10305000
               CIERR(ERRNUM := FILEBREFMISADES,,0,             <<02554>>10310000
                     @BFILE'ENTRY);                            <<02554>>10315000
         END;                                                  <<02554>>10320000
         BEGIN                                                 <<02554>>10325000
            QUALIFYFILENAME(PARMPTR(1),BFILE'ENTRY);           <<02554>>10330000
            IF PARSE'ONLY THEN                                 <<02554>>10335000
               ERRNUM := FILEBREFMISADES                       <<02554>>10340000
            ELSE                                               <<02554>>10345000
               CIERR(ERRNUM := FILEBREFMISADES,,0,             <<02554>>10350000
                     @BFILE'ENTRY);                            <<02554>>10355000
         END;                                                  <<02554>>10360000
      END;         << CASE >>                                  <<02554>>10365000
   END;  << BACK REFERENCE CASE>>                              <<01549>>10370000
   IF ERRNUM <= 0 THEN CHECKENVFILEDESIG := TRUE;              <<06021>>10375000
END;     <<CHECKENVFILEDESIG>>                                 <<02523>>10380000
                                                               <<01549>>10385000
<<                 *********************                   >>  <<U.RAO>>10390000
<<                 *    CHECKDOMAIN    *                   >>  <<U.RAO>>10395000
<<                 *********************                   >>  <<U.RAO>>10400000
                                                               <<U.RAO>>10405000
LOGICAL SUBROUTINE CHECKDOMAIN;                                <<U.RAO>>10410000
BEGIN                                                          <<U.RAO>>10415000
<<THIS ROUTINE PARSES THE DOMAIN PARAMETER IN A FILE EQUATE.>> <<U.RAO>>10420000
<<IT ALSO VERIFIES THAT THE DOMAIN AND THE DEFAULT DESIGNATOR>><<U.RAO>>10425000
<<ARE COMPATIBLE.>>                                            <<U.RAO>>10430000
CHECKDOMAIN := TRUE;                                           <<U.RAO>>10435000
GETNEXT;                                                       <<U.RAO>>10440000
IF FOPTIONS.DEFAULTDES <> 0 THEN  <<DOMAIN SPECIFIED FOR >>    <<U.RAO>>10445000
   PARSE'ERR(-FILEDOMAINSYSDF,PARMPTR)   << SYS DEF FILE >>    <<01200>>10450000
ELSE  <<IS REGULAR FILE REFERENCE>>                            <<U.RAO>>10455000
   BEGIN                                                       <<U.RAO>>10460000
   FLAGDOMAIN := TRUE;   <<DOMAIN SPECIFIED>>                  <<U.RAO>>10465000
   IF (PARMLEN=3) AND (PARMPTR="OLD") THEN                     <<U.RAO>>10470000
      FOPTIONS.DOMAIN := 1                                     <<U.RAO>>10475000
   ELSE IF (PARMLEN=7) AND (PARMPTR="OLDTEMP") THEN            <<U.RAO>>10480000
      FOPTIONS.DOMAIN := 2                                     <<U.RAO>>10485000
   ELSE IF (PARMLEN<>3) OR (PARMPTR<>"NEW") THEN               <<U.RAO>>10490000
      BEGIN  <<UNIDENTIFIED DOMAIN>>                           <<U.RAO>>10495000
      CHECKDOMAIN := FALSE;                                    <<U.RAO>>10500000
      IF PARMLEN = 0 THEN   <<MISSING>>                        <<U.RAO>>10505000
         PARSE'ERR(ERRNUM := FILEXPCTDOMAIN, PARMPTR)          <<01200>>10510000
      ELSE                                                     <<U.RAO>>10515000
         PARSE'ERR(ERRNUM := FILEINVLDDOMAIN, PARMPTR);        <<01200>>10520000
      END                                                      <<U.RAO>>10525000
   END;                                                        <<U.RAO>>10530000
END;  <<SUBROUTINE CHECKDOMAIN>>                               <<U.RAO>>10535000
                                                               <<U.RAO>>10540000
<<                 *********************                   >>  <<U.RAO>>10545000
<<                 *  CHECKLABELDATA   *                   >>  <<U.RAO>>10550000
<<                 *********************                   >>  <<U.RAO>>10555000
                                                               <<U.RAO>>10560000
LOGICAL SUBROUTINE CHECKLABELDATA;                             <<U.RAO>>10565000
<<CHECKS SYNTAX OF TAPE LABEL DATA.  FORM REQUIRED IS>>        <<U.RAO>>10570000
<<LABEL[=[VOLID][,[TYPE][,[EXPIRATION DATE][,[SEQUENCE NO.]]]]]<<U.RAO>>10575000
BEGIN                                                          <<U.RAO>>10580000
CHECKLABELDATA := TRUE;                                        <<U.RAO>>10585000
FOPTIONS.TAPELABELF := TRUE;  <<FLAG REQUIRES TAPE LABEL>>     <<U.RAO>>10590000
FLAGLABELEDTAPE := TRUE;  <<INTERNAL FLAG FOR PMASK>>          <<U.RAO>>10595000
IF <> THEN   <<REDUNDANTLY SPECIFIED PARAMETER>>               <<U.RAO>>10600000
   BEGIN                                                       <<U.RAO>>10605000
   PARSE'ERR(-FILEREDUNDLABEL, PARMPTR);                       <<01200>>10610000
   TAPELABELLEN := 0;                                          <<U.RAO>>10615000
   END;                                                        <<U.RAO>>10620000
IF NEXTDELIM=EQUALS THEN   <<NON-DEFAULT SPECIFIED>>           <<U.RAO>>10625000
   BEGIN                                                       <<U.RAO>>10630000
   CHECKLABELDATA := FALSE;                                    <<U.RAO>>10635000
   GETNEXT;                                                    <<U.RAO>>10640000
   INDEX := LOGICAL(@PARMPTR) - LOGICAL(@PARMSP);              <<02663>>10645000
   @BPTR := @SAVEDCOMIMAGE(INDEX);                             <<02663>>10650000
   IF PARMLEN <> 0 THEN  <<VOLID PRESENT>>                     <<U.RAO>>10655000
      IF PARMPTR = """" THEN << SPECIAL CHARS IN VOLID >>      <<02663>>10660000
         BEGIN                                                 <<02663>>10665000
         STOP := FALSE;                                        <<02663>>10670000
         @BPTR := LOGICAL(@BPTR) + 1;                          <<02663>>10675000
         WHILE NOT STOP DO                                     <<02663>>10680000
            BEGIN                                              <<02663>>10685000
            SCAN BPTR UNTIL %6442,1; << QUOTE'CR >>            <<02663>>10690000
            IF CARRY THEN                                      <<02663>>10695000
               BEGIN                                           <<02663>>10700000
               DEL;                                            <<02663>>10705000
               PARSE'ERR(ERRNUM := FILEMISSQUOTE,PARMPTR);     <<02663>>10710000
               STOP := TRUE;                                   <<02663>>10715000
               END                                             <<02663>>10720000
            ELSE                                               <<02663>>10725000
               BEGIN                                           <<02663>>10730000
               INDEX := LS0 - LOGICAL(@BPTR);                  <<02663>>10735000
               @BPTR := LOGICAL(TOS);                          <<02663>>10740000
               IF BPTR(1) = """" THEN                          <<02663>>10745000
                  BEGIN                                        <<02663>>10750000
                  INDEX := INDEX + 1;                          <<02663>>10755000
                  @BPTR := LOGICAL(@BPTR) + 1;                 <<02663>>10760000
                  END                                          <<02663>>10765000
               ELSE                                            <<02663>>10770000
                  STOP := TRUE;                                <<02663>>10775000
               IF (INDEX + TAPELABELLEN) > 6 THEN              <<02663>>10780000
                  BEGIN                                        <<02663>>10785000
                  PARSE'ERR(ERRNUM:=FILEVOLID2LONG,PARMPTR);   <<02663>>10790000
                  STOP := TRUE;                                <<02663>>10795000
                  END                                          <<02663>>10800000
               ELSE                                            <<02663>>10805000
                  BEGIN                                        <<02663>>10810000
                  MOVE TAPELABEL(TAPELABELLEN) :=              <<02663>>10815000
                       BPTR(-INDEX),(INDEX);                   <<02663>>10820000
                  TAPELABELLEN := TAPELABELLEN + INDEX;        <<02663>>10825000
                  @BPTR := LOGICAL(@BPTR) + 1;                 <<02663>>10830000
                  END;                                         <<02663>>10835000
               END;                                            <<02663>>10840000
            END; << WHILE LOOP >>                              <<02663>>10845000
         INDEX := -1;                                          <<02663>>10850000
         WHILE (INDEX := INDEX + 1) < TAPELABELLEN AND         <<02663>>10855000
               ERRNUM = 0 DO                                   <<02663>>10860000
            BEGIN                                              <<02663>>10865000
            IF NOT (%40 <= INTEGER(TAPELABEL(INDEX))           <<02663>>10870000
                        <= %176) THEN                          <<02663>>10875000
               PARSE'ERR(ERRNUM := FILENONPRINTCHAR,PARMPTR);  <<02663>>10880000
            IF TAPELABEL(INDEX) = "=" THEN GETNEXT;            <<02663>>10885000
            IF TAPELABEL(INDEX) = ";" OR                       <<02663>>10890000
               TAPELABEL(INDEX) = "," THEN                     <<02663>>10895000
               PARSE'ERR(ERRNUM := FILECOMMASEMINOK,PARMPTR);  <<02663>>10900000
            END;                                               <<02663>>10905000
         END                                                   <<02663>>10910000
      ELSE                                                     <<02663>>10915000
      IF PARMLEN > 6 THEN   <<INVALID VOLID>>                  <<U.RAO>>10920000
         PARSE'ERR(ERRNUM := FILEVOLID2LONG, PARMPTR)          <<01200>>10925000
      ELSE                                                     <<U.RAO>>10930000
         BEGIN                                                 <<U.RAO>>10935000
         TOS := PARMS(PARMNUM-1);                              <<U.RAO>>10940000
         DELB;   <<POP POINTER GARBAGE>>                       <<U.RAO>>10945000
         IF TOS.(10:1) THEN  <<EMBEDDED SPECIAL CHARACTER>>    <<U.RAO>>10950000
            PARSE'ERR(ERRNUM := FILEVOLIDSPECAL, PARMPTR)      <<01200>>10955000
         ELSE   <<VOLID OK>>                                   <<U.RAO>>10960000
            BEGIN                                              <<U.RAO>>10965000
            TAPELABELLEN := PARMLEN;                           <<U.RAO>>10970000
            MOVE TAPELABEL := BPTR,(PARMLEN);                  <<02663>>10975000
            END;                                               <<U.RAO>>10980000
         END;                                                  <<U.RAO>>10985000
   IF (NEXTDELIM=COMMA) AND (ERRNUM<=0) THEN                   <<06021>>10990000
      BEGIN   <<TYPE SPECIFIED?>>                              <<U.RAO>>10995000
      TAPELABEL(TAPELABELLEN) := ",";                          <<U.RAO>>11000000
      TAPELABELLEN := TAPELABELLEN+1;                          <<U.RAO>>11005000
      GETNEXT;   <<SET UP FOR TYPE FIELD>>                     <<U.RAO>>11010000
      IF PARMLEN <> 0 THEN   <<TYPE PRESENT>>                  <<U.RAO>>11015000
         IF PARMLEN<>3 OR PARMPTR<>"ANS" AND PARMPTR<>"IBM" THEN        11020000
            PARSE'ERR(ERRNUM := FILEINVVOLTYPE, PARMPTR)       <<01200>>11025000
         ELSE  <<VALID VOLUME TYPE, SAVE IT>>                  <<U.RAO>>11030000
            BEGIN                                              <<U.RAO>>11035000
            MOVE TAPELABEL(TAPELABELLEN) := PARMPTR,(PARMLEN); <<U.RAO>>11040000
            TAPELABELLEN := TAPELABELLEN+PARMLEN;              <<U.RAO>>11045000
            END;   <<OF PROCESSING OF TYPE>>                   <<U.RAO>>11050000
      IF (NEXTDELIM=COMMA) AND (ERRNUM<=0) THEN                <<06021>>11055000
         BEGIN   <<CHECK FOR EXPIRATION DATE>>                 <<U.RAO>>11060000
         TAPELABEL(TAPELABELLEN) := ",";                       <<U.RAO>>11065000
         TAPELABELLEN := TAPELABELLEN+1;                       <<U.RAO>>11070000
         GETNEXT;  <<SET UP FOR EXPIRATION DATE FIELD>>        <<U.RAO>>11075000
         IF PARMLEN <> 0 THEN  <<EXPIRATION DATE FIELD PRESENT><<U.RAO>>11080000
            IF CHECKEXPDATE(ERRNUM, PARMLEN, PARMPTR,          <<U.RAO>>11085000
                      TAPELABEL(TAPELABELLEN)) THEN            <<U.RAO>>11090000
               TAPELABELLEN := TAPELABELLEN+8;  <<VALID EXP DAT<<U.RAO>>11095000
         IF (NEXTDELIM=COMMA) AND (ERRNUM<=0) THEN             <<06021>>11100000
            BEGIN  <<SEQUENCE NUMBER FIELD SPECIFIED?>>        <<U.RAO>>11105000
            TAPELABEL(TAPELABELLEN) := ",";                    <<U.RAO>>11110000
            TAPELABELLEN := TAPELABELLEN+1;                    <<U.RAO>>11115000
            GETNEXT;                                           <<U.RAO>>11120000
            IF PARMLEN <> 0 THEN  <<SEQ NUM PRESENT>>          <<U.RAO>>11125000
               BEGIN                                           <<U.RAO>>11130000
               TOS := PARMS(PARMNUM-1);                        <<U.RAO>>11135000
               DELB;                                           <<U.RAO>>11140000
               IF LS0.(10:1) OR PARMLEN>4 THEN                 <<U.RAO>>11145000
                  BEGIN                                        <<U.RAO>>11150000
                  PARSE'ERR(ERRNUM := FILEXPINVSEQ, PARMPTR);  <<01200>>11155000
                  DEL;                                         <<U.RAO>>11160000
                  END                                          <<U.RAO>>11165000
               ELSE IF TOS.(8:1) AND PARMPTR<>"NEXT" AND       <<U.RAO>>11170000
                     PARMPTR<>"ADDF" THEN  <<ASCII IN SEQ FIELD<<U.RAO>>11175000
                  PARSE'ERR(ERRNUM := FILEXPINVSEQ, PARMPTR)   <<01200>>11180000
               ELSE   <<SEQUENCE OK>>                          <<U.RAO>>11185000
                  BEGIN                                        <<U.RAO>>11190000
                  MOVE TAPELABEL(TAPELABELLEN) := PARMPTR,(PARMLEN);    11195000
                  TAPELABELLEN := TAPELABELLEN+PARMLEN;        <<U.RAO>>11200000
                  END;                                         <<U.RAO>>11205000
               END;                                            <<U.RAO>>11210000
            END;                                               <<U.RAO>>11215000
         END;                                                  <<U.RAO>>11220000
      END;                                                     <<U.RAO>>11225000
   IF ERRNUM <= 0 THEN                                         <<06021>>11230000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>11235000
         BEGIN                                                 <<U.RAO>>11240000
         CHECKLABELDATA := TRUE;                               <<U.RAO>>11245000
         WHILE TAPELABEL(TAPELABELLEN-1) = "," DO              <<U.RAO>>11250000
            TAPELABELLEN := TAPELABELLEN-1;                    <<U.RAO>>11255000
         END                                                   <<U.RAO>>11260000
      ELSE   <<EXTRANEOUS PARAMETER>>                          <<U.RAO>>11265000
         BEGIN                                                 <<U.RAO>>11270000
         GETNEXT;                                              <<U.RAO>>11275000
         PARSE'ERR(ERRNUM := FILEXTRNLABEL, PARMPTR);          <<01200>>11280000
         END;                                                  <<U.RAO>>11285000
   END;                                                        <<U.RAO>>11290000
END;   <<SUBROUTINE CHECKLABELDATA>>                           <<U.RAO>>11295000
                                                               <<U.RAO>>11300000
<<                 *********************                   >>  <<U.RAO>>11305000
<<                 *     PROCDISC      *                   >>  <<U.RAO>>11310000
<<                 *********************                   >>  <<U.RAO>>11315000
                                                               <<U.RAO>>11320000
LOGICAL SUBROUTINE PROCDISC;                                   <<U.RAO>>11325000
BEGIN                                                          <<U.RAO>>11330000
PROCDISC := FALSE;                                             <<U.RAO>>11335000
IF NEXTDELIM <> EQUALS THEN  <<MISSING DELIMITER BEFORE LIST>> <<U.RAO>>11340000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>11345000
ELSE  <<DO SUB PARAMETER LIST>>                                <<U.RAO>>11350000
   BEGIN                                                       <<U.RAO>>11355000
   IF FLAGFILESIZE OR FLAGNUMEXTS OR FLAGINITALLOC THEN        <<U.RAO>>11360000
      BEGIN <<PREVIOUSLY SPECIFIED, CLEAN UP FROM BEFORE, WARN><<U.RAO>>11365000
      PARSE'ERR(-FILEDISCOVERIDE,PARMPTR);                     <<01200>>11370000
      FLAGFILESIZE := FALSE;                                   <<U.RAO>>11375000
      FLAGNUMEXTS := FALSE;                                    <<U.RAO>>11380000
      FLAGINITALLOC := FALSE;                                  <<U.RAO>>11385000
      END;                                                     <<U.RAO>>11390000
   <<FIRST CANDIDATE IS RECORD SIZE>>                          <<U.RAO>>11395000
   GETNEXT;                                                    <<U.RAO>>11400000
   IF PARMLEN <> 0 THEN   <<RECORD SIZE SPECIFIED>>            <<U.RAO>>11405000
      BEGIN                                                    <<U.RAO>>11410000
      FLAGFILESIZE := TRUE;                                    <<U.RAO>>11415000
      FILESIZE := DBINARY(PARMPTR, PARMLEN);                   <<U.RAO>>11420000
      IF <> OR (FILESIZE <= 0D) THEN                           <<U.RAO>>11425000
         BEGIN                                                 <<U.RAO>>11430000
         PARSE'ERR(ERRNUM := FILEFILESIZE,PARMPTR);            <<01200>>11435000
         RETURN;   <<BAIL OUT>>                                <<U.RAO>>11440000
         END;                                                  <<U.RAO>>11445000
      END;                                                     <<U.RAO>>11450000
   <<NEXT CANDIDATE IS THE NUMBER OF EXTENTS>>                 <<U.RAO>>11455000
   IF NEXTDELIM = COMMA THEN  <<OTHER PARMS WERE SPECIFIED>>   <<U.RAO>>11460000
      BEGIN                                                    <<U.RAO>>11465000
      GETNEXT;                                                 <<U.RAO>>11470000
      IF PARMLEN <> 0 THEN   <<BLOCKING FACTOR PRESENT>>       <<U.RAO>>11475000
         BEGIN  <<ATTEMPT TO PARSE IT>>                        <<U.RAO>>11480000
         FLAGNUMEXTS := TRUE;                                  <<U.RAO>>11485000
         NUMEXTENTS := BINARY(PARMPTR, PARMLEN);               <<U.RAO>>11490000
         IF <> OR NOT(1<=NUMEXTENTS<=32) THEN                  <<U.RAO>>11495000
            BEGIN  <<ERROR IN VALUE>>                          <<U.RAO>>11500000
            PARSE'ERR(ERRNUM := FILEEXTENTSPROB, PARMPTR);     <<01200>>11505000
            RETURN                                             <<U.RAO>>11510000
            END;                                               <<U.RAO>>11515000
         END;                                                  <<U.RAO>>11520000
      <<NEXT CANDIDATE IS THE NUMBER OF INITIALLY ALLOCATED EXTENTS>>   11525000
      IF NEXTDELIM = COMMA THEN  <<FURTHER PARMS WERE SPECIFIED>>       11530000
         BEGIN                                                 <<U.RAO>>11535000
         GETNEXT;                                              <<U.RAO>>11540000
         IF PARMLEN <> 0 THEN  <<INITIAL ALLOCATION PRESENT>>  <<U.RAO>>11545000
            BEGIN                                              <<U.RAO>>11550000
            FLAGINITALLOC := TRUE;                             <<U.RAO>>11555000
            IF NOT FLAGNUMEXTS THEN NUMEXTENTS := 32;          <<U.RAO>>11560000
            INITALLOC := BINARY(PARMPTR,PARMLEN);              <<U.RAO>>11565000
            IF <> OR (INITALLOC > NUMEXTENTS) THEN             <<U.RAO>>11570000
               IF PARSE'ONLY THEN ERRNUM := FILEINITALLOCBD    <<01200>>11575000
               ELSE CIERR(ERRNUM:=FILEINITALLOCBD,PARMPTR,     <<01200>>11580000
                          %10000,NUMEXTENTS);                  <<01200>>11585000
            END;                                               <<U.RAO>>11590000
         END;                                                  <<U.RAO>>11595000
      IF NOT BUILDFLAG THEN                                    <<U.RAO>>11600000
         BEGIN  <<EXTENT SIZE MUST FIT IN 5 BITS>>             <<U.RAO>>11605000
         NUMEXTENTS := NUMEXTENTS-1;                           <<U.RAO>>11610000
         INITALLOC := INITALLOC-1;                             <<U.RAO>>11615000
         END;                                                  <<U.RAO>>11620000
      END;                                                     <<U.RAO>>11625000
   IF ERRNUM <= 0 THEN                                         <<06021>>11630000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>11635000
         PROCDISC := TRUE                                      <<U.RAO>>11640000
      ELSE  <<UNKNOWN PARAMETER AT END OF LIST>>               <<U.RAO>>11645000
         BEGIN                                                 <<U.RAO>>11650000
         GETNEXT;                                              <<U.RAO>>11655000
         PARSE'ERR(ERRNUM := FILEDISCXPARMS, PARMPTR);         <<01200>>11660000
         END;                                                  <<U.RAO>>11665000
   END;                                                        <<U.RAO>>11670000
END;                                                           <<U.RAO>>11675000
                                                               <<U.RAO>>11680000
<<                 *********************                   >>  <<U.RAO>>11685000
<<                 *   CHECKFORMMSG    *                   >>  <<U.RAO>>11690000
<<                 *********************                   >>  <<U.RAO>>11695000
                                                               <<U.RAO>>11700000
LOGICAL SUBROUTINE CHECKFORMMSG;                               <<U.RAO>>11705000
<<VALIDATES AND PROCESSES FORMS MESSAGE>>                      <<U.RAO>>11710000
BEGIN                                                          <<U.RAO>>11715000
CHECKFORMMSG := FALSE;                                         <<U.RAO>>11720000
IF NEXTDELIM <> EQUALS THEN  <<MISSING MESSAGE>>               <<U.RAO>>11725000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>11730000
ELSE   <<PARSE FORMMSG PARAMETER>>                             <<U.RAO>>11735000
   BEGIN                                                       <<U.RAO>>11740000
   FLAGFORMS := TRUE;                                          <<U.RAO>>11745000
   IF <> THEN  <<REDUNDANTLY SPECIFIED>>                       <<U.RAO>>11750000
      PARSE'ERR(-FILEFORMOVERRID, PARMPTR);                    <<01200>>11755000
   GETNEXT;                                                    <<U.RAO>>11760000
   SCAN PARMPTR UNTIL [8/%15,8/"."],1;  <<LOOK FOR ".">>       <<U.RAO>>11765000
   IF CARRY THEN   <<FOUND CR INSTEAD>>                        <<U.RAO>>11770000
      BEGIN                                                    <<U.RAO>>11775000
      PARSE'ERR(ERRNUM := FILEFMSNOPERIOD, BPS0);              <<01200>>11780000
      DEL;  <<POP POINTER ON TOS>>                             <<U.RAO>>11785000
      END                                                      <<U.RAO>>11790000
   ELSE  <<MESSAGE IS PRESENT, SAVE IT>>                       <<U.RAO>>11795000
      BEGIN                                                    <<U.RAO>>11800000
      FORMSMSGLEN := TOS-@PARMPTR;                             <<U.RAO>>11805000
      IF FORMSMSGLEN > 49 THEN   <<MESSAGE TOO LONG>>          <<U.RAO>>11810000
         BEGIN                                                 <<U.RAO>>11815000
         PARSE'ERR(-FILEFMSTOOLONG, PARMPTR(49));              <<01200>>11820000
         FORMSMSGLEN := 49;                                    <<U.RAO>>11825000
         END;  <<HANDLING OF LINE TOO LONG CASE>>              <<U.RAO>>11830000
      FORMSMSG(FORMSMSGLEN) := ".";                            <<U.RAO>>11835000
      MOVE FORMSMSG := PARMPTR, (FORMSMSGLEN);                 <<U.RAO>>11840000
      CHECKFORMMSG := TRUE;                                    <<U.RAO>>11845000
      FORMSMSGLEN := FORMSMSGLEN+1;  <<FOR PERIOD>>            <<U.RAO>>11850000
      INDEX := -1;@BPTR := @PARMPTR;                           <<04179>>11855000
      WHILE BPTR(INDEX := INDEX + 1) <> "." DO                 <<04179>>11860000
         BEGIN << check for delimiters inside formsmsg >>      <<04179>>11865000
            IF BPTR(INDEX) = "=" OR                            <<04179>>11870000
               BPTR(INDEX) = "," OR                            <<04179>>11875000
               BPTR(INDEX) = ";" THEN                          <<04179>>11880000
               GETNEXT; << advance to next parameter >>        <<04179>>11885000
         END;                                                  <<04179>>11890000
      END;                                                     <<U.RAO>>11895000
   END;                                                        <<U.RAO>>11900000
END;   <<SUBROUTINE CHECKFORMMSG>>                             <<U.RAO>>11905000
                                                               <<U.RAO>>11910000
<<                 *********************                   >>  <<U.RAO>>11915000
<<                 *      PROCDEV      *                   >>  <<U.RAO>>11920000
<<                 *********************                   >>  <<U.RAO>>11925000
                                                               <<U.RAO>>11930000
LOGICAL SUBROUTINE PROCDEV;                                    <<U.RAO>>11935000
<<PARSES DEVICE PARAMETER LIST.  THINGS TO WATCH OUT FOR INCLUDE>>      11940000
<<1) MISSING EQUALS SIGN  2) INVALID DEVICE NAME  3) DS LINE NAME>>     11945000
<<4) OUTPRI  5) NUMCOPIES  6) EXTRANEOUS PARAMETERS.  >>       <<U.RAO>>11950000
BEGIN                                                          <<U.RAO>>11955000
PROCDEV := FALSE;                                              <<U.RAO>>11960000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>11965000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>11970000
ELSE  <<DO SUB PARAMETER LIST>>                                <<U.RAO>>11975000
   BEGIN                                                       <<U.RAO>>11980000
   IF FLAGADEV OR FLAGOUTPRI OR FLAGNUMCOPIES THEN             <<01549>>11985000
      BEGIN  <<REDUNDANTLY SPECIFIED DEVICE PARAMETERS>>       <<U.RAO>>11990000
      PARSE'ERR(-FILEDEVOVERRIDE, PARMPTR); <<WARN USER>>      <<01200>>11995000
      FLAGADEV := FALSE;                                       <<01549>>12000000
      @DEV := @DISC & LSL(1); <<REINITIALIZE POINTER>>         <<02569>>12005000
      DEVLEN := 0;                                             <<02569>>12010000
      FLAGOUTPRI := FALSE;                                     <<U.RAO>>12015000
      FLAGNUMCOPIES := FALSE;                                  <<U.RAO>>12020000
      END;                                                     <<U.RAO>>12025000
   <<FIRST CANDIDATE IS THE DEVICE NAME>>                      <<U.RAO>>12030000
   GETNEXT;                                                    <<U.RAO>>12035000
   IF PARMLEN <> 0 THEN                                        <<U.RAO>>12040000
      BEGIN                                                    <<U.RAO>>12045000
      FLAGADEV := TRUE;  << GOT DEVICE PART >>                 <<02569>>12050000
      IF COMTYPE=SYSDEF THEN  <<SYSTEM DEFINED FILE>>          <<U.RAO>>12055000
         BEGIN  <<DEVICE SYSTEM DEFINED>>                      <<U.RAO>>12060000
         PARSE'ERR(ERRNUM := FILESYSDEFDEV, PARMPTR);          <<01200>>12065000
         RETURN                                                <<U.RAO>>12070000
         END;                                                  <<U.RAO>>12075000
      @BPTR:=@DEV:=@PARMPTR; << SET AT 1ST CHAR OF DEV >>      <<01117>>12080000
      TOS:=PARMS(PARMNUM-1); << CURRENT PARM >>                <<01117>>12085000
      DEVLEN:=PARMLEN;                                         <<01117>>12090000
      IF PARMLEN > MAXDEVLEN THEN                              <<04171>>12095000
         BEGIN                                                 <<04171>>12100000
            DDEL;                                              <<04171>>12105000
            ERRNUM := FILEDEVNAME2LNG;                         <<04171>>12110000
            FLUSH'COMMAND;                                     <<04171>>12115000
                                                               <<04171>>12120000
         END;                                                  <<04171>>12125000
      DELB; << DELETE POINTER WORD >>                          <<01117>>12130000
      IF TOS.(10:1) THEN << DEV CONTAINS SPECIALS >>           <<01117>>12135000
         BEGIN                                                 <<01117>>12140000
           MOVE DEV := DEV WHILE AN,1;                         <<04171>>12145000
           STOP := FALSE;                                      <<04171>>12150000
           DO                                                  <<04171>>12155000
              BEGIN                                            <<04171>>12160000
                 IF BPS0 = "#" THEN                            <<04171>>12165000
                    BEGIN                                      <<04171>>12170000
                       IF (S0 - @BPTR) > MAXDEVCLASSLEN THEN   <<04171>>12175000
                          BEGIN                                <<04171>>12180000
                             DEL;                              <<04171>>12185000
                             ERRNUM := FILEDSNAME2LONG;        <<04171>>12190000
                             FLUSH'COMMAND;                    <<04171>>12195000
                                                               <<04171>>12200000
                          END;                                 <<04171>>12205000
                       TOS := TOS + 1;                         <<04171>>12210000
                       @BPTR := S0;                            <<04171>>12215000
                       ASSEMBLE(DUP);                          <<04171>>12220000
                       MOVE * := * WHILE AN,1;                 <<04171>>12225000
                    END                                        <<04171>>12230000
                 ELSE                                          <<04171>>12235000
                 IF BPS0 = " " THEN                            <<04171>>12240000
                    BEGIN                                      <<04171>>12245000
                       IF PARMLEN > (S0 - @DEV) THEN           <<04171>>12250000
                          BEGIN                                <<04171>>12255000
                             DEL;                              <<04171>>12260000
                             ERRNUM := FILEINVALDEVNAME;       <<04171>>12265000
                             FLUSH'COMMAND;                    <<04171>>12270000
                                                               <<04171>>12275000
                          END                                  <<04171>>12280000
                       ELSE                                    <<04171>>12285000
                          BEGIN                                <<04171>>12290000
                             DEL;                              <<04171>>12295000
                             STOP := TRUE;                     <<04171>>12300000
                          END;                                 <<04171>>12305000
                    END                                        <<04171>>12310000
                 ELSE                                          <<04171>>12315000
                 IF BPS0 = BDELIMS(NEXTDELIM) THEN             <<04171>>12320000
                    BEGIN                                      <<04171>>12325000
                       DEL;                                    <<04171>>12330000
                       STOP := TRUE;                           <<04171>>12335000
                    END                                        <<04171>>12340000
                 ELSE                                          <<04171>>12345000
                    BEGIN                                      <<04171>>12350000
                       DEL;                                    <<04171>>12355000
                       ERRNUM := FILEINVALDEVNAME;             <<04171>>12360000
                       FLUSH'COMMAND;                          <<04171>>12365000
                                                               <<04171>>12370000
                    END;                                       <<04171>>12375000
              END UNTIL STOP;                                  <<04171>>12380000
                                                               <<04171>>12385000
        END  << special character inside dev >>                <<04171>>12390000
     ELSE                                                      <<04171>>12395000
        BEGIN                                                  <<04171>>12400000
           IF DEVLEN > MAXDEVCLASSLEN THEN                              12405000
              BEGIN                                                     12410000
                 ERRNUM := FILEDEVNAME2LNG;                             12415000
                 FLUSH'COMMAND;                                         12420000
              END;                                                      12425000
           X := GETDEVINFO(DEV,DEVINFO) + 1;                   <<04171>>12430000
           CASE *X OF                                          <<04171>>12435000
              BEGIN                                            <<04171>>12440000
                 << virtual device >>                          <<04171>>12445000
                 BEGIN                                         <<04171>>12450000
                    ERRNUM := FILEVIRTUALDEV;                  <<04171>>12455000
                    FLUSH'COMMAND;                             <<04171>>12460000
                 END;                                          <<04171>>12465000
                 << ok >>                                      <<04171>>12470000
                    ;                                          <<04171>>12475000
                 << invalid class >>                           <<04171>>12480000
                 BEGIN                                         <<04171>>12485000
                    ERRNUM := FILEINVLDCLASPEC;                <<04171>>12490000
                    FLUSH'COMMAND;                             <<04171>>12495000
                 END;                                          <<04171>>12500000
                 << unknown class name >>                      <<04171>>12505000
                 BEGIN                                         <<04171>>12510000
                    ERRNUM := FILEUNKNOWNDEV;                  <<04171>>12515000
                    FLUSH'COMMAND;                             <<04171>>12520000
                 END;                                          <<04171>>12525000
                 << unknown logical device number >>           <<04171>>12530000
                 BEGIN                                         <<04171>>12535000
                    ERRNUM := FILEDONTKNOWLDEV;                <<04171>>12540000
                    FLUSH'COMMAND;                             <<04171>>12545000
                 END;                                          <<04171>>12550000
              END; << case of GETDEVINFO returns >>            <<04171>>12555000
        END; << device w/o special characters >>               <<04171>>12560000
      END;  <<PROCESSING OF DEVICE NAME>>                      <<U.RAO>>12565000
   IF (ERRNUM<=0) AND (NEXTDELIM=COMMA) THEN                   <<06021>>12570000
      BEGIN  <<MORE PARAMETERS, CHECK FOR OUTPRI>>             <<U.RAO>>12575000
      GETNEXT;                                                 <<U.RAO>>12580000
      IF (COMTYPE=BUILD) OR (COMTYPE=OLD) OR                   <<U.RAO>>12585000
            ((COMTYPE=SYSDEF) LAND (FOPTIONS.DEFAULTDES<>1)) THEN       12590000
         PARSE'ERR(ERRNUM := FILEOUTPRINOT, PARMPTR)           <<01200>>12595000
      ELSE IF PARMLEN <> 0 THEN  <<OUTPRI EVIDENTLY SPECIFIED>><<U.RAO>>12600000
         BEGIN                                                 <<U.RAO>>12605000
         FLAGOUTPRI := TRUE;                                   <<U.RAO>>12610000
         OUTPRI := BINARY(PARMPTR, PARMLEN);                   <<U.RAO>>12615000
         IF <> OR NOT(1<= OUTPRI <= 13) THEN                   <<U.RAO>>12620000
            PARSE'ERR(ERRNUM := FILEOUTPRIINVLD, PARMPTR);     <<01200>>12625000
         END;                                                  <<U.RAO>>12630000
      IF (ERRNUM<=0) AND (NEXTDELIM=COMMA) THEN                <<06021>>12635000
         BEGIN  <<FURTHER PARAMETER(S)>>                       <<U.RAO>>12640000
         GETNEXT;                                              <<U.RAO>>12645000
         IF PARMLEN <> 0 THEN   <<NUMCOPIES SPECIFIED>>        <<U.RAO>>12650000
            BEGIN                                              <<U.RAO>>12655000
            FLAGNUMCOPIES := TRUE;                             <<U.RAO>>12660000
            NUMCOPIES := BINARY(PARMPTR, PARMLEN);             <<U.RAO>>12665000
            IF <> OR NOT(1 <= NUMCOPIES <= 127) THEN           <<U.RAO>>12670000
               PARSE'ERR(ERRNUM := FILENUMCOPINVLD, PARMPTR);  <<01200>>12675000
            END;                                               <<U.RAO>>12680000
         END;  <<NUMCOPIES CASE>>                              <<U.RAO>>12685000
      END;  <<SPOOLING PARAMETERS>>                            <<U.RAO>>12690000
   IF ERRNUM <= 0 THEN                                         <<06021>>12695000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>12700000
         PROCDEV := TRUE                                       <<U.RAO>>12705000
      ELSE                                                     <<U.RAO>>12710000
         BEGIN  <<EXTRANEOUS PARAMETERS>>                      <<U.RAO>>12715000
         GETNEXT;                                              <<U.RAO>>12720000
         PARSE'ERR(ERRNUM := FILEDEVXPARMS, PARMPTR);          <<01200>>12725000
      END;                                                     <<U.RAO>>12730000
   END;                                                        <<U.RAO>>12735000
END;  <<SUBROUTINE PROCDEV>>                                   <<U.RAO>>12740000
                                                               <<U.RAO>>12745000
<<                 *********************                   >>  <<U.RAO>>12750000
<<                 *      PROCREC      *                   >>  <<U.RAO>>12755000
<<                 *********************                   >>  <<U.RAO>>12760000
                                                               <<U.RAO>>12765000
LOGICAL SUBROUTINE PROCREC;                                    <<U.RAO>>12770000
<<SYNTAX  REC=[recsize][,[blockfactor][,[F/V/U][,[BINARY/ASCII]]]]>>    12775000
BEGIN                                                          <<U.RAO>>12780000
PROCREC := FALSE;                                              <<U.RAO>>12785000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>12790000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>12795000
ELSE                                                           <<U.RAO>>12800000
   BEGIN  <<PARSE PARAMETER LIST>>                             <<U.RAO>>12805000
   IF FLAGRECSIZE OR FLAGBLOCKFACTOR OR FLAGRECFMT OR FLAGASCII THEN    12810000
      BEGIN  <<REDUNDANTLY SPECIFIED, WARN, CLEAN UP>>         <<U.RAO>>12815000
      PARSE'ERR(-FILERECOVERRIDE, PARMPTR);                    <<01200>>12820000
      FLAGRECSIZE := FALSE;                                    <<U.RAO>>12825000
      FLAGBLOCKFACTOR := FALSE;                                <<U.RAO>>12830000
      FLAGRECFMT := FALSE;                                     <<U.RAO>>12835000
      FOPTIONS.RECORDFMT := 0;  <<DEFAULT TO F>>               <<U.RAO>>12840000
      FLAGASCII := FALSE;                                      <<U.RAO>>12845000
      FOPTIONS.ASCIIBINARY := 0;  <<DEFAULT TO BINARY>>        <<U.RAO>>12850000
      END;                                                     <<U.RAO>>12855000
   <<FIRST CANDIDATE IS RECSIZE>>                              <<U.RAO>>12860000
   GETNEXT;                                                    <<U.RAO>>12865000
   IF PARMLEN <> 0 THEN  <<RECSIZE EVIDENTLY SPECIFIED>>       <<U.RAO>>12870000
      BEGIN                                                    <<U.RAO>>12875000
      FLAGRECSIZE := TRUE;                                     <<U.RAO>>12880000
      RECSIZE := BINARY(PARMPTR, PARMLEN);                     <<U.RAO>>12885000
      IF <> OR (RECSIZE = 0) THEN                              <<U.RAO>>12890000
         PARSE'ERR(ERRNUM := FILEBADRECSIZE, PARMPTR);         <<01200>>12895000
      END;                                                     <<U.RAO>>12900000
   IF (NEXTDELIM=COMMA) AND (ERRNUM<=0) THEN                   <<06021>>12905000
      BEGIN <<FURTHER PARAMETERS TO PARSE>>                    <<U.RAO>>12910000
      <<NEXT CANDIDATE IS THE BLOCKING FACTOR>>                <<U.RAO>>12915000
      GETNEXT;                                                 <<U.RAO>>12920000
      IF PARMLEN <> 0 THEN  <<BLOCKING FACTOR SPECIFIED>>      <<U.RAO>>12925000
         BEGIN                                                 <<U.RAO>>12930000
         FLAGBLOCKFACTOR := TRUE;                              <<U.RAO>>12935000
         BLOCKFACTOR := BINARY(PARMPTR, PARMLEN);              <<U.RAO>>12940000
         IF <> OR NOT (1 <= BLOCKFACTOR <= 255) THEN           <<U.RAO>>12945000
            PARSE'ERR(ERRNUM := FILEBADBLOCKING, PARMPTR);     <<01200>>12950000
         END;                                                  <<U.RAO>>12955000
      IF (NEXTDELIM=COMMA) AND (ERRNUM<=0) THEN                <<06021>>12960000
         BEGIN  <<FURTHER PARAMETERS, NEXT IS RECORD FORMAT>>  <<U.RAO>>12965000
         GETNEXT;                                              <<U.RAO>>12970000
         IF PARMLEN<>0 THEN  <<RECORD FORMAT SPECIFIED>>       <<U.RAO>>12975000
            BEGIN                                              <<U.RAO>>12980000
            FLAGRECFMT := TRUE;                                <<U.RAO>>12985000
            IF (PARMLEN=1) AND (PARMPTR="F") THEN              <<U.RAO>>12990000
               FOPTIONS.RECORDFMT := 0                         <<U.RAO>>12995000
            ELSE IF (PARMLEN=1) AND (PARMPTR="V") THEN         <<U.RAO>>13000000
               FOPTIONS.RECORDFMT := 1                         <<U.RAO>>13005000
            ELSE IF (PARMLEN=1) AND (PARMPTR="U") THEN         <<U.RAO>>13010000
               FOPTIONS.RECORDFMT := 2                         <<U.RAO>>13015000
            ELSE   <<UNKNOWN RECORD FORMAT>>                   <<U.RAO>>13020000
               PARSE'ERR(ERRNUM := FILEUNKRECFMT, PARMPTR);    <<01200>>13025000
            END;                                               <<U.RAO>>13030000
         IF (NEXTDELIM=COMMA) AND (ERRNUM<=0) THEN             <<06021>>13035000
            BEGIN   <<FURTHER PARAMETER(S)>>                   <<U.RAO>>13040000
            GETNEXT;  <<NEXT CANDIDATE IS BINARY/ASCII>>       <<U.RAO>>13045000
            IF PARMLEN <> 0 THEN   <<ASCII/BINARY SPECIFIED>>  <<U.RAO>>13050000
               BEGIN                                           <<U.RAO>>13055000
               FLAGASCII := TRUE;                              <<U.RAO>>13060000
               IF (PARMLEN=5) AND (PARMPTR="ASCII") THEN       <<U.RAO>>13065000
                  FOPTIONS.ASCIIBINARY := TRUE                 <<U.RAO>>13070000
               ELSE IF (PARMLEN=6) AND (PARMPTR="BINARY") THEN <<U.RAO>>13075000
                  FOPTIONS.ASCIIBINARY := FALSE                <<U.RAO>>13080000
               ELSE                                            <<U.RAO>>13085000
                  PARSE'ERR(ERRNUM:=FILEASCIIINVALD, PARMPTR); <<01200>>13090000
               END;                                            <<U.RAO>>13095000
            END;                                               <<U.RAO>>13100000
         END;                                                  <<U.RAO>>13105000
      END;                                                     <<U.RAO>>13110000
   IF ERRNUM <= 0 THEN                                         <<06021>>13115000
      IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN          <<U.RAO>>13120000
         PROCREC := TRUE                                       <<U.RAO>>13125000
      ELSE  <<EXTRANEOUS DELIMITER - UNKNOWN PARAMETER?>>      <<U.RAO>>13130000
         BEGIN                                                 <<U.RAO>>13135000
         GETNEXT;                                              <<U.RAO>>13140000
         PARSE'ERR(ERRNUM := FILERECXTRANPRM, PARMPTR);        <<01200>>13145000
         END;                                                  <<U.RAO>>13150000
   END;                                                        <<U.RAO>>13155000
END;   <<PROCREC>>                                             <<U.RAO>>13160000
                                                               <<U.RAO>>13165000
<<                 *********************                   >>  <<U.RAO>>13170000
<<                 *     PROCFCODE     *                   >>  <<U.RAO>>13175000
<<                 *********************                   >>  <<U.RAO>>13180000
                                                               <<U.RAO>>13185000
LOGICAL SUBROUTINE PROCFCODE;                                  <<U.RAO>>13190000
BEGIN                                                          <<U.RAO>>13195000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>13200000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>13205000
ELSE                                                           <<U.RAO>>13210000
   BEGIN   <<PARSE PARAMETER>>                                 <<U.RAO>>13215000
   GETNEXT;                                                    <<U.RAO>>13220000
   FLAGFILECODE := TRUE;                                       <<U.RAO>>13225000
   IF <> THEN   <<REDUNDANTLY SPECIFIED>>                      <<U.RAO>>13230000
      PARSE'ERR(-FILEFCODEREDUND, PARMPTR);                    <<01200>>13235000
   IF PARMLEN = 0 THEN  <<MISSING, DEFAULT TO 0>>              <<U.RAO>>13240000
      BEGIN                                                    <<U.RAO>>13245000
      FILECODE := 0;                                           <<U.RAO>>13250000
      PARSE'ERR(-FILEFCODEDEFALT, PARMPTR);                    <<01200>>13255000
      END                                                      <<U.RAO>>13260000
   ELSE  <<FILE CODE PARAMETER PRESENT>>                       <<U.RAO>>13265000
      BEGIN                                                    <<U.RAO>>13270000
      IF (PARMPTR<>NUMERIC) AND (PARMPTR<>"+") AND (PARMPTR<>"-") THEN  13275000
         BEGIN  <<APPARENTLY A NAMED CODE>>                    <<U.RAO>>13280000
         GET'FILECODE(FILECODE,PARMPTR,PARMLEN);               <<01454>>13285000
         IF <> THEN                                            <<01454>>13290000
            PARSE'ERR(ERRNUM := FILEUNKFCODE, PARMPTR);        <<01454>>13295000
         END                                                   <<U.RAO>>13300000
      ELSE   <<NUMERIC FILE CODE>>                             <<U.RAO>>13305000
         BEGIN                                                 <<U.RAO>>13310000
         FILECODE := BINARY(PARMPTR, PARMLEN);                 <<U.RAO>>13315000
         IF <> OR (FILECODE < 0) THEN                          <<U.RAO>>13320000
            PARSE'ERR(ERRNUM := FILEFCODEVALUE, PARMPTR);      <<01200>>13325000
         END;                                                  <<U.RAO>>13330000
      END;                                                     <<U.RAO>>13335000
   END;                                                        <<U.RAO>>13340000
IF ERRNUM > 0 THEN                                             <<06021>>13345000
   PROCFCODE := FALSE                                          <<U.RAO>>13350000
ELSE IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN        <<U.RAO>>13355000
   BEGIN                                                       <<U.RAO>>13360000
   GETNEXT;                                                    <<U.RAO>>13365000
   PROCFCODE := FALSE;                                         <<U.RAO>>13370000
   PARSE'ERR(ERRNUM := FILECODEXTRNDEL, PARMPTR);              <<01200>>13375000
   END                                                         <<U.RAO>>13380000
ELSE                                                           <<U.RAO>>13385000
   PROCFCODE := TRUE;                                          <<U.RAO>>13390000
END;  <<PROCFCODE>>                                            <<U.RAO>>13395000
                                                               <<U.RAO>>13400000
<<                 *********************                   >>  <<U.RAO>>13405000
<<                 *    PROCACCESS     *                   >>  <<U.RAO>>13410000
<<                 *********************                   >>  <<U.RAO>>13415000
                                                               <<U.RAO>>13420000
LOGICAL SUBROUTINE PROCACCESS;                                 <<U.RAO>>13425000
BEGIN                                                          <<U.RAO>>13430000
IF NEXTDELIM <> EQUALS THEN                                    <<U.RAO>>13435000
   PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))        <<01200>>13440000
ELSE                                                           <<U.RAO>>13445000
   BEGIN                                                       <<U.RAO>>13450000
   MOVE ACCTYPES := PACCTYPES, (ACCTYPEL);                     <<U.RAO>>13455000
   FLAGACCESSTYPE := TRUE;                                     <<U.RAO>>13460000
   IF <> THEN                                                  <<U.RAO>>13465000
      PARSE'ERR(-FILEACCESSREDND, PARMPTR);                    <<01200>>13470000
   GETNEXT;                                                    <<U.RAO>>13475000
   IF PARMLEN = 0 THEN  <<ACCESS SPECIFICATION REQUIRED>>      <<U.RAO>>13480000
      PARSE'ERR(ERRNUM := FILEACCREQVALUE, PARMPTR)            <<01200>>13485000
   ELSE                                                        <<U.RAO>>13490000
      BEGIN  <<PARAMETER SUPPLIED, SCAN TABLE FOR IT>>         <<U.RAO>>13495000
      TOS := SEARCH(PARMPTR, PARMLEN, ACCTYPES) -1;            <<U.RAO>>13500000
      IF < THEN  <<UNKNOWN ACCESS TYPE>>                       <<U.RAO>>13505000
         BEGIN                                                 <<U.RAO>>13510000
         DEL;                                                  <<U.RAO>>13515000
         PARSE'ERR(ERRNUM := FILEACCINVALID, PARMPTR)          <<01200>>13520000
         END                                                   <<U.RAO>>13525000
      ELSE                                                     <<U.RAO>>13530000
         AOPTIONS.ACCESSTYPE := TOS;  <<ORDINAL IN PACCTYPES>> <<U.RAO>>13535000
      END                                                      <<U.RAO>>13540000
   END;                                                        <<U.RAO>>13545000
IF ERRNUM > 0 THEN                                             <<06021>>13550000
   PROCACCESS := FALSE                                         <<U.RAO>>13555000
ELSE IF (NEXTDELIM <> CR) AND (NEXTDELIM <> SEMICOLON) THEN    <<U.RAO>>13560000
   BEGIN  <<EXTRANEOUS PARAMETER OR SYNTAX ERROR>>             <<U.RAO>>13565000
   GETNEXT;                                                    <<U.RAO>>13570000
   PROCACCESS := FALSE;                                        <<U.RAO>>13575000
   PARSE'ERR(ERRNUM := FILEACCXTRNPARM, PARMPTR);              <<01200>>13580000
   END                                                         <<U.RAO>>13585000
ELSE                                                           <<U.RAO>>13590000
   PROCACCESS := TRUE                                          <<U.RAO>>13595000
END;  <<SUBROUTINE PROCACCESS>>                                <<U.RAO>>13600000
                                                               <<U.RAO>>13605000
<<                 *********************                   >>  <<U.RAO>>13610000
<<                 *     PROCFBUF      *                   >>  <<U.RAO>>13615000
<<                 *********************                   >>  <<U.RAO>>13620000
                                                               <<U.RAO>>13625000
LOGICAL SUBROUTINE PROCBUF;                                    <<U.RAO>>13630000
BEGIN  <<PARSES BUF= PARAMETER>>                               <<U.RAO>>13635000
AOPTIONS.NOBUF := FALSE;                                       <<U.RAO>>13640000
FLAGBUFINHIBIT := TRUE; <<SO NOBUF IS SET FALSE IN FOPEN>>     <<00886>>13645000
IF <> THEN     <<NOBUF PREVIOUSLY SPECIFIED>>                  <<U.RAO>>13650000
   PARSE'ERR(-FILENOBUFBUF,PARMPTR);                           <<01200>>13655000
NUMBUFFERS := 2;  <<DEFAULT>>                                  <<U.RAO>>13660000
FLAGNUMBUFS := TRUE;                                           <<U.RAO>>13665000
IF <> THEN   <<BUF= PREVIOUSLY SPECIFIED>>                     <<U.RAO>>13670000
   PARSE'ERR(-FILEBUFOVERRIDE, PARMPTR);                       <<01200>>13675000
IF NEXTDELIM = EQUALS THEN   <<NUMBER OF BUFFERS SPECIFIED>>   <<U.RAO>>13680000
   BEGIN                                                       <<U.RAO>>13685000
   GETNEXT;                                                    <<U.RAO>>13690000
   IF PARMLEN <> 0 THEN                                        <<U.RAO>>13695000
      BEGIN                                                    <<U.RAO>>13700000
      NUMBUFFERS := BINARY(PARMPTR, PARMLEN);                  <<U.RAO>>13705000
      IF <> OR NOT(0 <= NUMBUFFERS <= 16) THEN                 <<U.RAO>>13710000
         PARSE'ERR(ERRNUM := FILEINVLDBUFNUM, PARMPTR);        <<01200>>13715000
      END                                                      <<U.RAO>>13720000
   END;                                                        <<U.RAO>>13725000
IF ERRNUM > 0 THEN                                             <<06021>>13730000
   PROCBUF := FALSE                                            <<U.RAO>>13735000
ELSE IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN        <<U.RAO>>13740000
   BEGIN <<EXTRANEOUS PARAMETER>>                              <<U.RAO>>13745000
   GETNEXT;                                                    <<U.RAO>>13750000
   PROCBUF := FALSE;                                           <<U.RAO>>13755000
   PARSE'ERR(ERRNUM := FILEBUFXTRANDEL, PARMPTR);              <<01200>>13760000
   END                                                         <<U.RAO>>13765000
ELSE                                                           <<U.RAO>>13770000
   PROCBUF := TRUE;                                            <<U.RAO>>13775000
END;                                                           <<U.RAO>>13780000
                                                               <<01549>>13785000
                                                               <<01549>>13790000
<<                 *********************                   >>  <<01549>>13795000
<<                 *     PROCENV       *                   >>  <<01549>>13800000
<<                 *********************                   >>  <<01549>>13805000
                                                               <<01549>>13810000
LOGICAL SUBROUTINE PROCENV;                                    <<01549>>13815000
<<PARSES ENV PARAMETER>>                                       <<01549>>13820000
<<CHECKS FOR EQUAL SIGN>>                                      <<01549>>13825000
<<VALID FILENAME>>                                             <<01549>>13830000
<< OK IF NO FILE NAME, GLOBAL ENV. FILE WILL >>                <<01851>>13835000
<< BE USED BY FOPEN.                         >>                <<01851>>13840000
                                                               <<01549>>13845000
BEGIN                                                          <<01549>>13850000
   PROCENV := FALSE;                                           <<01549>>13855000
   IF NEXTDELIM <> EQUALS THEN                                 <<01549>>13860000
      PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))     <<01549>>13865000
   ELSE                                                        <<01549>>13870000
      BEGIN                                                    <<01549>>13875000
         IF FLAGENV THEN                                       <<01549>>13880000
            BEGIN   <<REDUNDANTLY SPECIFIED ENV PARM>>         <<01549>>13885000
               PARSE'ERR(-FILEENVOVERRIDE,PARMPTR);            <<01549>>13890000
               FLAGENV := FALSE; <<WARN USER>>                 <<01549>>13895000
            END;                                               <<01549>>13900000
         GETNEXT;                                              <<01851>>13905000
         IF PARMLEN <> 0 THEN                                  <<01851>>13910000
            IF NOT CHECKENVFILEDESIG THEN                      <<02523>>13915000
               RETURN;                                         <<01851>>13920000
         @ENV := @PARMPTR;                                     <<01851>>13925000
         ENVLEN := PARMLEN;                                    <<01851>>13930000
         FLAGENV := TRUE;                                      <<01549>>13935000
         IF (NEXTDELIM=CR) OR (NEXTDELIM=SEMICOLON) THEN       <<01851>>13940000
            PROCENV := TRUE                                    <<01851>>13945000
         ELSE                                                  <<01851>>13950000
            BEGIN                                              <<01851>>13955000
               GETNEXT;                                        <<01851>>13960000
               PARSE'ERR(ERRNUM:=FILEENVXPARMS,PARMPTR);       <<01851>>13965000
            END;                                               <<01851>>13970000
         END;                                                  <<01549>>13975000
    END; <<SUBROUTINE PROCENV>>                                <<01549>>13980000
                                                               <<01549>>13985000
                                                               <<01549>>13990000
                                                               <<01549>>13995000
<<                 *********************                   >>  <<01549>>14000000
<<                 *     PROCOUTQ      *                   >>  <<01549>>14005000
<<                 *********************                   >>  <<01549>>14010000
                                                               <<01549>>14015000
LOGICAL SUBROUTINE PROCOUTQ;                                   <<01549>>14020000
<<PARSES OUTQ PARAMETER>>                                      <<01549>>14025000
<<CHECKS FOR EQUAL SIGN>>                                      <<01549>>14030000
<<VALID ALPHANUMERIC OUTQ NAME UP TO 8 CHARS>>                 <<01549>>14035000
<< OK IF NO OUTQNAME, GLOBAL OUTQ NAME WILL >>                 <<01851>>14040000
<< BE USED BY FOPEN.                        >>                 <<01851>>14045000
                                                               <<01549>>14050000
BEGIN                                                          <<01549>>14055000
                                                               <<01549>>14060000
   PROCOUTQ := FALSE;                                          <<01549>>14065000
   IF NEXTDELIM <> EQUALS THEN                                 <<01549>>14070000
      PARSE'ERR(ERRNUM := FILEREQEQSIGN, PARMPTR(PARMLEN))     <<01549>>14075000
   ELSE                                                        <<01549>>14080000
      BEGIN                                                    <<01549>>14085000
         IF FLAGOUTQ THEN                                      <<01549>>14090000
         BEGIN  <<REDUNDANTLY SPECIFIED OUTQ PARM>>            <<01549>>14095000
            PARSE'ERR(-FILEOUTQOVERRIDE,PARMPTR);              <<01549>>14100000
            FLAGOUTQ := FALSE;                                 <<01549>>14105000
         END;                                                  <<01549>>14110000
         GETNEXT;                                              <<01549>>14115000
            MOVE PARMPTR := PARMPTR WHILE ANS;                 <<01549>>14120000
            TOS := PARMS(PARMNUM-1); <<DOUBLE FOR OUTQNAME>>   <<01549>>14125000
            DELB;  <<POP POINTER WORD>>                        <<01549>>14130000
            IF TOS.(10:1) THEN <<OUTQNAME CONTAINS SPECIALS>>  <<01549>>14135000
               PARSE'ERR(ERRNUM := OUTQNAMEALPHNUM,PARMPTR)    <<01549>>14140000
            ELSE                                               <<01549>>14145000
               IF PARMLEN > 8 THEN                             <<01549>>14150000
               PARSE'ERR(ERRNUM := OUTQNAME2LNG,PARMPTR)       <<01549>>14155000
            ELSE                                               <<01549>>14160000
               IF PARMPTR = NUMERIC THEN                       <<01549>>14165000
               PARSE'ERR(ERRNUM := OUTQNAMENOTALPH,PARMPTR)    <<01549>>14170000
            ELSE                                               <<01549>>14175000
               BEGIN  <<GOOD OUTQ NAME>>                       <<01549>>14180000
                  @OUTQ := @PARMPTR;                           <<01851>>14185000
                  OUTQLEN := PARMLEN;                          <<01851>>14190000
                  FLAGOUTQ := TRUE;                            <<01549>>14195000
                  IF ERRNUM <= 0 THEN                          <<06021>>14200000
                     IF (NEXTDELIM = CR) OR                    <<01549>>14205000
                        (NEXTDELIM = SEMICOLON) THEN           <<01549>>14210000
                     PROCOUTQ := TRUE                          <<01549>>14215000
                     ELSE                                      <<01549>>14220000
                        BEGIN                                  <<01549>>14225000
                           GETNEXT;                            <<01549>>14230000
                           PARSE'ERR(ERRNUM := FILEOUTQXPARMS, <<01549>>14235000
                                  PARMPTR);                    <<01549>>14240000
                        END;                                   <<01549>>14245000
               END;                                            <<01549>>14250000
      END;                                                     <<01549>>14255000
END; <<SUBROUTINE PROCOUTQ>>                                   <<01549>>14260000
                                                               <<01549>>14265000
                                                               <<01549>>14270000
<<                 ********************                    >>  <<02569>>14275000
<<                 *     PROCDENS     *                    >>  <<02569>>14280000
<<                 ********************                    >>  <<02569>>14285000
LOGICAL SUBROUTINE PROCDENS;                                   <<02569>>14290000
<<Parses the DEN parameter. Checks for equal sign followed >>  <<02569>>14295000
<<by an optional density value.                            >>  <<02569>>14300000
<<SYNTAX:   ;DEN=[1600/6250]                               >>  <<02569>>14305000
BEGIN                                                          <<02569>>14310000
PROCDENS:=FALSE;                                               <<02569>>14315000
IF NEXTDELIM <> EQUALS THEN                                    <<02569>>14320000
  PARSE'ERR(ERRNUM:=FILEREQEQSIGN,PARMPTR(PARMLEN))            <<02569>>14325000
ELSE                                                           <<02569>>14330000
  BEGIN                                                        <<02569>>14335000
     IF FLAGDENS THEN                                          <<02569>>14340000
       BEGIN     <<REDUNDANTLY SPECFIED DENS PARM>>            <<02569>>14345000
          PARSE'ERR(-FILEDENSOVERRID,PARMPTR);                 <<02569>>14350000
          FLAGDENS := FALSE;   <<WARN USER>>                   <<02569>>14355000
       END;      <<REDUNDANTLY SPECIFIED DENS PARM>>           <<02569>>14360000
     GETNEXT;    <<LOOK FOR DENSITY VALUE>>                    <<02569>>14365000
     IF PARMLEN <> 0 THEN                                      <<02569>>14370000
       BEGIN           <<PARM FOUND>>                          <<02569>>14375000
          IF PARSE'DENSITY(PARMPTR,PARMLEN,DUMMY) THEN         <<02569>>14380000
             FLAGDENS := TRUE                                  <<02569>>14385000
          ELSE                                                 <<02569>>14390000
             BEGIN      << Invalid density subparameter >>     <<02569>>14395000
                PARSE'ERR(ERRNUM:=FILEDENSINVAL,PARMPTR);      <<02569>>14400000
                FLAGDENS := FALSE;                             <<02569>>14405000
             END;                                              <<02569>>14410000
       END             <<PARM FOUND>>                          <<02569>>14415000
     ELSE FLAGDENS := TRUE;    <<DEFAULT CASE>>                <<02569>>14420000
     IF FLAGDENS THEN        << GOOD PARM >>                   <<02569>>14425000
       BEGIN                                                   <<02569>>14430000
          @DENS := @PARMPTR;                                   <<02569>>14435000
          DENSLEN := PARMLEN;                                  <<02569>>14440000
          IF ERRNUM <= 0 THEN                                  <<06021>>14445000
            IF (NEXTDELIM = CR) OR (NEXTDELIM = SEMICOLON)     <<02569>>14450000
              THEN PROCDENS := TRUE                            <<02569>>14455000
            ELSE BEGIN                                         <<02569>>14460000
                 GETNEXT;                                      <<02569>>14465000
                 PARSE'ERR(ERRNUM:=FILEDENSXPARM,PARMPTR);     <<02569>>14470000
                 END;                                          <<02569>>14475000
       END;     <<GOOD PARM>>                                  <<02569>>14480000
  END;                                                         <<02569>>14485000
END;      << SUBROUTINE PROCDENS >>                            <<02569>>14490000
                                                               <<02569>>14495000
                                                               <<02569>>14500000
<<                 *********************                   >>  <<U.RAO>>14505000
<<                 *      PROCKEY      *                   >>  <<U.RAO>>14510000
<<                 *********************                   >>  <<U.RAO>>14515000
                                                               <<U.RAO>>14520000
LOGICAL SUBROUTINE PROCKEY;                                    <<U.RAO>>14525000
<<Processes the parameter list.  Note that it is only called       >>   14530000
<<if it appears that a parameter list is present.  In general      >>   14535000
<<this routine only controls the parse;  Anything which is even    >>   14540000
<<moderately complex (i.e, has parameters) is done in a further    >>   14545000
<<subroutine.  In essence, we must do four things in this routine. >>   14550000
<<1)  Identify the parameters which are not appropriate to this    >>   14555000
<<    form of the command.                                         >>   14560000
<<2)  Control the scan through the parameter list.  (done with     >>   14565000
<<    a do loop around a case statement.                           >>   14570000
<<3)  Process trivial parameters like WAIT, NOMR and a few others  >>   14575000
<<    which simply involve setting a few bits somewhere.           >>   14580000
<<4)  Look for extraneous subparameters on the trivial parameters. >>   14585000
<<Another thing to note is that for the most part we allow the     >>   14590000
<<user to specify a parameter redundantly, using the latest        >>   14595000
<<occurrence as the controlling one.                               >>   14600000
BEGIN                                                          <<U.RAO>>14605000
PROCKEY := FALSE;                                              <<U.RAO>>14610000
MOVE KEYLIST := PKEYLIST, (PKEYLISTL);                         <<U.RAO>>14615000
<<NOW GET COMTYPE.  COMTYPE IS AN INTEGER INDICATING WHICH >>  <<U.RAO>>14620000
<<TYPE OF COMMAND THIS IS.                                 >>  <<U.RAO>>14625000
IF BUILDFLAG THEN                                              <<U.RAO>>14630000
   COMTYPE := BUILD                                            <<U.RAO>>14635000
ELSE IF FOPTIONS.DEFAULTDES = 0 THEN  <<REGULAR FILEREFERENCE>><<U.RAO>>14640000
   IF FOPTIONS.DOMAIN = 0 THEN                                 <<U.RAO>>14645000
      COMTYPE := NEW                                           <<U.RAO>>14650000
   ELSE                                                        <<U.RAO>>14655000
      COMTYPE := OLD                                           <<U.RAO>>14660000
ELSE IF FOPTIONS.DEFAULTDES = 2 THEN <<$NEWPASS>>              <<U.RAO>>14665000
   COMTYPE := NEW                                              <<U.RAO>>14670000
ELSE IF FOPTIONS.DEFAULTDES = 3 THEN  <<$OLDPASS>>             <<U.RAO>>14675000
   COMTYPE := OLD                                              <<U.RAO>>14680000
ELSE   <<$STDIN, $STDLIST, $STDINX>>                           <<U.RAO>>14685000
   COMTYPE := SYSDEF;                                          <<U.RAO>>14690000
<<NOW DO BODY OF KEYWORD PROCESSING>>                          <<U.RAO>>14695000
DO    <<UNTIL ERROR OR END OF PARAMETERS>>                     <<U.RAO>>14700000
   BEGIN                                                       <<U.RAO>>14705000
   GETNEXT;  <<SET UP NEXT KEYWORD>>                           <<U.RAO>>14710000
   IF PARMLEN = 0 THEN  <<DOUBLED DELIMITER>>                  <<U.RAO>>14715000
      PARSE'ERR(-FILEEXTRANDELIM, PARMPTR)                     <<01200>>14720000
   ELSE   <<NON-BLANK STRING>>                                 <<U.RAO>>14725000
      BEGIN   <<IDENTIFY KEYWORD>>                             <<U.RAO>>14730000
      TOS := SEARCH(PARMPTR, PARMLEN, KEYLIST, DICTPTR);       <<U.RAO>>14735000
      <<BEFORE PROCESSING, CHECK TO SEE THAT THIS KEYWORD IS>> <<U.RAO>>14740000
      <<APPROPRIATE FOR THIS PARTICULAR VERSION OF THE COMMAND><<U.RAO>>14745000
      IF (S0 <> 0)  <<VALID KEY NAME>>   AND                   <<U.RAO>>14750000
         (((1&LSL(COMTYPE)) LAND LOGICAL(DICTPTR)) <> 0) THEN  <<U.RAO>>14755000
         BEGIN  <<KEYWORD OUT OF CONTEXT>>                     <<U.RAO>>14760000
         DEL;  <<POP ORDINAL OF KEYWORD>>                      <<U.RAO>>14765000
         <<FIXUP KEYWORD TO BE PARAMETER TO GENMSG>>           <<U.RAO>>14770000
         TOS := PARMPTR(PARMLEN);                              <<U.RAO>>14775000
         PARMPTR(X) := 0;                                      <<U.RAO>>14780000
         CASE *COMTYPE OF                                      <<U.RAO>>14785000
            BEGIN                                              <<U.RAO>>14790000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTBLD         <<01200>>14795000
            ELSE                                               <<01200>>14800000
               CIERR(ERRNUM:=FILECONTXTBLD,PARMPTR,0,@PARMPTR);<<01200>>14805000
                                                               <<01200>>14810000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTSYSDF       <<01200>>14815000
            ELSE                                               <<01200>>14820000
               CIERR(ERRNUM:=FILECONTXTSYSDF,PARMPTR,0,        <<01200>>14825000
                     @PARMPTR);                                <<01200>>14830000
                                                               <<01200>>14835000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTOLD         <<01200>>14840000
            ELSE                                               <<01200>>14845000
               CIERR(ERRNUM:=FILECONTXTOLD,PARMPTR,0,@PARMPTR);<<01200>>14850000
                                                               <<01200>>14855000
            IF PARSE'ONLY THEN ERRNUM := FILECONTXTNEW         <<01200>>14860000
            ELSE                                               <<01200>>14865000
               CIERR(ERRNUM:=FILECONTXTNEW,PARMPTR,0,@PARMPTR);<<01200>>14870000
            END;                                               <<U.RAO>>14875000
         PARMPTR(PARMLEN) := TOS;                              <<U.RAO>>14880000
         RETURN                                                <<U.RAO>>14885000
         END;                                                  <<U.RAO>>14890000
      <<WE KNOW THAT THIS KEYWORD IS APPROPRIATE TO THIS>>     <<U.RAO>>14895000
      <<FORM OF THE FILE OR BUILD COMMAND.  NOW ACTUALLY PROCESS>>      14900000
      <<THE KEYWORD>>                                          <<U.RAO>>14905000
      CASE *TOS OF                                             <<U.RAO>>14910000
         BEGIN                                                 <<U.RAO>>14915000
            BEGIN  <<UNKNOWN KEYWORD>>                         <<U.RAO>>14920000
            IF BUILDFLAG THEN                                  <<U.RAO>>14925000
               PARSE'ERR(ERRNUM := BLDUNKNOWNKEY, PARMPTR)     <<01200>>14930000
            ELSE   <<FILE COMMAND>>                            <<U.RAO>>14935000
               PARSE'ERR(ERRNUM := FILEUNKNOWNKEY, PARMPTR);   <<01200>>14940000
            RETURN;                                            <<U.RAO>>14945000
            END;                                               <<U.RAO>>14950000
                                                               <<U.RAO>>14955000
            <<DEV = >>                                         <<U.RAO>>14960000
            IF NOT PROCDEV THEN RETURN;                        <<U.RAO>>14965000
                                                               <<U.RAO>>14970000
            <<DISC = >>                                        <<U.RAO>>14975000
            IF NOT PROCDISC THEN RETURN;                       <<U.RAO>>14980000
                                                               <<U.RAO>>14985000
            <<REC = >>                                         <<U.RAO>>14990000
            IF NOT PROCREC THEN RETURN;                        <<U.RAO>>14995000
                                                               <<U.RAO>>15000000
            <<FILE CODE>>                                      <<U.RAO>>15005000
            IF NOT PROCFCODE THEN RETURN;                      <<U.RAO>>15010000
                                                               <<U.RAO>>15015000
            <<CCTL>>                                           <<U.RAO>>15020000
            BEGIN                                              <<U.RAO>>15025000
               FOPTIONS.CCTL := TRUE;   <<ALSO CHECKS PREVIOUS STATE>>  15030000
               IF = AND FLAGCCTL THEN   <<INCONSISTENT WITH AND >>      15035000
                  PARSE'ERR(-FILENOCCTLCCTL, PARMPTR);         <<01200>>15040000
               FLAGCCTL := TRUE;                               <<U.RAO>>15045000
            END;                                               <<U.RAO>>15050000
                                                               <<U.RAO>>15055000
            <<NOCCTL>>                                         <<U.RAO>>15060000
            BEGIN                                              <<U.RAO>>15065000
               FOPTIONS.CCTL := FALSE;                         <<U.RAO>>15070000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS CCTL>><<U.RAO>>15075000
                  PARSE'ERR(-FILECCTLNOCCTL, PARMPTR);         <<01200>>15080000
               FLAGCCTL := TRUE;                               <<U.RAO>>15085000
            END;                                               <<U.RAO>>15090000
                                                               <<U.RAO>>15095000
            <<TEMP>>                                           <<U.RAO>>15100000
            BEGIN                                              <<U.RAO>>15105000
               FLAGDISP := TRUE;                               <<U.RAO>>15110000
               IF <> THEN  <<POSSIBLE CONTRADICTION>>          <<U.RAO>>15115000
                  IF DISPOSITION = DELETE THEN                 <<U.RAO>>15120000
                     PARSE'ERR(-FILEDELTEMP, PARMPTR)          <<01200>>15125000
                  ELSE IF DISPOSITION = SAVE THEN              <<U.RAO>>15130000
                     PARSE'ERR(-FILESAVETEMP, PARMPTR);        <<01200>>15135000
               DISPOSITION := TEMP;                            <<U.RAO>>15140000
            END;                                               <<U.RAO>>15145000
                                                               <<U.RAO>>15150000
            <<SAVE>>                                           <<U.RAO>>15155000
            BEGIN                                              <<U.RAO>>15160000
               FLAGDISP := TRUE;                               <<U.RAO>>15165000
               IF <> THEN  <<POSSIBLE CONFLICT WITH PREVIOUS SPEC>>     15170000
                  IF DISPOSITION = DELETE THEN                 <<U.RAO>>15175000
                     PARSE'ERR(-FILEDELSAVE, PARMPTR)          <<01200>>15180000
                  ELSE IF DISPOSITION = TEMP THEN              <<U.RAO>>15185000
                     PARSE'ERR(-FILETEMPSAVE, PARMPTR);        <<01200>>15190000
               DISPOSITION := SAVE;                            <<U.RAO>>15195000
            END;                                               <<U.RAO>>15200000
                                                               <<U.RAO>>15205000
            <<DEL>>                                            <<U.RAO>>15210000
            BEGIN                                              <<U.RAO>>15215000
               FLAGDISP := TRUE;                               <<U.RAO>>15220000
               IF <> THEN  <<POSSIBLE INCONSISTENCY WITH PREVIOUS>>     15225000
                  IF DISPOSITION  = TEMP THEN                  <<U.RAO>>15230000
                     PARSE'ERR(-FILETEMPDEL, PARMPTR)          <<01200>>15235000
                  ELSE IF DISPOSITION = SAVE THEN              <<U.RAO>>15240000
                     PARSE'ERR(-FILESAVEDEL, PARMPTR);         <<01200>>15245000
               DISPOSITION := DELETE;                          <<U.RAO>>15250000
            END;                                               <<U.RAO>>15255000
                                                               <<U.RAO>>15260000
            <<ACCESS>>                                         <<U.RAO>>15265000
            IF NOT PROCACCESS THEN RETURN;                     <<U.RAO>>15270000
                                                               <<U.RAO>>15275000
            <<SHARE>>                                          <<U.RAO>>15280000
            BEGIN                                              <<U.RAO>>15285000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>15290000
               IF <> THEN                                      <<U.RAO>>15295000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<U.RAO>>15300000
                     PARSE'ERR(-FILEEXCLSHARE, PARMPTR)        <<01200>>15305000
                  ELSE IF AOPTIONS.EXCLACCESS = EXCLUSIVEREAD THEN      15310000
                     PARSE'ERR(-FILEEXCLSHARE,PARMPTR);        <<01549>>15315000
               AOPTIONS.EXCLACCESS := SHARE;                   <<U.RAO>>15320000
            END;                                               <<U.RAO>>15325000
                                                               <<U.RAO>>15330000
            <<EAR>>                                            <<U.RAO>>15335000
            BEGIN                                              <<U.RAO>>15340000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>15345000
               IF <> THEN                                      <<U.RAO>>15350000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<U.RAO>>15355000
                     PARSE'ERR(-FILEEXCLEAR, PARMPTR)          <<01200>>15360000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<U.RAO>>15365000
                     PARSE'ERR(-FILESHAREEAR, PARMPTR);        <<01200>>15370000
               AOPTIONS.EXCLACCESS := EXCLUSIVEREAD;           <<U.RAO>>15375000
            END;                                               <<U.RAO>>15380000
                                                               <<01549>>15385000
            <<SEMI>>                                           <<01549>>15390000
            BEGIN                                              <<01549>>15395000
               FLAGEXCLUSIVE := TRUE;                          <<01549>>15400000
               IF <> THEN                                      <<01549>>15405000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVE THEN      <<01549>>15410000
                     PARSE'ERR(-FILEEXCLSEMI,PARMPTR)          <<01549>>15415000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<01549>>15420000
                     PARSE'ERR(-FILESHARESEMI,PARMPTR);        <<01549>>15425000
               AOPTIONS.EXCLACCESS := EXCLUSIVEREAD;           <<01549>>15430000
            END;                                               <<01549>>15435000
                                                               <<01549>>15440000
                                                               <<U.RAO>>15445000
            <<EXC>>                                            <<U.RAO>>15450000
            BEGIN                                              <<U.RAO>>15455000
               FLAGEXCLUSIVE := TRUE;                          <<U.RAO>>15460000
               IF <> THEN                                      <<U.RAO>>15465000
                  IF AOPTIONS.EXCLACCESS = EXCLUSIVEREAD THEN  <<U.RAO>>15470000
                     PARSE'ERR(-FILEEAREXCL, PARMPTR)          <<01200>>15475000
                  ELSE IF AOPTIONS.EXCLACCESS = SHARE THEN     <<U.RAO>>15480000
                     PARSE'ERR(-FILESHAREEXCL, PARMPTR);       <<01200>>15485000
               AOPTIONS.EXCLACCESS := EXCLUSIVE;               <<U.RAO>>15490000
            END;                                               <<U.RAO>>15495000
                                                               <<U.RAO>>15500000
            <<BUF = >>                                         <<U.RAO>>15505000
            IF NOT PROCBUF THEN RETURN;                        <<U.RAO>>15510000
                                                               <<U.RAO>>15515000
            <<NOBUF>>                                          <<U.RAO>>15520000
            BEGIN                                              <<U.RAO>>15525000
               AOPTIONS.NOBUF := TRUE;                         <<U.RAO>>15530000
               FLAGNUMBUFS := FALSE;  << IN CASE PREVIOUS BUF= <<U.RAO>>15535000
               IF <> THEN  <<WAS A PREVIOUS BUF = PARAMETER>>  <<U.RAO>>15540000
                  PARSE'ERR(-FILEBUFNOBUF, PARMPTR);           <<01200>>15545000
               FLAGBUFINHIBIT := TRUE;  <<INHIBIT BUFFERING>>  <<U.RAO>>15550000
            END;                                               <<U.RAO>>15555000
            <<COPY>>                                           <<01549>>15560000
            BEGIN                                              <<01549>>15565000
               AOPTIONS.COPY := TRUE;                          <<01549>>15570000
               IF = AND FLAGCOPY THEN                          <<01549>>15575000
                  PARSE'ERR(-FILENOCOPYCOPY, PARMPTR);         <<01549>>15580000
               FLAGCOPY := TRUE;                               <<01549>>15585000
            END;                                               <<01549>>15590000
                                                               <<01549>>15595000
            <<NOCOPY>>                                         <<01549>>15600000
            BEGIN                                              <<01549>>15605000
               AOPTIONS.COPY := FALSE;                         <<01549>>15610000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS COPY>><<01549>>15615000
                  PARSE'ERR(-FILECOPYNOCOPY, PARMPTR);         <<01549>>15620000
               FLAGCOPY := TRUE;                               <<01549>>15625000
            END;                                               <<01549>>15630000
                                                               <<01549>>15635000
                                                               <<U.RAO>>15640000
            <<MR>>                                             <<U.RAO>>15645000
            BEGIN                                              <<U.RAO>>15650000
               AOPTIONS.MULTIRECORD := TRUE;                   <<U.RAO>>15655000
               IF = AND FLAGMULTIREC THEN                      <<U.RAO>>15660000
                  PARSE'ERR(-FILENOMRMR, PARMPTR);             <<01200>>15665000
               FLAGMULTIREC := TRUE;                           <<U.RAO>>15670000
            END;                                               <<U.RAO>>15675000
                                                               <<U.RAO>>15680000
            <<NOMR>>                                           <<U.RAO>>15685000
            BEGIN                                              <<U.RAO>>15690000
               AOPTIONS.MULTIRECORD := FALSE;                  <<U.RAO>>15695000
               IF <> THEN   <<INCONSISTENT WITH PREVIOUS MR>>  <<U.RAO>>15700000
                  PARSE'ERR(-FILEMRNOMR, PARMPTR);             <<01200>>15705000
               FLAGMULTIREC := TRUE;                           <<U.RAO>>15710000
            END;                                               <<U.RAO>>15715000
                                                               <<U.RAO>>15720000
            <<GLOBAL MULTIACCESS>>                             <<01549>>15725000
            BEGIN                                              <<01549>>15730000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>15735000
            IF <> THEN                                         <<01549>>15740000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>15745000
                  BEGIN                                        <<01549>>15750000
                  PARSE'ERR(-FILENOMULTGMULT, PARMPTR);        <<01549>>15755000
                  PARSE'ERR(-FILEMULTIGMULTI, PARMPTR);        <<01549>>15760000
                  END;                                         <<01549>>15765000
            AOPTIONS.MULTIACCESS:=GLOBALMULTI;                 <<01549>>15770000
            END;                                               <<01549>>15775000
            <<LOCAL MULTIACCESS>>                              <<01549>>15780000
            BEGIN                                              <<01549>>15785000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>15790000
            IF <> THEN                                         <<01549>>15795000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>15800000
                  BEGIN                                        <<01549>>15805000
                  PARSE'ERR(-FILENOMULTIMULTI, PARMPTR);       <<01549>>15810000
                  ;  <<ALREADY WAS SET TO LOCAL>>              <<01549>>15815000
                  PARSE'ERR(-FILEGMULTIMULTI, PARMPTR);        <<01549>>15820000
                  END;                                         <<01549>>15825000
            AOPTIONS.MULTIACCESS:=LOCALMULTI;                  <<01549>>15830000
            END;                                               <<01549>>15835000
                                                               <<01549>>15840000
            <<NO MULTIACCESS>>                                 <<01549>>15845000
            BEGIN                                              <<01549>>15850000
            FLAGMULTIACCESS:=TRUE;                             <<01549>>15855000
            IF <> THEN                                         <<01549>>15860000
               CASE AOPTIONS.MULTIACCESS OF                    <<01549>>15865000
                  BEGIN                                        <<01549>>15870000
                  ;  <<ALREADY SET TO NO MULTIACCESS>>         <<01549>>15875000
                  PARSE'ERR(-FILEMULTINOMULTI, PARMPTR);       <<01549>>15880000
                  PARSE'ERR(-FILEGMULTNOMULT, PARMPTR);        <<01549>>15885000
                  END;                                         <<01549>>15890000
            AOPTIONS.MULTIACCESS:=NOMULTI;                     <<01549>>15895000
            END;                                               <<01549>>15900000
            <<NOLABEL>>                                        <<U.RAO>>15905000
            BEGIN                                              <<U.RAO>>15910000
               FOPTIONS.TAPELABELF := FALSE;                   <<U.RAO>>15915000
               IF <> THEN  <<INCONSISTENTLY SPECIFIED>>        <<U.RAO>>15920000
                  BEGIN                                        <<U.RAO>>15925000
                  PARSE'ERR(-FILELABELNOLABEL, PARMPTR);       <<01200>>15930000
                  TAPELABELLEN := 0;  <<RESET>>                <<U.RAO>>15935000
                  END;                                         <<U.RAO>>15940000
               FLAGLABELEDTAPE := TRUE;                        <<01099>>15945000
            END;                                               <<U.RAO>>15950000
                                                               <<U.RAO>>15955000
            <<FORMS>>                                          <<U.RAO>>15960000
            IF NOT CHECKFORMMSG THEN RETURN;                   <<U.RAO>>15965000
                                                               <<U.RAO>>15970000
            <<LABEL=>>                                         <<U.RAO>>15975000
            IF NOT CHECKLABELDATA THEN RETURN;                 <<U.RAO>>15980000
                                                               <<U.RAO>>15985000
            <<LOCK>>                                           <<U.RAO>>15990000
            BEGIN                                              <<U.RAO>>15995000
               AOPTIONS.LOCKING := TRUE;                       <<U.RAO>>16000000
               IF = AND FLAGDYNLOCKING THEN                    <<U.RAO>>16005000
                  PARSE'ERR(-FILENOLOCKLOCK, PARMPTR);         <<01200>>16010000
               FLAGDYNLOCKING := TRUE;                         <<U.RAO>>16015000
            END;                                               <<U.RAO>>16020000
                                                               <<U.RAO>>16025000
            <<NOLOCK>>                                         <<U.RAO>>16030000
            BEGIN                                              <<U.RAO>>16035000
               AOPTIONS.LOCKING := FALSE;                      <<04.RO>>16040000
               IF <> THEN   <<INCONSISTENT>>                   <<U.RAO>>16045000
                  PARSE'ERR(-FILELOCKNOLOCK, PARMPTR);         <<01200>>16050000
               FLAGDYNLOCKING := TRUE;                         <<U.RAO>>16055000
            END;                                               <<U.RAO>>16060000
                                                               <<U.RAO>>16065000
            <<WAIT>>                                           <<U.RAO>>16070000
            BEGIN                                              <<U.RAO>>16075000
               AOPTIONS.NOWAIT := FALSE;                       <<U.RAO>>16080000
               IF <> THEN                                      <<U.RAO>>16085000
                  PARSE'ERR(-FILENOWAITWAIT, PARMPTR);         <<01200>>16090000
               FLAGWAIT := TRUE;                               <<U.RAO>>16095000
            END;                                               <<U.RAO>>16100000
                                                               <<U.RAO>>16105000
            <<NOWAIT>>                                         <<U.RAO>>16110000
            BEGIN                                              <<U.RAO>>16115000
               AOPTIONS.NOWAIT := TRUE;                        <<U.RAO>>16120000
               IF = AND FLAGWAIT THEN                          <<U.RAO>>16125000
                  PARSE'ERR(-FILEWAITNOWAIT, PARMPTR);         <<01200>>16130000
               FLAGWAIT := TRUE;                               <<U.RAO>>16135000
            END;                                               <<U.RAO>>16140000
                                                               <<01549>>16145000
            <<STD>>                                            <<01549>>16150000
            BEGIN                                              <<01549>>16155000
            FLAGFTYPE:=TRUE;                                   <<01549>>16160000
            IF <> THEN                                         <<01549>>16165000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>16170000
                  BEGIN                                        <<01549>>16175000
                  ;  <<ALREADY SET TO STD>>                    <<01549>>16180000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>16185000
                  PARSE'ERR(-FILERIOSTD, PARMPTR);             <<01549>>16190000
                  ;                                            <<01549>>16195000
                  PARSE'ERR(-FILECIRSTD, PARMPTR);             <<01549>>16200000
                  ;                                            <<01549>>16205000
                  PARSE'ERR(-FILEMSGSTD, PARMPTR);             <<01549>>16210000
                  END;                                         <<01549>>16215000
            FOPTIONS.FILETYPE:=STD;                            <<01549>>16220000
            END;                                               <<01549>>16225000
                                                               <<01549>>16230000
            <<RIO>>                                            <<01549>>16235000
            BEGIN                                              <<01549>>16240000
            FLAGFTYPE:=TRUE;                                   <<01549>>16245000
            IF <> THEN                                         <<01549>>16250000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>16255000
                  BEGIN                                        <<01549>>16260000
                  PARSE'ERR(-FILESTDRIO, PARMPTR);             <<01549>>16265000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>16270000
                  ;  <<ALREADY SET TO RIO>>                    <<01549>>16275000
                  ;                                            <<01549>>16280000
                  PARSE'ERR(-FILECIRRIO, PARMPTR);             <<01549>>16285000
                  ;                                            <<01549>>16290000
                  PARSE'ERR(-FILEMSGRIO, PARMPTR);             <<01549>>16295000
                  END;                                         <<01549>>16300000
            FOPTIONS.FILETYPE:=RIO;                            <<01549>>16305000
            END;                                               <<01549>>16310000
                                                               <<01549>>16315000
            <<NORIO>>                                          <<01549>>16320000
            BEGIN                                              <<01549>>16325000
            FLAGFTYPE:=TRUE;                                   <<01549>>16330000
            IF <> THEN                                         <<01549>>16335000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>16340000
                  BEGIN                                        <<01549>>16345000
                  ;  <<ALREADY SET TO STD>>                    <<01549>>16350000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>16355000
                  PARSE'ERR(-FILERIOSTD, PARMPTR);             <<01549>>16360000
                  ;                                            <<01549>>16365000
                  PARSE'ERR(-FILECIRSTD, PARMPTR);             <<01549>>16370000
                  ;                                            <<01549>>16375000
                  PARSE'ERR(-FILEMSGSTD, PARMPTR);             <<01549>>16380000
                  END;                                         <<01549>>16385000
            FOPTIONS.FILETYPE:=STD;                            <<01549>>16390000
            END;                                               <<01549>>16395000
                                                               <<01549>>16400000
                                                               <<01549>>16405000
            <<ENV>>                                            <<01549>>16410000
            IF NOT PROCENV THEN RETURN;                        <<01549>>16415000
                                                               <<01549>>16420000
            <<OUTQ>>                                           <<01549>>16425000
            IF NOT PROCOUTQ THEN RETURN;                       <<01549>>16430000
                                                               <<01549>>16435000
            <<MSG>>                                            <<01549>>16440000
            BEGIN                                              <<01549>>16445000
            FLAGFTYPE:=TRUE;                                   <<01549>>16450000
            IF <> THEN                                         <<01549>>16455000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>16460000
                  BEGIN                                        <<01549>>16465000
                  PARSE'ERR(-FILESTDMSG, PARMPTR);             <<01549>>16470000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>16475000
                  PARSE'ERR(-FILERIOMSG, PARMPTR);             <<01549>>16480000
                  ;                                            <<01549>>16485000
                  PARSE'ERR(-FILECIRMSG, PARMPTR);             <<01549>>16490000
                  END;                                         <<01549>>16495000
            FOPTIONS.FILETYPE:=MSG;                            <<01549>>16500000
            END;                                               <<01549>>16505000
                                                               <<01549>>16510000
            <<CIR>>                                            <<01549>>16515000
            BEGIN                                              <<01549>>16520000
            FLAGFTYPE:=TRUE;                                   <<01549>>16525000
            IF <> THEN                                         <<01549>>16530000
               CASE FOPTIONS.FILETYPE OF                       <<01549>>16535000
                  BEGIN                                        <<01549>>16540000
                  PARSE'ERR(-FILESTDCIR, PARMPTR);             <<01549>>16545000
                  ;  <<KSAM -- CANNOT BE>>                     <<01549>>16550000
                  PARSE'ERR(-FILERIOCIR, PARMPTR);             <<01549>>16555000
                  ;                                            <<01549>>16560000
                  ;  <<ALREADY SET TO CIRCULAR>>               <<01549>>16565000
                  ;                                            <<01549>>16570000
                  PARSE'ERR(-FILEMSGCIR, PARMPTR);             <<01549>>16575000
                  END;                                         <<01549>>16580000
            FOPTIONS.FILETYPE:=CIR;                            <<01549>>16585000
            END;                                               <<01549>>16590000
                                                               <<01549>>16595000
                                                               <<U.RAO>>16600000
            << DEN >>                                          <<02569>>16605000
            IF NOT PROCDENS THEN RETURN;                       <<02569>>16610000
                                                               <<02569>>16615000
         END;  <<OF CASE>>                                     <<U.RAO>>16620000
      END;  <<OF ELSE CLAUSE>>                                 <<U.RAO>>16625000
   END                                                         <<U.RAO>>16630000
      UNTIL NEXTDELIM <> SEMICOLON;                            <<U.RAO>>16635000
                                                               <<U.RAO>>16640000
<<Parse terminated because the next delimiter indicated that  ><<U.RAO>>16645000
<<what followed was not a keyword.  If it was not a carriage  ><<U.RAO>>16650000
<<return then there was a syntax error.  Since all of the     ><<U.RAO>>16655000
<<parsers of keywords with subparameters are responsible for  ><<U.RAO>>16660000
<<checking for extraneous or unexpected delimiters, the only  ><<U.RAO>>16665000
<<time the next delimiter would not be a carriage return would><<U.RAO>>16670000
<<be after one of the keywords which has no qualifiers.       ><<U.RAO>>16675000
IF NEXTDELIM <> CR THEN                                        <<U.RAO>>16680000
   BEGIN  <<HANDLE EXTRANEOUS DELIMITERS>>                     <<U.RAO>>16685000
   <<FIRST FIXUP SO PARAMETER NAME CAN BE PASSED TO CIERR>>    <<U.RAO>>16690000
   TOS := @PARMPTR;                                            <<U.RAO>>16695000
   TOS := BPS0(PARMLEN);                                       <<U.RAO>>16700000
   BPS1(X) := 0;                                               <<U.RAO>>16705000
   GETNEXT;                                                    <<U.RAO>>16710000
   IF PARSE'ONLY THEN ERRNUM := FILENOXPCTSPARM                <<01200>>16715000
   ELSE                                                        <<01200>>16720000
      CIERR(ERRNUM := FILENOXPCTSPARM, PARMPTR, 0, @BPS1);     <<01200>>16725000
   BPS1(X) := TOS;  <<RESTORE PREVIOUS VALUE OVER 0>>          <<U.RAO>>16730000
   DEL;  <<POP POINTER>>                                       <<U.RAO>>16735000
   END                                                         <<U.RAO>>16740000
ELSE                                                           <<U.RAO>>16745000
   PROCKEY := TRUE;                                            <<U.RAO>>16750000
END;  <<SUBROUTINE PROCKEY>>                                   <<U.RAO>>16755000
                                                               <<U.RAO>>16760000
<<                 *********************                   >>  <<U.RAO>>16765000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>16770000
<<                 *********************                   >>  <<U.RAO>>16775000
                                                               <<U.RAO>>16780000
<<MAIN BODY OF FILE COMMAND>>                                  <<U.RAO>>16785000
<<This code does three things, parse the file name part, invoke<<U.RAO>>16790000
<<the parse of any keywords which might be present, and do the><<U.RAO>>16795000
<<call to the routine which sets up the JDT entry.>>           <<U.RAO>>16800000
<<Note that when a failure is detected, this procedure is exited>>      16805000
<<immediately.>>                                               <<U.RAO>>16810000
                                                               <<01200>>16815000
<< NORMAL ENTRY POINT FOR :FILE COMMAND >>                     <<01255>>16820000
PARSE'ONLY := FALSE;                                           <<01200>>16825000
GOTO STARTPARSE;                                               <<01200>>16830000
                                                               <<01200>>16835000
<< PARSE'FILE'EQ IS AN ENTRY POINT TO PERFORM ONLY THE PARSE >><<01200>>16840000
<< OF A FILE EQUATION.  THE PARSED FILE EQUATION TABLE IS    >><<01200>>16845000
<< NOT ADDED TO THE JDT BUT RATHER RETURNED TO THE CALLER    >><<01200>>16850000
<< THROUGH THE 1ST PARAMETER OF THE CALL.                    >><<01200>>16855000
PARSE'FILE'EQ:                                                 <<01200>>16860000
PARSE'ONLY := TRUE;                                            <<01200>>16865000
                                                               <<01200>>16870000
STARTPARSE:                                                    <<01200>>16875000
PARMNUM := 0;                                                  <<U.RAO>>16880000
MOVE SAVEDCOMIMAGE := PARMSP,(CIS'BCOMBUFLEN);                 << I.A >>16885000
MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARMS);                  <<U.RAO>>16890000
IF NUMPARMS=0 THEN  <<LACKS REQUIRED FORMAL FILE DESIGNATOR>>  <<U.RAO>>16895000
   BEGIN                                                       <<U.RAO>>16900000
   PARMNUM := 1;                                               <<U.RAO>>16905000
   CIERR(ERRNUM := FILEREQFDESIG,PARMSP(1));                   <<U.RAO>>16910000
   RETURN;                                                     <<U.RAO>>16915000
   END;                                                        <<U.RAO>>16920000
<<FIRST STEP IS TO PARSE THE FORMAL FILE DESIGNATOR>>          <<U.RAO>>16925000
IF NOT CHECKFDESIG THEN RETURN;                                <<U.RAO>>16930000
<<HAVE VALID FORMAL FILE DESIGNATOR.  NOW LOOK FOR ACTUAL FDESIG.>>     16935000
IF NUMPARMS=1 THEN <<REQUIRES AT LEAST ONE OTHER PARM>>        <<U.RAO>>16940000
   BEGIN                                                       <<U.RAO>>16945000
   CIERR(ERRNUM := FILEREQSOMEPARM,FORMALDES(PARMLEN));        <<U.RAO>>16950000
   RETURN                                                      <<U.RAO>>16955000
   END;                                                        <<U.RAO>>16960000
IF NEXTDELIM=EQUALS THEN   <<ACTUAL DESIGNATOR PROMISED>>      <<U.RAO>>16965000
   IF NOT CHECKADESIG THEN RETURN;                             <<U.RAO>>16970000
<<CHECK FOR FILE DOMAIN>>                                      <<U.RAO>>16975000
IF NEXTDELIM=COMMA THEN   <<DOMAIN PROMISED>>                  <<U.RAO>>16980000
   IF NOT CHECKDOMAIN THEN RETURN;                             <<U.RAO>>16985000
<<THE ONLY LEGAL THING AFTER THIS IS THE KEYWORD LIST, IF ANY>>         16990000
IF (NEXTDELIM<>CR) AND (NEXTDELIM<>SEMICOLON) THEN             <<U.RAO>>16995000
   BEGIN  <<UNEXPECTED DELIMITERS, SYNTAX ERROR>>              <<U.RAO>>17000000
   GETNEXT;                                                    <<U.RAO>>17005000
   PARSE'ERR(ERRNUM := FILEXSTRTPARMCR, PARMPTR(-1));          <<01200>>17010000
   RETURN                                                      <<U.RAO>>17015000
   END;                                                        <<U.RAO>>17020000
<<NOW HAVE NAME INFO COMPLETELY PARSED.>>                      <<U.RAO>>17025000
                                                               <<U.RAO>>17030000
<<NEXT STEP IS THE PARSE OF THE PARAMETER LIST, IF PRESENT.>>  <<U.RAO>>17035000
IF NEXTDELIM = SEMICOLON THEN  <<SOME PARAMETERS EVIDENTLY EXIST>>      17040000
   IF NOT PROCKEY THEN RETURN;                                 <<U.RAO>>17045000
                                                               <<U.RAO>>17050000
<<At this point we have parsed the entire command.  If we made it   >>  17055000
<<this far, there are no obvious problems.  All parameters have been>>  17060000
<<put into the appropriate forms and saved in local variables by the>>  17065000
<<appropriate names.  It remains but to build the entry and         >>  17070000
<<insert it in the Job Directory Table.                             >>  17075000
PARMNUM := 0;                                                  <<U.RAO>>17080000
                                                               <<02569>>17085000
<< Device flag set only if one of the components is present >> <<02569>>17090000
FLAGDEV := FLAGADEV LOR FLAGDENS LOR FLAGENV LOR FLAGOUTQ;     <<02569>>17095000
                                                               <<02569>>17100000
WENTRY := FLAGS1;  <<PMASK WORD 1>>                            <<U.RAO>>17105000
WENTRY(1) := FLAGS2;  <<SECOND WORD OF PMASK>>                 <<U.RAO>>17110000
WENTRY(2) := 0;   <<NAME AND DEVICE LENGTH AND KEYWORD LEN>>   <<01549>>17115000
IF FLAGANAME THEN  <<ACTUAL DESIGNATOR PRESENT>>               <<U.RAO>>17120000
   BEGIN                                                       <<U.RAO>>17125000
   BENTRY(4) := ACTUALDESLEN;                                  <<U.RAO>>17130000
   MOVE BENTRY(NEXTENTRYX) := ACTUALDES, (ACTUALDESLEN);       <<U.RAO>>17135000
   NEXTENTRYX := NEXTENTRYX+INTEGER(ACTUALDESLEN);             <<U.RAO>>17140000
   END;                                                        <<U.RAO>>17145000
IF FLAGDEV THEN                                                <<02569>>17150000
   BEGIN           << SOME DEVICE INFO SPECIFIED >>            <<02569>>17155000
   IF FLAGADEV THEN                                            <<02569>>17160000
      BEGIN        << DEVICE NAME SPECIFIED >>                 <<02569>>17165000
   MOVE BENTRY(NEXTENTRYX) := DEV, (DEVLEN);                   <<U.RAO>>17170000
   NEXTENTRYX := NEXTENTRYX+DEVLEN;                            <<U.RAO>>17175000
      END;                                                     <<02569>>17180000
   IF FLAGDENS THEN                                            <<02569>>17185000
      BEGIN                                                    <<02569>>17190000
          MOVE BENTRY(NEXTENTRYX) := ";DEN=";                  <<02569>>17195000
          NEXTENTRYX := NEXTENTRYX + 5;                        <<02569>>17200000
          MOVE BENTRY(NEXTENTRYX) := DENS, (DENSLEN);          <<02569>>17205000
          NEXTENTRYX := NEXTENTRYX + DENSLEN;                  <<02569>>17210000
          KEYS'LEN := KEYS'LEN + DENSLEN + 5;                  <<02569>>17215000
      END;                                                     <<02569>>17220000
   IF FLAGENV THEN                                             <<01851>>17225000
      BEGIN                                                    <<01851>>17230000
         MOVE BENTRY(NEXTENTRYX) := ";ENV=";                   <<01851>>17235000
         NEXTENTRYX := NEXTENTRYX + 5;                         <<01851>>17240000
         MOVE BENTRY(NEXTENTRYX) := ENV,(ENVLEN);              <<01851>>17245000
         NEXTENTRYX := NEXTENTRYX + ENVLEN;                    <<01851>>17250000
         KEYS'LEN := KEYS'LEN + ENVLEN + 5;                    <<02569>>17255000
      END;                                                     <<01851>>17260000
   IF FLAGOUTQ THEN                                            <<01851>>17265000
      BEGIN                                                    <<01851>>17270000
         MOVE BENTRY(NEXTENTRYX) := ";OUTQ=";                  <<01851>>17275000
         NEXTENTRYX := NEXTENTRYX + 6;                         <<01851>>17280000
         MOVE BENTRY(NEXTENTRYX) := OUTQ,(OUTQLEN);            <<01851>>17285000
         NEXTENTRYX := NEXTENTRYX + OUTQLEN;                   <<01851>>17290000
         KEYS'LEN := KEYS'LEN + OUTQLEN + 6;                   <<01851>>17295000
      END;                                                     <<01851>>17300000
   IF KEYS'LEN <> 0 THEN                                       <<01851>>17305000
      BEGIN                                                    <<01851>>17310000
         KEYS'LEN := KEYS'LEN + 1;                             <<01851>>17315000
         BENTRY(NEXTENTRYX) := %15;                            <<01851>>17320000
         NEXTENTRYX := NEXTENTRYX + 1;                         <<01851>>17325000
      END;                                                     <<01851>>17330000
   BENTRY(5) := DEVLEN + KEYS'LEN;                             <<01851>>17335000
   END;                                                        <<U.RAO>>17340000
<<THIS ENDS THE VARIABLE PORTIONS OF THE WENTRY>>              <<U.RAO>>17345000
X := (NEXTENTRYX+1)&LSR(1);  <<WORD OFFSET FROM WENTRY BASE>>  <<U.RAO>>17350000
WENTRY(X) := FOPTIONS;                                         <<U.RAO>>17355000
WENTRY(X:=X+1) := AOPTIONS;                                    <<U.RAO>>17360000
TOS := NUMBUFFERS&LSL(8);                                      <<U.RAO>>17365000
TOS.(8:5) := INITALLOC;                                        <<U.RAO>>17370000
WENTRY(X:=X+1) := TOS LOR LOGICAL(DISPOSITION);                <<U.RAO>>17375000
WENTRY(X:=X+1) := RECSIZE;                                     <<U.RAO>>17380000
WENTRY(X:=X+1) := LOGICAL(NUMEXTENTS)&LSL(11) LOR LOGICAL(BLOCKFACTOR); 17385000
TOS := FILESIZE;                                               <<U.RAO>>17390000
ASSEMBLE(XCH);                                                 <<U.RAO>>17395000
WENTRY(X:=X+1) := TOS;  <<FIRST WORD OF FILESIZE>>             <<U.RAO>>17400000
WENTRY(X:=X+1) := TOS;  <<SECOND WORD>>                        <<U.RAO>>17405000
WENTRY(X:=X+1) := FILECODE;                                    <<U.RAO>>17410000
WENTRY(X:=X+1) := (LOGICAL(OUTPRI)&LSL(7)LOR LOGICAL(NUMCOPIES))&LSL(5);17415000
      WENTRY(X:=X+1) := 0;  <<USER LABELS COUNT>>              <<U.RAO>>17420000
      WENTRY(X:=X+1) := 0; << MPEV NATIVE LANGUAGE SUPPORT>>   <<06566>>17425000
      WENTRY(X:=X+1) := FORMSMSGLEN + TAPELABELLEN;            <<U.RAO>>17430000
      IF WENTRY(X) <> 0 THEN                                   <<U.RAO>>17435000
         BEGIN  <<MOVE IN OPTIONAL DATA>>                      <<U.RAO>>17440000
         TOS := (@WENTRY(X)+1)&LSL(1);  <<BYTE ADDRESS>>       <<U.RAO>>17445000
         IF FORMSMSGLEN<>0 THEN   <<MOVE IN FORMS MESSAGE>>    <<U.RAO>>17450000
            MOVE * := FORMSMSG, (FORMSMSGLEN), 2;              <<U.RAO>>17455000
         IF TAPELABELLEN<>0 THEN   <<MOVE IN TAPE LABEL DATA>> <<U.RAO>>17460000
            BEGIN                                              <<U.RAO>>17465000
            IF FORMSMSGLEN=0 THEN   <<MUST INSERT ".">>        <<U.RAO>>17470000
               BEGIN                                           <<U.RAO>>17475000
               BPS0 := ".";                                    <<U.RAO>>17480000
               TOS := TOS+1;                                   <<U.RAO>>17485000
               WENTRY(X) := WENTRY(X)+1;                       <<U.RAO>>17490000
               FORMSMSGLEN := 1;                               <<U.RAO>>17495000
               END;                                            <<U.RAO>>17500000
            MOVE * := TAPELABEL,(TAPELABELLEN),2;              <<U.RAO>>17505000
            BPS0 := ";";                                       <<U.RAO>>17510000
            WENTRY(X) := WENTRY(X)+1;                          <<U.RAO>>17515000
            TAPELABELLEN := TAPELABELLEN+1;                    <<U.RAO>>17520000
            END;                                               <<U.RAO>>17525000
         DEL;                                                  <<U.RAO>>17530000
         X := X+(FORMSMSGLEN+TAPELABELLEN+1)&LSR(1);           <<U.RAO>>17535000
         END;                                                  <<U.RAO>>17540000
IF PARSE'ONLY THEN                                             <<01200>>17545000
   BEGIN                                                       <<01200>>17550000
   << COPY LOCAL TABLE ENTRY OVER THE STRING PASSED TO     >>  <<01200>>17555000
   << PARSE'FILE'EQ.  THIS RETURNS THE PARSED FILE         >>  <<01200>>17560000
   << EQUATION INFO TO THE CALLER.                         >>  <<01200>>17565000
   X := (X+1) * 2;                                             <<01200>>17570000
   MOVE PARMSP := BENTRY, (X);                                 <<01200>>17575000
   END                                                         <<01200>>17580000
ELSE                                                           <<01200>>17585000
   BEGIN                                                       <<01200>>17590000
   << ADD TABLE ENTRY TO JDT >>                                <<01200>>17595000
   IF ADDJTENTRY(FORMALDES,GROUP,ACCT,-3,X+1,WENTRY) <> 0 THEN <<01200>>17600000
      CIERR(ERRNUM := FEQTABFULLXPLCT);  << INSERT FAILED >>   <<01200>>17605000
   END;                                                        <<01200>>17610000
RETURN;                                                        <<U.RAO>>17615000
                                                               <<U.RAO>>17620000
<<  ***  END OF CXFILE  ***   >>                               <<U.RAO>>17625000
                                                               <<U.RAO>>17630000
<<  ***   CXBUILD   ***  >>                                    <<U.RAO>>17635000
CXBUILD:                                                       <<U.RAO>>17640000
                                                               <<U.RAO>>17645000
<<This differs from the procedure for the FILE command primarily>>      17650000
<<in that we do an FOPEN instead of calling jobtables.          >>      17655000
                                                               <<U.RAO>>17660000
BUILDFLAG := TRUE;                                             <<U.RAO>>17665000
PARSE'ONLY := FALSE;                                           <<01255>>17670000
FOPTIONS := %2000;   <<DISALLOWS FILE EQUATES  >>              <<U.RAO>>17675000
PARMNUM := 0;                                                  <<U.RAO>>17680000
MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARMS);                  <<U.RAO>>17685000
IF NUMPARMS=0 THEN  <<LACKS REQUIRED FILE NAME>>               <<U.RAO>>17690000
   BEGIN                                                       <<U.RAO>>17695000
   PARMNUM := 1;                                               <<U.RAO>>17700000
   CIERR(ERRNUM := BLDREQFILENAME, PARMSP(1));                 <<U.RAO>>17705000
   END                                                         <<U.RAO>>17710000
ELSE IF BLDCHECKFDESIG THEN  <<FILE NAME IS VALID>>            <<U.RAO>>17715000
IF NEXTDELIM=COMMA THEN   <<DOMAIN NOT APPROPRIATE>>           <<U.RAO>>17720000
   BEGIN                                                       <<U.RAO>>17725000
   GETNEXT;                                                    <<U.RAO>>17730000
   CIERR(ERRNUM := BLDDOMAINNOT,PARMPTR);                      <<U.RAO>>17735000
   END                                                         <<U.RAO>>17740000
ELSE IF NEXTDELIM=EQUALS THEN  <<ACTUAL DESIGNATOR NOT APPROPRIATE>>    17745000
   BEGIN                                                       <<U.RAO>>17750000
   GETNEXT;                                                    <<U.RAO>>17755000
   CIERR(ERRNUM := BLDNOTADES,PARMPTR);                        <<U.RAO>>17760000
   END                                                         <<U.RAO>>17765000
ELSE  <<NAME SEEMS OK>>                                        <<U.RAO>>17770000
   BEGIN                                                       <<U.RAO>>17775000
   IF NEXTDELIM=SEMICOLON THEN  <<APPARENTLY KEYWORD LIST FOLLOWS>>     17780000
      IF NOT PROCKEY THEN   <<PARSE OF KEYWORD LIST FAILED>>   <<U.RAO>>17785000
         RETURN;                                               <<U.RAO>>17790000
   <<NOW JUST DO BUILD - FOPEN, FOLLOWED BY FCLOSE>>           <<U.RAO>>17795000
   SAVEDELIM := DEV(DEVLEN);                                   <<02053>>17800000
   DEV(DEVLEN) := %15; <<GET'DEV'PARMS WILL NOT GET CONFUSED >><<01835>>17805000
   IF FILECODE = 1090 THEN                                     <<00506>>17810000
      BEGIN                                                    <<00506>>17815000
      BLOCKFACTOR:=32;                                         <<00506>>17820000
      FOPTIONS.(13:1):=1;                                      <<00506>>17825000
      RECSIZE:=-256;                                           <<00506>>17830000
      IF NUMEXTENTS <= 0 THEN NUMEXTENTS:=1;                   <<00506>>17835000
      TOS:=FILESIZE:=FILESIZE+DOUBLE(BLOCKFACTOR);             <<00506>>17840000
      FILESIZE:=FILESIZE/DOUBLE(BLOCKFACTOR*NUMEXTENTS);       <<00506>>17845000
      TOS:=NUMEXTENTS*BLOCKFACTOR;                             <<00506>>17850000
      ASSEMBLE(DIVL);                                          <<00506>>17855000
      IF TOS <> 0 THEN FILESIZE:=FILESIZE+1D;                  <<00506>>17860000
      ASSEMBLE(DEL);                                           <<00506>>17865000
      FILESIZE:=FILESIZE*DOUBLE((BLOCKFACTOR)*NUMEXTENTS);     <<00506>>17870000
      FILESIZE:=FILESIZE-DOUBLE(BLOCKFACTOR);                  <<00506>>17875000
      FLAGBLOCKFACTOR:=1;                                      <<00506>>17880000
      END;                                                     <<00506>>17885000
   TOS := 0;  <<RETURN SPACE FOR FOPEN>>                       <<U.RAO>>17890000
   TOS := @FORMALDES;                                          <<U.RAO>>17895000
   TOS := FOPTIONS;                                            <<U.RAO>>17900000
   TOS := %100;   <<EXCLUSIVE ACCESS>>                         <<U.RAO>>17905000
   TOS := RECSIZE;                                             <<U.RAO>>17910000
   TOS := @DEV;                                                <<U.RAO>>17915000
   TOS := 0;  <<FORMS MESSAGE>>                                <<U.RAO>>17920000
   TOS := 0;   <<USER LABELS>>                                 <<U.RAO>>17925000
   TOS := BLOCKFACTOR;                                         <<U.RAO>>17930000
   TOS := 1;   <<NUMBER OF BUFFERS FOR OPEN>>                  <<U.RAO>>17935000
   TOS := FILESIZE;                                            <<U.RAO>>17940000
   TOS := NUMEXTENTS;                                          <<U.RAO>>17945000
   TOS := INITALLOC;                                           <<U.RAO>>17950000
   TOS := FILECODE;                                            <<U.RAO>>17955000
   <<NOW DO OPTION VARIABLE MASK>>                             <<U.RAO>>17960000
   TOS := %16020;   <<PROTOTYPE SPL OPTION VAR MASK>>          <<U.RAO>>17965000
   TOS.(6:1)  := FLAGRECSIZE;                                  <<U.RAO>>17970000
   TOS.(7:1)  := FLAGADEV;                                     <<02569>>17975000
   TOS.(10:1) := FLAGBLOCKFACTOR;                              <<U.RAO>>17980000
   TOS.(12:1) := FLAGFILESIZE;                                 <<U.RAO>>17985000
   TOS.(13:1) := FLAGNUMEXTS;                                  <<U.RAO>>17990000
   TOS.(14:1) := FLAGINITALLOC;                                <<U.RAO>>17995000
   TOS.(15:1) := FLAGFILECODE;                                 <<U.RAO>>18000000
   <<MASK IS COMPLETE, ALL PARMS STACKED.>>                    <<U.RAO>>18005000
   ASSEMBLE(PCAL DFOPEN);                                      <<00200>>18010000
   IF CARRY THEN                                               <<U.RAO>>18015000
      BEGIN  <<OPEN FAILED ON NEW FILE>>                       <<U.RAO>>18020000
      FERROR'(*, PARMNUM);                                     <<U.RAO>>18025000
      QUALIFYFILENAME(FORMALDES, BENTRY);                      <<U.RAO>>18030000
      CIERR(ERRNUM := BLDFAILED,,0,@BENTRY);                   <<U.RAO>>18035000
      END                                                      <<U.RAO>>18040000
   ELSE                                                        <<U.RAO>>18045000
      BEGIN  <<TRY CLOSE>>                                     <<U.RAO>>18050000
      FCLOSE(S0,DISPOSITION,0);                                <<U.RAO>>18055000
      IF CARRY THEN                                            <<U.RAO>>18060000
         BEGIN                                                 <<U.RAO>>18065000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>18070000
         QUALIFYFILENAME(FORMALDES,BENTRY);                    <<U.RAO>>18075000
         CIERR(ERRNUM := BLDFAILED,,0,@BENTRY);                <<U.RAO>>18080000
         END;                                                  <<U.RAO>>18085000
      END;                                                     <<U.RAO>>18090000
   DEV(DEVLEN) := SAVEDELIM;                                   <<02053>>18095000
   END;                                                        <<U.RAO>>18100000
END;   <<PROCEDURE CXFILE/CXBUILD>>                            <<U.RAO>>18105000
$PAGE "FILE MANAGEMENT COMMAND EXECUTORS--RESET,SAVE,PURGE,RENAME"      18110000
$CONTROL    SEGMENT  =  CIFILEM                                         18115000
                                                                        18120000
      PROCEDURE CXRESET EXECUTORHEAD;                                   18125000
      OPTION PRIVILEGED,UNCALLABLE;                                     18130000
      BEGIN                                                             18135000
<< RESET, CRESET commands:  If a particular equate is to be >> <<U.RAO>>18140000
<< reset, then find it in the JDT, remove it and contract the>><<U.RAO>>18145000
<< table.  If all are to be reset, just delete the table.   >> <<U.RAO>>18150000
      DOUBLE ARRAY PARMS(0:1) =Q;                              <<U.RAO>>18155000
      BYTE POINTER BADPARM = PARMS+2;                          <<U.RAO>>18160000
      LOGICAL LBADPARM = BADPARM;                              <<U.RAO>>18165000
      ARRAY QARRAY(*) = Q + 0;                                 <<06567>>18170000
      INTEGER PCBGLOBLOC;                                      <<06567>>18175000
      INTEGER NUMPARMS;                                        <<U.RAO>>18180000
      INTEGER                                                           18185000
        JDTEND = DB+6,                                         <<U.RAO>>18190000
        JDTJCW = DB+5,    <<JOB CONTROL TABLE>>                <<U.RAO>>18195000
         JDTLINEEQ=DB+4,                                                18200000
         JDTFILEEQ=DB+3;                                                18205000
                                                                        18210000
      ARRAY                                                             18215000
        JDTJCWARR(@) = DB+5,  <<POINTS TO JCW TABLE>>          <<U.RAO>>18220000
         JDTLINE(@) = DB+4,                                             18225000
         JDTFILE(@) = DB+3;                                             18230000
      LOGICAL BLANK := "  ";  <<FOR BPNTR>>                    <<U.RAO>>18235000
<<>>                                                           <<U.RAO>>18240000
      LOGICAL X2 = PARMS+1;                                    <<U.RAO>>18245000
      LOGICAL GPNTR := 0;                                      <<U.RAO>>18250000
      LOGICAL APNTR := 0;                                      <<U.RAO>>18255000
      BYTE POINTER GROUP=GPNTR,BPNTR:=@BLANK,ACCNT=APNTR,FORMDES=PARMS; 18260000
      INTEGER TNUM;                                                     18265000
      ENTRY CXCRESET;                                                   18270000
                                                                        18275000
      IF FALSE THEN                                                     18280000
         BEGIN                                                          18285000
CXCRESET:                                                               18290000
         TNUM := 4;           <<LINE EQUATION TABLE>>                   18295000
         END ELSE TNUM := 3;  <<FILE EQUATION TABLE>>                   18300000
      MYCOMMAND(PARMSP,,2,NUMPARMS,PARMS);                     <<U.RAO>>18305000
      IF <> OR NUMPARMS=0 THEN                                 <<U.RAO>>18310000
         BEGIN  <<PARAMETER SPECIFICATION ERROR>>              <<U.RAO>>18315000
         IF = THEN PARMNUM := 1 ELSE PARMNUM := 2;             <<U.RAO>>18320000
         TOS := ERRNUM := (IF TNUM=3 THEN RESETPARMERR         <<U.RAO>>18325000
                                     ELSE CRESETPARMERR);      <<U.RAO>>18330000
         IF PARMNUM = 1 THEN TOS := @PARMSP(1)                 <<U.RAO>>18335000
                        ELSE TOS := @FORMDES;                  <<U.RAO>>18340000
         CIERR(*,*);                                           <<U.RAO>>18345000
         RETURN                                                <<U.RAO>>18350000
         END;                                                  <<U.RAO>>18355000
      IF FORMDES="@" AND X2=%443 THEN                          <<U.RAO>>18360000
         BEGIN<<ALL FILES ELIMINATED>>                                  18365000
         TOS := LOCKJIR;<<LOCK DOWN JOB SIR>>                           18370000
         PXGLOBAL;                                             <<06567>>18375000
         EXCHANGEDB(PXG'JDTDST);                               <<06567>>18380000
         IF TNUM = 3 THEN                                               18385000
         <<:FILE RESET>>                                                18390000
         IF JDTFILEEQ <> JDTLINEEQ THEN                                 18395000
         BEGIN                                                          18400000
            MOVE JDTFILE := JDTLINE,(JDTEND-JDTLINEEQ);                 18405000
            JDTEND := JDTEND-JDTLINEEQ+JDTFILEEQ;              <<U.RAO>>18410000
            JDTJCW := JDTJCW-JDTLINEEQ+JDTFILEEQ;              <<U.RAO>>18415000
            JDTLINEEQ := JDTFILEEQ;                                     18420000
         END ELSE ELSE                                                  18425000
         <<:CLINE RESET>>                                               18430000
            BEGIN   <<MOVE JCW TABLE UP>>                      <<U.RAO>>18435000
            MOVE JDTLINE := JDTJCWARR,(JDTEND-JDTJCW);         <<U.RAO>>18440000
            JDTEND := JDTEND-JDTJCW+JDTLINEEQ;                 <<U.RAO>>18445000
            JDTJCW := JDTLINEEQ;                               <<U.RAO>>18450000
            END;                                               <<U.RAO>>18455000
         EXCHANGEDB(0);                                                 18460000
         UNLOCKJIR (*);                                                 18465000
         END                                                            18470000
      ELSE                                                              18475000
         BEGIN<<INDIVIDUAL FILE>>                                       18480000
        TOS:=CHECKFILENAME'(PARMS&LSR(8),GPNTR,APNTR,LBADPARM);<<U.RAO>>18485000
         IF < THEN  <<PROBLEM PARSING FILE NAME>>              <<U.RAO>>18490000
            BEGIN                                              <<U.RAO>>18495000
            PARMNUM := 1;                                      <<U.RAO>>18500000
            ERRNUM := S0;                                      <<U.RAO>>18505000
            CIERR(*,BADPARM);                                  <<U.RAO>>18510000
            END                                                <<U.RAO>>18515000
         ELSE IF > THEN   <<SYSTEM DEFINED FILE>>              <<U.RAO>>18520000
            BEGIN                                              <<U.RAO>>18525000
            PARMNUM := 1;                                      <<U.RAO>>18530000
            CIERR(ERRNUM := REQFORMALFDESIG, FORMDES);         <<U.RAO>>18535000
            END                                                <<U.RAO>>18540000
         ELSE                                                  <<U.RAO>>18545000
            BEGIN                                              <<U.RAO>>18550000
            <<HAVE VALID FORMAL FILE DESIGNATOR. IT NOW REMAINS<<U.RAO>>18555000
            <<TO ATTEMPT TO REMOVE THIS FILE EQUATE>>          <<U.RAO>>18560000
            IF GPNTR = 0 THEN GPNTR := @BPNTR; <<SET TO BLANK>><<U.RAO>>18565000
            IF APNTR = 0 THEN APNTR := @BPNTR;                 <<U.RAO>>18570000
            IF XREMJTENTRY(FORMDES,GROUP,ACCNT,TNUM) <> 0 THEN <<U.RAO>>18575000
               BEGIN                                           <<U.RAO>>18580000
               TOS := IF TNUM=3 THEN ERRNUM := -FEQNOTFOUND    <<04785>>18585000
                               ELSE ERRNUM := -ERRLNOTFOUND;   <<04785>>18590000
               CIERR(*,FORMDES);                               <<U.RAO>>18595000
               END;                                            <<U.RAO>>18600000
            END;                                               <<U.RAO>>18605000
         END;                                                  <<U.RAO>>18610000
      END;<<CXRESET>>                                                   18615000
PROCEDURE CXRENAME EXECUTORHEAD;                                        18620000
   OPTION PRIVILEGED, UNCALLABLE;                                       18625000
BEGIN                                                                   18630000
LOGICAL DL := %26015;  <<COMMA, CR>>                           <<U.RAO>>18635000
INTEGER NUMPARMS;                                              <<U.RAO>>18640000
DOUBLE ARRAY PARMS(0:3)=Q;                                     <<U.RAO>>18645000
BYTE POINTER OLDFNAME = PARMS;                                 <<U.RAO>>18650000
BYTE OLDFNAMELEN = PARMS+1;                                    <<U.RAO>>18655000
BYTE POINTER NEWFNAME = PARMS+2;                               <<U.RAO>>18660000
BYTE POINTER TEMPPARM = PARMS+4;                               <<U.RAO>>18665000
BYTE TEMPPARMLEN = PARMS+5;                                    <<U.RAO>>18670000
BYTE POINTER ERRPTR = PARMS+6;                                 <<U.RAO>>18675000
INTEGER FOPTIONS := %2001;  <<OLD PERM., DISALLOW FILE EQ.>>   <<U.RAO>>18680000
BYTE ARRAY FULLFILENAME(0:35);                                 <<U.RAO>>18685000
                                                               <<U.RAO>>18690000
MYCOMMAND(PARMSP,DL,4,NUMPARMS,PARMS);                         <<U.RAO>>18695000
IF NUMPARMS > 3 THEN                                           <<U.RAO>>18700000
   BEGIN  <<TOO MANY PARAMETERS>>                              <<U.RAO>>18705000
   PARMNUM := 4;                                               <<U.RAO>>18710000
   CIERR(ERRNUM := RENAME2MP, ERRPTR);                         <<U.RAO>>18715000
   END                                                         <<U.RAO>>18720000
ELSE IF NUMPARMS=0 THEN                                        <<U.RAO>>18725000
   BEGIN  <<EXPECTED OLD FILE NAME>>                           <<U.RAO>>18730000
   PARMNUM := 1;                                               <<U.RAO>>18735000
   CIERR(ERRNUM := RENAMEREQOLDNAME, PARMSP(1));               <<U.RAO>>18740000
   END                                                         <<U.RAO>>18745000
ELSE IF NUMPARMS=1 THEN                                        <<U.RAO>>18750000
   BEGIN  <<EXPECTED NEW FILE NAME>>                           <<U.RAO>>18755000
   PARMNUM := 2;                                               <<U.RAO>>18760000
   CIERR(ERRNUM := RENAMEREQNEWNAME, OLDFNAME(OLDFNAMELEN));   <<U.RAO>>18765000
   END                                                         <<U.RAO>>18770000
ELSE IF CIBADFILENAME(ERRNUM,PARMS) THEN                       <<U.RAO>>18775000
   PARMNUM := 1  <<FIRST FILE NAME FAILED TO PARSE>>           <<U.RAO>>18780000
ELSE IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN                    <<U.RAO>>18785000
   PARMNUM := 2                                                <<U.RAO>>18790000
ELSE                                                           <<U.RAO>>18795000
   BEGIN                                                       <<U.RAO>>18800000
   <<WE KNOW THAT WE HAVE AT LEAST TWO GOOD PARMS.  NOW WE>>   <<U.RAO>>18805000
   <<START GETTING TO THE HEART OF THE MATTER>>                <<U.RAO>>18810000
   IF NUMPARMS = 3 THEN  <<CHECK FOR "TEMP">>                  <<U.RAO>>18815000
      IF (TEMPPARMLEN <> 4) OR (TEMPPARM <> "TEMP") THEN       <<U.RAO>>18820000
         BEGIN                                                 <<U.RAO>>18825000
         PARMNUM := 3;                                         <<U.RAO>>18830000
         CIERR(ERRNUM := RENAMEEXPECTTEMP,TEMPPARM);           <<U.RAO>>18835000
         RETURN                                                <<U.RAO>>18840000
         END                                                   <<U.RAO>>18845000
      ELSE                                                     <<U.RAO>>18850000
         FOPTIONS := %2002;  <<OLD TEMP, DISALLOW FILE EQ.>>   <<U.RAO>>18855000
   TOS := FOPEN(OLDFNAME,FOPTIONS,%10500); <<NOBUF,EXC,KSAM>>  <<06.RO>>18860000
   IF CARRY THEN  <<OPEN ON OLD FILE FAILED>>                  <<U.RAO>>18865000
      BEGIN                                                    <<U.RAO>>18870000
      FERROR'(*,PARMNUM);                                      <<U.RAO>>18875000
      QUALIFYFILENAME(OLDFNAME,FULLFILENAME);                  <<U.RAO>>18880000
      CIERR(ERRNUM := RENAMEOLDFFSERR,,0,@FULLFILENAME);       <<U.RAO>>18885000
      END                                                      <<U.RAO>>18890000
   ELSE  <<OPEN SUCCEEDED>>                                    <<U.RAO>>18895000
      BEGIN   <<TRY NEW NAME>>                                 <<U.RAO>>18900000
      FRENAME(S0,NEWFNAME);                                    <<U.RAO>>18905000
      IF CARRY THEN   <<RENAME FAILED>>                        <<U.RAO>>18910000
         BEGIN                                                 <<U.RAO>>18915000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>18920000
         CIERR(ERRNUM := RENAMEFAILED);                        <<U.RAO>>18925000
         END                                                   <<U.RAO>>18930000
      ELSE   <<NOW JUST CLOSE THE NEWLY NAMED FILE>>           <<U.RAO>>18935000
         BEGIN                                                 <<U.RAO>>18940000
         FCLOSE(S0,0,0);                                       <<U.RAO>>18945000
         IF CARRY THEN   <<CLOSE SOMEHOW FAILED>>              <<U.RAO>>18950000
            BEGIN                                              <<U.RAO>>18955000
            FERROR'(*,PARMNUM);                                <<U.RAO>>18960000
            CIERR(ERRNUM := RENAMECLSFAILED);                  <<U.RAO>>18965000
            END;                                               <<U.RAO>>18970000
         END;                                                  <<U.RAO>>18975000
      END;                                                     <<U.RAO>>18980000
   END;                                                        <<U.RAO>>18985000
END;                                                           <<U.RAO>>18990000
PROCEDURE CXPURGE EXECUTORHEAD;                                         18995000
   OPTION PRIVILEGED, UNCALLABLE;                                       19000000
BEGIN                                                                   19005000
DOUBLE DL := [8/",",8/";",8/%15,8/0]D;  <<DELIMITERS>>         <<U.RAO>>19010000
EQUATE                                                         <<U.RAO>>19015000
   SEMI = 1;                                                   << I.A >>19020000
INTEGER NUMPARMS;                                              <<U.RAO>>19025000
INTEGER FCHECKCODE = NUMPARMS;                                 <<U.RAO>>19030000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>19035000
BYTE POINTER FILENAME = PARMS;                                 <<U.RAO>>19040000
BYTE FILENAMELEN = PARMS+1;                                    <<U.RAO>>19045000
LOGICAL FILEDATA = PARMS+1;                                    <<U.RAO>>19050000
BYTE POINTER TEMPPARM = PARMS+2;                               <<U.RAO>>19055000
BYTE TEMPPARMLEN = PARMS+3;                                    <<U.RAO>>19060000
BYTE POINTER EXTRAPARM = PARMS+4;                              <<U.RAO>>19065000
BYTE ARRAY TEMPFILENAME(0:35);  <<FOR ERROR REPORTING>>        <<U.RAO>>19070000
LOGICAL FOPTIONS := %2001;   <<OLD PERM, DISALLOW FILE EQ.>>   <<U.RAO>>19075000
EQUATE DELETE = 4,                                             <<U.RAO>>19080000
       AOPTIONS = %10501;                                      <<U.RAO>>19085000
DEFINE DELIMITER=FILEDATA.(11:5)#;                             <<U.RAO>>19090000
                                                               <<U.RAO>>19095000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>19100000
IF NUMPARMS > 2 THEN                                           <<U.RAO>>19105000
   BEGIN  <<TOO MANY PARAMETERS>>                              <<U.RAO>>19110000
   PARMNUM := 3;                                               <<U.RAO>>19115000
   CIERR(ERRNUM := PURGE2MP, FILENAME );                       <<06020>>19120000
   END                                                         <<U.RAO>>19125000
ELSE IF NUMPARMS = 0 THEN                                      <<U.RAO>>19130000
   BEGIN <<TOO FEW PARAMETERS>>                                <<U.RAO>>19135000
   PARMNUM := 1;                                               <<U.RAO>>19140000
   CIERR(ERRNUM := PURGEREQFNAME, PARMSP(1));                  <<U.RAO>>19145000
   END                                                         <<U.RAO>>19150000
ELSE IF CIBADFILENAME(ERRNUM,PARMS) THEN                       <<U.RAO>>19155000
   PARMNUM := 1                                                <<U.RAO>>19160000
ELSE                                                           <<U.RAO>>19165000
   BEGIN                                                       <<U.RAO>>19170000
   <<CHECK SEPARATING DELIMITER>>                              <<U.RAO>>19175000
   IF DELIMITER=SEMI THEN                                      <<U.RAO>>19180000
      CIERR(ERRNUM := -PURGESEMICOLON,  FILENAME(FILENAMELEN));<<04785>>19185000
   <<HAVE VALID FILE NAME.  CHECK FOR "TEMP">>                 <<U.RAO>>19190000
   IF NUMPARMS = 2 THEN  <<EXPECT "TEMP">>                     <<U.RAO>>19195000
      IF (TEMPPARMLEN<>4) OR (TEMPPARM<>"TEMP") THEN           <<U.RAO>>19200000
         BEGIN                                                 <<U.RAO>>19205000
         PARMNUM := 2;                                         <<U.RAO>>19210000
         CIERR(ERRNUM := PURGEEXPECTTEMP, TEMPPARM);           <<U.RAO>>19215000
         RETURN                                                <<U.RAO>>19220000
         END                                                   <<U.RAO>>19225000
      ELSE                                                     <<U.RAO>>19230000
         FOPTIONS := %2002;  <<OLD TEMP, DISALLOW FILE EQ.>>   <<U.RAO>>19235000
   TOS :=DFOPEN(FILENAME,FOPTIONS,AOPTIONS);                   <<00200>>19240000
   IF CARRY THEN  <<OPEN FAILED>>                              <<U.RAO>>19245000
      BEGIN                                                    <<U.RAO>>19250000
      FCHECK(S0,FCHECKCODE);                                   <<U.RAO>>19255000
      IF FCHECKCODE<>52 AND FCHECKCODE<>53 AND FCHECKCODE<>58  <<U.RAO>>19260000
         THEN                                                  <<U.RAO>>19265000
         BEGIN   <<SERIOUS PURGE ERROR>>                       <<U.RAO>>19270000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>19275000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>19280000
         CIERR(ERRNUM := PURGEFOPENFAILD,,0,@TEMPFILENAME);    <<U.RAO>>19285000
         END                                                   <<U.RAO>>19290000
      ELSE                                                     <<U.RAO>>19295000
         BEGIN                                                 <<U.RAO>>19300000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>19305000
         CIERR(ERRNUM := -PURGEFNOTFOUND,FILENAME,0,           <<04785>>19310000
     @TEMPFILENAME);                                           <<04785>>19315000
         END                                                   <<U.RAO>>19320000
      END                                                      <<U.RAO>>19325000
   ELSE                                                        <<U.RAO>>19330000
      BEGIN <<GOOD OPEN>>                                      <<U.RAO>>19335000
      FCLOSE(S0,DELETE,0);                                     <<U.RAO>>19340000
      IF CARRY THEN                                            <<U.RAO>>19345000
         BEGIN  <<CLOSE FAILED>>                               <<U.RAO>>19350000
         FERROR'(*,PARMNUM);                                   <<U.RAO>>19355000
         QUALIFYFILENAME(FILENAME,TEMPFILENAME);               <<U.RAO>>19360000
         CIERR(ERRNUM := PURGECLOSEFAILD,,0,@TEMPFILENAME);    <<U.RAO>>19365000
         END;                                                  <<U.RAO>>19370000
      END;                                                     <<U.RAO>>19375000
   END;                                                        <<U.RAO>>19380000
END;  <<CXPURGE>>                                              <<U.RAO>>19385000
PROCEDURE MAKEFN(FN);                                          <<04784>>19390000
BYTE ARRAY FN; <<MINIMUM OF 9 CHARACTERS >>                    <<04784>>19395000
OPTION PRIVILEGED,UNCALLABLE;                                  <<*7882>>19400000
BEGIN                                                          <<04784>>19405000
<<*********************************************************>>  <<04784>>19410000
<<                                                         >>  <<04784>>19415000
<<                 M A K E F N                             >>  <<04784>>19420000
<<*********************************************************>>  <<04784>>19425000
COMMENT.                                                       <<04784>>19430000
  This procedure will use the chronos intrinsics to generate   <<04784>>19435000
a file name which is used by the SAVE command to temporarily   <<04784>>19440000
create a file to save $OLDPASS to to avoid the problem of      <<04784>>19445000
running into duplicate temporary file names.  This file        <<04784>>19450000
will be used to rename $OLDPASS to and then saved as a         <<04784>>19455000
permanent file, and later renamed again to the desired file    <<04784>>19460000
name specified by the user.                                    <<04784>>19465000
CHRONOS RETURN THE FOLLOWING THREE WORDS:                      <<04784>>19470000
       00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15         <<04784>>19475000
WORD 1:LAST 2 DIGITS OF YR : DAY OF YEAR (JULIAN SEQ)  :       <<04784>>19480000
WORD 2:          HOUR         :        MINUTE          :       <<04784>>19485000
WORD 3:        SECOND         :   TENTHS OF SECONDS    :       <<04784>>19490000
       00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15         <<04784>>19495000
This routine places the character "S" in the first position    <<04784>>19500000
of the output string, the julian day of the year into pos-     <<04784>>19505000
ition one through three (converted into characters). Minutes   <<04784>>19510000
into four and five.  And seconds into six and seven, and a     <<04784>>19515000
blank into eight                                               <<04784>>19520000
      0      1    2     3     4     5     6     7     8        <<04784>>19525000
  :   S   :   JULIAN DAY   :  HOURS    :  MINUTES  : BLANK :   <<04784>>19530000
      0      1    2     3     4     5     6     7     8        <<04784>>19535000
A secondary entry point MAKEFN' is used whenever duplicate     <<04784>>19540000
names occur.  In this circumstance as attempt is make to stay  <<04784>>19545000
within the same day and hour by incrementing minutes from the  <<04784>>19550000
value 60.  If this fails the hour is reset and incremented     <<04784>>19555000
beginning with the value 24.  Should this fail the day is      <<04784>>19560000
reset and all value are incremented beginning with the value   <<04784>>19565000
367 for the day, 00 for the hour and 00, for the minute.  AS   <<04784>>19570000
a last resort the day, hour, minute string is reset to zero.   <<04784>>19575000
;                                                              <<04784>>19580000
<<*********************************************************>>  <<04784>>19585000
   LONG DTGL;                                                  <<04784>>19590000
   ARRAY DTG(*)=DTGL;                                          <<04784>>19595000
   DOUBLE DTGC=DTGL+1;                                         <<04784>>19600000
   BYTE ARRAY DTGB(*)=DTGL;                                    <<04784>>19605000
   INTEGER                                                     <<04784>>19610000
      I,                                                       <<04784>>19615000
      DAY,                                                     <<04784>>19620000
      HOUR,                                                    <<04784>>19625000
      MINUTE;   << USED BY MAKEFN' >>                          <<04784>>19630000
   ENTRY MAKEFN';                                              <<04784>>19635000
   MOVE FN := "S0000000 ";  << HOUSEKEEP >>                    <<04784>>19640000
   DTG := CALENDAR;  <<YEAR-DAY  REPLACES UPPER PART >>        <<04784>>19645000
                     << OF CHRONOS                   >>        <<04784>>19650000
   DTGC := CLOCK;    <<HOUR-MINUTE-SECOND-FRACTION   >>        <<04784>>19655000
                     << LOWER PART.                  >>        <<04784>>19660000
   I := 1; <<CONVERSION POSITION INDEX FOR JULIAN DAY>>        <<04784>>19665000
   IF DTG.(7:9) < 10 THEN                                      <<04784>>19670000
      I := 3                                                   <<04784>>19675000
   ELSE                                                        <<04784>>19680000
      IF DTG.(7:9) <100 THEN                                   <<04784>>19685000
         I := 2;                                               <<04784>>19690000
   ASCII(DTG.(7:9),10,FN(I));  << CONVERT DAY  >>              <<04784>>19695000
   I := IF DTG(1).(0:8) < 10 THEN 5 ELSE 4; <<ADJUST HOUR >>   <<04784>>19700000
                                            <<INDEX       >>   <<04784>>19705000
   IF DTGB(2) <> 0 THEN                                        <<04784>>19710000
      ASCII(DTG(1).(0:8),10,FN(I)); <<HOUR <> ZERO  >>         <<04784>>19715000
   I := IF DTG(1).(8:8) < 10 THEN 7 ELSE 6; <<ADJUST MINUTE>>  <<04784>>19720000
                                            <<INDEX        >>  <<04784>>19725000
   IF DTGB(3) <> 0 THEN                                        <<04784>>19730000
      ASCII(DTG(1).(8:8),10,FN(I)); << MINUTE <> 0  >>         <<04784>>19735000
   RETURN;  << NORMAL ENTRY >>                                 <<04784>>19740000
                                                               <<04784>>19745000
MAKEFN':                                                       <<04784>>19750000
   << SECONDARY ENTRY FOR DUPLICATE NAMES  >>                  <<04784>>19755000
   DAY := BINARY(FN(1),3);   <<CONVERT RECEIVED VALUES >>      <<04784>>19760000
   HOUR := BINARY(FN(4),2);                                    <<04784>>19765000
   MINUTE := BINARY(FN(6),2);                                  <<04784>>19770000
   IF MINUTE < 60 THEN                                         <<04784>>19775000
      BEGIN   << BUILD PHONY MINUTE NUMBER >>                  <<04784>>19780000
      MOVE FN(6) := "60";                                      <<04784>>19785000
      RETURN;                                                  <<04784>>19790000
      END;                                                     <<04784>>19795000
   IF MINUTE < 99 THEN                                         <<04784>>19800000
      BEGIN  << BUILD PHONY MINUTE NUMBER  >>                  <<04784>>19805000
      MINUTE := MINUTE + 1;                                    <<04784>>19810000
      ASCII(MINUTE,10,FN(6));                                  <<04784>>19815000
      RETURN;                                                  <<04784>>19820000
      END;                                                     <<04784>>19825000
   IF HOUR < 24 THEN                                           <<04784>>19830000
      BEGIN   << BUILD PHONY HOUR NUMBER >>                    <<04784>>19835000
      MOVE FN(4) := "2400";                                    <<04784>>19840000
      RETURN;                                                  <<04784>>19845000
      END;                                                     <<04784>>19850000
   IF HOUR < 99 THEN                                           <<04784>>19855000
      BEGIN  << BUMP PHONY HOUR NUMBER  >>                     <<04784>>19860000
      HOUR := HOUR +1;                                         <<04784>>19865000
      ASCII(HOUR,10,FN(4));                                    <<04784>>19870000
      RETURN;                                                  <<04784>>19875000
      END;                                                     <<04784>>19880000
   IF DAY < 366 THEN                                           <<04784>>19885000
      BEGIN   << BUILD PHONY DAY NUMBER >>                     <<04784>>19890000
      MOVE FN(1) :="3670000";                                  <<04784>>19895000
      RETURN;                                                  <<04784>>19900000
      END;                                                     <<04784>>19905000
   IF DAY < 999 THEN                                           <<04784>>19910000
      BEGIN  << BUMP PHONY DAY NUMBER  >>                      <<04784>>19915000
      DAY := DAY + 1;                                          <<04784>>19920000
      ASCII(DAY,10,FN(1));                                     <<04784>>19925000
      RETURN;                                                  <<04784>>19930000
      END;                                                     <<04784>>19935000
   MOVE FN(1) := "0000000";   << LAST RESORT >>                <<04784>>19940000
END;    << MAKEFN >>                                           <<04784>>19945000
PROCEDURE CXSAVE EXECUTORHEAD;                                          19950000
   OPTION PRIVILEGED, UNCALLABLE;                                       19955000
BEGIN                                                          <<U.RAO>>19960000
DOUBLE DL := [8/",",8/";",8/%15,8/0]D;  <<DELIMITERS>>         <<U.RAO>>19965000
EQUATE                                                         <<U.RAO>>19970000
   SEMI = 1;                                                   << I.A >>19975000
LOGICAL DUMMY = DL,                                            <<04784>>19980000
        TRIEDONCE := FALSE;                                    <<04784>>19985000
INTEGER NUMPARMS,                                              <<04784>>19990000
        FNUM,                                                  <<04784>>19995000
        ERRORCODE;                                             <<04784>>20000000
DOUBLE ARRAY PARMS(0:2) = Q;                                   <<U.RAO>>20005000
BYTE POINTER OLDFNAME = PARMS;                                 <<U.RAO>>20010000
BYTE OLDFNAMELEN=PARMS+1;                                      <<U.RAO>>20015000
LOGICAL FILENAMEDATA = PARMS+1;                                <<U.RAO>>20020000
DEFINE DELIMITER = FILENAMEDATA.(11:5)#;                       <<U.RAO>>20025000
BYTE POINTER NEWFNAME = PARMS+2;                               <<U.RAO>>20030000
BYTE POINTER ERRPARM = PARMS+4;                                <<U.RAO>>20035000
BYTE ARRAY TEMPFNAME(0:35);                                    <<U.RAO>>20040000
BYTE ARRAY STEMPFNAME(0:8);                                    <<04784>>20045000
BYTE POINTER SPTR;                                             <<04784>>20050000
LOGICAL LERRPTR = ERRPARM;                                     <<U.RAO>>20055000
SUBROUTINE RENAMESTEMP;                                        <<04784>>20060000
BEGIN                                                          <<04784>>20065000
<< THIS PROCEDURE IS USED WHEN THE CXSAVE PROC. GOTTEN A >>    <<04784>>20070000
<< TEMPORARY "S" FILE NAME TO RENAME $OLDPASS TO.  IT    >>    <<04784>>20075000
<< NOW NEEDS TO CLOSE THAT "S" FILE PERMANENT AND RENAME >>    <<04784>>20080000
<< IT TO THE FILE NAME DESIRED BY THE USER.              >>    <<04784>>20085000
                                                               <<04784>>20090000
<< CLOSE THE TEMP. "S" FILE SOMEHOW, PREFERABLY PERMANENT>>    <<04784>>20095000
   FCLOSE(FNUM,1,0);    << CLOSE AS PERMANENT >>               <<04784>>20100000
   IF <> THEN    << CLOSE FAILED >>                            <<04784>>20105000
   BEGIN                                                       <<04784>>20110000
      FCLOSE(FNUM,0,0);  << CLOSE WITH SAME DISPOSITION>>      <<04784>>20115000
      IF <> THEN                                               <<04784>>20120000
         FCLOSE(FNUM,-1,0);    << MUST CLOSE >>                <<04784>>20125000
      FERROR'(FNUM,PARMNUM);                                   <<04784>>20130000
      QUALIFYFILENAME(SPTR,TEMPFNAME);                         <<04784>>20135000
      CIERR(ERRNUM:=SAVETEMPCLOSE,,0,@TEMPFNAME);              <<04784>>20140000
      RETURN;                                                  <<04784>>20145000
   END;                                                        <<04784>>20150000
   FNUM := FOPEN(SPTR,1,%104); << OPEN "S" FILE >>             <<04784>>20155000
   IF <> THEN                                                  <<04784>>20160000
      BEGIN                                                    <<04784>>20165000
      QUALIFYFILENAME(SPTR,TEMPFNAME);                         <<04784>>20170000
      CIERR(ERRNUM:=SAVETEMPCLOSE,,0,@TEMPFNAME);              <<04784>>20175000
      RETURN;                                                  <<04784>>20180000
      END;                                                     <<04784>>20185000
   FRENAME(FNUM,NEWFNAME);  <<RENAME TO USERS NAME>>           <<04784>>20190000
   IF <> THEN                                                  <<04784>>20195000
      BEGIN                                                    <<04784>>20200000
      FERROR'(FNUM,PARMNUM);                                   <<04784>>20205000
      QUALIFYFILENAME(SPTR,TEMPFNAME);                         <<04784>>20210000
      FCLOSE(FNUM,-1,0);     <<MUST CLOSE>>                    <<04784>>20215000
      CIERR(ERRNUM := SAVETEMPFAIL,,0,@TEMPFNAME);             <<04784>>20220000
      RETURN;                                                  <<04784>>20225000
      END;                                                     <<04784>>20230000
   FCLOSE(FNUM,1,0);    << CLOSE NEWFNAME >>                   <<04784>>20235000
   IF <> THEN                                                  <<04784>>20240000
      FCLOSE(FNUM,-1,0);    << MUST CLOSE >>                   <<04784>>20245000
                                                               <<04784>>20250000
END;      << RENAMESTEMP >>                                    <<04784>>20255000
                                                               <<04784>>20260000
LOGICAL SUBROUTINE FCHECKERR;                                  <<04784>>20265000
BEGIN                                                          <<04784>>20270000
<< USED TO CHECK THE FILE ERROR CODE RETURNED BY INTRINSIC >>  <<04784>>20275000
<< FRENAME.  IF ERROR PRINTS ERROR MSG AND RETURNS.        >>  <<04784>>20280000
FCHECKERR := FALSE;                                            <<04784>>20285000
FCHECK(FNUM,ERRORCODE);                                        <<04784>>20290000
IF ERRORCODE <> 101 THEN                                       <<04784>>20295000
   BEGIN                                                       <<04784>>20300000
   FERROR'(FNUM,PARMNUM);                                      <<04784>>20305000
   CIERR(ERRNUM := RENAMEFAILED);                              <<04784>>20310000
   FCHECKERR := TRUE;                                          <<04784>>20315000
   END;                                                                 20320000
END;        << FCHECKERR  >>                                   <<04784>>20325000
                                                               <<U.RAO>>20330000
              <<******************************>>               <<04784>>20335000
              <<                              >>               <<04784>>20340000
              <<    M A I N   C O D E         >>               <<04784>>20345000
              <<                              >>               <<04784>>20350000
              <<******************************>>               <<04784>>20355000
MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARMS);                         <<U.RAO>>20360000
IF NUMPARMS > 2 THEN                                           <<U.RAO>>20365000
   BEGIN                                                       <<U.RAO>>20370000
   PARMNUM := 3;                                               <<U.RAO>>20375000
   CIERR(ERRNUM := SAVE2MP, ERRPARM);                          <<U.RAO>>20380000
   END                                                         <<U.RAO>>20385000
ELSE IF NUMPARMS = 0 THEN                                      <<U.RAO>>20390000
   BEGIN                                                       <<U.RAO>>20395000
   PARMNUM := 1;                                               <<U.RAO>>20400000
   CIERR(ERRNUM := SAVEREQFNAME,PARMSP(1));                    <<U.RAO>>20405000
   END                                                         <<U.RAO>>20410000
ELSE                                                           <<U.RAO>>20415000
   BEGIN                                                       <<U.RAO>>20420000
   IF DELIMITER=SEMI THEN  <<EXPECTED COMMA, FOUND ";", WARN>> <<U.RAO>>20425000
      CIERR(ERRNUM := -SAVESEMICOLON, OLDFNAME(OLDFNAMELEN));  <<04785>>20430000
   <<HAVE AT LEAST A LEGAL NUMBER OF PARMS. NOW VALIDATE THEM>><<U.RAO>>20435000
   TOS := CHECKFILENAME'(PARMS&LSR(8),DUMMY,DUMMY,LERRPTR);    <<U.RAO>>20440000
   IF < THEN  <<FILE NAME ERROR OF SOME SORT>>                 <<U.RAO>>20445000
      BEGIN                                                    <<U.RAO>>20450000
      PARMNUM := 1;                                            <<U.RAO>>20455000
      ERRNUM := S0;                                            <<U.RAO>>20460000
      CIERR(*,ERRPARM);                                        <<U.RAO>>20465000
      END                                                      <<U.RAO>>20470000
   ELSE IF > AND S0 <> 0 THEN                                  <<U.RAO>>20475000
      BEGIN <<SYSTEM DEFINED FILE - $OLDPASS?>>                <<U.RAO>>20480000
      IF TOS <> 3 THEN  <<NOT $OLDPASS>>                       <<U.RAO>>20485000
         BEGIN                                                 <<U.RAO>>20490000
         PARMNUM := 1;                                         <<U.RAO>>20495000
         CIERR(ERRNUM := SAVEEXPECTOLDPASS,OLDFNAME);          <<U.RAO>>20500000
         END                                                   <<U.RAO>>20505000
      ELSE IF NUMPARMS <> 2 THEN  <<MISSING NEW FILE NAME>>    <<U.RAO>>20510000
         BEGIN                                                 <<U.RAO>>20515000
         PARMNUM := 2;                                         <<U.RAO>>20520000
         CIERR(ERRNUM := SAVEREQFNAME, OLDFNAME(OLDFNAMELEN)); <<U.RAO>>20525000
         END                                                   <<U.RAO>>20530000
      ELSE                                                     <<U.RAO>>20535000
         BEGIN  <<HAVE $OLDPASS, CHECK NEW FILE NAME>>         <<U.RAO>>20540000
         TOS := CHECKFILENAME'(PARMS(1)&LSR(8),DUMMY,DUMMY,LERRPTR);    20545000
         IF < THEN   <<FILE NAME ERROR>>                       <<U.RAO>>20550000
            BEGIN                                              <<U.RAO>>20555000
            PARMNUM := 2;                                      <<U.RAO>>20560000
            ERRNUM := S0;                                      <<U.RAO>>20565000
            CIERR(*,ERRPARM);                                  <<U.RAO>>20570000
            END                                                <<U.RAO>>20575000
         ELSE IF > AND TOS <> 0 THEN                           <<U.RAO>>20580000
            BEGIN  <<SYS DEFINED FILE>>                        <<U.RAO>>20585000
            PARMNUM := 2;                                      <<U.RAO>>20590000
            CIERR(ERRNUM := SAVEREQFNAME,NEWFNAME);            <<U.RAO>>20595000
            END                                                <<U.RAO>>20600000
         ELSE  <<OK - LET'S DO IT>>                            <<U.RAO>>20605000
            BEGIN                                              <<U.RAO>>20610000
            FNUM:= FOPEN(,%2032,%10500);                       <<04784>>20615000
            IF <>    THEN  <<OPEN FAILED>>                     <<04784>>20620000
               BEGIN                                           <<U.RAO>>20625000
               FERROR'(FNUM,PARMNUM);                          <<04784>>20630000
               QUALIFYFILENAME(NEWFNAME,TEMPFNAME);            <<U.RAO>>20635000
               CIERR(ERRNUM := SAVEOPENOLDPASS,,0,@TEMPFNAME); <<U.RAO>>20640000
               END                                             <<U.RAO>>20645000
            ELSE  <<OPEN WORKED, NOW TRY RENAME>               <<RV.PV>>20650000
               BEGIN                                           <<U.RAO>>20655000
                   FRENAME (FNUM,NEWFNAME);                    <<04784>>20660000
                   IF <>    THEN                               <<04784>>20665000
                      BEGIN   <<RENAME FAILED >>               <<04784>>20670000
                      IF FCHECKERR THEN       <<GET FILE ERR>> <<04784>>20675000
                      RETURN                                   <<04784>>20680000
                      ELSE                                     <<04784>>20685000
                        BEGIN  << GET TEMP "S" NAME >>         <<04784>>20690000
                        @SPTR := @STEMPFNAME;                  <<04784>>20695000
TRYAGAIN:               IF TRIEDONCE THEN MAKEFN'(SPTR) ELSE   <<04784>>20700000
                                MAKEFN(SPTR);                  <<04784>>20705000
                        FRENAME(FNUM,SPTR);                    <<04784>>20710000
                        IF <> AND STEMPFNAME <> "S0000000"     <<04784>>20715000
                           THEN                                <<04784>>20720000
                           IF FCHECKERR THEN                   <<04784>>20725000
                               RETURN                          <<04784>>20730000
                               ELSE                            <<04784>>20735000
                                  BEGIN                        <<04784>>20740000
                                  TRIEDONCE := TRUE;           <<04784>>20745000
                                  GOTO TRYAGAIN;               <<04784>>20750000
                                  END                          <<04784>>20755000
                        ELSE RENAMESTEMP   <<"S" NAME TO NEWFNA<<04784>>20760000
                        END     << GET TEMP "S" NAME >>        <<04784>>20765000
                      END     << RENAME FAILED >>              <<04784>>20770000
                   ELSE                                        <<RV.PV>>20775000
                   BEGIN <<RENAME WORKED, CLOSE WITH SAVE>>    <<RV.PV>>20780000
                       FCLOSE(FNUM,1,0);                       <<04784>>20785000
                       IF <>    THEN   <<CLOSE FAILED >>       <<04784>>20790000
                       BEGIN                                   <<RV.PV>>20795000
                          FERROR'(FNUM,PARMNUM);               <<04784>>20800000
                          QUALIFYFILENAME(NEWFNAME,TEMPFNAME); <<RV.PV>>20805000
                          CIERR(ERRNUM:=SAVECLOSOLDPASS,,0,    <<RV.PV>>20810000
                                @TEMPFNAME);                   <<RV.PV>>20815000
                       END                                     <<RV.PV>>20820000
                   END;                                        <<RV.PV>>20825000
               END                                             <<U.RAO>>20830000
            END                                                <<U.RAO>>20835000
         END                                                   <<U.RAO>>20840000
      END                                                      <<U.RAO>>20845000
   ELSE  IF NUMPARMS=1 THEN  <<REGULAR FILE NAME>>             <<U.RAO>>20850000
      BEGIN                                                    <<U.RAO>>20855000
      FNUM:= FOPEN(OLDFNAME,%2002,%10500);                     <<04784>>20860000
      IF <>    THEN  <<OPEN FAILED>>                           <<04784>>20865000
         BEGIN                                                 <<U.RAO>>20870000
         FERROR'(FNUM,PARMNUM);                                <<04784>>20875000
         QUALIFYFILENAME(OLDFNAME,TEMPFNAME);                  <<U.RAO>>20880000
         CIERR(ERRNUM := SAVETEMPOPEN,,0,@TEMPFNAME);          <<U.RAO>>20885000
         END                                                   <<U.RAO>>20890000
      ELSE                                                     <<U.RAO>>20895000
         BEGIN                                                 <<U.RAO>>20900000
         FCLOSE(FNUM,1,0);                                     <<04784>>20905000
         IF <>    THEN  <<CLOSE FAILED>>                       <<04784>>20910000
            BEGIN                                              <<U.RAO>>20915000
            FERROR'(FNUM,PARMNUM);                             <<04784>>20920000
            QUALIFYFILENAME(OLDFNAME,TEMPFNAME);               <<U.RAO>>20925000
            CIERR(ERRNUM := SAVETEMPCLOSE,,0,@TEMPFNAME);      <<U.RAO>>20930000
            END                                                <<U.RAO>>20935000
         END                                                   <<U.RAO>>20940000
      END                                                      <<U.RAO>>20945000
   ELSE  <<REGULAR FILE NAME BUT 2 PARAMETERS>>                <<U.RAO>>20950000
      CIERR(ERRNUM := SAVE2MP,NEWFNAME);                       <<U.RAO>>20955000
   END;                                                        <<U.RAO>>20960000
END;  <<CXSAVE>>                                               <<U.RAO>>20965000
INTEGER PROCEDURE FORMACCESS'(LEVEL,ACCSTRING,SEC,NUMPARMS,ERRNUM);     20970000
VALUE LEVEL;                                                   <<U.RAO>>20975000
INTEGER LEVEL,  <<LEVEL OF SECURITY - 0/1/2 = FILE/GROUP/ACCT>><<U.RAO>>20980000
        NUMPARMS, <<NUMBER OF PARAMETERS ENCOUNTERED BEFORE RETURN>>    20985000
        ERRNUM;  <<THE USUAL MEANING>>                         <<U.RAO>>20990000
BYTE ARRAY ACCSTRING;  <<POINTER TO THE ACCESS LIST>>          <<U.RAO>>20995000
DOUBLE SEC;  <<THE SECURITY MATRIX TO BE RETURNED>>            <<U.RAO>>21000000
  <<RETURN VALUE IS ADDRESS OF NEXT NON-BLANK AFTER ACCSTRING>><<U.RAO>>21005000
OPTION UNCALLABLE,PRIVILEGED;                                  <<U.RAO>>21010000
                                                               <<U.RAO>>21015000
  <<THIS PROCEDURE PARSES THE SECURITY SPECIFICATION AND RETURNS THE>>  21020000
  <<MATRIX APPROPRIATE TO THE <LEVEL> IN <SEC>.  >>            <<U.RAO>>21025000
                                                               <<U.RAO>>21030000
BEGIN                                                          <<U.RAO>>21035000
LOGICAL LEVELMASK := 1;<<BIT 15=>FILE, BIT 14=>GROUP, BIT 13=>ACCT>>    21040000
BYTE POINTER STRINGPTR = FORMACCESS';                          <<U.RAO>>21045000
BYTE POINTER PERMIT;  <<USED IN ANALYZING VALIDITY OF USER LIST<<U.RAO>>21050000
<<INDIVIDUAL PARAMETER CHARACTERISTICS VARIABLES>>             <<U.RAO>>21055000
BYTE POINTER PARM;  <<POINTER TO CURRENT PARAMETER>>           <<U.RAO>>21060000
INTEGER PARMLEN;    <<LENGTH OF CURRENT PARAMETER>>            <<U.RAO>>21065000
BYTE DELIM;         <<NEXT DELIMITER AFTER PARAMETER>>         <<U.RAO>>21070000
<<VARIABLES FOR PARSE>>                                        <<U.RAO>>21075000
BYTE ARRAY PBACCESSORS(0:1)=PB :=                              <<U.RAO>>21080000
   6,3,"ANY",%7,                                               <<U.RAO>>21085000
   5,2,"AC" ,%7,                                               <<U.RAO>>21090000
   5,2,"AL" ,%3,                                               <<U.RAO>>21095000
   5,2,"GU" ,%3,                                               <<U.RAO>>21100000
   5,2,"GL" ,%3,                                               <<U.RAO>>21105000
   5,2,"CR" ,%1,                                               <<U.RAO>>21110000
   0;                                                          <<U.RAO>>21115000
BYTE ARRAY ACCESSORS(0:31);                                    <<U.RAO>>21120000
BYTE ARRAY PBACCESSMODES(0:1)=PB :=                            <<U.RAO>>21125000
   3,1,"R",                                                    <<U.RAO>>21130000
   3,1,"A",                                                    <<U.RAO>>21135000
   3,1,"W",                                                    <<U.RAO>>21140000
   3,1,"L",                                                    <<U.RAO>>21145000
   3,1,"X",                                                    <<U.RAO>>21150000
   3,1,"S",                                                    <<U.RAO>>21155000
   0;                                                          <<U.RAO>>21160000
BYTE ARRAY ACCESSMODES(0:24);                                  <<U.RAO>>21165000
<<VARIABLES FOR PROCESSING MATRIX  (ALREADY SET FOR FILE)>>    <<U.RAO>>21170000
INTEGER FACTOR := 6;  <<BIT WIDTH OF MODE FIELD IN MATRIX>>    <<U.RAO>>21175000
INTEGER BASE := 3;  <<NUMBER OF WASTE BITS IN MATRIX+1>>       <<U.RAO>>21180000
INTEGER SHIFTCOUNT;  <<USED WHEN USER HAS DUPLICATE ACCESS>>   <<U.RAO>>21185000
                                                               <<U.RAO>>21190000
<<                 *********************                   >>  <<U.RAO>>21195000
<<                 *   PRINTWARNING    *                   >>  <<U.RAO>>21200000
<<                 *********************                   >>  <<U.RAO>>21205000
                                                               <<U.RAO>>21210000
SUBROUTINE PRINTWARNING;  <<PRINTS DUPLICATE ACCESS WARNING>>  <<U.RAO>>21215000
BEGIN                                                          <<U.RAO>>21220000
CASE *(SHIFTCOUNT/FACTOR) OF                                   <<U.RAO>>21225000
   BEGIN                                                       <<U.RAO>>21230000
   CIERR(ERRNUM := -ACCESSRREDUND, PARM);  <<READ>>            <<04785>>21235000
   CIERR(ERRNUM := -ACCESSAREDUND, PARM);  <<APPEND>>          <<04785>>21240000
   CIERR(ERRNUM := -ACCESSWREDUND, PARM);  <<WRITE>>           <<04785>>21245000
   CIERR(ERRNUM := -ACCESSLREDUND, PARM);  <<LOCK>>            <<04785>>21250000
   CIERR(ERRNUM := -ACCESSXREDUND, PARM);  <<EXECUTE>>         <<04785>>21255000
   CIERR(ERRNUM := -ACCESSSREDUND, PARM);  <<SAVE>>            <<04785>>21260000
   END;                                                        <<U.RAO>>21265000
END;  <<SUBROUTINE PRINTWARNING>>                              <<U.RAO>>21270000
                                                               <<U.RAO>>21275000
<<                 *********************                   >>  <<U.RAO>>21280000
<<                 *  CHECKDUPACCESS   *                   >>  <<U.RAO>>21285000
<<                 *********************                   >>  <<U.RAO>>21290000
                                                               <<U.RAO>>21295000
SUBROUTINE CHECKDUPACCESS(ACCESSMASK);                         <<U.RAO>>21300000
VALUE ACCESSMASK;                                              <<U.RAO>>21305000
DOUBLE ACCESSMASK;                                             <<U.RAO>>21310000
BEGIN                                                          <<U.RAO>>21315000
<<THIS SUBROUTINE CHECKS FOR THE POSSIBLITY OF THE USER>>      <<U.RAO>>21320000
<<HAVING SPECIFIED AN ACCESS:USER POINT REDUNDANTLY.  IF>>     <<U.RAO>>21325000
<<SO THE ROUTINE WARNS THE USER, BUT ALLOWS IT.>>              <<U.RAO>>21330000
<<THE ESSENCE OF THE PROBLEM IS THAT WE ARE PASSED A BIT>>     <<U.RAO>>21335000
<<MASK (ACCESSMASK) INDICATING THE POINTS WE JUST PARSED.>>    <<U.RAO>>21340000
<<THIS REQUIRES US TO CAREFULLY UNPACK THE INFO FROM THE >>    <<U.RAO>>21345000
<<MASK.  THE DIFFICULTY ARISES FROM THE FACT THAT THE MASK>>   <<U.RAO>>21350000
<<IS DIFFERENT BASED ON WHETHER IT IS FOR FILE, ACCT OR GROUP>><<U.RAO>>21355000
<<THE ALGORITHM IS 1) FIND OUT WHETHER ANY BITS WERE >>        <<U.RAO>>21360000
<<REDUNDANT, THEN 2) SCAN THROUGH THOSE REDUNDANT BITS,>>      <<U.RAO>>21365000
<<IDENTIFYING THEM AS TO THEIR MEANING.  FORTUNATELY THIS>>    <<U.RAO>>21370000
<<CHECK IS DONE ON A PER USER MODE BASIS, ALLOWING US TO>>     <<U.RAO>>21375000
<<PUT OUT A REASONABLE MESSAGE.>>                              <<U.RAO>>21380000
TOS := ACCESSMASK;                                             <<U.RAO>>21385000
TOS := SEC;    <<FIRST AND DOUBLES TOGETHER FOR REDUNDANT BITS><<U.RAO>>21390000
ASSEMBLE(                                                      <<U.RAO>>21395000
   CAB,  <<TWO LEAST SIGNIFICANT WORDS ON TOS>>                <<U.RAO>>21400000
   AND;  <<MERGE                             >>                <<U.RAO>>21405000
   CAB,  <<NOW DO TWO MOST SIGNIFICANT WORDS>>                 <<U.RAO>>21410000
   CAB;                                                        <<U.RAO>>21415000
   AND);  <<MERGE, LEAVING MSW ON TOS>>                        <<U.RAO>>21420000
IF DS1<>0D THEN                                                <<U.RAO>>21425000
   BEGIN   <<SOMETHING WAS REDUNDANT, FIND IT>>                <<U.RAO>>21430000
   SHIFTCOUNT := -BASE;  <<ACCOUNTS FOR UNUSED BITS>>          <<U.RAO>>21435000
   WHILE S0<>0 DO                                              <<U.RAO>>21440000
      BEGIN                                                    <<U.RAO>>21445000
      SHIFTCOUNT := SHIFTCOUNT+1;  <<FOR SCAN IDIOSINCRACIES>> <<U.RAO>>21450000
      ASSEMBLE(SCAN);                                          <<U.RAO>>21455000
      SHIFTCOUNT := SHIFTCOUNT+XREG;                           <<U.RAO>>21460000
      PRINTWARNING;                                            <<U.RAO>>21465000
      END;                                                     <<U.RAO>>21470000
   DEL;  <<POP EXHAUSTED WORD>>                                <<U.RAO>>21475000
   SHIFTCOUNT := 16-BASE;  <<REINITIALIZE FOR SECOND WORD>>    <<U.RAO>>21480000
   WHILE S0<>0 DO                                              <<U.RAO>>21485000
      BEGIN                                                    <<U.RAO>>21490000
      SHIFTCOUNT := SHIFTCOUNT+1;  <<DITTO FOR SCAN INSTR>>    <<U.RAO>>21495000
      ASSEMBLE(SCAN);                                          <<U.RAO>>21500000
      SHIFTCOUNT := SHIFTCOUNT+XREG;                           <<U.RAO>>21505000
      PRINTWARNING;                                            <<U.RAO>>21510000
      END;                                                     <<U.RAO>>21515000
   DEL;                                                        <<U.RAO>>21520000
   END                                                         <<U.RAO>>21525000
ELSE DDEL;                                                     <<U.RAO>>21530000
END;                                                           <<U.RAO>>21535000
                                                               <<U.RAO>>21540000
<<                 *********************                   >>  <<U.RAO>>21545000
<<                 *       NEXT        *                   >>  <<U.RAO>>21550000
<<                 *********************                   >>  <<U.RAO>>21555000
                                                               <<U.RAO>>21560000
SUBROUTINE NEXT;                                               <<U.RAO>>21565000
   <<FINDS THE NEXT PARAMETER, CALCULATES ITS LENGTH,>>        <<U.RAO>>21570000
   <<SETS APPROPRIATE VARIABLES, FINDS NEXT DELIMITER>>        <<U.RAO>>21575000
BEGIN                                                          <<U.RAO>>21580000
NUMPARMS := NUMPARMS+1;                                        <<U.RAO>>21585000
SCAN STRINGPTR WHILE %6440,1;                                  <<U.RAO>>21590000
ASSEMBLE(DUP,DDUP);                                            <<U.RAO>>21595000
@PARM := TOS;                                                  <<U.RAO>>21600000
MOVE * := * WHILE AS,0;                                        <<U.RAO>>21605000
ASSEMBLE(CAB,SUB);  <<CALCULATE LENGTH>>                       <<U.RAO>>21610000
PARMLEN := TOS;                                                <<U.RAO>>21615000
SCAN * WHILE %6440,1;  <<FIND NEXT DELIM>>                     <<U.RAO>>21620000
DELIM := BPS0;                                                 <<U.RAO>>21625000
@STRINGPTR := TOS+1;                                           <<U.RAO>>21630000
END;                                                           <<U.RAO>>21635000
                                                               <<U.RAO>>21640000
<<                 *********************                   >>  <<U.RAO>>21645000
<<                 *     MAIN BODY     *                   >>  <<U.RAO>>21650000
<<                 *********************                   >>  <<U.RAO>>21655000
                                                               <<U.RAO>>21660000
<<FILE SECURITY MATRIX FORMAT>>                                <<U.RAO>>21665000
<<----------------------------------------------------------------->>   21670000
<<!   !   ! R ! R ! R ! R ! R ! R ! A ! A ! A ! A ! A ! A ! W ! W !>>   21675000
<<!   !   !ANY! AC! AL! GU! GL! CR!ANY! AC! AL! GU! GL! CR!ANY! AC!>>   21680000
<<----------------------------------------------------------------->>   21685000
<<! W ! W ! W ! W ! L ! L ! L ! L ! L ! L ! X ! X ! X ! X ! X ! X !>>   21690000
<<! AL! GU! GL! CR!ANY! AC! AL! GU! GL!(CR!ANY! AC! AL! GU! GL! CR!>>   21695000
<<----------------------------------------------------------------->>   21700000
                                                               <<U.RAO>>21705000
<<FILE SECURITY VARIABLES SET ON ENTRY>>                       <<U.RAO>>21710000
IF LEVEL = 1 THEN  <<GROUP>>                                   <<U.RAO>>21715000
   BEGIN                                                       <<U.RAO>>21720000
<<GROUP SECURITY MATRIX FORMAT>>                               <<U.RAO>>21725000
<<----------------------------------------------------------------->>   21730000
<<!   !   ! R ! R ! R ! R ! R ! A ! A ! A ! A ! A ! W ! W ! W ! W !>>   21735000
<<!   !   !ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU!>>   21740000
<<----------------------------------------------------------------->>   21745000
<<! W ! L ! L ! L ! L ! L ! X ! X ! X ! X ! X ! S ! S ! S ! S ! S !>>   21750000
<<! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!ANY! AC! AL! GU! GL!>>   21755000
<<----------------------------------------------------------------->>   21760000
   FACTOR := 5;                                                <<U.RAO>>21765000
   LEVELMASK := 2;                                             <<U.RAO>>21770000
   END                                                         <<U.RAO>>21775000
ELSE  IF > THEN  <<ACCOUNT SECURITY MATRIX>>                   <<U.RAO>>21780000
   BEGIN                                                       <<U.RAO>>21785000
<<ACCOUNT SECURITY MATRIX>>                                    <<U.RAO>>21790000
<<----------------------------------------------------------------->>   21795000
<<!   !   !   !   ! R ! R ! A ! A ! W ! W ! L ! L ! X ! X ! S ! S !>>   21800000
<<!   !   !   !   !ANY! AC!ANY! AC!ANY! AC!ANY! AC!ANY! AC!ANY! AC!>>   21805000
<<----------------------------------------------------------------->>   21810000
   BASE := 5;                                                  <<U.RAO>>21815000
   FACTOR := 2;                                                <<U.RAO>>21820000
   LEVELMASK := 4;                                             <<U.RAO>>21825000
   END;                                                        <<U.RAO>>21830000
NUMPARMS := 0;                                                 <<U.RAO>>21835000
<<ALL VARIABLES HAVE BEEN INITIALIZED (EXCEPT SEC)>>           <<U.RAO>>21840000
<<NOW WE START THE ACTUAL PROCESSING. THE SCHEME IS   >>       <<U.RAO>>21845000
<<  CHECK FOR "("                                     >>       <<U.RAO>>21850000
<<  WHILE MORE ACCESS LISTS DO                        >>       <<U.RAO>>21855000
<<     PROCESS SPECIFIED ACCESS MODES INTO ACCESS MASK>>       <<U.RAO>>21860000
<<     CHECK FOR ":"                                  >>       <<U.RAO>>21865000
<<     FOR EACH SPECIFIED ACCESSOR, LOR THE ACCESS    >>       <<U.RAO>>21870000
<<        MASK INTO THE SECURITY MATRIX               >>       <<U.RAO>>21875000
<<     END                                            >>       <<U.RAO>>21880000
<<  CHECK FOR ")"                                     >>       <<U.RAO>>21885000
                                                               <<U.RAO>>21890000
SCAN ACCSTRING WHILE %6440,1;  <<STRIP BLANKS>>                <<U.RAO>>21895000
IF BPS0 <> "(" THEN                                            <<U.RAO>>21900000
   CIERR(ERRNUM := ACCESSEXPECTLPAREN, BPS0)                   <<U.RAO>>21905000
ELSE  <<HAVE LEADING "(">>                                     <<U.RAO>>21910000
   BEGIN                                                       <<U.RAO>>21915000
   TOS := TOS+1;                                               <<U.RAO>>21920000
   SCAN * WHILE %6440,1;  <<SCAN FOR NEXT NON-BLANK>>          <<U.RAO>>21925000
   @STRINGPTR := TOS;  <<INITIALIZE STRINGPTR>>                <<U.RAO>>21930000
   IF STRINGPTR = ")" THEN  <<NULL ACCESS STRING>>             <<U.RAO>>21935000
      BEGIN                                                    <<U.RAO>>21940000
      SCAN STRINGPTR(1) WHILE %6440,1;                         <<U.RAO>>21945000
      @STRINGPTR := TOS;                                       <<U.RAO>>21950000
      NUMPARMS := 1;                                           <<U.RAO>>21955000
      RETURN                                                   <<U.RAO>>21960000
      END;                                                     <<U.RAO>>21965000
   <<NOW INITIALIZE SECURITY MASK>>                            <<U.RAO>>21970000
   IF LEVEL=2 THEN SEC := [16/1,16/0]D <<ACCOUNT, FORCE S:AC>> <<U.RAO>>21975000
              ELSE SEC := 0D;                                  <<U.RAO>>21980000
   <<OK, WE HAVE THE PRELIMINARIES DONE WITH.  THE TASK>>      <<U.RAO>>21985000
   <<NOW IS TO PARSE THE BODY OF THE ACCESS LIST>>             <<U.RAO>>21990000
   MOVE ACCESSMODES := PBACCESSMODES,(25);                     <<U.RAO>>21995000
   MOVE ACCESSORS := PBACCESSORS,(32);                         <<U.RAO>>22000000
   DO BEGIN  <<UNTIL NO MORE ACCESS LISTS>>                    <<U.RAO>>22005000
      <<FIRST TASK IS TO CREATE ACCESS MASK TEMPLATE>>         <<U.RAO>>22010000
      TOS := 0D;   <<INITIALIZE TEMPLATE>>                     <<U.RAO>>22015000
      DO BEGIN  <<UNTIL END OF MODELIST>>                      <<U.RAO>>22020000
         <<STRATEGY IS TO LOOP THROUGH MODE LIST, CREATING>>   <<U.RAO>>22025000
         <<A DOUBLE WITH BITS SET FOR "ANY" WITH  THE >>       <<U.RAO>>22030000
         <<SPECIFIED MODES AND THE SPECIFIED BIT SPACING>>     <<U.RAO>>22035000
         NEXT;  <<SET CHARACTERISTICS OF NEXT PARM>>           <<U.RAO>>22040000
         TOS := SEARCH(PARM,PARMLEN,ACCESSMODES) - 1;          <<U.RAO>>22045000
         IF < THEN <<UNKNOWN ACCESS MODE>>                     <<U.RAO>>22050000
            BEGIN                                              <<U.RAO>>22055000
            IF LEVEL < 1 THEN ERRNUM:=ACCESSUNKNOWNFMODE       <<U.RAO>>22060000
            ELSE IF = THEN    ERRNUM:=ACCESSUNKNOWNGMODE       <<U.RAO>>22065000
            ELSE              ERRNUM:=ACCESSUNKNOWNAMODE;      <<U.RAO>>22070000
            CIERR(ERRNUM,PARM);                                <<U.RAO>>22075000
            RETURN;                                            <<U.RAO>>22080000
            END;                                               <<U.RAO>>22085000
         IF (S0=5) AND (LEVEL<>1) THEN                         <<U.RAO>>22090000
            BEGIN <<WARN - ILLEGAL USE OF SAVE MODE>>          <<U.RAO>>22095000
            DEL;                                               <<U.RAO>>22100000
            IF LEVEL = 0 THEN ERRNUM := -ACCESSFSNOTPERMIT     <<04785>>22105000
                         ELSE ERRNUM := -ACCESSASNOTPERMIT;    <<04785>>22110000
            CIERR(ERRNUM,PARM);                               <<<04785>>22115000
            END                                                <<U.RAO>>22120000
         ELSE                                                  <<U.RAO>>22125000
            BEGIN <<EVERYTHING GOOD, SET MASK BIT>>            <<U.RAO>>22130000
            X := TOS*FACTOR+BASE;  <<OFFSET FROM BIT 31>>      <<U.RAO>>22135000
            ASSEMBLE(DCSL 0,X;  <<ROTATE TO BIT 31>>           <<U.RAO>>22140000
                     TSBC 15);  <<SET ACCESS BIT>>             <<U.RAO>>22145000
            <<NOTE:  X HAS THE SHIFT COUNT IN IT, UPON WHICH>> <<U.RAO>>22150000
            <<THE FOLLOWING ASSEMBLE DEPENDS.  DON'T MESS IT UP<<U.RAO>>22155000
            IF <> THEN  <<ACCESS MODE REDUNDANTLY SPECIFIED>>  <<U.RAO>>22160000
               CIERR(ERRNUM := -ACCESSREDUNDMODE, PARM);       <<04785>>22165000
            ASSEMBLE(DCSR 0,X);  <<ROTATE BACK>>               <<U.RAO>>22170000
            END                                                <<U.RAO>>22175000
         END UNTIL DELIM <> ",";                               <<U.RAO>>22180000
      <<ACCESS MODE LIST PARSED. NOW CHECK FOR ":">>           <<U.RAO>>22185000
      IF DELIM <> ":" THEN                                     <<U.RAO>>22190000
         BEGIN                                                 <<U.RAO>>22195000
         CIERR(ERRNUM := ACCESSEXPECTCOLON, STRINGPTR(-1));    <<U.RAO>>22200000
         RETURN                                                <<U.RAO>>22205000
         END;                                                  <<U.RAO>>22210000
      <<NOW PROCESS USER LIST.  AS WE FIND A VALID USER, >>    <<U.RAO>>22215000
      <<WE SHIFT THE PROTOTYPE MODE LIST (DOUBLE ON TOS) >>    <<U.RAO>>22220000
      <<AND LOR IT INTO THE NEW SECURITY MATRIX>>              <<U.RAO>>22225000
      DO BEGIN  <<UNTIL END OF USER LIST>>                     <<U.RAO>>22230000
         NEXT;                                                 <<U.RAO>>22235000
         X := SEARCH(PARM,PARMLEN,ACCESSORS,PERMIT)-1;         <<U.RAO>>22240000
         IF < THEN <<UNKNOWN ACCESSOR TYPE>>                   <<U.RAO>>22245000
            BEGIN                                              <<U.RAO>>22250000
            IF LEVEL < 1 THEN ERRNUM := ACCESSUNKNOWNFUSER     <<U.RAO>>22255000
            ELSE IF = THEN ERRNUM := ACCESSUNKNOWNGUSER        <<U.RAO>>22260000
            ELSE ERRNUM := ACCESSUNKNOWNAUSER;                 <<U.RAO>>22265000
            CIERR(ERRNUM,PARM);                                <<U.RAO>>22270000
            RETURN                                             <<U.RAO>>22275000
            END;                                               <<U.RAO>>22280000
         IF (LOGICAL(PERMIT) LAND LEVELMASK) = 0 THEN          <<U.RAO>>22285000
            BEGIN  <<WARN - NOT PERMITTED FOR THIS LEVEL>>     <<U.RAO>>22290000
            DEL;                                               <<U.RAO>>22295000
            IF LEVEL=1 THEN ERRNUM := -ACCESSCRNOTPERMIT       <<04785>>22300000
                        ELSE ERRNUM := -ACCESSUSNOTPERMIT;     <<04785>>22305000
            CIERR(ERRNUM,PARM);                                <<04785>>22310000
            END                                                <<U.RAO>>22315000
         ELSE                                                  <<U.RAO>>22320000
            BEGIN                                              <<U.RAO>>22325000
            <<HAVE VALID USER TYPE AND A VALID ACCESS MODE>>   <<U.RAO>>22330000
            <<MASK.  NOW PROCESS THE MASK INTO THE SECURITY>>  <<U.RAO>>22335000
            <<MATRIX.  THE INDEX REGISTER HAS THE ORDINAL OF>> <<U.RAO>>22340000
            <<THE USER TYPE AND THE PROTOTYPE MODE MASK IS >>  <<U.RAO>>22345000
            <<IN S-0 AND S-1>>                                 <<U.RAO>>22350000
            ASSEMBLE(DDUP;  <<COPY MODE MASK>>                 <<U.RAO>>22355000
                     DCSR 0,X); <<SHIFT COPY BY USER TYPE>>    <<U.RAO>>22360000
            CHECKDUPACCESS(DS1);                               <<U.RAO>>22365000
            TOS := SEC;                                        <<U.RAO>>22370000
            ASSEMBLE(CAB, <<GET 2 LEAST SIGNIFICANT WORDS>>    <<U.RAO>>22375000
                     OR;  <<MERGE THEM>>                       <<U.RAO>>22380000
                     CAB, <<GET 2 MOST SIGNIFICANT WORDS>>     <<U.RAO>>22385000
                     CAB;                                      <<U.RAO>>22390000
                     OR,  <<MERGE THEM>>                       <<U.RAO>>22395000
                     XCH); <<PUT BACK IN ORDER>>               <<U.RAO>>22400000
            SEC := TOS;  <<NEW BITS LOR'D INTO OLD MASK>>      <<U.RAO>>22405000
            END;                                               <<U.RAO>>22410000
         END UNTIL DELIM <> ",";                               <<U.RAO>>22415000
      DDEL;  <<POP PROTOTYPE MODE MASK>>                       <<U.RAO>>22420000
      END UNTIL DELIM <> ";";  <<GLOBAL DO LOOP>>              <<U.RAO>>22425000
                                                               <<U.RAO>>22430000
   <<WE HAVE NOW PROCESSED THE ENTIRE SET OF ACCESS LISTS>>    <<U.RAO>>22435000
   <<TIME TO FOLD OUR TENTS AND STEAL AWAY INTO THE NIGHT>>    <<U.RAO>>22440000
   IF DELIM <> ")" THEN                                        <<U.RAO>>22445000
      CIERR(ERRNUM := ACCESSEXPECTRPAREN, STRINGPTR(-1))       <<U.RAO>>22450000
   ELSE                                                        <<U.RAO>>22455000
      BEGIN  <<FIND NEXT NON-BLANK BEYOND ")">>                <<U.RAO>>22460000
      SCAN STRINGPTR WHILE %6440,1;                            <<U.RAO>>22465000
      @STRINGPTR := TOS;                                       <<U.RAO>>22470000
      END;                                                     <<U.RAO>>22475000
   END;                                                        <<U.RAO>>22480000
END;  <<FORMACCESS'>>                                          <<U.RAO>>22485000
INTEGER PROCEDURE GETFLABEL (FILEREF, LEN, FLABEL, FLDN, FADDR,         22490000
      FNUM,SIRINFO);                                           <<04.RO>>22495000
   VALUE LEN;                                                           22500000
   BYTE ARRAY FILEREF;                 <<U-SUPPLIED FILEREF>>           22505000
   INTEGER LEN;                        <<ITS LENGTH>>                   22510000
   ARRAY FLABEL;                       <<128 WD TARGET ARRAY>>          22515000
   INTEGER FLDN;                       <<FILE'S LDN>>                   22520000
   DOUBLE FADDR;                       <<FILE'S SECTOR ADDR>>           22525000
   INTEGER FNUM;  <<FNUM OF FILE FOR WHICH WE WANT FILE LABEL>><<04.RO>>22530000
   DOUBLE SIRINFO;                     <<SIR AND FLAGS TO RELEASE>>     22535000
   OPTION VARIABLE, PRIVILEGED, UNCALLABLE;                             22540000
<< ANALYZES THE FILEREFERENCE;  GETS THE FILE LABEL;  VERIFIES LOCKWORD;22545000
   AND ENSURES THAT CALLER IS CREATOR.                                  22550000
   FILESIR LOCKED ON RETURN FOR UPDATE.                                 22555000
                                                                        22560000
   ALTERNATE CALL:                                                      22565000
INTEGER PROCEDURE GETFLABEL (FILEREF, LEN, FLABEL);                     22570000
   SAME AS ABOVE BUT FILESIR RELEASED.  FOR EXAMINATION.                22575000
                                                                        22580000
   RETURNS ERROR NUMBER IF ONE WAS FOUND.>>                    <<U.RAO>>22585000
                                                                        22590000
BEGIN                                                                   22595000
   ARRAY             QARRAY(*)         =Q+0;                   <<06567>>22600000
   INTEGER           PCBGLOBLOC;                               <<06567>>22605000
   LOGICAL ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                   <<06840>>22610000
   INTEGER JIT'DSTN;                                           <<06840>>22615000
   INTEGER           RETURNVAL         = GETFLABEL;                     22620000
   LOGICAL           PMASK             = Q-4;                           22625000
   BYTE POINTER      BFLABEL           := @FLABEL;                      22630000
   DEFINE            FLANAME           = BFLABEL (16)  #;      << I.A >>22635000
   INTEGER           TYPE              := ACCOUNTLEVEL;        <<38.PV>>22640000
   DOUBLE            FLABADDR          ;                       <<RV.PV>>22645000
   INTEGER           LDEV              ;                       <<RV.PV>>22650000
   BYTE POINTER      GPNTR,                                             22655000
                     ERRPTR,  <<DUMMY FOR CHECKFILENAME'>>     <<U.RAO>>22660000
                     APNTR;                                             22665000
   LOGICAL           LGPNTR            = GPNTR,                         22670000
                     LERRPTR           = ERRPTR,               <<U.RAO>>22675000
                     LAPNTR            = APNTR;                         22680000
   INTEGER ARRAY     UAN(0:7),                                 <<06840>>22685000
                     FNAME (0:57),                                      22690000
                     GNAME (*)         = FNAME (4),                     22695000
                     ANAME (*)         = GNAME (4);                     22700000
   BYTE ARRAY        BANUN (*)         = UAN,                           22705000
                     BFNAME (*)        = FNAME,                         22710000
                     BGNAME (*)        = GNAME,                         22715000
                     BANAME (*)        = ANAME,                         22720000
                     LOCK (*)          = ANAME (4);                     22725000
                                                                        22730000
   FNAME := "  ";                                                       22735000
   MOVE FNAME (1) := FNAME, (31);                                       22740000
   TOS := 0;  <<RETURN SPACE>>                                 <<U.RAO>>22745000
   TOS := @FILEREF;                                            <<U.RAO>>22750000
   TOS := LEN;                                                 <<U.RAO>>22755000
   TOS := CHECKFILENAME'(*,LGPNTR,LAPNTR,LERRPTR);             <<U.RAO>>22760000
   IF < THEN  <<FILE NAME PARSE ERROR>>                        <<U.RAO>>22765000
      BEGIN                                                    <<U.RAO>>22770000
      RETURNVAL := S0;                                         <<U.RAO>>22775000
      CIERR(*,ERRPTR);                                         <<U.RAO>>22780000
      RETURN                                                   <<U.RAO>>22785000
      END                                                      <<U.RAO>>22790000
   ELSE IF > THEN  <<REQUIRES ACTUAL DESIGNATOR>>              <<U.RAO>>22795000
      BEGIN                                                    <<U.RAO>>22800000
      CIERR(RETURNVAL := REQFORMALFDESIG);                     <<U.RAO>>22805000
      RETURN                                                   <<U.RAO>>22810000
      END;                                                     <<U.RAO>>22815000
   MOVE BFNAME := FILEREF WHILE ANS, 0;                                 22820000
   IF BPS0 = "/" THEN                                                   22825000
      BEGIN                                                             22830000
      TOS := @LOCK;                                                     22835000
      ASSEMBLE (XCH, INCA);                                             22840000
      MOVE * := * WHILE ANS, 0;                                         22845000
      END;                                                              22850000
   IF BPS0 = "." THEN                                                   22855000
      BEGIN                                                             22860000
      TYPE := TYPE -1;                                                  22865000
      MOVE BGNAME := GPNTR WHILE ANS, 0;                                22870000
      IF BPS0 = "." THEN                                                22875000
         BEGIN                                                          22880000
         TYPE := TYPE -1;                                               22885000
         MOVE BANAME := APNTR WHILE ANS;                                22890000
         END ELSE                                              <<31.PV>>22895000
          WHO (,,,,,BANAME);                                   <<31.PV>>22900000
      END ELSE                                                 <<31.PV>>22905000
       WHO (,,,,BGNAME,BANAME);                                <<31.PV>>22910000
   <<AT THIS POINT WE HAVE THE FILE NAME.  NEXT WE OPEN THE>>  <<04.RO>>22915000
   <<FILE.  THIS HAS NO RELEVANCE TO THE ACTUAL ACCESSING OF>> <<04.RO>>22920000
   <<THE FILE.  IT'S ONLY PURPOSE IS TO CAUSE A MOUNT OF THE>> <<04.RO>>22925000
   <<PRIVATE VOLUME, IF NECESSARY>>                            <<04.RO>>22930000
   FNUM := FOPEN(FILEREF,%2001,%10717);<<INONLY,NOBUF,NO SEC.>><<01652>>22935000
   IF <> THEN                                                  <<04.RO>>22940000
      BEGIN   <<OPEN FAILED, TELL USER>>                       <<04.RO>>22945000
      FERROR'(FNUM, TYPE);                                     <<04.RO>>22950000
      QUALIFYFILENAME(FILEREF, BFNAME);                        <<04.RO>>22955000
      CIERR(RETURNVAL := GETFLABOPEN,,0,@BFNAME);              <<04.RO>>22960000
      RETURN                                                   <<04.RO>>22965000
      END;                                                     <<04.RO>>22970000
   PXGLOBAL;                                                   <<06567>>22975000
   JIT'DSTN:=PXG'JITDST;                                       <<06840>>22980000
   TOS:=@JITARR;                                               <<06840>>22985000
   TOS:=JIT'DSTN;                                              <<06840>>22990000
   TOS:=0;                                                     <<06840>>22995000
   TOS:=JIT'ENTRY'SIZE;                                        <<06840>>23000000
   ASSEMBLE(MFDS 4);                                           <<06840>>23005000
   MOVE UAN(0):=JITHACCTNAME,(4);                              <<06840>>23010000
   MOVE UAN(4):=JITUSERNAME,(4);                               <<06840>>23015000
   TOS := FILESIR;                                                      23020000
   TOS := GETSIR (FILESIR);                                             23025000
   IF PMASK THEN SIRINFO := DS1;                                        23030000
   FGETINFO (FNUM,,,,,,LDEV,,,,,,,,,,,,,FLABADDR);             <<RV.PV>>23035000
   TOS := 0;                                                            23040000
   TOS := LDEV;                                                <<RV.PV>>23045000
   TOS := FLABADDR;                                            <<RV.PV>>23050000
   TOS := 0;                                                            23055000
   TOS := @FLABEL;                                                      23060000
   IF PMASK THEN                                                        23065000
      BEGIN                                                             23070000
      FLDN := S4;                                                       23075000
      FADDR := DS3;                                                     23080000
      END;                                                              23085000
   TOS := FLABIO (*,*,*,*);                                             23090000
   IF TOS <> 0 THEN  <<DISC IO ERROR>>                         <<U.RAO>>23095000
      BEGIN                                                    <<U.RAO>>23100000
      TOS := SIRINFO;                                          <<06.RO>>23105000
      RELSIR(*,*);  <<RELEASE FILE SIR>>                       <<06.RO>>23110000
      CIERR(RETURNVAL := DISCIOERR);                           <<U.RAO>>23115000
      FCLOSE(FNUM,0,0);                                        <<06.RO>>23120000
      RETURN;                                                  <<06.RO>>23125000
      END;                                                     <<U.RAO>>23130000
   IF FLANAME <> BANUN,(16) THEN  <<CREATOR CONFLICT>>         <<U.RAO>>23135000
      BEGIN                                                    <<U.RAO>>23140000
      TOS := SIRINFO;                                          <<06.RO>>23145000
      RELSIR(*,*);   <<RELEASE FILE SYSTEM SIR>>               <<06.RO>>23150000
      CIERR(RETURNVAL := NOTCREATOR);                          <<U.RAO>>23155000
      FCLOSE(FNUM,0,0);                                        <<06.RO>>23160000
      RETURN;                                                  <<06.RO>>23165000
      END;                                                     <<U.RAO>>23170000
   IF NOT (PMASK) THEN                                                  23175000
      BEGIN                                                    <<04.RO>>23180000
         TOS := SIRINFO;                                       <<06.RO>>23185000
         RELSIR(*,*);  <<RELEASE FILE SIR>>                    <<06.RO>>23190000
         FCLOSE(FNUM,0,0);                                     <<04.RO>>23195000
      END;                                                     <<04.RO>>23200000
   END    <<GETFLABEL>>;                                                23205000
LOGICAL PROCEDURE ALTSECURITY(ERRNUM,FILEREF,TYPE,SEC);        <<U.RAO>>23210000
VALUE FILEREF,TYPE,SEC;                                        <<U.RAO>>23215000
DOUBLE FILEREF,SEC;                                            <<U.RAO>>23220000
INTEGER ERRNUM,TYPE;                                           <<U.RAO>>23225000
OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                       <<U.RAO>>23230000
<<THIS PROCEDURE IS CALLED BY CXRELEASE, CXSECURE, CXALTSEC>>  <<U.RAO>>23235000
<<ITS FUNCTION IS TO ACTUALLY DO THE FILE LABEL MANIPULATIONS>><<U.RAO>>23240000
<<FILEREF IS A DOUBLE WITH A BYTE POINTER TO THE BEGINNING OF>><<U.RAO>>23245000
<<THE FILE REFERENCE IN WORD 1 AND THE LENGTH OF THE FILE    >><<U.RAO>>23250000
<<REFERENCE IN WORD 2.  THIS IS USUALLY OBTAINED BY A LSR(8) >><<U.RAO>>23255000
<<ON THE DOUBLE RETURNED FROM MYCOMMAND.                     >><<U.RAO>>23260000
<<TYPE = 1 => SECURE THE FILE                                >><<U.RAO>>23265000
<<     = 0 => RELEASE THE FILE                               >><<U.RAO>>23270000
<<     = -1 => ALTER THE SECURITY MASK.                      >><<U.RAO>>23275000
<<SEC IS PRESENT IFF TYPE = -1 AND IS NEW SECURITY MASK.     >><<U.RAO>>23280000
BEGIN                                                          <<U.RAO>>23285000
DOUBLE SIRINFO; <<FILE SYSTEM SIR>>                            <<U.RAO>>23290000
DOUBLE FADDR;                                                  <<U.RAO>>23295000
INTEGER FLDN;  <<LOGICAL DEVICE NUMBER>>                       <<U.RAO>>23300000
INTEGER ARRAY FLABEL(0:127);                                   <<U.RAO>>23305000
DOUBLE ARRAY DFLABEL(*)=FLABEL;                                <<U.RAO>>23310000
LOGICAL PMASK = Q-4;                                           <<U.RAO>>23315000
BYTE POINTER FREF = FILEREF;                                   <<U.RAO>>23320000
INTEGER LEN = FILEREF+1;                                       <<U.RAO>>23325000
INTEGER FNUM;  <<HOLDS FNUM OF FILEREF OPENED IN GETFLABEL>>   <<04.RO>>23330000
                                                               <<U.RAO>>23335000
ALTSECURITY := FALSE;                                          <<U.RAO>>23340000
ERRNUM := GETFLABEL(FREF,LEN,FLABEL,FLDN,FADDR,FNUM,SIRINFO);  <<U.RAO>>23345000
IF ERRNUM = 0 THEN                                             <<U.RAO>>23350000
   BEGIN  <<OK - GO ON>>                                       <<U.RAO>>23355000
   IF PMASK THEN <<ALTSEC, SINCE NEW SECURITY MASK PASSED>>    <<U.RAO>>23360000
      DFLABEL(FLSECMATRIX) := SEC                              <<U.RAO>>23365000
   ELSE  <<RELEASE/SECURE>>                                    <<U.RAO>>23370000
      FLABEL( FILE'SECURE ).(15:1) := TYPE;                    << 8500>>23375000
   TOS := FLABIO(FLDN,FADDR,1,FLABEL);                         <<U.RAO>>23380000
   TOS := SIRINFO;                                             <<U.RAO>>23385000
   RELSIR(*,*);  <<RELEASE FILE SYSTEM SIR GOTTEN BY GETFLABEL><<U.RAO>>23390000
   FCLOSE(FNUM,0,0);  <<CLOSE MODIFIED FILE>>                  <<04.RO>>23395000
   ALTSECURITY := TRUE;                                        <<U.RAO>>23400000
   IF TOS <> 0 THEN                                            <<U.RAO>>23405000
      BEGIN                                                    <<U.RAO>>23410000
      ALTSECURITY := FALSE;                                    <<U.RAO>>23415000
      CIERR(ERRNUM := DISCIOERR);                              <<U.RAO>>23420000
      END;                                                     <<U.RAO>>23425000
   FLABEL := 0;                                                <<U.RAO>>23430000
   MOVE FLABEL(1) := FLABEL,(127);                             <<U.RAO>>23435000
   END;                                                        <<U.RAO>>23440000
END;                                                           <<U.RAO>>23445000
PROCEDURE CXRELEASE EXECUTORHEAD;                              <<U.RAO>>23450000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>23455000
BEGIN                                                          <<U.RAO>>23460000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>23465000
BYTE POINTER ERRPTR = PARMS+2;                                 <<U.RAO>>23470000
INTEGER NUMPARMS;                                              <<U.RAO>>23475000
DOUBLE DL:=COMMASEMICR;                                        <<U.RAO>>23480000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>23485000
PARMNUM := 1;                                                  <<U.RAO>>23490000
IF NUMPARMS >= 2 THEN                                          <<U.RAO>>23495000
   CIERR(ERRNUM := RELEASE2MP, ERRPTR)                         <<U.RAO>>23500000
ELSE IF NUMPARMS < 1 THEN                                      <<U.RAO>>23505000
   CIERR(ERRNUM := RELEASENOTENUF, PARMSP(1))                  <<U.RAO>>23510000
ELSE   <<EVERYTHING PARSED OK>>                                <<U.RAO>>23515000
   IF ALTSECURITY(ERRNUM,PARMS&LSR(8),0) THEN                  <<U.RAO>>23520000
      PARMNUM := 0;  <<EVERYTHING IS FINE>>                    <<U.RAO>>23525000
END;                                                           <<U.RAO>>23530000
PROCEDURE CXSECURE EXECUTORHEAD;                               <<U.RAO>>23535000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>23540000
BEGIN                                                          <<U.RAO>>23545000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>23550000
BYTE POINTER ERRPTR = PARMS+2;                                 <<U.RAO>>23555000
INTEGER NUMPARMS;                                              <<U.RAO>>23560000
DOUBLE DL := COMMASEMICR;                                      <<U.RAO>>23565000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>23570000
PARMNUM := 1;                                                  <<U.RAO>>23575000
IF NUMPARMS >= 2 THEN                                          <<U.RAO>>23580000
   CIERR(ERRNUM := SECURE2MP,ERRPTR)                           <<U.RAO>>23585000
ELSE IF NUMPARMS < 1 THEN                                      <<U.RAO>>23590000
   CIERR(ERRNUM := SECURENOTENUF, PARMSP(1))                   <<U.RAO>>23595000
ELSE  <<EVERYTHING PARSED OK SO FAR>>                          <<U.RAO>>23600000
   IF ALTSECURITY(ERRNUM, PARMS&LSR(8),1) THEN                 <<U.RAO>>23605000
      PARMNUM := 0;                                            <<U.RAO>>23610000
END;                                                           <<U.RAO>>23615000
PROCEDURE CXALTSEC EXECUTORHEAD;                               <<U.RAO>>23620000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>23625000
BEGIN                                                          <<U.RAO>>23630000
DOUBLE ARRAY PARMS(0:1) = Q;                                   <<U.RAO>>23635000
INTEGER DL := SEMICR;                                          <<U.RAO>>23640000
INTEGER NUMPARMS;                                              <<U.RAO>>23645000
DOUBLE SEC := [6/32,6/32,6/32,6/32,6/32]D;                     <<U.RAO>>23650000
BYTE POINTER ACCSTRING = PARMS+2;                              <<U.RAO>>23655000
                                                               <<U.RAO>>23660000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>23665000
IF NUMPARMS < 1 THEN                                           <<U.RAO>>23670000
   BEGIN                                                       <<U.RAO>>23675000
   PARMNUM := 1;                                               <<U.RAO>>23680000
   CIERR(ERRNUM := ALTSECNOTENUF, PARMSP(1));                  <<U.RAO>>23685000
   END                                                         <<U.RAO>>23690000
ELSE                                                           <<U.RAO>>23695000
   BEGIN                                                       <<U.RAO>>23700000
   IF > THEN  <<MODELIST INCLUDED?>>                           <<U.RAO>>23705000
      BEGIN                                                    <<U.RAO>>23710000
      TOS := FORMACCESS'(0,ACCSTRING,SEC,NUMPARMS,ERRNUM);     <<U.RAO>>23715000
      IF ERRNUM > 0 THEN   <<ERROR REPORTED>>                  <<U.RAO>>23720000
         BEGIN                                                 <<U.RAO>>23725000
         PARMNUM := NUMPARMS;                                  <<U.RAO>>23730000
         RETURN                                                <<U.RAO>>23735000
         END;                                                  <<U.RAO>>23740000
      IF BPS0 <> %15 <<CR>> THEN                               <<U.RAO>>23745000
         BEGIN                                                 <<U.RAO>>23750000
         PARMNUM := NUMPARMS+1;                                <<U.RAO>>23755000
         CIERR(ERRNUM := ALTSEC2MP, BPS0);                     <<U.RAO>>23760000
         RETURN                                                <<U.RAO>>23765000
         END;                                                  <<U.RAO>>23770000
      END;                                                     <<U.RAO>>23775000
   IF NOT ALTSECURITY(ERRNUM,PARMS&LSR(8),-1,SEC) THEN         <<U.RAO>>23780000
      PARMNUM := 1;                                            <<U.RAO>>23785000
   END;                                                        <<U.RAO>>23790000
END;  <<CXALTSEC>>                                             <<U.RAO>>23795000
$PAGE    "LISTF EXECUTOR AND RELATED PROCEDURES"                        23800000
$CONTROL   SEGMENT  =  CILISTF                                          23805000
                                                                        23810000
PROCEDURE LISTFNOTMTDMSG (GHVSNAME',SOURCEDST);                <<RV.PV>>23815000
    VALUE SOURCEDST;  INTEGER SOURCEDST;                       <<RV.PV>>23820000
    ARRAY GHVSNAME';                                           <<RV.PV>>23825000
    OPTION PRIVILEGED, UNCALLABLE;                             <<04.RO>>23830000
    BEGIN                                                      <<RV.PV>>23835000
       INTEGER ERRNUM;                                         <<04785>>23840000
        ARRAY                                                  <<RV.PV>>23845000
            HVSNAME (0:(NAMESIZE*3)-1);                        <<RV.PV>>23850000
        BYTE ARRAY                                             <<RV.PV>>23855000
            STRING (0:((NAMESIZE*3)*2)+2);                     <<RV.PV>>23860000
        TOS := @HVSNAME;                                       <<RV.PV>>23865000
        TOS := SOURCEDST;                                      <<RV.PV>>23870000
        TOS := @GHVSNAME';                                     <<RV.PV>>23875000
        TOS := NAMESIZE*3;                                     <<RV.PV>>23880000
        ASSEMBLE (MFDS);                                       <<RV.PV>>23885000
        FORMNAME (1,STRING,HVSNAME (NAMESIZE*2),               <<RV.PV>>23890000
                  HVSNAME (NAMESIZE),HVSNAME,HVSNAME);         <<RV.PV>>23895000
        CIERR (ERRNUM := -LISTFHVSNOTMTD,,0,@STRING);          <<04785>>23900000
    END;<<OF LISTFNOTMTDMSG>>                                  <<RV.PV>>23905000
                                                               <<04.KM>>23910000
                                                               <<04.KM>>23915000
$CONTROL  SEGMENT=CILISTF                                      <<04.KM>>23920000
<<********************************************************************>>23925000
<< M U L T I L I N E >>                                        <<04.KM>>23930000
                                                               <<04.KM>>23935000
INTEGER PROCEDURE MULTILINE(FILE,MSG,MSGLEN,FIELD,FIELDLEN,    <<04.KM>>23940000
                            LASTCCTL,PREFIX,PREFIXLEN);        <<04.KM>>23945000
  VALUE FILE,MSG,MSGLEN,FIELD,FIELDLEN,LASTCCTL,PREFIXLEN;     <<04.KM>>23950000
  INTEGER FILE,MSGLEN,FIELD,FIELDLEN,LASTCCTL,PREFIXLEN;       <<04.KM>>23955000
  BYTE POINTER MSG;                                            <<04.KM>>23960000
  BYTE ARRAY PREFIX;                                           <<04.KM>>23965000
  OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                       <<04.KM>>23970000
BEGIN                                                          <<04.KM>>23975000
  COMMENT:                                                     <<04.KM>>23980000
    WRITES "MSG" TO "FILE" AT POSITION "FIELD" WITHIN RECORD.  <<04.KM>>23985000
    IF "MSGLEN" EXCEEDS "FIELDLEN", THE MESSAGE IS BROKEN ON   <<04.KM>>23990000
    WORD BOUNDARY AND WRITTEN ON MULTIPLE LINES.  FIRST LINE   <<04.KM>>23995000
    MAY BE PREFACED BY "PREFIX" -- SUBSEQUENT LINES CONTAIN    <<04.KM>>24000000
    BLANKS TO THE LEFT OF "FIELD".  LAST LINE IS WRITTEN WITH  <<04.KM>>24005000
    "CCTL" CARRIAGE CONTROL.                                   <<04.KM>>24010000
                                                               <<04.KM>>24015000
    RETURNS SAME CONDITION CODE AS FCONTROL OR FWRITE.  ALSO   <<04.KM>>24020000
    RETURNS FILE SYSTEM ERROR NUMBER (FCHECK).                 <<04.KM>>24025000
                                                               <<04.KM>>24030000
    INPUT PARAMETERS:                                          <<04.KM>>24035000
      MSGLEN=    # BYTES (POSITIVE)                            <<04.KM>>24040000
      FIELD=     0-ORIGINED BYTE POSITION WITHIN RECORD        <<04.KM>>24045000
      FIELDLEN=  # BYTES (POSITIVE)                            <<04.KM>>24050000
      LASTCCTL=  "FWRITE" CCTL                                 <<04.KM>>24055000
      PREFIXLEN= # BYTES (POSITIVE).                           <<04.KM>>24060000
                                                               <<04.KM>>24065000
    DEFAULT VALUES ARE:                                        <<04.KM>>24070000
      FILE=      $STDLIST                                      <<04.KM>>24075000
      MSGLEN=    0                                             <<04.KM>>24080000
      FIELD=     0                                             <<04.KM>>24085000
      FIELDLEN=  RECSIZE-FIELD                                 <<04.KM>>24090000
      LASTCCTL=  0                                             <<04.KM>>24095000
      PREFIXLEN= 0.                                            <<04.KM>>24100000
                                                               <<04.KM>>24105000
    IF "FIELD" EXCEEDS RECSIZE THE DEFAULT IS TAKEN.  HOWEVER, <<04.KM>>24110000
    FIELD+FIELDLEN MAY EXCEED RECSIZE.  IF FILE<=0 OR FIELD<0  <<04.KM>>24115000
    OR FIELDLEN<=0, THE CORRESPONDING DEFAULT IS TAKEN.  IF    <<04.KM>>24120000
    "MSG" OR "PREFIX" IS NOT PASSED, THE CORRESPONDING DEFAULT <<04.KM>>24125000
    "MSGLEN" OR "PREFIXLEN" IS TAKEN.                          <<04.KM>>24130000
    ;                                                          <<04.KM>>24135000
                                                               <<04.KM>>24140000
  INTEGER MLINEVALUE= MULTILINE;                               <<04.KM>>24145000
  LABEL EXITINSTR;                                             <<04.KM>>24150000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<04.KM>>24155000
                                                               <<04.KM>>24160000
  DEFINE FNFLAG= QPARM.(8:1) #,        <<FILE PASSED>>         <<04.KM>>24165000
         MFLAG=  QPARM.(9:1) #,        <<MSG PASSED>>          <<04.KM>>24170000
         MLFLAG= QPARM.(10:1) #,       <<MSGLEN PASSED>>       <<04.KM>>24175000
         FFLAG=  QPARM.(11:1) #,       <<FIELD PASSED>>        <<04.KM>>24180000
         FLFLAG= QPARM.(12:1) #,       <<FIELDLEN PASSED>>     <<04.KM>>24185000
         LFLAG=  QPARM.(13:1) #,       <<LASTCCTL PASSED>>     <<04.KM>>24190000
         PFLAG=  QPARM.(14:1) #,       <<PREFIX PASSED>>       <<04.KM>>24195000
         PLFLAG= QPARM #;              <<PREFIXLEN PASSED>>    <<04.KM>>24200000
  DEFINE QCC=     6:2 #;                                       <<04.KM>>24205000
  EQUATE CCL=     1,                                           <<04.KM>>24210000
         CCE=     2,                                           <<04.KM>>24215000
         CCG=     0,                                           <<04.KM>>24220000
         STDLIST= 2;                                           <<04.KM>>24225000
  BYTE TOPSTACK= MULTILINE,                                    <<04.KM>>24230000
       DUMMY=    TOPSTACK;                                     <<04.KM>>24235000
  BYTE POINTER TEMP;                                           <<04.KM>>24240000
  INTEGER QSTATUS= Q-1,                                        <<04.KM>>24245000
          X=       X,                                          <<04.KM>>24250000
          S0=      S-0,                                        <<04.KM>>24255000
          DL,                                                  <<04.KM>>24260000
          LAST,                                                <<04.KM>>24265000
          RECSIZE,                                             <<04.KM>>24270000
          CCTL;                                                <<04.KM>>24275000
  LOGICAL QPARM= Q-4;                                          <<04.KM>>24280000
  POINTER WTEMP;                                               <<04.KM>>24285000
  INTRINSIC FWRITE,FGETINFO,FCHECK;                            <<04.KM>>24290000
                                                               <<04.KM>>24295000
  ARRAY WBUF(*)=     Q;                                        <<04.KM>>24300000
  BYTE ARRAY BUF(*)= WBUF;                                     <<04.KM>>24305000
                                                               <<04.KM>>24310000
                                                               <<04.KM>>24315000
  <<*******************>>                                      <<04.KM>>24320000
  << SUBROUTINE CXEXIT >>                                      <<04.KM>>24325000
  <<*******************>>                                      <<04.KM>>24330000
                                                               <<04.KM>>24335000
  SUBROUTINE CXEXIT(CCODE); VALUE CCODE; INTEGER CCODE;        <<04.KM>>24340000
  BEGIN                                                        <<04.KM>>24345000
    QSTATUS.(QCC):=CCODE;                                      <<04.KM>>24350000
    IF CCODE=CCE THEN MULTILINE:=0                             <<04.KM>>24355000
    ELSE FCHECK(FILE,MLINEVALUE);                              <<04.KM>>24360000
    EXITPROC;                                                  <<04.KM>>24365000
  END <<SUBROUTINE CXEXIT>>;                                   <<04.KM>>24370000
                                                               <<04.KM>>24375000
                                                               <<04.KM>>24380000
  <<***************************>>                              <<04.KM>>24385000
  << SUBROUTINE BLANKLEFTFIELD >>                              <<04.KM>>24390000
  <<***************************>>                              <<04.KM>>24395000
                                                               <<04.KM>>24400000
  SUBROUTINE BLANKLEFTFIELD;                                   <<04.KM>>24405000
  BEGIN                                                        <<04.KM>>24410000
    BUF:=" ";                                                  <<04.KM>>24415000
    MOVE BUF(1):=BUF,(FIELD);                                  <<04.KM>>24420000
  END <<SUBROUTINE BLANKLEFTFIELD>>;                           <<04.KM>>24425000
                                                               <<04.KM>>24430000
                                                               <<04.KM>>24435000
  <<*********************>>                                    <<04.KM>>24440000
  << SUBROUTINE BYTESIZE >>                                    <<04.KM>>24445000
  <<*********************>>                                    <<04.KM>>24450000
                                                               <<04.KM>>24455000
  INTEGER SUBROUTINE BYTESIZE(LENGTH);                         <<04.KM>>24460000
    VALUE LENGTH; INTEGER LENGTH;                              <<??,KM>>24465000
  BEGIN                                                        <<04.KM>>24470000
    BYTESIZE:=IF LENGTH=-32768 OR LENGTH>=16384 THEN 32767     <<04.KM>>24475000
              ELSE IF LENGTH<0 THEN -LENGTH                    <<04.KM>>24480000
              ELSE 2*LENGTH;                                   <<04.KM>>24485000
  END <<SUBROUTINE BYTESIZE>>;                                 <<04.KM>>24490000
                                                               <<04.KM>>24495000
                                                               <<04.KM>>24500000
  <<**************************>>                               <<04.KM>>24505000
  << SUBROUTINE LASTWORDINDEX >>                               <<04.KM>>24510000
  <<**************************>>                               <<04.KM>>24515000
                                                               <<04.KM>>24520000
  INTEGER SUBROUTINE LASTWORDINDEX;                            <<04.KM>>24525000
  BEGIN                                                        <<04.KM>>24530000
    COMMENT:                                                   <<04.KM>>24535000
      FIND WORD BOUNDARY.  WE ASSUME THAT MSG(0) IS NONBLANK   <<04.KM>>24540000
      (IE., "MSG" HAS BEEN LEFT-DEBLANKED);                    <<04.KM>>24545000
                                                               <<04.KM>>24550000
    X:=FIELDLEN;                                               <<04.KM>>24555000
    WHILE X>0 AND MSG(X)<>" " DO X:=X-1;                       <<04.KM>>24560000
    LASTWORDINDEX:=IF X>0 THEN X ELSE FIELDLEN;                <<04.KM>>24565000
  END <<SUBROUTINE LASTWORDINDEX>>;                            <<04.KM>>24570000
                                                               <<04.KM>>24575000
                                                               <<04.KM>>24580000
  <<***********************>>                                  <<04.KM>>24585000
  << SUBROUTINE SKIPBLANKS >>                                  <<04.KM>>24590000
  <<***********************>>                                  <<04.KM>>24595000
                                                               <<04.KM>>24600000
  SUBROUTINE SKIPBLANKS;                                       <<04.KM>>24605000
  BEGIN                                                        <<04.KM>>24610000
    X:=0;                                                      <<04.KM>>24615000
    WHILE X<MSGLEN AND MSG(X)=" " DO X:=X+1;                   <<04.KM>>24620000
    @MSG:=@MSG(X);                                             <<04.KM>>24625000
    MSGLEN:=MSGLEN-X;                                          <<04.KM>>24630000
  END <<SUBROUTINE SKIPBLANKS>>;                               <<04.KM>>24635000
                                                               <<04.KM>>24640000
                                                               <<04.KM>>24645000
  <<*********************>>                                    <<04.KM>>24650000
  << SUBROUTINE WORDSIZE >>                                    <<04.KM>>24655000
  <<*********************>>                                    <<04.KM>>24660000
                                                               <<04.KM>>24665000
  INTEGER SUBROUTINE WORDSIZE(BYTELENGTH);                     <<04.KM>>24670000
    VALUE BYTELENGTH; INTEGER BYTELENGTH;                      <<04.KM>>24675000
  BEGIN                                                        <<04.KM>>24680000
    WORDSIZE:=(BYTELENGTH/2)+BYTELENGTH.(15:1);                <<04.KM>>24685000
  END <<SUBROUTINE WORDSIZE>>;                                 <<04.KM>>24690000
                                                               <<04.KM>>24695000
                                                               <<04.KM>>24700000
  <<**********************>>                                   <<04.KM>>24705000
  << SUBROUTINE WRITELINE >>                                   <<04.KM>>24710000
  <<**********************>>                                   <<04.KM>>24715000
                                                               <<04.KM>>24720000
  SUBROUTINE WRITELINE;                                        <<04.KM>>24725000
  BEGIN                                                        <<04.KM>>24730000
    COMMENT:                                                   <<04.KM>>24735000
      FILL IN "FIELD" WITH AS MUCH OF "MSG" AS POSSIBLE.       <<04.KM>>24740000
      WE ASSUME THAT "MSG" HAS BEEN RIGHT-DEBLANKED.  NOTE     <<04.KM>>24745000
      THAT AREA TO THE LEFT OF "FIELD" MAY OR MAY NOT BE       <<04.KM>>24750000
      BLANK, TO BE SET-UP BY CALLER;                           <<04.KM>>24755000
                                                               <<04.KM>>24760000
    SKIPBLANKS;                                                <<04.KM>>24765000
    IF MSGLEN<=FIELDLEN THEN           <<ASSUME FL>=1>>        <<04.KM>>24770000
      BEGIN                                                    <<04.KM>>24775000
      LAST:=MSGLEN;                    <<ASSUME ML>0>>         <<04.KM>>24780000
      CCTL:=LASTCCTL;                                          <<04.KM>>24785000
      END                                                      <<04.KM>>24790000
    ELSE                                                       <<04.KM>>24795000
      BEGIN                                                    <<04.KM>>24800000
      LAST:=LASTWORDINDEX;                                     <<04.KM>>24805000
      CCTL:=0;                                                 <<04.KM>>24810000
      END;                                                     <<04.KM>>24815000
    MOVE BUF(FIELD):=MSG,(LAST);                               <<04.KM>>24820000
    FWRITE(FILE,WBUF,-(FIELD+LAST),CCTL);                      <<04.KM>>24825000
    IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                 <<04.KM>>24830000
    @MSG:=@MSG(LAST);                                          <<04.KM>>24835000
    MSGLEN:=MSGLEN-LAST;                                       <<04.KM>>24840000
  END <<SUBROUTINE WRITELINE>>;                                <<04.KM>>24845000
                                                               <<04.KM>>24850000
                                                               <<04.KM>>24855000
  <<************************>>                                 <<04.KM>>24860000
  << SUBROUTINE WRITEPREFIX >>                                 <<04.KM>>24865000
  <<************************>>                                 <<04.KM>>24870000
                                                               <<04.KM>>24875000
  SUBROUTINE WRITEPREFIX;                                      <<04.KM>>24880000
  BEGIN                                                        <<04.KM>>24885000
    COMMENT:                                                   <<04.KM>>24890000
      WRITE PREFIX ON SEPARATE LINE;                           <<04.KM>>24895000
                                                               <<04.KM>>24900000
    TOS:=WORDSIZE(PREFIXLEN);          <<ALLOCATE BUFFER>>     <<04.KM>>24905000
    @TEMP:=(@WTEMP:=@S0)&LSL(1);                               <<04.KM>>24910000
    ASSEMBLE(ADDS 0);                                          <<04.KM>>24915000
    MOVE TEMP:=PREFIX,(PREFIXLEN);                             <<04.KM>>24920000
    FWRITE(FILE,WTEMP,-PREFIXLEN,0);                           <<04.KM>>24925000
    IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                 <<04.KM>>24930000
    TOS:=WORDSIZE(PREFIXLEN);          <<DEALLOCATE BUFFER>>   <<04.KM>>24935000
    ASSEMBLE(SUBS 0);                                          <<04.KM>>24940000
  END <<SUBROUTINE WRITEPREFIX>>;                              <<04.KM>>24945000
                                                               <<04.KM>>24950000
                                                               <<04.KM>>24955000
  <<************************>>                                 <<04.KM>>24960000
  << MAIN PROCEDURE BODY    >>                                 <<04.KM>>24965000
  <<                        >>                                 <<04.KM>>24970000
  << CHECK CALLING SEQUENCE >>                                 <<04.KM>>24975000
  <<************************>>                                 <<04.KM>>24980000
                                                               <<04.KM>>24985000
  PUSH(DL);                                                    <<04.KM>>24990000
  DL:=TOS;                                                     <<04.KM>>24995000
  IF NOT FNFLAG OR FILE<=0 THEN FILE:=STDLIST;                 <<04.KM>>25000000
                                                               <<04.KM>>25005000
  IF NOT MFLAG OR NOT MLFLAG OR MSGLEN<0 OR                    <<04.KM>>25010000
     @MSG<DL OR @MSG(MSGLEN)>@TOPSTACK THEN                    <<04.KM>>25015000
    BEGIN                                                      <<04.KM>>25020000
    @MSG:=@DUMMY;                                              <<04.KM>>25025000
    MSGLEN:=0;                                                 <<04.KM>>25030000
    END;                                                       <<04.KM>>25035000
  WHILE MSGLEN>0 AND MSG(MSGLEN-1)=" " DO MSGLEN:=MSGLEN-1;    <<04.KM>>25040000
                                                               <<04.KM>>25045000
  COMMENT:                                                     <<04.KM>>25050000
    CHECK "FIELD" & "FIELDLEN".  DEVICE RECORD SIZE IS         <<04.KM>>25055000
    DIMINISHED BY TWO (ONE FOR CCTL) TO AVOID PRINTING IN LAST <<05.KM>>25060000
    COLUMN, CAUSING EXTRA LF OR HOME-UP ON SOME DEVICES.       <<05.KM>>25065000
    "FIELD" CANNOT EQUAL "RECSIZE" TO ENSURE THAT FIELDLEN>=1; <<05.KM>>25070000
                                                               <<04.KM>>25075000
  FGETINFO(FILE,<<FNAME>>,<<FOPS>>,<<AOPS>>,RECSIZE);          <<04.KM>>25080000
  IF <> THEN CXEXIT(IF < THEN CCL ELSE CCG);                   <<04.KM>>25085000
  RECSIZE:=BYTESIZE(RECSIZE)-2;                                <<05.KM>>25090000
  IF NOT FFLAG OR FIELD<0 OR FIELD>=RECSIZE THEN FIELD:=0;     <<04.KM>>25095000
  IF NOT FLFLAG OR FIELDLEN=0 THEN FIELDLEN:=RECSIZE-FIELD;    <<04.KM>>25100000
                                                               <<04.KM>>25105000
  IF NOT LFLAG THEN CCTL:=0;                                   <<04.KM>>25110000
                                                               <<04.KM>>25115000
  IF NOT PFLAG OR NOT PLFLAG OR PREFIXLEN<0 OR                 <<04.KM>>25120000
     @PREFIX<DL OR @PREFIX(PREFIXLEN)>@TOPSTACK THEN           <<04.KM>>25125000
    BEGIN                                                      <<04.KM>>25130000
    @PREFIX:=@DUMMY;                                           <<04.KM>>25135000
    PREFIXLEN:=0;                                              <<04.KM>>25140000
    END;                                                       <<04.KM>>25145000
                                                               <<04.KM>>25150000
  <<****************>>                                         <<04.KM>>25155000
  << OUTPUT MESSAGE >>                                         <<04.KM>>25160000
  <<****************>>                                         <<04.KM>>25165000
                                                               <<04.KM>>25170000
  TOS:=WORDSIZE(FIELD+FIELDLEN);       <<ALLOCATE "WBUF">>     <<04.KM>>25175000
  ASSEMBLE(ADDS 0);                                            <<04.KM>>25180000
                                                               <<04.KM>>25185000
  IF PREFIXLEN>FIELD THEN WRITEPREFIX                          <<04.KM>>25190000
  ELSE IF PREFIXLEN>0 THEN                                     <<04.KM>>25195000
    BEGIN                                                      <<04.KM>>25200000
    BLANKLEFTFIELD;                                            <<04.KM>>25205000
    MOVE BUF:=PREFIX,(PREFIXLEN);                              <<04.KM>>25210000
    WRITELINE;                                                 <<04.KM>>25215000
    END;                                                       <<04.KM>>25220000
  BLANKLEFTFIELD;                                              <<04.KM>>25225000
  WHILE MSGLEN>0 DO WRITELINE;                                 <<04.KM>>25230000
  CXEXIT(CCE);                                                 <<04.KM>>25235000
                                                               <<04.KM>>25240000
EXITINSTR:                                                     <<04.KM>>25245000
END <<PROCEDURE MULTILINE>>;                                   <<04.KM>>25250000
                                                               <<04.KM>>25255000
                                                               <<04.KM>>25260000
                                                               <<04.KM>>25265000
                                                               <<04.KM>>25270000
$CONTROL  SEGMENT=CILISTF                                      <<04.KM>>25275000
<<********************************************************************>>25280000
<< L I S T F D I S M N T >>                                    <<04.KM>>25285000
                                                               <<04.KM>>25290000
PROCEDURE LISTFDISMNT(MOUNTDST,FATALERR,GROUP,ACCT,ERRNUM);    <<04.KM>>25295000
  VALUE FATALERR;                                              <<04.KM>>25300000
  INTEGER MOUNTDST,FATALERR,ERRNUM;                            <<04.KM>>25305000
  ARRAY GROUP,ACCT;                                            <<04.KM>>25310000
  OPTION PRIVILEGED,UNCALLABLE;                                <<04.KM>>25315000
BEGIN                                                          <<04.KM>>25320000
  EQUATE CATRECSIZE=   80,                                     <<04.KM>>25325000
         MAXMSG=       160,                                    <<04.KM>>25330000
         NAMEFIELD=    4,                                      <<04.KM>>25335000
         MAXPREFIX=    NAMEFIELD+22,                           <<04.KM>>25340000
         EXPLAINFIELD= MAXPREFIX;                              <<04.KM>>25345000
  EQUATE NOMOUNT=        0,                                    <<04.KM>>25350000
         CONDMOUNT'BIND= -3,                                   <<04.KM>>25355000
         SINGLESPACE=    0,                                    <<04.KM>>25360000
         NOPARM=         %100000,                              <<04.KM>>25365000
         RETURNIT=       -1,                                   <<04.KM>>25370000
         STDLIST=        2;                                    <<04.KM>>25375000
  BYTE ARRAY MSG(0:MAXMSG-1),                                  <<04.KM>>25380000
             PREFIX(0:MAXPREFIX-1),                            <<04.KM>>25385000
             INBUF(0:CATRECSIZE),                              <<04.KM>>25390000
             HOMEVS(0:7);                                      <<04.KM>>25395000
  BYTE POINTER NEXT,                                           <<04.KM>>25400000
               LAST;                                           <<04.KM>>25405000
  INTEGER DUMMY,                                               <<04.KM>>25410000
          PREFIXLEN,                                           <<04.KM>>25415000
          REQ'ERROR,                                           <<04.KM>>25420000
          MSGLEN,                                              <<04.KM>>25425000
          DSTENTINFO;                                          <<04.KM>>25430000
  LOGICAL FIRSTERROR:=TRUE;                                    <<04.KM>>25435000
                                                               <<04.KM>>25440000
  EQUATE DSTINFO=  0,                                          <<04.KM>>25445000
         OURINFOSIZE= 7;                                       <<04.KM>>25450000
  INTEGER ARRAY IMPINFO(0:OURINFOSIZE-1)= Q;                   <<04.KM>>25455000
  INTEGER IMPLEN=     IMPINFO,                                 <<04.KM>>25460000
          IMPINFOLEN= IMPLEN+1,                                <<04.KM>>25465000
          IMPENTLEN=  IMPINFOLEN+1,                            <<04.KM>>25470000
          IMPENTLOC=  IMPENTLEN+1;                             << I.A >>25475000
                                                               <<04.KM>>25480000
  EQUATE OURENTSIZE= 10;                                       <<04.KM>>25485000
  INTEGER ARRAY ENTINFO(0:OURENTSIZE-1)= Q;                    <<04.KM>>25490000
  INTEGER ENTERR=           ENTINFO,                           <<04.KM>>25495000
          ENTPVINFO=        ENTERR+1;                          <<04.KM>>25500000
  INTEGER ARRAY ENTNAME(*)= ENTPVINFO+1,                       <<04.KM>>25505000
                ENTGRP(*)=  ENTNAME,                           <<04.KM>>25510000
                ENTACCT(*)= ENTNAME+4;                         <<04.KM>>25515000
  INTRINSIC FREEDSEG;                                          <<04.KM>>25520000
  INTEGER PROCEDURE FORMSG(IBUF,MSET,MNUM,PMASK,P1,P2,P3,P4,   <<04.KM>>25525000
                           P5,OBUF,OSIZE,OLEN,DEST,CNTL);      <<04.KM>>25530000
    VALUE MSET,MNUM,PMASK,P1,P2,P3,P4,P5,OSIZE,DEST,CNTL;      <<04.KM>>25535000
    BYTE ARRAY IBUF,OBUF;                                      <<04.KM>>25540000
    INTEGER MSET,MNUM,PMASK,P1,P2,P3,P4,P5,OSIZE,OLEN,DEST,    <<04.KM>>25545000
            CNTL;                                              <<04.KM>>25550000
    OPTION EXTERNAL;                                           <<04.KM>>25555000
                                                               <<04.KM>>25560000
  SUBROUTINE DEF'MOVEFROMDSEG;                                 <<04.KM>>25565000
                                                               <<04.KM>>25570000
                                                               <<04.KM>>25575000
  <<*******************>>                                      <<04.KM>>25580000
  << SUBROUTINE APPEND >>                                      <<04.KM>>25585000
  <<*******************>>                                      <<04.KM>>25590000
                                                               <<04.KM>>25595000
  LOGICAL SUBROUTINE APPEND(NAME,SUFFIX,BUF);                  <<04.KM>>25600000
    VALUE SUFFIX; BYTE ARRAY NAME,BUF; INTEGER SUFFIX;         <<04.KM>>25605000
  BEGIN                                                        <<04.KM>>25610000
    IF NAME(7)=" " THEN MOVE BUF:=NAME WHILE ANS,1             <<04.KM>>25615000
    ELSE MOVE BUF:=NAME,(8),2;                                 <<04.KM>>25620000
    @LAST:=TOS;                                                <<04.KM>>25625000
    LAST:=SUFFIX;                                              <<04.KM>>25630000
    APPEND:=@LAST(1);                                          <<04.KM>>25635000
  END <<SUBROUTINE APPEND>>;                                   <<04.KM>>25640000
                                                               <<04.KM>>25645000
                                                               <<04.KM>>25650000
  <<********************>>                                     <<04.KM>>25655000
  << SUBROUTINE DMERROR >>                                     <<04.KM>>25660000
  <<********************>>                                     <<04.KM>>25665000
                                                               <<04.KM>>25670000
  SUBROUTINE DMERROR(MSGSET,MSGNUM,GROUP,ACCT);                <<04.KM>>25675000
    VALUE MSGSET,MSGNUM; INTEGER MSGSET,MSGNUM;                <<04.KM>>25680000
    BYTE ARRAY GROUP,ACCT;                                     <<04.KM>>25685000
  BEGIN                                                        <<04.KM>>25690000
    IF FIRSTERROR THEN                                         <<04.KM>>25695000
      BEGIN                                                    <<04.KM>>25700000
      IF JOBSESSIONMAIN THEN FWRITE(STDLIST,DUMMY,0,0);        <<04.KM>>25705000
      CIERR(-(ERRNUM:=IM'MNTERR));                             <<04.KM>>25710000
      FIRSTERROR:=FALSE;                                       <<04.KM>>25715000
      END;                                                     <<04.KM>>25720000
    IF NOT JOBSESSIONMAIN OR REQUESTSERVICE THEN RETURN;       <<07.KM>>25725000
    @NEXT:=APPEND(GROUP,".",PREFIX(NAMEFIELD));                <<04.KM>>25730000
    PREFIXLEN:=APPEND(ACCT,":",NEXT)-LOGICAL(@PREFIX);         <<04.KM>>25735000
    MSGLEN:=0;                                                 <<04.KM>>25740000
    FORMSG(INBUF,MSGSET,MSGNUM,NOPARM,0,0,0,0,0,MSG,MAXMSG,    <<04.KM>>25745000
           MSGLEN,RETURNIT,0);                                 <<04.KM>>25750000
    MULTILINE(<<FILE>>,MSG,MSGLEN,EXPLAINFIELD,<<FIELDLEN>>,   <<04.KM>>25755000
              SINGLESPACE,PREFIX,PREFIXLEN);                   <<04.KM>>25760000
  END <<SUBROUTINE DMERROR>>;                                  <<04.KM>>25765000
                                                               <<04.KM>>25770000
                                                               <<04.KM>>25775000
  <<*********************>>                                    <<04.KM>>25780000
  << MAIN PROCEDURE BODY >>                                    <<04.KM>>25785000
  <<*********************>>                                    <<04.KM>>25790000
                                                               <<04.KM>>25795000
  MOVE PREFIX:="  *.";                                         <<04.KM>>25800000
  IF MOUNTDST>0 THEN                                           <<04.KM>>25805000
    BEGIN                                                      <<04.KM>>25810000
    MOVEFROMDSEG(@IMPINFO,MOUNTDST,DSTINFO,OURINFOSIZE);       <<04.KM>>25815000
    MOVE HOMEVS:="*       ";                                   <<04.KM>>25820000
    FOR DSTENTINFO:=IMPINFOLEN STEP IMPENTLEN                  <<04.KM>>25825000
                    UNTIL IMPENTLOC-1 DO                       <<04.KM>>25830000
      BEGIN                                                    <<04.KM>>25835000
      MOVEFROMDSEG(@ENTINFO,MOUNTDST,DSTENTINFO,OURENTSIZE);   <<04.KM>>25840000
      IF ENTERR<>0 THEN                                        <<04.KM>>25845000
        BEGIN                                                  <<04.KM>>25850000
        DMERROR(PVERRMSGSET,ENTERR,ENTGRP,ENTACCT)             <<04.KM>>25855000
        END                                                    <<04.KM>>25860000
      ELSE                                                     <<04.KM>>25865000
        BEGIN                                                  <<04.KM>>25870000
        REQ'ERROR:=CONDMOUNT'BIND;                             <<04.KM>>25875000
        DISMOUNT(HOMEVS,ENTGRP,ENTACCT,REQ'ERROR,ENTPVINFO);   <<04.KM>>25880000
        IF <> THEN                                             <<04.KM>>25885000
          BEGIN                                                <<04.KM>>25890000
          DMERROR(PVERRMSGSET,REQ'ERROR,ENTGRP,ENTACCT);       <<04.KM>>25895000
          END;                                                 <<04.KM>>25900000
        END;                                                   <<04.KM>>25905000
      END;                                                     <<04.KM>>25910000
    FREEDSEG(MOUNTDST,0);                                      <<04.KM>>25915000
    MOUNTDST:=0;                                               <<04.KM>>25920000
    END;                                                       <<04.KM>>25925000
                                                               <<04.KM>>25930000
  IF FATALERR>NOMOUNT THEN                                     <<04.KM>>25935000
    BEGIN                                                      <<04.KM>>25940000
    DMERROR(CIERRMSGSET,IM'MNTERR+FATALERR,GROUP,ACCT);        <<04.KM>>25945000
    END;                                                       <<04.KM>>25950000
END <<PROCEDURE LISTFDISMNT>>;                                 <<04.KM>>25955000
                                                              <<00.GEN>>25960000
                                                              <<00.GEN>>25965000
$CONTROL  SEGMENT=CILISTF                                      <<03.KM>>25970000
                                                               <<03.KM>>25975000
INTEGER PROCEDURE DIRMATCH(DESIGNATOR,REALNAME);              <<00.GEN>>25980000
                          VALUE DESIGNATOR,REALNAME;          <<00.GEN>>25985000
                          BYTE POINTER DESIGNATOR,            <<00.GEN>>25990000
                                       REALNAME;              <<00.GEN>>25995000
                          OPTION UNCALLABLE;                  <<00.GEN>>26000000
BEGIN                                                         <<00.GEN>>26005000
  COMMENT:                                                    <<00.GEN>>26010000
    COMPARES GENERIC AND DIRECTORY NAMES AND RETURNS AN       <<00.GEN>>26015000
    INDICATOR OF THE MATCH, VIZ.:                             <<00.GEN>>26020000
                                                              <<00.GEN>>26025000
      -1 = INITIAL SUBSTRING OF "DESIGNATOR" IS LESS          <<00.GEN>>26030000
           THAN "REALNAME"                                    <<00.GEN>>26035000
       0 = "DESIGNATOR" AND "REALNAME" MATCH                  <<00.GEN>>26040000
       1 = "DESIGNATOR" AND "REALNAME" DO NOT MATCH.          <<00.GEN>>26045000
                                                              <<00.GEN>>26050000
    NOTE THAT -1 CAN BE RETURNED ONLY IF THE INITIAL          <<00.GEN>>26055000
    SUBSTRING OF "DESIGNATOR" STARTS WITH AN ALPHABETIC       <<00.GEN>>26060000
    CHARACTER.                                                <<00.GEN>>26065000
                                                              <<00.GEN>>26070000
    ASCERTIONS:                                               <<00.GEN>>26075000
      (1) "DESIGNATOR" CONTAINS ONLY ALPHANUMERIC, "?",       <<00.GEN>>26080000
          "#" AND "@" CHARACTERS                              <<00.GEN>>26085000
      (2) "DESIGNATOR" DOES NOT CONTAIN THE SEQUENCES         <<00.GEN>>26090000
          "@?" & "@@" (THESE SHOULD BE CONVERTED TO           <<00.GEN>>26095000
          "?@" & "@" BY THE PATTERN BUILDER)                  <<00.GEN>>26100000
      (3) "REALNAME" CONTAINS ONLY ALPHANUMERIC CHARACTERS    <<00.GEN>>26105000
      (4) "DESIGNATOR" & "REALNAME" ARE 8 BYTES LONG, WITH    <<00.GEN>>26110000
          BLANK-FILL ON THE RIGHT                             <<00.GEN>>26115000
      (5) "DESIGNATOR" & "REALNAME" ARE BOTH THE SAME CASE,   <<00.GEN>>26120000
          VIZ. UPPER- OR LOWER-CASE;                          <<00.GEN>>26125000
                                                              <<00.GEN>>26130000
                                                              <<00.GEN>>26135000
  EQUATE NOCODE= -2,                                          <<00.GEN>>26140000
         LTCODE= -1,                                          <<00.GEN>>26145000
         EQCODE=  0,                                          <<00.GEN>>26150000
         GTCODE=  1;                                          <<00.GEN>>26155000
                                                              <<00.GEN>>26160000
  BYTE POINTER DLEFT,                                         <<00.GEN>>26165000
               NLEFT;                                         <<00.GEN>>26170000
  INTEGER X=         X,                                       <<00.GEN>>26175000
          MATCHCODE= DIRMATCH;                                <<00.GEN>>26180000
                                                              <<00.GEN>>26185000
  ARRAY NEXTQ(*)=    Q;                <<ALLOCATE ON TOS>>    <<00.GEN>>26190000
  BYTE POINTER DPTR= NEXTQ,                                   <<00.GEN>>26195000
               NPTR= DPTR+1;                                  <<00.GEN>>26200000
  INTEGER LENGTH=    NPTR+1;                                  <<00.GEN>>26205000
                                                              <<00.GEN>>26210000
                                                              <<00.GEN>>26215000
  <<*************************>>                               <<00.GEN>>26220000
  << DEFINE LESSER'SUBSTRING >>                               <<00.GEN>>26225000
  <<*************************>>                               <<00.GEN>>26230000
                                                              <<00.GEN>>26235000
  DEFINE LESSER'SUBSTRING=                                    <<00.GEN>>26240000
    < AND (DPTR<>SPECIAL OR DPTR=" ") #;                      <<00.GEN>>26245000
                                                              <<00.GEN>>26250000
  <<**************************>>                              <<00.GEN>>26255000
  << DEFINE RESET'MATCHSTART >>                               <<00.GEN>>26260000
  <<**************************>>                              <<00.GEN>>26265000
                                                              <<00.GEN>>26270000
  COMMENT:                                                    <<00.GEN>>26275000
    S-2 = @DPTR                                               <<00.GEN>>26280000
    S-1 = @NPTR                                               <<00.GEN>>26285000
    S-0 = LENGTH OF COMPARE.                                  <<00.GEN>>26290000
                                                              <<00.GEN>>26295000
    BACK-UP POINTERS SO THAT "@" WILL MATCH LONGER            <<00.GEN>>26300000
    SUBSTRING.  "DPTR" IS RESET TO THE RIGHT OF               <<00.GEN>>26305000
    LAST "@".  "NPTR" IS RESET TO THE RIGHT OF LAST           <<00.GEN>>26310000
    INITIAL MATCH DETERMINED BY "FIND'MATCHSTART";            <<00.GEN>>26315000
                                                              <<00.GEN>>26320000
  DEFINE RESET'MATCHSTART=                                    <<00.GEN>>26325000
    BEGIN                                                     <<00.GEN>>26330000
      @NLEFT:=@NLEFT+1;                                       <<00.GEN>>26335000
      DEL; DDEL;                                              <<00.GEN>>26340000
      TOS:=@DLEFT;                                            <<00.GEN>>26345000
      TOS:=@NLEFT;                                            <<00.GEN>>26350000
      TOS:=@REALNAME(8)-@NLEFT;                               <<00.GEN>>26355000
      DIRMATCH:=NOCODE;                                       <<00.GEN>>26360000
      FIND'MATCHSTART;                                        <<00.GEN>>26365000
    END <<DEFINE RESET'MATCHSTART>>#;                         <<00.GEN>>26370000
                                                              <<00.GEN>>26375000
  <<*********************>>                                   <<00.GEN>>26380000
  << DEFINE TURNOFFTRAPS >>                                   <<00.GEN>>26385000
  <<*********************>>                                   <<00.GEN>>26390000
                                                              <<00.GEN>>26395000
  DEFINE TURNOFFTRAPS=                                        <<00.GEN>>26400000
    BEGIN                                                     <<00.GEN>>26405000
      COMMENT:                                                <<00.GEN>>26410000
        AVOID INTEGER OVERFLOW FOR BYTE ADDRESS               <<00.GEN>>26415000
        ARITHMETIC;                                           <<00.GEN>>26420000
                                                              <<00.GEN>>26425000
      PUSH(STATUS);                                           <<00.GEN>>26430000
      TOS.(2:1):=0;                                           <<00.GEN>>26435000
      SET(STATUS);                                            <<00.GEN>>26440000
    END <<DEFINE TURNOFFTRAPS>>#;                             <<00.GEN>>26445000
                                                              <<00.GEN>>26450000
  <<****************>>                                        <<00.GEN>>26455000
  << SUBROUTINE MIN >>                                        <<00.GEN>>26460000
  <<****************>>                                        <<00.GEN>>26465000
                                                              <<00.GEN>>26470000
  INTEGER SUBROUTINE MIN(I,J); VALUE I,J; INTEGER I,J;        <<00.GEN>>26475000
  BEGIN                                                       <<00.GEN>>26480000
    MIN:=IF I<=J THEN I ELSE J;                               <<00.GEN>>26485000
  END <<SUBROUTINE MIN>>;                                     <<00.GEN>>26490000
                                                               <<03.KM>>26495000
                                                               <<03.KM>>26500000
  <<****************************>>                             <<03.KM>>26505000
  << SUBROUTINE FIND'MATCHSTART >>                             <<03.KM>>26510000
  <<****************************>>                             <<03.KM>>26515000
                                                               <<03.KM>>26520000
  SUBROUTINE FIND'MATCHSTART;                                  <<03.KM>>26525000
  BEGIN                                                        <<03.KM>>26530000
    COMMENT:                                                   <<03.KM>>26535000
      SCAN "NPTR" FOR MATCH WITH CHARACTER FOLLOWING           <<03.KM>>26540000
      "@" IN "DSTR".  SAVE POSITION IN "NLEFT" AND             <<03.KM>>26545000
      SET "LENGTH" TO LENGTH OF COMPARE;                       <<03.KM>>26550000
                                                               <<03.KM>>26555000
    IF DPTR="#" THEN                                           <<03.KM>>26560000
    BEGIN                                                      <<03.KM>>26565000
      WHILE (LENGTH:=LENGTH-1)>=0 AND                          <<03.KM>>26570000
            NPTR<>NUMERIC DO @NPTR:=@NPTR+1;                   <<03.KM>>26575000
    END                                                        <<03.KM>>26580000
    ELSE BEGIN                                                 <<03.KM>>26585000
      WHILE (LENGTH:=LENGTH-1)>=0 AND                          <<03.KM>>26590000
            NPTR<>DPTR DO @NPTR:=@NPTR+1;                      <<03.KM>>26595000
    END;                                                       <<03.KM>>26600000
                                                               <<03.KM>>26605000
    LENGTH:=LENGTH+1;                                          <<03.KM>>26610000
    IF <= THEN DIRMATCH:=GTCODE                                <<03.KM>>26615000
    ELSE BEGIN                                                 <<03.KM>>26620000
      @NLEFT:=@NPTR;                                           <<03.KM>>26625000
      LENGTH:=MIN(@DESIGNATOR(8)-@DPTR, @REALNAME(8)-@NPTR);   <<03.KM>>26630000
    END;                                                       <<03.KM>>26635000
  END <<SUBROUTINE FIND'MATCHSTART>>;                          <<03.KM>>26640000
                                                               <<03.KM>>26645000
                                                               <<03.KM>>26650000
  <<**************************>>                               <<03.KM>>26655000
  << SUBROUTINE CHECK'ENDCOND >>                               <<03.KM>>26660000
  <<**************************>>                               <<03.KM>>26665000
                                                               <<03.KM>>26670000
  SUBROUTINE CHECK'ENDCOND;                                    <<03.KM>>26675000
  BEGIN                                                        <<03.KM>>26680000
    COMMENT:                                                   <<03.KM>>26685000
      ENSURE THAT BOTH "DPTR" AND "NPTR" STRINGS ARE           <<03.KM>>26690000
      EXHAUSTED.  IF EQCODE, THEN AT LEAST ONE STRING          <<03.KM>>26695000
      IS EXHAUSTED;                                            <<03.KM>>26700000
                                                               <<03.KM>>26705000
    IF MATCHCODE=EQCODE THEN                                   <<03.KM>>26710000
    BEGIN                                                      <<03.KM>>26715000
      IF @DPTR=@DESIGNATOR(8) THEN                             <<03.KM>>26720000
      BEGIN                                                    <<03.KM>>26725000
        IF @NPTR<>@REALNAME(8) AND                             <<03.KM>>26730000
           NPTR<>" " THEN DIRMATCH:=GTCODE;                    <<03.KM>>26735000
      END                                                      <<03.KM>>26740000
      ELSE                                                     <<03.KM>>26745000
        IF DPTR<>" " THEN                                      <<03.KM>>26750000
        BEGIN                                                  <<03.KM>>26755000
          IF DPTR<>"@" OR                                      <<03.KM>>26760000
             @DPTR<>@DESIGNATOR(7) AND                         <<03.KM>>26765000
             DPTR(1)<>" " THEN DIRMATCH:=GTCODE;               <<03.KM>>26770000
        END;                                                   <<03.KM>>26775000
    END;                                                       <<03.KM>>26780000
  END <<SUBROUTINE CHECK'ENDCOND>>;                            <<03.KM>>26785000
                                                              <<00.GEN>>26790000
  <<********************>>                                    <<00.GEN>>26795000
  << SUBROUTINE CLOSURE >>                                    <<00.GEN>>26800000
  <<********************>>                                    <<00.GEN>>26805000
                                                              <<00.GEN>>26810000
  LOGICAL SUBROUTINE CLOSURE;                                 <<00.GEN>>26815000
  BEGIN                                                       <<00.GEN>>26820000
    COMMENT:                                                  <<00.GEN>>26825000
      RETURN "TRUE" IF WE'VE ENCOUNTERED AN EMBEDDED          <<00.GEN>>26830000
      "@" (CLOSURE WILDCARD).  WE ASSUME THAT WE'VE           <<00.GEN>>26835000
      DONE A "SIMPLEMATCH" FIRST.  THUS, FAILURE TO           <<00.GEN>>26840000
      FIND CLOSURE WILDCARD MEANS THAT NO FURTHER             <<00.GEN>>26845000
      MATCH IS POSSIBLE (MATCH=GTCODE).  NOTE THAT            <<00.GEN>>26850000
      IF CLOSURE WILDCARD IS AT THE END OF "DPTR",            <<00.GEN>>26855000
      THE MATCH IS DONE (MATCH=EQCODE) SINCE IT WILL          <<00.GEN>>26860000
      MATCH REMAINDER OF "NPTR";                              <<00.GEN>>26865000
                                                              <<00.GEN>>26870000
    CLOSURE:=FALSE;                                           <<00.GEN>>26875000
    IF MATCHCODE=NOCODE THEN                                  <<00.GEN>>26880000
    BEGIN                                                     <<00.GEN>>26885000
      IF DPTR<>"@" THEN DIRMATCH:=GTCODE                      <<00.GEN>>26890000
      ELSE                                                    <<00.GEN>>26895000
        IF @DPTR=@DESIGNATOR(7) OR                            <<00.GEN>>26900000
           DPTR(1)=" " THEN DIRMATCH:=EQCODE                  <<00.GEN>>26905000
      ELSE IF NPTR=" " THEN DIRMATCH:=GTCODE                  <<00.GEN>>26910000
      ELSE BEGIN                                              <<00.GEN>>26915000
        @DPTR:=@DPTR+1;                                       <<00.GEN>>26920000
        @DLEFT:=@DPTR;                                        <<00.GEN>>26925000
        @NLEFT := @NPTR;                                       <<01516>>26930000
        LENGTH:=@REALNAME(8)-@NPTR;                           <<00.GEN>>26935000
        FIND'MATCHSTART;                                      <<00.GEN>>26940000
        IF MATCHCODE=NOCODE THEN CLOSURE:=TRUE;               <<00.GEN>>26945000
      END;                                                    <<00.GEN>>26950000
    END;                                                      <<00.GEN>>26955000
  END <<SUBROUTINE CLOSURE>>;                                 <<00.GEN>>26960000
                                                              <<00.GEN>>26965000
  <<************************>>                                <<00.GEN>>26970000
  << SUBROUTINE SIMPLEMATCH >>                                <<00.GEN>>26975000
  <<************************>>                                <<00.GEN>>26980000
                                                              <<00.GEN>>26985000
  SUBROUTINE SIMPLEMATCH;                                     <<00.GEN>>26990000
  BEGIN                                                       <<00.GEN>>26995000
    COMMENT:                                                  <<00.GEN>>27000000
      S-3 = @DPTR                                             <<00.GEN>>27005000
      S-2 = @NPTR                                             <<00.GEN>>27010000
      S-1 = LENGTH OF COMPARE                                 <<00.GEN>>27015000
      S-0 = "SIMPLEMATCH" RETURN ADDRESS.                     <<00.GEN>>27020000
                                                              <<00.GEN>>27025000
      MATCH ALPHANUMERIC CHARACTERS AND SINGLE-BYTE           <<00.GEN>>27030000
      WILDCARD CHARACTERS ("?" AND "#");                      <<00.GEN>>27035000
                                                              <<00.GEN>>27040000
    X:=TOS;                            <<SAVE RETN ADDR>>     <<00.GEN>>27045000
    DO BEGIN                                                  <<00.GEN>>27050000
      IF * <> *,(TOS),0 THEN                                  <<00.GEN>>27055000
      BEGIN                                                   <<00.GEN>>27060000
  LOOP:                                                       <<00.GEN>>27065000
        IF DPTR="?" AND NPTR<>SPECIAL OR                      <<00.GEN>>27070000
           DPTR="#" AND NPTR=NUMERIC THEN                     <<00.GEN>>27075000
        BEGIN                                                 <<00.GEN>>27080000
          @DPTR:=@DPTR+1;                                     <<00.GEN>>27085000
          ASSEMBLE(INCB,DECA);                                <<00.GEN>>27090000
          IF <> THEN GO LOOP;                                 <<00.GEN>>27095000
        END;                                                  <<00.GEN>>27100000
      END;                                                    <<00.GEN>>27105000
    END UNTIL LENGTH=0 OR DPTR<>NPTR;                         <<00.GEN>>27110000
    IF = THEN DIRMATCH:=EQCODE;        <<LENGTH=0>>           <<00.GEN>>27115000
    TOS:=X;                            <<RESET RETN ADDR>>    <<00.GEN>>27120000
  END <<SUBROUTINE SIMPLEMATCH>>;                             <<00.GEN>>27125000
                                                              <<00.GEN>>27130000
                                                              <<00.GEN>>27135000
  <<***********************>>                                 <<00.GEN>>27140000
  <<                       >>                                 <<00.GEN>>27145000
  << BEGIN PROCEDURE MATCH >>                                 <<00.GEN>>27150000
  <<                       >>                                 <<00.GEN>>27155000
  <<***********************>>                                 <<00.GEN>>27160000
                                                              <<00.GEN>>27165000
  TURNOFFTRAPS;                                               <<00.GEN>>27170000
  IF DESIGNATOR=REALNAME,(8),0 THEN DIRMATCH:=EQCODE          <<00.GEN>>27175000
  ELSE IF LESSER'SUBSTRING THEN DIRMATCH:=LTCODE              <<00.GEN>>27180000
  ELSE BEGIN                                                  <<00.GEN>>27185000
    COMMENT:                                                  <<00.GEN>>27190000
      S-2 = @DPTR                                             <<00.GEN>>27195000
      S-1 = @NPTR                                             <<00.GEN>>27200000
      S-0 = COMPARE LENGTH;                                   <<00.GEN>>27205000
                                                              <<00.GEN>>27210000
    DIRMATCH:=NOCODE;                                         <<00.GEN>>27215000
    SIMPLEMATCH;                                              <<00.GEN>>27220000
    IF CLOSURE THEN                                           <<00.GEN>>27225000
    BEGIN                                                     <<00.GEN>>27230000
      DO BEGIN                                                <<00.GEN>>27235000
        DO SIMPLEMATCH UNTIL NOT CLOSURE;                     <<00.GEN>>27240000
        CHECK'ENDCOND;                                        <<00.GEN>>27245000
        IF MATCHCODE<>EQCODE THEN RESET'MATCHSTART;           <<00.GEN>>27250000
      END UNTIL MATCHCODE<>NOCODE;                             <<01454>>27255000
    END;                                                       <<01454>>27260000
  END;                                                         <<01454>>27265000
END <<PROCEDURE DIRMATCH>>;                                    <<01454>>27270000
                                                               <<01454>>27275000
                                                               <<01454>>27280000
                                                               <<01454>>27285000
PROCEDURE GET'FILECODE(FILECODE,MNEMONIC,MNEMONIC'LENGTH);     <<01454>>27290000
   INTEGER FILECODE,MNEMONIC'LENGTH;                           <<01454>>27295000
   BYTE ARRAY MNEMONIC;                                        <<01454>>27300000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01454>>27305000
                                                               <<01454>>27310000
COMMENT                                                        <<01454>>27315000
   This procedure contains two entry points for converting file<<01454>>27320000
   code mnemonics to file code values and vice versa.          <<01454>>27325000
                                                               <<01454>>27330000
GET'FILECODE                                                   <<01454>>27335000
   This entry point takes a character string, compares it to   <<01454>>27340000
   a list of HP defined file code mnemonics, and returns the   <<01454>>27345000
   integer value of the corresponding file code.               <<01454>>27350000
                                                               <<01454>>27355000
   INPUT                                                       <<01454>>27360000
      MNEMONIC -- byte array containing the character string.  <<01454>>27365000
      MNEMONIC'LENGTH -- length of the character string        <<01454>>27370000
         contained in MNEMONIC.  Must be > 0.                  <<01454>>27375000
   OUTPUT                                                      <<01454>>27380000
      FILECODE -- integer file code corresponding to the string<<01454>>27385000
         passed in MNEMONIC.  If there is no HP defined file   <<01454>>27390000
         code corresponding to the input string, the value     <<01454>>27395000
         returned in FILECODE is 0.                            <<01454>>27400000
   CONDITION CODE                                              <<01454>>27405000
      CCE -- string passed is an HP defined file code mnemonic.<<01454>>27410000
      CCG -- string passed is not an HP defined mnemonic.      <<01454>>27415000
      CCL -- error in call, length <= 0.                       <<01454>>27420000
                                                               <<01454>>27425000
GET'FILEMNEMONIC                                               <<01454>>27430000
   This entry point takes an integer value, compares it to a   <<01454>>27435000
   list of HP defined file codes, and returns the mnemonic     <<01454>>27440000
   corresponding to the input value.                           <<01454>>27445000
                                                               <<01454>>27450000
   INPUT                                                       <<01454>>27455000
      FILECODE -- integer file code.                           <<01454>>27460000
   OUTPUT                                                      <<01454>>27465000
      MNEMONIC -- 5 character mnemonic corresponding to the    <<01454>>27470000
         input value.  The mnemonic is left-justified with     <<01454>>27475000
         trailing blanks.  If the file code does not have a    <<01454>>27480000
         corresponding mnemonic, the string is all blanks.     <<01454>>27485000
      MNEMONIC'LENGTH -- the number of non-blank characters    <<01454>>27490000
         returned in MNEMONIC.                                 <<01454>>27495000
   CONDITION CODE                                              <<01454>>27500000
      CCE -- the input value had a corresponding mnemonic.     <<01454>>27505000
      CCG -- no mnemonic for file code value.                  <<01454>>27510000
      CCL -- not returned.                                     <<01454>>27515000
                                                               <<01454>>27520000
ISSUES                                                         <<01454>>27525000
   1)  The dictionary entries are of fixed length so that they <<01454>>27530000
       can be indexed.                                         <<01454>>27535000
   2)  The search for GET'FILEMNEMONIC is faster than the      <<01454>>27540000
       search for GET'FILECODE because LISTF's are done more   <<01454>>27545000
       frequently than FILE or BUILD commands.                 <<01454>>27550000
                                                               <<01454>>27555000
ADDING A NEW MNEMONIC                                          <<01454>>27560000
   1)  Change NUMBER'CODES to reflect the new number of        <<01454>>27565000
       mnemonics.                                              <<01454>>27570000
   2)  Insert an entry into BOTH the dictionary and the the    <<01454>>27575000
       file code array so that the indices match.              <<01454>>27580000
;                                                              <<01454>>27585000
                                                               <<01454>>27590000
                                                               <<01454>>27595000
                                                               <<01454>>27600000
BEGIN                                                          <<01454>>27605000
   ENTRY GET'FILEMNEMONIC;                                     <<01454>>27610000
                                                               <<01454>>27615000
   BYTE ARRAY LOCAL'BUFFER(0:7);                               <<01454>>27620000
                                                               <<01454>>27625000
   INTEGER ENTRY'NUMBER,  << INDEX OF ENTRY >>                 <<01454>>27630000
           LOWER'BOUND,   << BOUNDS FOR BINARY SEARCH >>       <<01454>>27635000
           UPPER'BOUND;                                        <<01454>>27640000
                                                               <<01454>>27645000
<< NUMBER'CODES -- the number of file codes and associated >>  <<01454>>27650000
<<    mnemonics contained in the two data structures.      >>  <<01454>>27655000
                                                               <<01454>>27660000
   EQUATE NUMBER'CODES = 87,                                   << 8084>>27665000
          DICT'LENGTH = NUMBER'CODES*8 + 1;                    <<01454>>27670000
                                                               <<01454>>27675000
   BYTE ARRAY LOCAL'DICT(0:DICT'LENGTH-1);                     <<01454>>27680000
                                                               <<01454>>27685000
<< MNEMONIC'DICT -- a byte array formatted for use by the    >><<01454>>27690000
<<    SEARCH intrinsic.  The "name" portion of each entry is >><<01454>>27695000
<<    five characters containing a file code mnemonic left-  >><<01454>>27700000
<<    justified with trailing blanks.  The definition        >><<01454>>27705000
<<    portion of each entry is the length of the mnemonic.   >><<01454>>27710000
                                                               <<01454>>27715000
   BYTE ARRAY MNEMONIC'DICT(0:DICT'LENGTH-1) = PB :=           <<01454>>27720000
                                                               <<01454>>27725000
8,5,"USL  ",3,     << 1024 >>                                  <<01454>>27730000
8,5,"BASD ",4,     << 1025 >>                                  <<01454>>27735000
8,5,"BASP ",4,     << 1026 >>                                  <<01454>>27740000
8,5,"BASFP",5,     << 1027 >>                                  <<01454>>27745000
8,5,"RL   ",2,     << 1028 >>                                  <<01454>>27750000
8,5,"PROG ",4,     << 1029 >>                                  <<01454>>27755000
8,5,"SL   ",2,     << 1031 >>                                  <<01454>>27760000
8,5,"VFORM",5,     << 1035 >>                                  <<01454>>27765000
8,5,"VFAST",5,     << 1036 >>                                  <<01454>>27770000
8,5,"VREF ",4,     << 1037 >>                                  <<01454>>27775000
8,5,"XLSAV",5,     << 1040 >>                                  <<01454>>27780000
8,5,"XLBIN",5,     << 1041 >>                                  <<01454>>27785000
8,5,"XLDSP",5,     << 1042 >>                                  <<01454>>27790000
8,5,"EDITQ",5,     << 1050 >>                                  <<01454>>27795000
8,5,"EDTCQ",5,     << 1051 >>                                  <<01454>>27800000
8,5,"EDTCT",5,     << 1052 >>                                  <<01454>>27805000
8,5,"TDPDT",5,     << 1054 >>                                           27810000
8,5,"TDPQM",5,     << 1055 >>                                           27815000
8,5,"TDPP ",4,     << 1056 >>                                           27820000
8,5,"TDPCP",5,     << 1057 >>                                           27825000
8,5,"TDPQ ",4,     << 1058 >>                                           27830000
8,5,"TDPXQ",5,     << 1059 >>                                           27835000
8,5,"RJEPN",5,     << 1060 >>                                  <<01454>>27840000
8,5,"QPROC",5,     << 1070 >>                                  <<01454>>27845000
8,5,"KSAMK",5,     << 1080 >>                                  <<01454>>27850000
8,5,"GRAPH",5,     << 1083 >>                                  <<01454>>27855000
8,5,"SD   ",2,     << 1084 >>                                  <<01454>>27860000
8,5,"LOG  ",3,     << 1090 >>                                  <<01454>>27865000
8,5,"WDOC ",4,     << 1100 >>                                  <<01454>>27870000
8,5,"WDICT",5,     << 1101 >>                                  <<01454>>27875000
8,5,"WCONF",5,     << 1102 >>                                  <<04783>>27880000
8,5,"W2601",5,     << 1103 >>                                  <<04783>>27885000
8,5,"PCELL",5,     << 1110 >>                                  <<01454>>27890000
8,5,"PFORM",5,     << 1111 >>                                  <<01454>>27895000
8,5,"PENV ",4,     << 1112 >>                                  <<06843>>27900000
8,5,"PCCMP",5,     << 1113 >>                                  <<01454>>27905000
8,5,"RASTR",5,     << 1114 >>                                  <<04783>>27910000
8,5,"OPTLF",5,     << 1130 >>                                  <<01652>>27915000
8,5,"TEPES",5,     << 1131 >>                                  <<01454>>27920000
8,5,"TEPEL",5,     << 1132 >>                                  <<01454>>27925000
8,5,"SAMPL",5,     << 1133 >>                                  <<04783>>27930000
8,5,"MPEDL",5,     << 1139 >>                                  <<04783>>27935000
8,5,"TSR  ",3,     << 1140 >>                                  <<04783>>27940000
8,5,"TSD  ",3,     << 1141 >>                                  <<04783>>27945000
8,5,"DRAW ",4,     << 1145 >>                                  <<04783>>27950000
8,5,"FIG  ",3,     << 1146 >>                                           27955000
8,5,"FONT ",4,     << 1147 >>                                  <<06843>>27960000
8,5,"COLOR",5,     << 1148 >>                                  <<07276>>27965000
8,5,"D48  ",3,     << 1149 >>                                  <<07276>>27970000
8,5,"SLATE",5,     << 1152 >>                                  << 7794>>27975000
8,5,"SLATW",5,     << 1153 >>                                  << 7794>>27980000
8,5,"DSTOR",5,     << 1156 >>                                  <<04783>>27985000
8,5,"TCODE",5,     << 1157 >>                                  <<04783>>27990000
8,5,"RCODE",5,     << 1158 >>                                  <<04783>>27995000
8,5,"ICODE",5,     << 1159 >>                                  <<04783>>28000000
8,5,"MDIST",5,     << 1166 >>                                  <<04783>>28005000
8,5,"MTEXT",5,     << 1167 >>                                  <<04783>>28010000
8,5,"VCSF ",4,     << 1176 >>                                  <<04783>>28015000
8,5,"TTYPE",5,     << 1177 >>                                  <<04783>>28020000
8,5,"TVFC ",4,     << 1178 >>                                           28025000
8,5,"NCONF",5,     << 1192 >>                                  <<04783>>28030000
8,5,"NTRAC",5,     << 1193 >>                                  <<04783>>28035000
8,5,"NLOG ",4,     << 1194 >>                                  <<04783>>28040000
8,5,"MIDAS",5,     << 1195 >>                                  <<04783>>28045000
8,5,"ANODE",5,     << 1211 >>                                  << 8084>>28050000
8,5,"INODE",5,     << 1212 >>                                  << 8084>>28055000
8,5,"INVRT",5,     << 1213 >>                                  << 8084>>28060000
8,5,"EXCEP",5,     << 1214 >>                                  << 8084>>28065000
8,5,"TAXON",5,     << 1215 >>                                  << 8084>>28070000
8,5,"QUERF",5,     << 1216 >>                                  << 8084>>28075000
8,5,"DOCDR",5,     << 1217 >>                                  << 8084>>28080000
8,5,"VC   ",2,     << 1226 >>                                  <<06843>>28085000
8,5,"DIF  ",3,     << 1227 >>                                  <<06843>>28090000
8,5,"LANGD",5,     << 1228 >>                                  <<06843>>28095000
8,5,"CHARD",5,     << 1229 >>                                  <<06843>>28100000
8,5,"MGCAT",5,     << 1230 >>                                  <<06843>>28105000
8,5,"ATLAS",5,     << 1235 >>                                  << 7794>>28110000
8,5,"BMAP ",4,     << 1236 >>                                  <<06843>>28115000
8,5,"BDATA",5,     << 1242 >>                                  << 7794>>28120000
8,5,"BFORM",5,     << 1243 >>                                  << 7794>>28125000
8,5,"BSAVE",5,     << 1244 >>                                  << 7794>>28130000
8,5,"BCNFG",5,     << 1245 >>                                  << 7794>>28135000
8,5,"PFJOB",5,     << 1257 >>                                  << 7794>>28140000
8,5,"PFTAB",5,     << 1258 >>                                  << 7794>>28145000
8,5,"PFDYN",5,     << 1259 >>                                  << 7794>>28150000
8,5,"PFSRC",5,     << 1260 >>                                  << 7794>>28155000
8,5,"CWPTX",5,     << 1401 >>                                  << 8084>>28160000
0;                                                             <<01454>>28165000
                                                               <<01454>>28170000
<< MNEMONIC'CODE -- an ascending ordered integer array       >><<01454>>28175000
<<    containing those HP defined file codes which have a    >><<01454>>28180000
<<    corresponding mnemonic.  The index of each element     >><<01454>>28185000
<<    corresponds to the entry number returned by the SEARCH >><<01454>>28190000
<<    intrinsic for its mnemonic.                            >><<01454>>28195000
                                                               <<01454>>28200000
   INTEGER ARRAY MNEMONIC'CODE(1:NUMBER'CODES) = PB :=         <<01454>>28205000
                                                               <<01454>>28210000
1024      << USL   >>                                          <<01454>>28215000
,1025     << BASD  >>                                          <<01454>>28220000
,1026     << BASP  >>                                          <<01454>>28225000
,1027     << BASFP >>                                          <<01454>>28230000
,1028     << RL    >>                                          <<01454>>28235000
,1029     << PROG  >>                                          <<01454>>28240000
,1031     << SL    >>                                          <<01454>>28245000
,1035     << VFORM >>                                          <<01454>>28250000
,1036     << VFAST >>                                          <<01454>>28255000
,1037     << VREF  >>                                          <<01454>>28260000
,1040     << XLSAV >>                                          <<01454>>28265000
,1041     << XLBIN >>                                          <<01454>>28270000
,1042     << XLDSP >>                                          <<01454>>28275000
,1050     << EDITQ >>                                          <<01454>>28280000
,1051     << EDTCQ >>                                          <<01454>>28285000
,1052     << EDTCT >>                                          <<01454>>28290000
<< 1053:       RESERVED FOR EDIT EXTENSIONS >>                          28295000
,1054     << TDPDT >>                                                   28300000
,1055     << TDPQM >>                                                   28305000
,1056     << TDPP  >>                                                   28310000
,1057     << TDPCP >>                                                   28315000
,1058     << TDPQ  >>                                                   28320000
,1059     << TDPCQ >>                                                   28325000
,1060     << RJEPN >>                                          <<01454>>28330000
<< 1061-1069:  RESERVED FOR RJE EXTENSIONS >>                  <<01454>>28335000
,1070     << QPROC >>                                          <<01454>>28340000
<< 1071&1072 -- QUERY WORK FILES >>                            <<01454>>28345000
<< 1073-1079:  RESERVED FOR QUERY EXTENSIONS >>                <<01454>>28350000
,1080     << KSAMK >>                                          <<01454>>28355000
,1083     << GRAPH >>                                          <<01454>>28360000
,1084     << SD    >>                                          <<01454>>28365000
,1090     << LOG   >>                                          <<01454>>28370000
,1100     << WDOC  >>                                          <<01454>>28375000
,1101     << WDICT >>                                          <<01454>>28380000
,1102     << WCONF >>                                          <<04783>>28385000
,1103     << W2601 >>                                          <<04783>>28390000
<< 1104-1109: RESERVED FOR WORD EXTENSIONS >>                  <<04783>>28395000
,1110     << PCELL >>                                          <<01454>>28400000
,1111     << PFORM >>                                          <<01454>>28405000
,1112     << PENV  >>                                          <<06843>>28410000
,1113     << PCCMP >>                                          <<01454>>28415000
,1114     << RASTR >>                                          <<04783>>28420000
<< 1115-1129: RESERVED FOR PSP EXTENSIONS >>                   <<04783>>28425000
,1130     << OPTLF >>                                          <<01652>>28430000
,1131     << TEPES >>                                          <<01454>>28435000
,1132     << TEPEL >>                                          <<01454>>28440000
,1133     << SAMPL >>                                          <<04783>>28445000
<< 1134-1138: RESERVED FOR PERF. TOOLS EXTENSIONS >>           <<04783>>28450000
,1139     << MPEDL >>                                          <<04783>>28455000
,1140     << TSR   >>                                          <<04783>>28460000
,1141     << TSD   >>                                          <<04783>>28465000
<< 1142-1144: RESERVED FOR TOOLSET EXTENSIONS >>               <<04783>>28470000
,1145     << DRAW  >>                                          <<04783>>28475000
,1146     << FIG   >>                                                   28480000
,1147     << FONT  >>                                          <<06843>>28485000
,1148     << COLOR >>                                          <<07276>>28490000
,1149     << D48   >>                                          <<07276>>28495000
,1152     << SLATE >>                                          << 7794>>28500000
,1153     << SLATW >>                                          << 7794>>28505000
<< 1150,1151,1154,1155: RESERVED FOR SLATE >>                  << 7794>>28510000
,1156     << DSTOR >>                                          <<04783>>28515000
,1157     << TCODE >>                                          <<04783>>28520000
,1158     << RCODE >>                                          <<04783>>28525000
,1159     << ICODE >>                                          <<04783>>28530000
<< 1160-1165: RESERVED FOR RAPID >>                            <<04783>>28535000
,1166     << MDIST >>                                          <<04783>>28540000
,1167     << MTEXT >>                                          <<04783>>28545000
<< 1168-1170: RESERVED FOR HPMAIL >>                           <<04783>>28550000
,1176     << VCSF  >>                                          <<04783>>28555000
,1177     << TTYPE >>                                          <<04783>>28560000
,1178     << TVFC  >>                                                   28565000
<< 1178-1186: RESERVED FOR TERMINAL I/O >>                     <<04783>>28570000
<< 1187-1191: RESERVED FOR DS >>                               <<04783>>28575000
,1192     << NCONF >>                                          <<04783>>28580000
,1193     << NTRAC >>                                          <<04783>>28585000
,1194     << NLOG  >>                                          <<04783>>28590000
,1195     << MIDAS >>                                          <<04783>>28595000
<< 1196-1199: RESERVED FOR DS NETWORK MANAGEMENT >>            <<04783>>28600000
<< 1200-1210: RESERVED FOR KANJI >>                            <<04783>>28605000
,1211     << ANODE >>                                          << 8084>>28610000
,1212     << INODE >>                                          << 8084>>28615000
,1213     << INVRT >>                                          << 8084>>28620000
,1214     << EXCEP >>                                          << 8084>>28625000
,1215     << TAXON >>                                          << 8084>>28630000
,1216     << QUERF >>                                          << 8084>>28635000
,1217     << DOCDR >>                                          << 8084>>28640000
<< 1218-1224: RESERVED FOR DS'83 >>                            << 8084>>28645000
,1226     << VC    >>                                          <<06843>>28650000
,1227     << DIF   >>                                          <<06843>>28655000
,1228     << LANGD >>                                          <<06843>>28660000
,1229     << CHARD >>                                          <<06843>>28665000
,1230     << MGCAT >>                                          <<06843>>28670000
<< 1231-1232: RESERVED FOR NATIVE LANGUAGE SUPPORT >>          <<06843>>28675000
<< 1233-1234: RESERVED FOR HORIZON >>                          <<06843>>28680000
,1235     << ATLAS >>                                          <<07276>>28685000
,1236     << BMAP  >>                                          <<06843>>28690000
<< 1237-1241: RESERVED FOR TDP >>                              << 7794>>28695000
,1242     << BDATA >>                                          << 7794>>28700000
,1243     << BFORM >>                                          << 7794>>28705000
,1244     << BSAVE >>                                          << 7794>>28710000
,1245     << BCNFG >>                                          << 7794>>28715000
<< 1246-1256: RESERVED FOR HP BUSINESS BASIC >>                << 7794>>28720000
,1257     << PFJOB >>                                          << 7794>>28725000
,1258     << PFTAB >>                                          << 7794>>28730000
,1259     << PFDYN >>                                          << 7794>>28735000
,1260     << PFSRC >>                                          << 7794>>28740000
<< 1261-1264: RESERVED FOR PATHFLOW >>                         << 7794>>28745000
<< 1265-1400: RESERVED FOR ROSEVILLE >>                        << 7794>>28750000
,1401     << CWPTX >>                                          << 8084>>28755000
<< 1402-1420: RESERVED FOR TAIWAN APPLICATIONS CENTER >>       << 8084>>28760000
;                                                              <<01454>>28765000
                                                               <<01454>>28770000
                                                               <<01454>>28775000
SUBROUTINE BINARY'SEARCH;                                      <<01454>>28780000
BEGIN                                                          <<01454>>28785000
   << INITIALIZE LOOP VARIABLES >>                             <<01454>>28790000
   LOWER'BOUND := 1;                                           <<01454>>28795000
   UPPER'BOUND := NUMBER'CODES;                                <<01454>>28800000
                                                               <<01454>>28805000
   WHILE LOWER'BOUND <= UPPER'BOUND DO                         <<01454>>28810000
      BEGIN                                                    <<01454>>28815000
      X := (LOWER'BOUND + UPPER'BOUND)/2;                      <<01454>>28820000
                                                               <<01454>>28825000
      IF FILECODE < MNEMONIC'CODE(X) THEN                      <<01454>>28830000
         UPPER'BOUND := X - 1     << LESS THAN CASE >>         <<01454>>28835000
      ELSE IF > THEN                                           <<01454>>28840000
         LOWER'BOUND := X + 1     << GREATER THAN CASE >>      <<01454>>28845000
      ELSE                                                     <<01454>>28850000
         BEGIN                                                 <<01454>>28855000
         ENTRY'NUMBER := X;       << FOUND ENTRY >>            <<01454>>28860000
         RETURN;                                               <<01454>>28865000
         END;                                                  <<01454>>28870000
      END;                << OF SEARCH LOOP >>                 <<01454>>28875000
                                                               <<01454>>28880000
   ENTRY'NUMBER := 0;     << ENTRY NOT FOUND >>                <<01454>>28885000
                                                               <<01454>>28890000
END;      << OF BINARY'SEARCH >>                               <<01454>>28895000
                                                               <<01454>>28900000
                                                               <<01454>>28905000
                                                               <<01454>>28910000
<< ENTRY POINT FOR GET'FILECODE >>                             <<01454>>28915000
                                                               <<01454>>28920000
   CC := CCL;           << SET COND CODE FOR ERROR CASE >>     <<01454>>28925000
                                                               <<01454>>28930000
   << LENGTH MUST BE POSITIVE >>                               <<01454>>28935000
   IF MNEMONIC'LENGTH <= 0 THEN RETURN;         << CCL >>      <<01454>>28940000
                                                               <<01454>>28945000
   << INITIALIZE VARIABLES FOR NOT FOUND CASE >>               <<01454>>28950000
   FILECODE := 0;                                              <<01454>>28955000
   CC := CCG;                                                  <<01454>>28960000
                                                               <<01454>>28965000
   << NO MNEMONICS > 5 CHARACTERS >>                           <<01454>>28970000
   IF MNEMONIC'LENGTH > 5 THEN RETURN;          << CCG >>      <<01454>>28975000
                                                               <<01454>>28980000
   << GET LOCAL COPY OF MNEMONIC UPSHIFTED >>                  <<01454>>28985000
   MOVE LOCAL'BUFFER := "      ";                              <<01454>>28990000
   MOVE LOCAL'BUFFER := MNEMONIC,(MNEMONIC'LENGTH);            <<01454>>28995000
   MOVE LOCAL'BUFFER := LOCAL'BUFFER WHILE ANS;                <<01454>>29000000
                                                               <<01454>>29005000
   << SEARCH FOR MNEMONIC IN DICTIONARY >>                     <<01454>>29010000
   MOVE LOCAL'DICT := MNEMONIC'DICT,(DICT'LENGTH);             <<01454>>29015000
   ENTRY'NUMBER := SEARCH(LOCAL'BUFFER,5,LOCAL'DICT);          <<01454>>29020000
                                                               <<01454>>29025000
   IF ENTRY'NUMBER <> 0 THEN                                   <<01454>>29030000
      BEGIN              << FOUND MNEMONIC >>                  <<01454>>29035000
      CC := CCE;                                               <<01454>>29040000
      FILECODE := MNEMONIC'CODE(ENTRY'NUMBER);                 <<01454>>29045000
      END;                                                     <<01454>>29050000
                                                               <<01454>>29055000
   RETURN;         << ALL DONE WITH GET'FILECODE ENTRY POINT >><<01454>>29060000
                                                               <<01454>>29065000
                                                               <<01454>>29070000
GET'FILEMNEMONIC:                                              <<01454>>29075000
                                                               <<01454>>29080000
   << INITIALIZE OUTPUT VARIABLES FOR NOT FOUND CASE >>        <<01454>>29085000
   CC := CCG;                                                  <<01454>>29090000
   MNEMONIC'LENGTH := 0;                                       <<01454>>29095000
   MOVE MNEMONIC := "     ";                                   <<01454>>29100000
                                                               <<01454>>29105000
   << CHECK IF FILE CODE IN RANGE OF POSSIBLE MNEMONICS >>     <<01454>>29110000
   IF MNEMONIC'CODE(1) <= FILECODE <=                          <<01454>>29115000
      MNEMONIC'CODE(NUMBER'CODES) THEN                         <<01454>>29120000
      BEGIN                                                    <<01454>>29125000
      BINARY'SEARCH;     << BINARY'SEARCH SETS ENTRY'NUMBER >> <<01454>>29130000
                                                               <<01454>>29135000
      IF ENTRY'NUMBER <> 0 THEN                                <<01454>>29140000
         BEGIN                << FOUND CODE >>                 <<01454>>29145000
                                                               <<01454>>29150000
         << GET LOCAL COPY OF DICTIONARY ENTRY >>              <<01454>>29155000
         MOVE LOCAL'BUFFER :=                                  <<01454>>29160000
              MNEMONIC'DICT( (ENTRY'NUMBER-1)*8 ),(8);         <<01454>>29165000
                                                               <<01454>>29170000
         << SET RETURN VARIABLES >>                            <<01454>>29175000
         CC := CCE;                                            <<01454>>29180000
         MOVE MNEMONIC := LOCAL'BUFFER(2),(5);                 <<01454>>29185000
         MNEMONIC'LENGTH := LOCAL'BUFFER(7);                   <<01454>>29190000
         END;                                                  <<01454>>29195000
      END;                                                     <<01454>>29200000
                                                               <<01454>>29205000
                                                               <<01454>>29210000
END;     << OF GET'FILECODE/MNEMONIC >>                        <<01454>>29215000
                                                               <<01454>>29220000
                                                               <<01454>>29225000
INTEGER PROCEDURE LISTFILE (PARMS);                           <<00.GEN>>29230000
   INTEGER ARRAY PARMS;                                       <<00.GEN>>29235000
   OPTION PRIVILEGED, UNCALLABLE;                                       29240000
BEGIN                                                                   29245000
                                                                        29250000
   DOUBLE ARRAY      DPARMS (*)        = PARMS;                         29255000
<< "OWN" VARIABLES IN <PARMS>. >>                                       29260000
   INTEGER ARRAY     FNAME (*)         = PARMS,                         29265000
                     CURRENTG (*)      = PARMS (4),                     29270000
                     CURRENTA (*)      = PARMS (8),                     29275000
                     CURRENTGA (*)     = CURRENTG;                      29280000
   DEFINE            DETAIL            = PARMS (12) #,                  29285000
                     DETAILLENGTH      = PARMS (13) #,   <<WORDS>>      29290000
                     FPNTR1            = PARMS (14) #,                  29295000
                     FPNTR2            = PARMS (15) #,                  29300000
                     SIRS              = DPARMS (8) #,                  29305000
                     FILENUM           = PARMS (18) #,                  29310000
                     DEVSIZE           = PARMS (19) #,   <<BYTES>>      29315000
                     LINENO            = PARMS (20) #,                  29320000
                     NUMPERLINECOUNT   = PARMS (21) #,         <<RV.PV>>29325000
                     GLINKAGEW         = PARMS (23) #;         << I.A >>29330000
                                                                        29335000
<< LOCALS >>                                                            29340000
   EQUATE            MAXDETAILLENGTH   = 72,                            29345000
                     MDLWORDSM1        = MAXDETAILLENGTH/2 -1,          29350000
                     FINFOSIZE         = 128,                           29355000
                     LONGDEV           = 128;                           29360000
   INTEGER ARRAY     FLABEL (*),                                        29365000
                     BUF (0:MDLWORDSM1);                                29370000
   DOUBLE ARRAY      DFLABEL (*)       = FLABEL;                        29375000
   BYTE ARRAY        BBUF (*)          = BUF,                           29380000
                     TBUF (0:9);                                        29385000
   INTEGER           LEN,                                               29390000
                     BF,                                                29395000
                     NX;                                                29400000
   LOGICAL           FIRSTFILE := FALSE,  << 1ST IN GROUP >>   <<01724>>29405000
                     BADFLABEL := FALSE;  << BAD FILE LABEL >> <<01724>>29410000
   << DOUBLE (TOS) / X  --->  DOUBLE (Q), SINGLE (REM)    (ON TOS) >>   29415000
   << DOUBLE (TOS) * X  --->  DOUBLE (PRODUCT)  (ON TOS) >>             29420000
                                                                        29425000
<< FILE LABEL >>                                                        29430000
   << FOLLOWING 3 ARRAY ADDRESSES ARE SET WHEN (IF) <FLABEL> IS INTITL>>29435000
INTEGER ARRAY     FLGA (*)       << = FLABEL (4) >>;           <<0307>> 29440000
DOUBLE ARRAY      FLEXTMAP (*)   << = FLABEL (44) >>;          <<0307>> 29445000
   BYTE ARRAY        BFLGA (*)      << = FLGA >>;                       29450000
   DEFINE            FLFLIM            = DFLABEL (15) #,                29455000
                     FLEOF             = DFLABEL (21) #,                29460000
                     FLCODE            = FLABEL (26) #,                 29465000
                     FLOPENED          = DFLABEL(16) <> 0D AND <<06569>>29470000
                         FLABEL (35) =ABSOLUTE(COLDLOADID) #,           29475000
                     FLRECFORMAT       = FLABEL (36) .(8:2) #,          29480000
                     FLASCII           = LOGICAL (FLABEL(36).(13:1)) #, 29485000
                     FLCNTRL           = LOGICAL (FLABEL(36).(7:1)) #,  29490000
                     FLFILETYPE    =LOGICAL(FLABEL(36).(2:3))#,<<01549>>29495000
                     FLKSAM            = (FLFILETYPE = 1) #,   <<01549>>29500000
                     FLMSGFILE         = (FLFILETYPE = 6) #,   <<01549>>29505000
                     FLRECSIZE         = FLABEL (37) #,                 29510000
                     FLBLKSIZE         = FLABEL (38) #,                 29515000
                     FLNUMEXTS         = FLABEL (39) .(11:5) #,         29520000
                  FLLASTEXTSIZE     = FLABEL (40) #,           <<0307>> 29525000
                     FLEXTSIZE         = FLABEL (41) #;                 29530000
   BYTE ARRAY        PRIV (0:4) = PB   := "PRIV ";                      29535000
   ARRAY             FILETYPE(0:7)=PB:="     R ? O ? M ?";     <<01549>>29540000
                                                                        29545000
<< MISC. JUNK >>                                                        29550000
      DEFINE                                                            29555000
                     EJECT             = BEGIN                          29560000
                                         FWRITE (FILENUM, BUF, 0, %61); 29565000
                                         IF <> THEN                     29570000
                                            BEGIN                       29575000
                                            TOS := 2;                   29580000
                                            GOTO EXIT;                  29585000
                                            END;                        29590000
                                         LINENO := 1;                   29595000
                                         END  #,                        29600000
                     FINISHWRITE       = IF <> THEN                     29605000
                                            BEGIN                       29610000
                                            TOS := 2;                   29615000
                                            GOTO EXIT;                  29620000
                                            END;                        29625000
                                         LINENO := LINENO  #,           29630000
                     SPACE             = BEGIN                          29635000
                                         FWRITE (FILENUM, BUF, 0, %40); 29640000
                                         FINISHWRITE +1;                29645000
                                         END #,                         29650000
                     DSPACE            = BEGIN                          29655000
                                         FWRITE (FILENUM, BUF, 0, %60); 29660000
                                         FINISHWRITE +2;                29665000
                                         END #;                         29670000
                                                                        29675000
<< LIST FORMAT >>                                                       29680000
   ARRAY             TITLE1 (0:33) = PB :=  "FILENAME",        <<U.RAO>>29685000
"  CODE  ------------LOGICAL RECORD-----------  ----SPACE----";<<U.RAO>>29690000
   ARRAY             TITLE1A (0:33) = PB := "        ",        <<U.RAO>>29695000
"          SIZE  TYP        EOF      LIMIT R/B  SECTORS #X MX";<<U.RAO>>29700000
   EQUATE            OPPOS             = 8,                             29705000
                     CODEPOS           = 10,                            29710000
                     RSIZEPOS          = 21,                            29715000
                     RTYPPOS           = 24,                            29720000
                     REOFPOS           = 37,                            29725000
                     RLIMPOS           = 48,                            29730000
                     RBPOS             = 52,                            29735000
                     SECTPOS           = 61,                            29740000
                     NXPOS             = 64,                            29745000
                     MXPOS             = 67;                   <<U.RAO>>29750000
   ARRAY             AGTITLE (0:25) = PB :=                            "29755000
ACCOUNT=              GROUP=              (CONT.) ";                    29760000
   EQUATE            GROUPPOS          = 15,                            29765000
                     ACCTPOS           = 5;                             29770000
                                                                        29775000
SUBROUTINE RIGHTNUM (NUM, BBUFDEST);                                    29780000
   VALUE BBUFDEST, NUM;                                                 29785000
   INTEGER BBUFDEST, NUM;                                               29790000
<< RIGHT-JUSTIFIED NUMBER AT BBUF (BBUFDEST) >>                         29795000
BEGIN                                                                   29800000
   LEN := ASCII (NUM, 10, TBUF);                                        29805000
   MOVE BBUF (BBUFDEST -LEN +1) := TBUF, (LEN);                         29810000
   END    <<RIGHTNUM>>;                                                 29815000
SUBROUTINE RIGHTDNUM (DNUM, BBUFDEST);                                  29820000
   VALUE BBUFDEST, DNUM;                                                29825000
   INTEGER BBUFDEST;                                                    29830000
   DOUBLE DNUM;                                                         29835000
<< RIGHT-JUSTIFIED DOUBLE AT BBUF (BBUFDEST) >>                         29840000
BEGIN                                                                   29845000
   LEN := DASCII (DNUM, 10, TBUF);                                      29850000
   MOVE BBUF (BBUFDEST -LEN +1) := TBUF, (LEN);                         29855000
   END    <<RIGHTDNUM>>;                                                29860000
SUBROUTINE PRINTAG (LENGTH);                                            29865000
   VALUE LENGTH;                                                        29870000
   INTEGER LENGTH;                                                      29875000
<< PRINT "ACCOUNT/GROUP" TITLE >>                                       29880000
BEGIN                                                                   29885000
   MOVE BUF := AGTITLE, (LENGTH);                                       29890000
   MOVE BUF (ACCTPOS) := CURRENTA, (4);                                 29895000
   MOVE BUF (GROUPPOS) := CURRENTG, (4);                                29900000
   FWRITE (FILENUM, BUF, LENGTH, 0);                                    29905000
   FINISHWRITE +1;                                                      29910000
   END    <<PRINTAG>>;                                                  29915000
SUBROUTINE PRINTTITLE;                                                  29920000
<< PRINTS COLUMN HEADING INFORMATION.                                   29925000
   VERY SIMPLE PRINT FOR NOW. >>                                        29930000
BEGIN                                                                   29935000
   SPACE;                                                               29940000
   MOVE BUF := TITLE1, (DETAILLENGTH);                                  29945000
   FWRITE (FILENUM, BUF, DETAILLENGTH, 0);                              29950000
   FINISHWRITE +1;                                                      29955000
   IF DETAIL <> 0 THEN                                                  29960000
      BEGIN                                                             29965000
      MOVE BUF := TITLE1A, (DETAILLENGTH);                              29970000
      FWRITE (FILENUM, BUF, DETAILLENGTH, 0);                           29975000
      FINISHWRITE +1;                                                   29980000
      END;                                                              29985000
   SPACE;                                                               29990000
   NUMPERLINECOUNT := 0;                                                29995000
   END    <<PRINTTITLE>>;                                               30000000
                                                                        30005000
                                                                        30010000
                                                                        30015000
SUBROUTINE PRINTFORM1 (BUFSTART, LENGTH);                               30020000
   VALUE BUFSTART, LENGTH;                                              30025000
   INTEGER BUFSTART, LENGTH;                                            30030000
<< SIMPLY PRINT BUF (BUFSTART), LENGTH.  >>                             30035000
BEGIN                                                                   30040000
   FWRITE (FILENUM, BUF (BUFSTART), LENGTH, 0);                         30045000
   FINISHWRITE +1;                                                      30050000
   END    <<PRINTFORM1>>;                                               30055000
SUBROUTINE PRINTFORM2 (LENGTH, NUMBERPERLINE);                          30060000
   VALUE LENGTH, NUMBERPERLINE;                                         30065000
   INTEGER LENGTH, NUMBERPERLINE;                                       30070000
<< PUT 4 BLANKS AT BUF (LENGTH) AND WRITE IT OUT %320,                  30075000
   UNLESS THIS IS LAST ONE ON THE LINE.  >>                             30080000
BEGIN                                                                   30085000
   NUMPERLINECOUNT := NUMPERLINECOUNT -1;                               30090000
   IF < THEN    <<1ST FILE: INITIALIZE <NUMPERLINECOUNT>.>>             30095000
      NUMPERLINECOUNT := NUMBERPERLINE -1;                              30100000
   IF > THEN                                                            30105000
      BEGIN                                                             30110000
      BUF (LENGTH) := "  ";                                             30115000
      BUF (X +1) := "  ";                                               30120000
      FWRITE (FILENUM, BUF, LENGTH +2, %320);                           30125000
      FINISHWRITE;    << <LINENO> NOT MODIFIED >>                       30130000
      END                                                               30135000
   ELSE                                                                 30140000
      BEGIN                                                             30145000
      FWRITE (FILENUM, BUF, LENGTH, 0);                                 30150000
      FINISHWRITE +1;                                                   30155000
      NUMPERLINECOUNT := NUMBERPERLINE;                                 30160000
      END;                                                              30165000
   END    <<PRINTFORM2>>;                                               30170000
                                                                        30175000
SUBROUTINE PRINTLINE;                                                   30180000
BEGIN                                                                   30185000
   TOS := DETAIL & LSL(1);                                              30190000
   IF DEVSIZE >= LONGDEV THEN TOS := TOS +1;                            30195000
   CASE TOS OF                                                          30200000
      BEGIN                                                             30205000
         PRINTFORM2 (4, 6);                                             30210000
         PRINTFORM2 (4, 11);                                            30215000
         PRINTFORM1 (0, 25);                                            30220000
         PRINTFORM2 (25, 2);                                            30225000
         PRINTFORM1 (0, 34);                                   <<U.RAO>>30230000
         PRINTFORM1 (0,34);                                    <<U.RAO>>30235000
      END;                                                              30240000
   END    <<PRINTLINE>>;                                                30245000
                                                                        30250000
                                                                        30255000
SUBROUTINE FORMATINFO;                                                  30260000
BEGIN                                                                   30265000
   BUF := "  ";                                                         30270000
   MOVE BUF (1) := BUF, (MDLWORDSM1);                                   30275000
IF DETAIL >= 2 THEN                                                     30280000
   BEGIN                                                                30285000
   TOS := DOUBLE (FLBLKSIZE);          <<BLOCK FACTOR>>                 30290000
   TOS := FLRECSIZE;                                                    30295000
   IF = THEN TOS := TOS +128                                            30300000
   ELSE IF < THEN TOS := (-TOS +1) & LSR(1);                            30305000
   IF FLMSGFILE THEN TOS:=TOS+3;  <<ADD IN MG HDR LENGTH>>     <<01565>>30310000
   ASSEMBLE (LDIV, DEL);                                                30315000
   RIGHTNUM ((BF := TOS), RBPOS);                                       30320000
   TOS := @FLEXTMAP;                                                    30325000
   X := FLNUMEXTS;                                                      30330000
   TOS := 0;                                                            30335000
   DO BEGIN                                                             30340000
      IF DPS1(X) <> 0D THEN TOS := TOS +1;                              30345000
      X := X -1;                                                        30350000
      END                                                               30355000
   UNTIL <;                                                             30360000
   RIGHTNUM ((NX := TOS), NXPOS);                                       30365000
   ASSEMBLE (DEL);                                                      30370000
   RIGHTNUM(FLNUMEXTS+1, MXPOS);                               <<0307>> 30375000
                                                               <<0307>> 30380000
   << COMPUTE FILE SPACE IN SECTORS.  NOTE: LAST EXTENT MAY >> <<0307>> 30385000
   << CONTAIN FEWER SECTORS THAN THE OTHERS.                >> <<0307>> 30390000
   TOS := IF FLEXTMAP(FLNUMEXTS) = 0D THEN                     <<0307>> 30395000
              LOGICAL(NX)**LOGICAL(FLEXTSIZE)                  <<0307>> 30400000
          ELSE                                                 <<0307>> 30405000
             (LOGICAL(NX)-1)**LOGICAL(FLEXTSIZE) +             <<0307>> 30410000
         DOUBLE(LOGICAL(FLLASTEXTSIZE));                                30415000
   RIGHTDNUM (*, SECTPOS);                                              30420000
   END;                                                                 30425000
IF DETAIL >= 1 THEN                                                     30430000
   BEGIN                                                                30435000
   IF FLOPENED THEN BBUF(OPPOS) := "*";<<OPENED FLAG>>                  30440000
   IF FLCODE < 0 THEN   << PRIVILEGED FILE >>                  <<01454>>30445000
      MOVE BBUF(CODEPOS) := PRIV,(4)                           <<01454>>30450000
   ELSE IF > THEN   << FILE CODE > 0     >>                    <<01454>>30455000
      BEGIN         << CHECK FOR HP CODE >>                    <<01454>>30460000
      GET'FILEMNEMONIC(FLCODE,BBUF(CODEPOS),LEN);              <<01454>>30465000
      IF <> THEN    << NOT HP MNEMONIC CODE >>                 <<01454>>30470000
         ASCII(FLCODE,10,BBUF(CODEPOS));                       <<01454>>30475000
      END                                                      <<01454>>30480000
   ELSE   << FILE CODE = 0, TRY KSAM >>                        <<01454>>30485000
      IF FLKSAM THEN MOVE BBUF(CODEPOS) := "KSAM ";            <<01454>>30490000
   TOS := FLRECSIZE;                   <<REC SIZE>>                     30495000
   IF = THEN TOS := TOS +128;                                           30500000
   IF > THEN TOS := "W"                                                 30505000
   ELSE                                                                 30510000
      BEGIN                                                             30515000
      TOS := -TOS;                                                      30520000
      IF FLASCII THEN TOS:="B" ELSE                                     30525000
         BEGIN                                                          30530000
         TOS:=TOS&ASR(1);                                               30535000
         TOS:="W";                                                      30540000
         END;                                                           30545000
      END;                                                              30550000
   IF FLRECFORMAT = 1 AND NOT FLMSGFILE THEN                   <<01549>>30555000
      BEGIN                                                             30560000
      ASSEMBLE (DECB, DECB);                                            30565000
      IF S0 = "B" THEN ASSEMBLE (DECB, DECB);                           30570000
      END;                                                              30575000
   BBUF (RSIZEPOS) := TOS;                                              30580000
   RIGHTNUM (*, X -1);                                                  30585000
   CASE FLRECFORMAT OF                 <<REC TYP>>                      30590000
      BEGIN                                                             30595000
      TOS := "F";                                                       30600000
      TOS := "V";                                                       30605000
      TOS := "U";                                                       30610000
                                                               <<01724>>30615000
   << UNDEFINED VALUE (3) -- BAD FILE LABEL >>                 <<01724>>30620000
      BEGIN                                                    <<01724>>30625000
      BADFLABEL := TRUE;                                       <<01724>>30630000
      TOS := "*";                                              <<01724>>30635000
      END;                                                     <<01724>>30640000
                                                               <<01724>>30645000
      END;                                                              30650000
   BBUF (RTYPPOS) := TOS;                                               30655000
   BBUF (RTYPPOS +1) := IF FLASCII THEN "A" ELSE "B";                   30660000
   IF FLCNTRL THEN BBUF (RTYPPOS +2) := "C";                            30665000
   BBUF(RTYPPOS+(IF FLCNTRL THEN 3 ELSE 2)) :=                 <<01549>>30670000
      BYTE(FILETYPE(FLFILETYPE));                              <<01549>>30675000
   RIGHTDNUM (FLEOF, REOFPOS);         <<FILE EOF>>                     30680000
   RIGHTDNUM (FLFLIM, RLIMPOS);        <<FILE LIMIT>>                   30685000
   END;                                                                 30690000
                                                               <<01724>>30695000
   << IF BAD FILE LABEL, STAR OUT BUFFER. >>                   <<01724>>30700000
   IF BADFLABEL THEN                                           <<01724>>30705000
      BEGIN                                                    <<01724>>30710000
      BUF := "**";                                             <<01724>>30715000
      MOVE BUF(1) := BUF,(MDLWORDSM1);                         <<01724>>30720000
      END;                                                     <<01724>>30725000
                                                               <<01724>>30730000
   MOVE BUF := FNAME, (4);             <<FILENAME>>                     30735000
                                                                        30740000
   END    <<FORMATINFO>>;                                               30745000
   IF DETAIL > 0 THEN                                                   30750000
      BEGIN    <<READ IN FILE LABLE>>                                   30755000
      TOS := FINFOSIZE;                                                 30760000
      @BFLGA := (@FLGA := (@FLABEL := @S0) +4) & LSL(1);                30765000
      @FLEXTMAP := @S0 +44;                                             30770000
      ASSEMBLE (ADDS 0);                                                30775000
      TOS := 0D;  <<RETURN FOR ATTACHIO>>                      <<RV.PV>>30780000
      TOS := LUN (FPNTR1.(0:8),GLINKAGEW.(MVTABXF));           <<RV.PV>>30785000
      TOS := ATTACHIO (*,0,0,@FLABEL,0,128,FPNTR1.(8:8),FPNTR2,1);      30790000
      ASSEMBLE (DEL);                                                   30795000
      IF TOS.(13:3) <> 1 THEN                                           30800000
         BEGIN                         <<FILE LABEL I/O ERROR>>         30805000
         TOS:=SIRS;                                                     30810000
         IF<>THEN RELSIR(*,*);                                          30815000
         CIERR(-LISTFFLABIOERR);                               <<U.RAO>>30820000
         TOS := 1;                                                      30825000
         GOTO EXIT;                                                     30830000
         END;                                                           30835000
      END;                                                              30840000
   TOS := SIRS;                                                         30845000
   IF <> THEN RELSIR (*, *);                                            30850000
                                                                        30855000
   <<GOT ALL THE INFO.  NOW FORMAT AND PRINT>>                          30860000
   IF LINENO<0 THEN                                            <<05.KM>>30865000
      BEGIN                                                    <<05.KM>>30870000
      LINENO:=-LINENO;                                         <<05.KM>>30875000
      FIRSTFILE:=TRUE;                                         <<05.KM>>30880000
      END;                                                     <<05.KM>>30885000
   IF LINENO = 61 THEN EJECT;                                           30890000
   IF DETAIL>0 AND FIRSTFILE THEN                              <<06.KM>>30895000
      BEGIN                                                             30900000
      MOVE CURRENTGA := FLGA, (8);                                      30905000
      IF LINENO <> 1 THEN                                               30910000
         IF LINENO <= 52 THEN DSPACE                                    30915000
         ELSE EJECT;                                                    30920000
      PRINTAG (20);                                                     30925000
      END                                                               30930000
   ELSE                                                                 30935000
      BEGIN                                                             30940000
      IF LINENO <> 1 THEN                                               30945000
         BEGIN                                                          30950000
         IF LINENO <= 58 THEN GOTO PRINTINFOL;                          30955000
         EJECT;                                                         30960000
         END;                                                           30965000
      IF DETAIL > 0 THEN PRINTAG (25);                                  30970000
      END;                                                              30975000
   PRINTTITLE;                                                          30980000
PRINTINFOL:                                                             30985000
   FORMATINFO;                                                          30990000
    PRINTLINE;                                                          30995000
   TOS := 0;                                                            31000000
                                                                        31005000
EXIT:                                                                   31010000
   LISTFILE := TOS;                                                     31015000
   IF DETAIL > 0 THEN                                         <<01.02>> 31020000
     BEGIN                                                    <<01.02>> 31025000
       DFLABEL(8):=0D; <<WIPE OUT LOCKWORD>>                  <<01.02>> 31030000
       DFLABEL(9):=0D;                                        <<01.02>> 31035000
     END;                                                     <<01.02>> 31040000
   END    <<LISTFILE>>;                                                 31045000
INTEGER PROCEDURE LISTSAVEFILES (ELEMENT, LEVEL, PARMS, SIRS);          31050000
   VALUE LEVEL, PARMS, SIRS;                                            31055000
   INTEGER ARRAY ELEMENT;                                               31060000
   INTEGER LEVEL, PARMS;                                                31065000
   DOUBLE SIRS;                                                         31070000
   OPTION PRIVILEGED, UNCALLABLE;                                       31075000
BEGIN                                                                   31080000
   DEFINE P'FNAME=      RPARMS #,                              <<03.KM>>31085000
          P'FNAME1=     RPARMS(1) #,                           <<03.KM>>31090000
          P'GANAME=     RPARMS(2) #,                           <<03.KM>>31095000
          P'GNAME=      RPARMS(2) #,                           <<03.KM>>31100000
          P'GNAME1=     RPARMS(3) #,                           <<03.KM>>31105000
          P'ANAME=      RPARMS(4) #,                           <<03.KM>>31110000
          P'ANAME1=     RPARMS(5) #,                           <<03.KM>>31115000
          P'FPNTR=      RPARMS(7) #,                           <<03.KM>>31120000
          P'SIRS=       RPARMS(8) #,                           <<03.KM>>31125000
          P'LINENO=     RPARMSW(20) #,                         <<06.KM>>31130000
          P'GLINKAGEW=  RPARMSW(23) #,                         <<03.KM>>31135000
          P'GOTENTRY=   RPARMSW(24) #,                         <<03.KM>>31140000
          P'IMPMNTDST=  RPARMSW(25) #,                         <<03.KM>>31145000
          P'IMPMNTERR=  RPARMSW(26) #,                         <<03.KM>>31150000
          P'IMPMNTNAME= RPARMSW(27) #;                         << I.A >>31155000
   DEFINE PVGROUP=    LOGICAL(P'GLINKAGEW.(PVF)) #,            <<03.KM>>31160000
          RELEASESIR=                                          <<03.KM>>31165000
            BEGIN                                              <<03.KM>>31170000
            TOS:=SIRS;                                         <<03.KM>>31175000
            IF <> THEN RELSIR(*,*) ELSE DDEL;                  <<03.KM>>31180000
            END #;                                             <<03.KM>>31185000
   INTEGER PVINFO'ERROR;                                       <<10.KM>>31190000
   EQUATE NOMOUNT= 0;                                          <<03.KM>>31195000
   ARRAY LEAFNAME(*)=S-6;                                      <<04.KM>>31200000
   DOUBLE ARRAY DELEMENT(*)=ELEMENT,RPARMS(*);                          31205000
   INTEGER POINTER PPRESULT;                                  <<00.GEN>>31210000
   INTEGER ARRAY RPARMSW (*) = RPARMS;                         <<06.KM>>31215000
   EQUATE            DIRDST            = 20;                            31220000
                                                                        31225000
<<   ********************************************    >>        <<U.RAO>>31230000
<<   *   A RECIP procedure for CXLISTF          *    >>        <<U.RAO>>31235000
<<   ********************************************    >>        <<U.RAO>>31240000
                                                               <<U.RAO>>31245000
   IF REQUESTSERVICE THEN                                               31250000
      BEGIN                                                             31255000
      LISTSAVEFILES:=ABORTSCAN'SIR;                            <<03.KM>>31260000
      RETURN;                                                  <<03.KM>>31265000
      END;                                                              31270000
   TOS:=DELEMENT;                                             <<00.GEN>>31275000
   TOS:=DELEMENT(1);                                          <<00.GEN>>31280000
   TOS:=DELEMENT(2);                                          <<01.GEN>>31285000
   TOS:=ELEMENT(GLINKAGE);                                    <<00.GEN>>31290000
   EXCHANGEDB(0);                                             <<00.GEN>>31295000
   @RPARMS:=@ARRQ0(PARMS-DELTAQ);                             <<00.GEN>>31300000
                                                              <<00.GEN>>31305000
   @PPRESULT:=@RPARMS+SYSL'PPRINX;                            <<00.GEN>>31310000
   IF LOGICAL(D'TYPE.(ALLFLAG)) THEN                          <<00.GEN>>31315000
   BEGIN                                                      <<00.GEN>>31320000
     COMMENT:                                                 <<00.GEN>>31325000
       (S-6,S-3) = LEAF NAME                                   <<04.KM>>31330000
       (S-2,S-0) = MISC ENTRY INFO;                            <<04.KM>>31335000
                                                              <<00.GEN>>31340000
     CASE *LEVEL OF BEGIN                                     <<00.GEN>>31345000
       TOS:=DIRMATCH(G'FNAME,LEAFNAME);                       <<00.GEN>>31350000
       TOS:=DIRMATCH(G'GNAME,LEAFNAME);                       <<00.GEN>>31355000
       TOS:=DIRMATCH(G'ANAME,LEAFNAME);                       <<00.GEN>>31360000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>31365000
       TOS:=-1;                        <<SHOULDN'T HAPPEN>>    <<03.KM>>31370000
     END;                                                     <<00.GEN>>31375000
     IF TOS<>0 THEN                                           <<00.GEN>>31380000
     BEGIN                                                    <<00.GEN>>31385000
       LISTSAVEFILES:=IF < THEN NEXTUNCLE'SIR                  <<03.KM>>31390000
                      ELSE NEXTBROTHER'SIR;                    <<03.KM>>31395000
       EXCHANGEDB(DIRDST);                                     <<03.KM>>31400000
       RETURN;                                                 <<03.KM>>31405000
     END;                                                     <<00.GEN>>31410000
   END;                                                       <<00.GEN>>31415000
                                                              <<00.GEN>>31420000
   CASE *LEVEL OF                                              <<04.KM>>31425000
     BEGIN                                                     <<04.KM>>31430000
     COMMENT:                                                  <<04.KM>>31435000
       (S-6,S-3)= LEAF NAME                                    <<04.KM>>31440000
       (S-2,S-1)= FPNTR (VALID IFF FILE LEVEL)                 <<04.KM>>31445000
       S-0=       GLINKAGEW (VALID IFF GROUP LEVEL).           <<04.KM>>31450000
                                                               <<04.KM>>31455000
       EACH CASE LEAVES "LISTSAVEFILES" VALUE ON TOS;          <<04.KM>>31460000
                                                               <<04.KM>>31465000
     <<0>> BEGIN <<FILE>>                                      <<04.KM>>31470000
           DEL;                                                <<04.KM>>31475000
           P'FPNTR:=TOS;                                       <<04.KM>>31480000
           P'FNAME1:=TOS;                                      <<04.KM>>31485000
           P'FNAME:=TOS;                                       <<04.KM>>31490000
           P'SIRS:=SIRS;                                       <<04.KM>>31495000
           P'GOTENTRY:=TRUE;                                   <<04.KM>>31500000
           IF LISTFILE(RPARMS)<=1 THEN TOS:=NEXTSON            <<04.KM>>31505000
           ELSE                                                <<04.KM>>31510000
             BEGIN                                             <<04.KM>>31515000
             RPARMSW(1):=-1;                                   <<04.KM>>31520000
             TOS:=ABORTSCAN;                                   <<04.KM>>31525000
             END;                                              <<04.KM>>31530000
           END;                                                <<04.KM>>31535000
                                                               <<04.KM>>31540000
     <<1>> BEGIN <<GROUP>>                                     <<04.KM>>31545000
           P'GLINKAGEW:=TOS;                                   <<04.KM>>31550000
           DDEL;                                               <<04.KM>>31555000
           P'GNAME1:=TOS;                                      <<04.KM>>31560000
           P'GNAME:=TOS;                                       <<04.KM>>31565000
           IF P'LINENO>0 THEN P'LINENO:=-P'LINENO;             <<10.KM>>31570000
           RELEASESIR;                                         <<04.KM>>31575000
           IF NOT PVGROUP THEN TOS:=NEXTSON                    <<04.KM>>31580000
           ELSE IF IMPLICITMNT(P'GNAME,P'ANAME,P'IMPMNTDST,    <<04.KM>>31585000
                               PVINFO'ERROR) THEN              <<10.KM>>31590000
             BEGIN                                             <<04.KM>>31595000
             P'GLINKAGEW.(MVTABXF):=PVINFO'ERROR.(PVMVTABXF);  <<10.KM>>31600000
             TOS:=REVISIT;                                     <<04.KM>>31605000
             END                                               <<04.KM>>31610000
           ELSE IF PVINFO'ERROR=NOMOUNT THEN                   <<10.KM>>31615000
             BEGIN                                             <<04.KM>>31620000
             P'IMPMNTERR:=PVINFO'ERROR;                        <<10.KM>>31625000
             TOS:=REVISIT;             <<DDS USED BY "MOUNT">> <<05.KM>>31630000
             END                                               <<04.KM>>31635000
           ELSE                                                <<04.KM>>31640000
             BEGIN                                             <<04.KM>>31645000
             P'IMPMNTERR:=PVINFO'ERROR;                        <<10.KM>>31650000
             MOVE P'IMPMNTNAME:=P'GANAME,(8);                  <<04.KM>>31655000
             TOS:=ABORTSCAN;                                   <<04.KM>>31660000
             END;                                              <<04.KM>>31665000
           END;                                                <<04.KM>>31670000
                                                               <<04.KM>>31675000
     <<2>> BEGIN <<ACCOUNT>>                                   <<04.KM>>31680000
           DEL;                                                <<04.KM>>31685000
           DDEL;                                               <<04.KM>>31690000
           P'ANAME1:=TOS;                                      <<04.KM>>31695000
           P'ANAME:=TOS;                                       <<04.KM>>31700000
           TOS:=NEXTSON'SIR;                                   <<04.KM>>31705000
           END;                                                <<04.KM>>31710000
                                                               <<05.KM>>31715000
     <<3>> TOS:=ABORTSCAN'SIR;         <<SHOULDN'T HAPPEN>>    <<10.KM>>31720000
     <<4>> TOS:=ABORTSCAN'SIR;         <<SHOULDN'T HAPPEN>>    <<10.KM>>31725000
     END <<CASE>>;                                             <<04.KM>>31730000
   EXCHANGEDB(DIRDST);                                         <<04.KM>>31735000
   LISTSAVEFILES:=TOS;                                         <<04.KM>>31740000
   END;                                                                 31745000
                                                              <<00.GEN>>31750000
                                                              <<00.GEN>>31755000
PROCEDURE GETDIRINFO(STARTINX,DEFLEVEL,PPRESULT);             <<00.GEN>>31760000
                    VALUE STARTINX,DEFLEVEL;                  <<00.GEN>>31765000
                    INTEGER STARTINX,                         <<00.GEN>>31770000
                            DEFLEVEL;                         <<00.GEN>>31775000
                    INTEGER ARRAY PPRESULT;                   <<00.GEN>>31780000
                    OPTION PRIVILEGED,UNCALLABLE;              <<01.KM>>31785000
BEGIN                                                         <<00.GEN>>31790000
  COMMENT:                                                    <<00.GEN>>31795000
    ACQUIRES THE GROUP OR ACCOUNT INDEX AND LOG-ON            <<00.GEN>>31800000
    GROUP AND ACCOUNT NAMES FROM THE JIT.  THESE              <<00.GEN>>31805000
    ARE STORED INTO "D'INX", "G'GNAME" AND "G'ANAME"          <<00.GEN>>31810000
    OF "PPRESULT";                                            <<00.GEN>>31815000
                                                              <<00.GEN>>31820000
INTEGER ARRAY JITARR(0:JIT'ENTRY'SIZE-1);                      <<06840>>31825000
  EQUATE  PXGLOB= -1;                                          <<06840>>31830000
  ARRAY QARRAY(*)=Q+0;                                         <<06567>>31835000
  INTEGER PCBGLOBLOC;                                          <<06567>>31840000
  DOUBLE ARRAY DPPRESULT(*)=PPRESULT;                         <<00.GEN>>31845000
  INTEGER JIT'DST;                                             <<06840>>31850000
  SWITCH DEFAULT:= NODEFAULT,ADEFAULT,GDEFAULT;               <<00.GEN>>31855000
                                                              <<00.GEN>>31860000
  SUBROUTINE DEF'MOVEFROMDSEG;                                <<00.GEN>>31865000
                                                              <<00.GEN>>31870000
                                                              <<00.GEN>>31875000
                                                              <<00.GEN>>31880000
  PXGLOBAL;                                                    <<06567>>31885000
  JIT'DST:=PXG'JITDST;                                         <<06840>>31890000
  TOS:=@JITARR;                                                <<06840>>31895000
  TOS:=JIT'DST;                                                <<06840>>31900000
  TOS:=0;                                                      <<06840>>31905000
  TOS:=JIT'ENTRY'SIZE;                                         <<06840>>31910000
  ASSEMBLE(MFDS 4);                                            <<06840>>31915000
  CASE *STARTINX OF BEGIN                                     <<00.GEN>>31920000
    <<0>> D'INX:=0D;                                          <<00.GEN>>31925000
          << Get Account Index pointers if first CASE       >> <<06840>>31930000
    <<1>> MOVE D'INX:=JITAIP,(2);                              <<06840>>31935000
    <<2>> BEGIN                                                <<06840>>31940000
            << IF Mounted PV, then get Group Index pointers >> <<06840>>31945000
            << to that PV, else get Group Index pointers to >> <<06840>>31950000
            << the group on system domain                   >> <<06840>>31955000
            IF JITGIMVF = 1                                    <<06840>>31960000
               THEN MOVE D'INX:=JITPVGIP,(2)                   <<06840>>31965000
               ELSE MOVE D'INX:=JITGIP,(2);                    <<06840>>31970000
            D'INX1.(PVF):=JITGIPVF;                            <<06840>>31975000
          END;                                                <<00.GEN>>31980000
  END;                                                        <<00.GEN>>31985000
  GOTO *DEFAULT(DEFLEVEL);                                    <<00.GEN>>31990000
                                                              <<00.GEN>>31995000
GDEFAULT:                                                     <<00.GEN>>32000000
  MOVE G'GNAME:=JITLOGONGROUP,(4);                             <<06840>>32005000
  MOVE D'GNAME := G'GNAME, (4);                                <<07275>>32010000
                                                              <<00.GEN>>32015000
ADEFAULT:                                                     <<00.GEN>>32020000
  MOVE G'ANAME:=JITHACCTNAME,(4);                              <<06840>>32025000
  MOVE D'ANAME := G'ANAME, (4);                                <<07275>>32030000
                                                              <<00.GEN>>32035000
NODEFAULT:                                                    <<00.GEN>>32040000
                                                              <<00.GEN>>32045000
END <<PROCEDURE GETDIRINFO>>;                                 <<00.GEN>>32050000
                                                              <<00.GEN>>32055000
                                                              <<00.GEN>>32060000
INTEGER PROCEDURE GETGENNAME(QNAME,ERRBASE,LEAFNAME,NAMEFOUND,<<01.GEN>>32065000
                             GENERIC);                        <<01.GEN>>32070000
                            VALUE ERRBASE,LEAFNAME,GENERIC;   <<01.GEN>>32075000
                            BYTE POINTER QNAME;               <<00.GEN>>32080000
                            INTEGER ERRBASE;                  <<00.GEN>>32085000
                            BYTE POINTER LEAFNAME;            <<00.GEN>>32090000
                            LOGICAL NAMEFOUND;                <<01.GEN>>32095000
                            INTEGER POINTER GENERIC;          <<01.GEN>>32100000
                            OPTION VARIABLE,UNCALLABLE;       <<00.GEN>>32105000
BEGIN                                                         <<00.GEN>>32110000
  COMMENT:                                                    <<00.GEN>>32115000
    SCAN "QNAME" FOR DIRECTORY NAME, VIZ:  UP TO 8 ALPHA-     <<00.GEN>>32120000
    NUMERIC CHARACTERS STARTING WITH ALPHABETIC, DELIMITED BY <<00.GEN>>32125000
    SPECIAL (ULTIMATELY A 'CR').  IF ERROR IS DETECTED,       <<00.GEN>>32130000
    OFFSET IS ADDED TO "ERRBASE" TO DETERMINE ERROR CODE.     <<00.GEN>>32135000
    "GETGENNAME" RETURNS THE ERROR CODE (>0) OR A NO-ERROR    <<00.GEN>>32140000
    INDICATION (=0).  ROUTINE MOVES DIRECTORY NAME INTO       <<00.GEN>>32145000
    "LEAFNAME" AND, IN "QNAME", RETURNS POINTER TO DELIMITER. <<00.GEN>>32150000
    "GENERIC" IS NONZERO IF DIRECTORY NAME CONTAINED "@",     <<00.GEN>>32155000
    "?" OR "#".                                               <<00.GEN>>32160000
                                                              <<00.GEN>>32165000
    NOTE THAT "@@" AND "@?" ARE AMBIGUOUS.  THESE ARE AUTO-   <<00.GEN>>32170000
    MATICALLY CORRECTED TO "@" AND "?@".  (ON THE OTHER HAND, <<00.GEN>>32175000
    "@#" IS MEANINGFUL AND IS NOT EQUIVALENT TO "#@".)        <<00.GEN>>32180000
                                                              <<00.GEN>>32185000
    ON ENTRY, "NAMEFOUND" INDICATES WHETHER A LEAFNAME        <<01.GEN>>32190000
    HAD BEEN FOUND PREVIOUSLY.  ON EXIT, "NAMEFOUND" IS       <<01.GEN>>32195000
    TRUE IF LEAFNAME WAS FOUND.  IF NO LEAFNAME IS FOUND      <<01.GEN>>32200000
    AND "NAMEFOUND" WAS TRUE ON ENTRY, THEN WE FLAG AN        <<01.GEN>>32205000
    ERROR.                                                    <<01.GEN>>32210000
                                                              <<01.GEN>>32215000
    NOTE THAT WE ASSUME THAT TRAPS ARE OFF ON ENTRY.  ALSO    <<00.GEN>>32220000
    NOTE THAT NAME IS UPSHIFTED IN "QNAME" ITSELF.  CALLER    <<00.GEN>>32225000
    SHOULD BLANK-FILL "LEAFNAME" BEFORE CALL;                 <<00.GEN>>32230000
                                                               <<01.KM>>32235000
  LABEL EXITINSTR;                                             <<01.KM>>32240000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<01.KM>>32245000
                                                              <<00.GEN>>32250000
  DEFINE SKIPWILDCARD=                                        <<00.GEN>>32255000
           BEGIN                                              <<00.GEN>>32260000
             BPS1:=BPS0;               <<MOVE "?" OR "@">>    <<00.GEN>>32265000
             ASSEMBLE(INCB,INCA);      <<AND SKIP IT    >>    <<00.GEN>>32270000
             GENERIC:=GENERIC+1;                              <<00.GEN>>32275000
           END #,                                             <<00.GEN>>32280000
         SKIPALL'AT=                                          <<00.GEN>>32285000
           BEGIN                                              <<00.GEN>>32290000
             BPS1:="@";                <<MOVE "@" AND   >>    <<00.GEN>>32295000
             GENERIC:=GENERIC+1;       <<SKIP SUBSEQUENT>>    <<00.GEN>>32300000
             IGNOREALL'AT;                                    <<00.GEN>>32305000
           END #,                                             <<00.GEN>>32310000
         IGNOREALL'AT=                                        <<00.GEN>>32315000
           BEGIN                                              <<00.GEN>>32320000
             ASSEMBLE(INCB,INCA);                             <<00.GEN>>32325000
             SCAN * WHILE CR'AT,1;                            <<00.GEN>>32330000
           END #,                                              <<00608>>32335000
         IGNORE'WILDCARD=                                      <<00608>>32340000
           BEGIN                                               <<00608>>32345000
             ASSEMBLE(INCB,INCA);                              <<00608>>32350000
           END #;                                              <<00608>>32355000
                                                              <<00.GEN>>32360000
  DEFINE NOGENERIC= NOT PARMMASK #;                           <<01.GEN>>32365000
                                                              <<00.GEN>>32370000
  EQUATE EXPECTALPHA=  FILEEXPECTALPHA-FFNAMEBASE,            <<00.GEN>>32375000
         NAMEMISSING=  FILENAMEMISSING-FFNAMEBASE,            <<00.GEN>>32380000
         NAMETOOLONG=  FILENAMETOOLONG-FFNAMEBASE,            <<00.GEN>>32385000
         MISSINGDELIM= FILEMISSINGDELIM-FFNAMEBASE,           <<00.GEN>>32390000
         NOGENNAME=    FILENOGENNAME-FFNAMEBASE;              <<00.GEN>>32395000
                                                              <<00.GEN>>32400000
  EQUATE CR=%15,                                              <<00.GEN>>32405000
         CRBLANK= [8/CR,8/" "],                               <<00.GEN>>32410000
         CR'AT=   [8/CR,8/"@"];                               <<00.GEN>>32415000
                                                              <<00.GEN>>32420000
  BYTE POINTER BPS0=S-0,                                      <<00.GEN>>32425000
               BPS1=S-1,                                      <<00.GEN>>32430000
               BUF,                                            <<00608>>32435000
               DELIM:=@QNAME;                                 <<00.GEN>>32440000
  INTEGER DUMGEN,                                             <<00.GEN>>32445000
          LENGTH;                                             <<01.GEN>>32450000
  LOGICAL PARMMASK=Q-4;                                       <<00.GEN>>32455000
                                                              <<00.GEN>>32460000
                                                              <<00.GEN>>32465000
  SUBROUTINE ERROR(OFFSET); VALUE OFFSET; INTEGER OFFSET;     <<00.GEN>>32470000
  BEGIN                                                       <<00.GEN>>32475000
    CIERR((GETGENNAME:=ERRBASE+OFFSET),QNAME);                <<00.GEN>>32480000
    @QNAME:=@DELIM;                                           <<00.GEN>>32485000
    EXITPROC;                                                  <<01.KM>>32490000
  END <<SUBROUTINE ERROR>>;                                   <<00.GEN>>32495000
                                                              <<00.GEN>>32500000
                                                              <<00.GEN>>32505000
  GETGENNAME:=0;                                              <<00.GEN>>32510000
  IF NOGENERIC THEN @GENERIC:=@DUMGEN;                        <<00.GEN>>32515000
  SCAN QNAME WHILE CRBLANK,1;          <<SKIP LEAD BLANKS>>   <<00.GEN>>32520000
  @QNAME:=TOS;                                                <<00.GEN>>32525000
  IF > THEN ERROR(EXPECTALPHA);                               <<00.GEN>>32530000
  IF QNAME="#" THEN ERROR(IF NOGENERIC THEN NOGENNAME         <<00.GEN>>32535000
                          ELSE EXPECTALPHA);                  <<00.GEN>>32540000
                                                              <<00.GEN>>32545000
  GENERIC:=0;                                                 <<00.GEN>>32550000
  TOS:=TOS:=@QNAME;                    <<FIND LEN OF NAME>>    <<00608>>32555000
  DO BEGIN                                                     <<00608>>32560000
    MOVE * := * WHILE ANS,0;                                   <<00608>>32565000
    WHILE BPS0="?" OR BPS0="#" OR BPS0="@" DO                  <<00608>>32570000
      IGNORE'WILDCARD;                                         <<00608>>32575000
  END UNTIL BPS0=SPECIAL;                                      <<00608>>32580000
  @DELIM := TOS;                                               <<00608>>32585000
  LENGTH := TOS-@QNAME;                                        <<00608>>32590000
  COMMENT:                                                     <<00608>>32595000
    ALLOCATE SPACE FOR BUF & USE BUF AS A WORK-                <<00608>>32600000
    SPACE AS WE MAY                                            <<00608>>32605000
      1) NEED TO MODIFY THE NAME IN QNAME                      <<00608>>32610000
      2) FIND THAT THE NAME IS LONGER THAN 8                   <<00608>>32615000
         CHAR. (IE TOO LONG FOR LEAFNAME)                      <<00608>>32620000
    BUF MUST BE ABLE TO HOLD 'LENGTH' BYTES OF DATA            <<00608>>32625000
    PLUS A CR.;                                                <<00608>>32630000
  TOS := (LENGTH+2)/2;                 <<# OF WORDS IN BUF>>   <<00608>>32635000
  @BUF := @S0 & LSL(1);                                        <<00608>>32640000
  ASSEMBLE(ADDS 0);                                            <<00608>>32645000
  BUF(LENGTH) := CR;                                           <<00608>>32650000
  MOVE BUF := QNAME,(LENGTH);                                  <<00608>>32655000
                                                               <<00608>>32660000
  TOS:=TOS:=@BUF;                      <<SCAN GENERIC NAME>>   <<00608>>32665000
  DO BEGIN                                                    <<00.GEN>>32670000
    MOVE * := * WHILE ANS,0;                                  <<00.GEN>>32675000
    WHILE BPS0="?" OR BPS0="#" DO SKIPWILDCARD;               <<00.GEN>>32680000
    IF BPS0="@" THEN                                          <<00.GEN>>32685000
    BEGIN                                                     <<00.GEN>>32690000
      SKIPALL'AT;                      <<"@...@" ==> "@">>    <<00.GEN>>32695000
      WHILE BPS0="?" DO                <<"@?...?" ==> >>      <<00.GEN>>32700000
      BEGIN                            <<"?...?@"     >>      <<00.GEN>>32705000
        BPS1(-1):="?";                                        <<00.GEN>>32710000
        BPS1:="@";                                            <<00.GEN>>32715000
        IGNOREALL'AT;                  <<"@...@" ==> "@">>    <<00.GEN>>32720000
      END;                                                    <<00.GEN>>32725000
    END;                                                      <<00.GEN>>32730000
  END UNTIL BPS0=SPECIAL AND BPS0<>"#";                       <<00.GEN>>32735000
  DEL;                                                         <<00608>>32740000
  LENGTH:=TOS-@BUF;                                            <<00608>>32745000
                                                              <<00.GEN>>32750000
  IF <> THEN NAMEFOUND:=TRUE                                  <<01.GEN>>32755000
  ELSE IF NAMEFOUND THEN ERROR(NAMEMISSING);                  <<01.GEN>>32760000
  IF GENERIC>0 AND NOGENERIC THEN ERROR(NOGENNAME);           <<00.GEN>>32765000
  IF LENGTH>8 THEN ERROR(NAMETOOLONG);                        <<00.GEN>>32770000
  MOVE LEAFNAME:=BUF,(LENGTH);                                 <<00608>>32775000
  SCAN DELIM WHILE CRBLANK,1;          <<SKIP TRAIL BLANKS>>  <<00.GEN>>32780000
  @QNAME:=TOS;                                                <<00.GEN>>32785000
  IF >= THEN ERROR(MISSINGDELIM);      <<ALPHANUMERIC>>       <<00.GEN>>32790000
                                                               <<01.KM>>32795000
EXITINSTR:                                                     <<01.KM>>32800000
END <<PROCEDURE GETGENNAME>>;                                 <<00.GEN>>32805000
                                                              <<00.GEN>>32810000
                                                              <<00.GEN>>32815000
LOGICAL PROCEDURE PRODUCEPARMS(LEAFLEVEL,QNAME,PPRESULT,      <<00.GEN>>32820000
                               DELIM,ERRNUM);                 <<00.GEN>>32825000
                              VALUE LEAFLEVEL,QNAME;          <<00.GEN>>32830000
                              INTEGER LEAFLEVEL;              <<00.GEN>>32835000
                              BYTE POINTER QNAME;             <<00.GEN>>32840000
                              ARRAY PPRESULT;                 <<00.GEN>>32845000
                              BYTE POINTER DELIM;             <<00.GEN>>32850000
                              INTEGER ERRNUM;                 <<00.GEN>>32855000
                              OPTION PRIVILEGED,UNCALLABLE;   <<00.GEN>>32860000
BEGIN                                                         <<00.GEN>>32865000
  COMMENT:                                                    <<00.GEN>>32870000
    PARSES FULLY-QUALIFIED "LEAFLEVEL" NAME IN "QNAME" AND    <<00.GEN>>32875000
    SETS UP DIRECSCAN PARAMETERS IN "PPRESULT".  RETURNS      <<00.GEN>>32880000
    FINAL DELIMITER IN "DELIM".  NAMES IN "QNAME" MAY CONTAIN <<00.GEN>>32885000
    BLANKS AROUND DELIMITERS.  IF NO NAME IS PRESENT, WE       <<01.KM>>32890000
    RETURN ONE OF THE FOLLOWING DEFAULTS:                      <<01.KM>>32895000
                                                              <<05.GEN>>32900000
    LEAFLEVEL = 0, FILE F[.G[.A]]:  @.LGN.LAN                 <<05.GEN>>32905000
     (INPUT)    1, GROUP G[.A]:  @.LAN                        <<05.GEN>>32910000
                2, ACCOUNT A:  @                              <<05.GEN>>32915000
                3, USER U[.A]:  @.LAN                         <<05.GEN>>32920000
                4, VOL SET DEFN V[.G[.A]]:  @.LGN.LAN         <<05.GEN>>32925000
                                                              <<00.GEN>>32930000
    OTHER OUTPUTS ARE:                                        <<05.GEN>>32935000
                                                              <<05.GEN>>32940000
    STARTLEVEL = 0: GLOBAL SEARCH FOR F.G.A, V.G.A, U[.A], A  <<00.GEN>>32945000
     (OUTPUT)    1: USE ACCT INX PTR FOR F.G, V[.G]           <<05.GEN>>32950000
                 2: USE GROUP INX PTR FOR F                   <<00.GEN>>32955000
                                                              <<00.GEN>>32960000
    ENDLEVEL = 0: F[.G[.A]], @[.G[.A]]                        <<00.GEN>>32965000
    (OUTPUT)   1: G[.A], @[.A]                                <<05.GEN>>32970000
               2: @.@.@, A                                    <<00.GEN>>32975000
               3: U[.A], @[.A]                                <<00.GEN>>32980000
               4: V[.G[.A]], @[.G[.A]]                        <<00.GEN>>32985000
                                                              <<00.GEN>>32990000
    RESULT IS RETURNED IN "PPRESULT" IN THE FORM:             <<00.GEN>>32995000
                                                              <<00.GEN>>33000000
      ********************                                    <<00.GEN>>33005000
      * D'INX      (2WD) * 0                                  <<00.GEN>>33010000
      *------------------*                                    <<00.GEN>>33015000
      * D'TYPE     (1WD) * 2                                  <<00.GEN>>33020000
      *------------------*                                    <<00.GEN>>33025000
      * D'FNAME    (4WD) * 3   "D'XXX" CONTAIN THE NAMES USED <<00.GEN>>33030000
      * D'VNAME          *     FOR THE DIRECTORY SEARCH.  THE <<00.GEN>>33035000
      *------------------*     NAMES MUST BE IN ONE OF THE    <<00.GEN>>33040000
      * D'GNAME    (4WD) * 7   FOLLOWING FORMS:               <<00.GEN>>33045000
      * D'UNAME          *       F.G.A     @.@.A              <<00.GEN>>33050000
      *------------------*       @.G.A     @.@.@              <<00.GEN>>33055000
      * D'ANAME    (4WD) * 11                                 <<00.GEN>>33060000
      *                  *                                    <<00.GEN>>33065000
      *------------------*                                    <<00.GEN>>33070000
      * D'LOCKWORD (4WD) * 15                                 <<00.GEN>>33075000
      *                  *                                    <<00.GEN>>33080000
      *------------------*                                    <<00.GEN>>33085000
      * G'FNAME    (4WD) * 19  "G'XXX" CONTAIN THE GENERIC    <<00.GEN>>33090000
      * G'VNAME          *     NAMES ACTUALLY SPECIFIED.      <<00.GEN>>33095000
      *------------------*     THESE ARE USED BY THE "RECIP"  <<00.GEN>>33100000
      * G'GNAME    (4WD) * 23  PROCEDURE TO DETERMINE A MATCH <<00.GEN>>33105000
      * G'UNAME          *     DURING THE DIRECTORY SEARCH.   <<00.GEN>>33110000
      *------------------*                                    <<00.GEN>>33115000
      * G'ANAME    (4WD) * 27                                 <<00.GEN>>33120000
      *                  *                                    <<00.GEN>>33125000
      ********************                                    <<00.GEN>>33130000
    ;                                                         <<00.GEN>>33135000
                                                               <<01.KM>>33140000
  LABEL EXITINSTR;                                             <<01.KM>>33145000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<01.KM>>33150000
                                                              <<00.GEN>>33155000
  DEFINE TURNOFFTRAPS=                                        <<00.GEN>>33160000
           BEGIN                                              <<00.GEN>>33165000
             PUSH(STATUS);                                    <<00.GEN>>33170000
             TOS.(2:1):=0;                                    <<00.GEN>>33175000
             SET(STATUS);                                     <<00.GEN>>33180000
           END #;                                             <<00.GEN>>33185000
  DEFINE NAMEMISSING= ERRBASE+FILENAMEMISSING-FFNAMEBASE #;   <<05.GEN>>33190000
  EQUATE NOINX=    0,                                         <<00.GEN>>33195000
         ACCTINX=  1,                                         <<00.GEN>>33200000
         GROUPINX= 2;                                         <<00.GEN>>33205000
  INTEGER ARRAY INITPARMS(*)=PB:=                             <<02.GEN>>33210000
    3(0),3("@       "),4("  "),3("@       ");                 <<05.GEN>>33215000
  INTEGER ARRAY INITSTART(*)=PB:=                             <<00.GEN>>33220000
    GROUPINX,ACCTINX,NOINX,NOINX,ACCTINX;                     <<00.GEN>>33225000
  INTEGER ARRAY INITDEF(*)=PB:=                               <<00.GEN>>33230000
    GROUPINX,ACCTINX,NOINX,ACCTINX,GROUPINX;                  <<00.GEN>>33235000
  INTEGER ARRAY INITBASE(*)=PB:=                              <<00.GEN>>33240000
    FFNAMEBASE,FGNAMEBASE,FANAMEBASE,USERNAMEBASE,VSDNAMEBASE;<<00.GEN>>33245000
  INTEGER ARRAY INITALL(*)=PB:= 1,2,3,2,1;                    <<03.GEN>>33250000
                                                              <<00.GEN>>33255000
  INTEGER STARTINX,                                           <<00.GEN>>33260000
          DEFLEVEL,                                           <<00.GEN>>33265000
          ERRBASE,                                            <<00.GEN>>33270000
          GENERIC,                                            <<00.GEN>>33275000
          ALLLEVEL:= 0;                                       <<05.GEN>>33280000
  LOGICAL NAMEFOUND:=FALSE;                                   <<01.GEN>>33285000
  SWITCH PARSER:= FILES,GROUPS,ACCOUNTS,USERS,VSDS;           <<00.GEN>>33290000
                                                              <<00.GEN>>33295000
                                                              <<00.GEN>>33300000
  SUBROUTINE ERROR(MSGNUM); VALUE MSGNUM; INTEGER MSGNUM;     <<00.GEN>>33305000
  BEGIN                                                       <<00.GEN>>33310000
    CIERR((ERRNUM:=MSGNUM),QNAME);                            <<00.GEN>>33315000
    EXITPROC;                                                  <<01.KM>>33320000
  END <<SUBROUTINE ERROR>>;                                   <<00.GEN>>33325000
                                                              <<00.GEN>>33330000
                                                              <<00.GEN>>33335000
  PRODUCEPARMS:=FALSE;                                        <<00.GEN>>33340000
  TURNOFFTRAPS;                        <<FOR BYTE ADR ARITH>> <<00.GEN>>33345000
  MOVE PPRESULT:=INITPARMS,(31);       <<F.G.A="@.@.@">>      <<02.GEN>>33350000
  STARTINX:=INITSTART(LEAFLEVEL);                             <<05.GEN>>33355000
  DEFLEVEL:=INITDEF(LEAFLEVEL);                               <<05.GEN>>33360000
  ERRBASE:=INITBASE(LEAFLEVEL);                               <<00.GEN>>33365000
  GOTO *PARSER(LEAFLEVEL);                                    <<00.GEN>>33370000
                                                              <<00.GEN>>33375000
  <<**********************>>                                  <<00.GEN>>33380000
  << PARSE QUALIFIED NAME >>                                  <<00.GEN>>33385000
  <<**********************>>                                  <<00.GEN>>33390000
                                                              <<00.GEN>>33395000
FILES:                                                        <<00.GEN>>33400000
VSDS:                                                         <<00.GEN>>33405000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'FNAME,NAMEFOUND,     <<01.GEN>>33410000
                         GENERIC))<>0                         <<01.GEN>>33415000
     THEN RETURN;                                             <<00.GEN>>33420000
  IF GENERIC>0 THEN ALLLEVEL:=1;                              <<00.GEN>>33425000
  IF QNAME="/" THEN                                           <<00.GEN>>33430000
  BEGIN                                                       <<00.GEN>>33435000
    IF LEAFLEVEL=VSDEFLEVEL THEN ERROR(VSDNOLOCKWORD);        <<00.GEN>>33440000
    IF NOT NAMEFOUND THEN ERROR(NAMEMISSING);                 <<04.GEN>>33445000
    @QNAME:=@QNAME+1;                                         <<00.GEN>>33450000
    IF (ERRNUM:=GETGENNAME(QNAME,FLWORDBASE,D'LOCKWORD,       <<02.GEN>>33455000
                           NAMEFOUND))<>0                     <<02.GEN>>33460000
       THEN RETURN;                                           <<00.GEN>>33465000
  END;                                                        <<00.GEN>>33470000
  IF NOT NAMEFOUND OR QNAME<>"." THEN GO COMPLETEPARMS;       <<04.GEN>>33475000
  @QNAME:=@QNAME+1;                                           <<00.GEN>>33480000
  ERRBASE:=FGNAMEBASE;                                        <<00.GEN>>33485000
  STARTINX:=DEFLEVEL:=ACCTINX;                                <<00.GEN>>33490000
                                                              <<00.GEN>>33495000
GROUPS:                                                       <<00.GEN>>33500000
USERS:                                                        <<00.GEN>>33505000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'GNAME,NAMEFOUND,     <<02.GEN>>33510000
                         GENERIC))<>0                         <<01.GEN>>33515000
     THEN RETURN;                                             <<00.GEN>>33520000
  IF GENERIC>0 THEN ALLLEVEL:=2;                              <<00.GEN>>33525000
  IF NOT NAMEFOUND OR QNAME<>"." THEN GO COMPLETEPARMS;       <<01.GEN>>33530000
  @QNAME:=@QNAME+1;                                           <<00.GEN>>33535000
  ERRBASE:=FANAMEBASE;                                        <<00.GEN>>33540000
  STARTINX:=DEFLEVEL:=NOINX;                                  <<00.GEN>>33545000
                                                              <<00.GEN>>33550000
ACCOUNTS:                                                     <<00.GEN>>33555000
  IF (ERRNUM:=GETGENNAME(QNAME,ERRBASE,G'ANAME,NAMEFOUND,     <<02.GEN>>33560000
                         GENERIC))<>0                         <<01.GEN>>33565000
     THEN RETURN;                                             <<00.GEN>>33570000
  IF GENERIC>0 THEN ALLLEVEL:=3;                              <<00.GEN>>33575000
                                                              <<00.GEN>>33580000
COMPLETEPARMS:                                                <<00.GEN>>33585000
  IF NOT NAMEFOUND THEN                                       <<04.GEN>>33590000
  BEGIN                                                       <<04.GEN>>33595000
    IF QNAME="." THEN ERROR(NAMEMISSING);                     <<04.GEN>>33600000
    ALLLEVEL:=INITALL(LEAFLEVEL);                             <<04.GEN>>33605000
  END;                                                        <<04.GEN>>33610000
  @DELIM:=@QNAME;                                             <<00.GEN>>33615000
  D'TYPE.(STARTLEVELF):=STARTINX;                             <<00.GEN>>33620000
  D'TYPE.(TOLEVELF):=LEAFLEVEL;                               <<00.GEN>>33625000
                                                              <<00.GEN>>33630000
  <<***************************>>                             <<00.GEN>>33635000
  << SET UP GROUP/ACCT INDEX & >>                             <<00.GEN>>33640000
  << DEFAULT GROUP/ACCT NAMES  >>                             <<00.GEN>>33645000
  <<***************************>>                             <<00.GEN>>33650000
                                                              <<00.GEN>>33655000
  IF STARTINX<>NOINX OR DEFLEVEL<>NOINX THEN                  <<00.GEN>>33660000
  BEGIN                                                       <<00.GEN>>33665000
    GETDIRINFO(STARTINX,DEFLEVEL,PPRESULT);                   <<00.GEN>>33670000
  END;                                                        <<00.GEN>>33675000
                                                              <<00.GEN>>33680000
  <<*****************>>                                       <<00.GEN>>33685000
  << SET UP ENDLEVEL >>                                       <<00.GEN>>33690000
  <<*****************>>                                       <<00.GEN>>33695000
                                                              <<00.GEN>>33700000
  CASE *ALLLEVEL OF BEGIN              <<SET ENDLEVELFX>>     <<00.GEN>>33705000
    <<0>> BEGIN                                               <<00.GEN>>33710000
            MOVE D'FNAME:=G'FNAME,(12);                       <<00.GEN>>33715000
            D'TYPE.(ENDLEVELFX):=LEAFLEVEL;                   <<00.GEN>>33720000
          END;                                                <<00.GEN>>33725000
    <<1>> BEGIN                                               <<00.GEN>>33730000
            MOVE D'GNAME:=G'GNAME,(8);                        <<00.GEN>>33735000
            D'TYPE.(ENDLEVELFX):=ALLXXX+LEAFLEVEL;            <<00.GEN>>33740000
          END;                                                <<00.GEN>>33745000
    <<2>> BEGIN                                               <<00.GEN>>33750000
            MOVE D'ANAME:=G'ANAME,(4);                        <<00.GEN>>33755000
            D'TYPE.(ENDLEVELFX):=                             <<00.GEN>>33760000
              IF LEAFLEVEL=USERLEVEL THEN ALLUSERS            <<00.GEN>>33765000
              ELSE ALLGROUPS;                                 <<00.GEN>>33770000
          END;                                                <<00.GEN>>33775000
    <<3>> D'TYPE.(ENDLEVELFX):=ALLACCTS;                      <<00.GEN>>33780000
  END;                                                        <<00.GEN>>33785000
  PRODUCEPARMS:=TRUE;                                         <<01.GEN>>33790000
                                                               <<01.KM>>33795000
EXITINSTR:                                                     <<01.KM>>33800000
END  <<PROCEDURE PRODUCEPARMS>>;                              <<00.GEN>>33805000
                                                              <<00.GEN>>33810000
                                                              <<00.GEN>>33815000
PROCEDURE CXLISTF EXECUTORHEAD;                                <<U.RAO>>33820000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>33825000
BEGIN                                                          <<U.RAO>>33830000
$INCLUDE INCLCAP                                               <<06567>>33835000
                                                               <<03.KM>>33840000
DEFINE P'GANAME=     RECIPPARMS(4) #,                          <<04.KM>>33845000
       P'GOTENTRY=   RECIPPARMS(24) #,                         <<03.KM>>33850000
       P'IMPMNTDST=  RECIPPARMS(25) #,                         <<03.KM>>33855000
       P'IMPMNTERR=  RECIPPARMS(26) #,                         <<03.KM>>33860000
       P'IMPMNTGRP=  RECIPPARMS(27) #,                         <<03.KM>>33865000
       P'IMPMNTACCT= RECIPPARMS(31) #;                         <<03.KM>>33870000
DEFINE PAGEEJECT = FWRITE(FNUM,DATEBUF,0,%61) #;               <<09.MM>>33875000
EQUATE NOMNTERR= -1,                                           <<03.KM>>33880000
       NOMOUNT=  0;                                            <<03.KM>>33885000
EQUATE F'STDLIST      = 1,                                     <<00852>>33890000
       NEW'FILE       = 0,                                     <<00852>>33895000
       TEMP'DOMAIN    = 2,                                     <<00852>>33900000
       CURRENT'DOMAIN = 0;                                     <<00852>>33905000
DOUBLE DL := COMMASEMICR;                                      <<U.RAO>>33910000
INTEGER NUMPARMS;                                              <<U.RAO>>33915000
DOUBLE ARRAY PARMS(0:3)=Q;                                     <<U.RAO>>33920000
INTEGER ARRAY RECIPPARMS(0:SYSL'PARMLEN-1);                   <<00.GEN>>33925000
INTEGER ARRAY PPRESULT(*)=RECIPPARMS(SYSL'PPRINX);            <<00.GEN>>33930000
BYTE POINTER LEAFNAME = PARMS;                                 <<U.RAO>>33935000
INTEGER LEAFNAMECHAR = PARMS+1;                                <<U.RAO>>33940000
BYTE LEAFNAMELEN = PARMS+1;                                    <<U.RAO>>33945000
BYTE POINTER LISTLEVEL = PARMS+2;                              <<U.RAO>>33950000
BYTE LISTLEVELLEN = PARMS+3;                                   <<U.RAO>>33955000
BYTE POINTER LISTFILE = PARMS+2;  <<TRICKY BIT>>               <<U.RAO>>33960000
INTEGER LISTFILECHAR = PARMS+3;                                <<U.RAO>>33965000
BYTE POINTER EXTRAPARM = PARMS+6;                              <<U.RAO>>33970000
BYTE EXTRAPARMLEN = PARMS+7;                                   <<U.RAO>>33975000
EQUATE COMMA = 0, SEMI = 1, CR = 2;                            <<U.RAO>>33980000
BYTE POINTER DELIM;                                           <<00.GEN>>33985000
INTEGER FOPTIONS := %2504;                                     <<U.RAO>>33990000
INTEGER FCLOSE'FOPTIONS := 0;                                  <<00852>>33995000
LOGICAL STDLIST := TRUE;                                       <<U.RAO>>34000000
INTEGER FNUM := 2;  <<DEFAULT TO $STDLIST>>                    <<U.RAO>>34005000
ARRAY DATEBUF(0:13);  <<USED FOR TIME STAMP OF OUTPUT>>        <<02.RO>>34010000
INTEGER DEV := 0;  <<DEVICE TYPE OF LIST FILE>>                <<03.RO>>34015000
ARRAY QARRAY(*)=Q+0;                                           <<06567>>34020000
INTEGER PCBGLOBLOC;                                            <<06567>>34025000
POINTER UCAPPTR;                                               <<06567>>34030000
LOGICAL INTERACTIVE;                                           <<09.MM>>34035000
                                                               <<U.RAO>>34040000
<<INITIALIZE PARMS ARRAY>>                                     <<U.RAO>>34045000
PARMS := 0D;                                                   <<U.RAO>>34050000
TOS := @PARMS+2;                                               <<U.RAO>>34055000
TOS := @PARMS+1;                                               <<U.RAO>>34060000
TOS := 6;                                                      <<U.RAO>>34065000
ASSEMBLE(MOVE);                                                <<U.RAO>>34070000
MYCOMMAND(PARMSP,DL,4,NUMPARMS,PARMS);                         <<U.RAO>>34075000
PARMNUM := 1;                                                  <<U.RAO>>34080000
IF NOT PRODUCEPARMS(0,PARMSP,PPRESULT,DELIM,ERRNUM) THEN      <<00.GEN>>34085000
    RETURN;  <<ERROR IN PARSING LEAFNAME>>                     <<U.RAO>>34090000
IF (NUMPARMS > 0) AND  <<NOT JUST A CR>>                       <<U.RAO>>34095000
   (@DELIM < @LEAFNAME+INTEGER(LEAFNAMELEN)) THEN             <<00.GEN>>34100000
   BEGIN  <<EXTRANEOUS STUFF IN LEAFNAME>>                     <<U.RAO>>34105000
   TOS := ERRNUM := LISTFEXTRANEOUS;                           <<U.RAO>>34110000
   TOS := @DELIM;                                             <<00.GEN>>34115000
   CIERR(*,*);                                                 <<U.RAO>>34120000
   RETURN                                                      <<U.RAO>>34125000
   END;                                                        <<U.RAO>>34130000
                                                               <<U.RAO>>34135000
IF NUMPARMS=0 THEN LEAFNAMECHAR := CR;                         <<U.RAO>>34140000
                                                               <<U.RAO>>34145000
<<CHECK FOR LISTLEVEL, IF ANY>>                                <<U.RAO>>34150000
IF LEAFNAMECHAR.(11:5)=COMMA THEN  <<LISTLEVEL PRESENT>>       <<U.RAO>>34155000
   BEGIN                                                       <<U.RAO>>34160000
   PARMNUM := 2;                                               <<U.RAO>>34165000
   TOS := BINARY(LISTLEVEL,INTEGER(LISTLEVELLEN));             <<U.RAO>>34170000
   IF <> OR NOT(-1 <= S0 <= 2) THEN                            <<U.RAO>>34175000
      BEGIN   <<BAD CONVERSION OR BAD NUMBER>>                 <<U.RAO>>34180000
      CIERR(ERRNUM := -LISTFBADLEVEL, LISTLEVEL);              <<04785>>34185000
      IF TOS < -1 THEN    <<GIVE LISTF,-1>>                    <<U.RAO>>34190000
         TOS := -1                                             <<U.RAO>>34195000
      ELSE                <<GIVE LISTF,2>>                     <<U.RAO>>34200000
         TOS := 2;                                             <<U.RAO>>34205000
      END;                                                     <<U.RAO>>34210000
   IF S0 > 2 THEN TOS := 2;  <<MAX LEVEL>>                     <<U.RAO>>34215000
   IF S0 < 0 THEN  <<LISTF -1 CASE?>>                          <<U.RAO>>34220000
      BEGIN  <<CHECK CAPABILITY>>                              <<U.RAO>>34225000
      IF D'TYPE.(STARTLEVELF) = 0 THEN  <<SYSTEM LEVEL FILE>> <<00.GEN>>34230000
         BEGIN                                                 <<U.RAO>>34235000
         PXGLOBAL;                                             <<06567>>34240000
         @UCAPPTR := @PXG'USERATTRIBUTES;                      <<06567>>34245000
         IF NOT UCAPSM AND                                     <<06567>>34250000
            NOT (UCAPAM LAND CHECKHOMEACCT(PPRESULT)=0) THEN   <<06567>>34255000
            BEGIN << NOT (SMCAP OR AMCAP AND HOMEACCT =     >> <<00450>>34260000
                  <<                         REQUESTEDACCT) >> <<00450>>34265000
            IF CHECKHOMEACCT(PPRESULT)=0 THEN                  <<00450>>34270000
               CIERR(ERRNUM := LISTFAMCAP)                     <<00450>>34275000
            ELSE CIERR(ERRNUM := LISTFSMCAP);                  <<00450>>34280000
            RETURN                                             <<U.RAO>>34285000
            END;                                               <<U.RAO>>34290000
         END                                                   <<U.RAO>>34295000
      ELSE   <<CHECK FOR ACCOUNT MANAGER CAPABILITY>>          <<04.RO>>34300000
         BEGIN                                                 <<04.RO>>34305000
         PXGLOBAL;                                             <<06567>>34310000
         @UCAPPTR := @PXG'USERATTRIBUTES;                      <<06567>>34315000
         IF NOT UCAPAM AND NOT UCAPSM THEN                     <<06567>>34320000
            BEGIN                                              <<04.RO>>34325000
            CIERR(ERRNUM := LISTFAMCAP);                       <<04.RO>>34330000
            RETURN                                             <<04.RO>>34335000
            END;                                               <<04.RO>>34340000
         END;                                                  <<04.RO>>34345000
      RECIPPARMS(13) := 0;                                     <<U.RAO>>34350000
      END;  <<LISTF -1 CASE>>                                  <<U.RAO>>34355000
   PARMS := PARMS(1);                                          <<U.RAO>>34360000
   PARMS(1) := PARMS(2);  <<FIXUP FOR MISSING LISTLEVEL>>      <<U.RAO>>34365000
   END                                                         <<U.RAO>>34370000
ELSE                                                           <<U.RAO>>34375000
   TOS := 0;   <<LISTLEVEL DEFAULT>>                           <<U.RAO>>34380000
RECIPPARMS(12) := S0;  <<LISTLEVEL IN BINARY>>                 <<U.RAO>>34385000
CASE TOS OF                                                    <<U.RAO>>34390000
   BEGIN   <<SET WIDTH OF ENTRY IN WORDS>>                     <<U.RAO>>34395000
   RECIPPARMS(13) := 4;                                        <<U.RAO>>34400000
   RECIPPARMS(13) := 25;                                       <<U.RAO>>34405000
   RECIPPARMS(13) := 34;                                       <<U.RAO>>34410000
   END;                                                        <<U.RAO>>34415000
<<WE HAVE NOW PROCESSED THE LISTLEVEL. NOW DO LISTFILE>>       <<U.RAO>>34420000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>34425000
IF LEAFNAMECHAR.(11:5)=SEMI THEN  <<PROBABLY IS ONE>>         <<U.RAO>>34430000
   BEGIN                                                       <<U.RAO>>34435000
   IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN RETURN;              <<U.RAO>>34440000
   STDLIST := FALSE;  <<USER SPECIFIED A FILE >>               <<U.RAO>>34445000
   END                                                         <<U.RAO>>34450000
ELSE IF LEAFNAMECHAR.(11:5)=COMMA THEN  <<ERROR>>              <<U.RAO>>34455000
   BEGIN                                                       <<U.RAO>>34460000
   CIERR(ERRNUM := LISTFEXPECTFILE, LISTFILE);                 <<U.RAO>>34465000
   RETURN                                                      <<U.RAO>>34470000
   END;                                                        <<U.RAO>>34475000
                                                               <<U.RAO>>34480000
IF (LISTFILECHAR.(11:5) <> CR) AND (EXTRAPARMLEN<>0) THEN      <<U.RAO>>34485000
   BEGIN                                                       <<U.RAO>>34490000
   PARMNUM := PARMNUM+1;                                       <<U.RAO>>34495000
   CIERR(ERRNUM := LISTF2MP,EXTRAPARM);                        <<U.RAO>>34500000
   RETURN                                                      <<U.RAO>>34505000
   END;                                                        <<U.RAO>>34510000
PARMNUM := 0;                                                  <<U.RAO>>34515000
                                                               <<U.RAO>>34520000
IF NOT STDLIST THEN   <<OPEN USER DEFINED FILE>>               <<U.RAO>>34525000
FNUM := FOPEN(LISTFILE, FOPTIONS, %101);                       <<00267>>34530000
IF CARRY THEN                                                  <<U.RAO>>34535000
   BEGIN                                                       <<U.RAO>>34540000
   FERROR'(FNUM, PARMNUM);                                     <<U.RAO>>34545000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>34550000
   RETURN                                                      <<U.RAO>>34555000
   END;                                                        <<U.RAO>>34560000
RECIPPARMS(18) := FNUM;                                        <<U.RAO>>34565000
                                                               <<U.RAO>>34570000
FGETINFO(FNUM,,FOPTIONS,,RECIPPARMS(19),DEV);                  <<09.MM>>34575000
<< DETERMINE FINAL DOMAIN OF LIST FILE >>                      <<00852>>34580000
FCLOSE'FOPTIONS.(13:3) := IF FOPTIONS.(14:2) = NEW'FILE        <<00852>>34585000
                             THEN TEMP'DOMAIN                  <<00852>>34590000
                          ELSE CURRENT'DOMAIN;                 <<00852>>34595000
TOS := RECIPPARMS(19);                                         <<U.RAO>>34600000
IF < THEN TOS := -TOS                                          <<U.RAO>>34605000
ELSE TOS := TOS&LSL(1);  <<CONVERT TO BYTE COUNT>>             <<U.RAO>>34610000
RECIPPARMS(19) := TOS;  <<LINE LENGTH>>                        <<U.RAO>>34615000
                                                               <<U.RAO>>34620000
<<SET OTHER FILE ATTRIBUTES>>                                  <<U.RAO>>34625000
RECIPPARMS(20):=-1;                    <<1ST-TIME LINE# FLAG>> <<05.KM>>34630000
RECIPPARMS(21) := 0;                                           <<U.RAO>>34635000
RECIPPARMS := FNUM;                                            <<U.RAO>>34640000
RECIPPARMS(1) := 0;                                            <<U.RAO>>34645000
                                                               <<U.RAO>>34650000
<<PUT OUT TIME STAMP IF JOB OR LIST FILE>>                     <<02.RO>>34655000
PXGLOBAL;                                                      <<06567>>34660000
INTERACTIVE := PXG'INTERACTIVE;                                <<06567>>34665000
IF NOT INTERACTIVE AND STDLIST OR                              <<09.MM>>34670000
   NOT STDLIST AND DEV.(8:8) >= 8  <<NOT DISC>> THEN           <<03.RO>>34675000
   BEGIN                                                       <<02.RO>>34680000
   <<IF JOB AND (STDLIST OF USERFILE IS STDLIST) DO PAGEEJECT>><<09.MM>>34685000
   IF NOT INTERACTIVE AND FOPTIONS.(10:3)=F'STDLIST            <<09.MM>>34690000
      THEN PAGEEJECT;                                          <<09.MM>>34695000
   DATE'LINE(DATEBUF);                                         <<02.RO>>34700000
   FWRITE(FNUM, DATEBUF, -27, %60);                            <<02.RO>>34705000
   RECIPPARMS(20):=-3;                 <<1ST-TIME LINE# FLAG>> <<05.KM>>34710000
   END;                                                        <<02.RO>>34715000
                                                               <<02.RO>>34720000
P'GOTENTRY:=FALSE;                                             <<03.KM>>34725000
P'IMPMNTDST:=0;                                                <<03.KM>>34730000
P'IMPMNTERR:=NOMNTERR;                                         <<03.KM>>34735000
IF LOGICAL(D'INX1.(PVF)) THEN                                  <<03.KM>>34740000
   BEGIN                                                       <<03.KM>>34745000
   COMMENT:                                                    <<03.KM>>34750000
     FORCE ACCT-LEVEL SEARCH TO ENSURE THAT WE VISIT           <<03.KM>>34755000
     GROUP ENTRY AND FORCE IMPLICIT MOUNT;                     <<03.KM>>34760000
                                                               <<03.KM>>34765000
   D'TYPE.(STARTLEVELF):=1;                                    <<03.KM>>34770000
   GETDIRINFO(1,2,PPRESULT);                                   <<03.KM>>34775000
   END;                                                        <<03.KM>>34780000
MOVE P'GANAME:=D'GNAME,(4),2; <<IN CASE WE DON'T VISIT NODE>>  <<06.KM>>34785000
MOVE * := D'ANAME,(4);                                         <<06.KM>>34790000
RECIPPARMS (22) := D'TYPE;                                    <<00.GEN>>34795000
RECIPPARMS (23) := D'INX1;  <<GLINKAGE INITIALIZATION>>       <<00.GEN>>34800000
RECIPPARMS(SAVEBUFFINDEX) := 0; << see syslist >>              <<04178>>34805000
RECIPPARMS(SAVEBUFFINDEX + ASIZE + 1) := 0;                    <<04178>>34810000
                                                               <<RV.PV>>34815000
<<NOW SET UP COMMON DIRECSCAN STUFF ON STACK>>                 <<RV.PV>>34820000
TOS := 0D;  <<RETURN VALUE>>                                   <<U.RAO>>34825000
TOS := D'TYPE;                                                <<00.GEN>>34830000
TOS.(HITFLAG) := 1;                                            <<RV.PV>>34835000
TOS := D'INX1.(MVTABXF);               <<LINKAGE>>            <<04.GEN>>34840000
TOS := D'INX2;                         <<INDEXP>>             <<05.GEN>>34845000
TOS := @D'ANAME;                                              <<00.GEN>>34850000
TOS := @D'GNAME;                                              <<00.GEN>>34855000
TOS := @D'FNAME;                                              <<00.GEN>>34860000
IF RECIPPARMS(12)<0 THEN  <<LISTF ,-1>>                        <<U.RAO>>34865000
   TOS := DIRECSCAN(*,*,*,*,*,SYSLIST,RECIPPARMS)              <<U.RAO>>34870000
ELSE                                                           <<U.RAO>>34875000
   TOS := DIRECSCAN(*,*,*,*,*,LISTSAVEFILES,RECIPPARMS);       <<U.RAO>>34880000
                                                               <<04.KM>>34885000
PUSH(STATUS);                                                  <<04.KM>>34890000
IF LOGICAL(P'GOTENTRY) THEN FWRITE(FNUM,RECIPPARMS,0,0);       <<04.KM>>34895000
IF P'IMPMNTDST<>0 OR P'IMPMNTERR<>NOMNTERR THEN                <<04.KM>>34900000
  BEGIN                                                        <<04.KM>>34905000
  LISTFDISMNT(P'IMPMNTDST,P'IMPMNTERR,P'IMPMNTGRP,P'IMPMNTACCT,<<04.KM>>34910000
              ERRNUM);                                         <<04.KM>>34915000
  IF P'IMPMNTERR>NOMOUNT AND                                   <<04.KM>>34920000
     JOBSESSIONMAIN THEN GENMSG(CIERRMSGSET,LISTFSTOPPED);     <<04.KM>>34925000
  END;                                                         <<04.KM>>34930000
SET(STATUS);                                                   <<04.KM>>34935000
                                                               <<04.KM>>34940000
IF <> THEN   <<DIRECTORY ERROR>>                               <<U.RAO>>34945000
   BEGIN                                                       <<U.RAO>>34950000
   IF NOT STDLIST THEN   <<CLOSE USER DEFINED FILE>>           <<U.RAO>>34955000
      FCLOSE(FNUM, FCLOSE'FOPTIONS, 0);                        <<00852>>34960000
   CYDIRERR'(*,%120000,ERRNUM);                                <<U.RAO>>34965000
   RETURN;                                                     <<U.RAO>>34970000
   END;                                                        <<U.RAO>>34975000
DDEL;                                                          <<U.RAO>>34980000
IF RECIPPARMS(1) < 0 THEN                                      <<U.RAO>>34985000
   BEGIN                                                       <<U.RAO>>34990000
   FERROR'(FNUM,PARMNUM);                                      <<U.RAO>>34995000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>35000000
   RETURN                                                      <<U.RAO>>35005000
   END;                                                        <<U.RAO>>35010000
IF LOGICAL(P'GOTENTRY) THEN FWRITE(FNUM,RECIPPARMS,0,0)        <<03.KM>>35015000
ELSE CIERR(ERRNUM := -NOFILESLISTED);                          <<04785>>35020000
             <<XPARENT TO PROGRAMMATIC CALL FOR UPWARD COMPAT>><<03.KM>>35025000
IF NOT STDLIST THEN  <<CLOSE USER DEFINED FILE>>               <<U.RAO>>35030000
   FCLOSE(FNUM, FCLOSE'FOPTIONS, 0);                           <<00852>>35035000
IF CARRY THEN                                                  <<U.RAO>>35040000
   BEGIN                                                       <<U.RAO>>35045000
   FERROR'(FNUM,PARMNUM);                                      <<U.RAO>>35050000
   CIERR(ERRNUM := LISTFFSERR,LISTFILE,%10000,PARMNUM);        <<U.RAO>>35055000
   END;                                                        <<U.RAO>>35060000
END;  <<CXLISTF>>                                              <<U.RAO>>35065000
                                                               <<01.KM>>35070000
                                                               <<01.KM>>35075000
$CONTROL SEGMENT = CIPREPRUN                                   <<U.RAO>>35080000
LOGICAL PROCEDURE CISUBSYSFINISH(MESSAGETYPE, ERRNUM, PARMNUM);<<U.RAO>>35085000
VALUE MESSAGETYPE;                                             <<U.RAO>>35090000
INTEGER MESSAGETYPE, ERRNUM, PARMNUM;                          <<U.RAO>>35095000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>35100000
<<This procedure is called by all subsystem executors and the>><<U.RAO>>35105000
<<executor for the RUN command.  It cleans up various job>>    <<U.RAO>>35110000
<<related parameters and put out any appropriate termination>> <<U.RAO>>35115000
<<message.>>                                                   <<U.RAO>>35120000
<<MESSAGETYPE = 0 => NO MESSAGE.                            >> <<U.RAO>>35125000
<<            = 1 => "END OF PROGRAM"                       >> <<U.RAO>>35130000
<<            = 2 => "END OF PREPARE"                       >> <<U.RAO>>35135000
<<            = 3 => "END OF SUBSYSTEM"                     >> <<U.RAO>>35140000
<<            = 4 => "END OF COMPILE"                       >> <<U.RAO>>35145000
<<            = 5 => "END OF REMOTE PROGRAM"                >> <<U.RAO>>35150000
BEGIN                                                          <<U.RAO>>35155000
LOGICAL RESULT = CISUBSYSFINISH;                               <<U.RAO>>35160000
LOGICAL LEN;                                                   <<U.RAO>>35165000
INTEGER ARRAY JITARR(*) = DB+0;                                <<06840>>35170000
LOGICAL JOBSESSTYPE;                                           <<06840>>35175000
INTEGER JITJNUM;  <<HOLDS VALUE OF JITJNUM>>                   <<U.RAO>>35180000
INTEGER JIT'EOF;                                               <<06840>>35185000
INTEGER JITDSTN;  <<HOLDS DATASEG NUMBER OF JIT>>              <<U.RAO>>35190000
ARRAY QARRAY(*)=Q+0;                                           <<06567>>35195000
INTEGER PCBGLOBLOC;                                            <<06567>>35200000
INTEGER NEWJITEOF := 0;  <<ALMOST A DUMMY>>                    <<U.RAO>>35205000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<U.RAO>>35210000
SUBROUTINE DEF'MOVETODSEG;                                     <<U.RAO>>35215000
                                                               <<U.RAO>>35220000
NEXTLINE;  <<LINE FEED>>                                       <<U.RAO>>35225000
<<FIRST DEAL WITH JIT, GETTING AND RESETING EOF AND JNUM>>     <<U.RAO>>35230000
PXGLOBAL;                                                      <<06567>>35235000
JITDSTN := PXG'JITDST;                                         <<06567>>35240000
EXCHANGEDB(JITDSTN);                                           <<06840>>35245000
JITJNUM:=JITJOBNUMBER;                                         <<06840>>35250000
JIT'EOF:=JITEOF;                                               <<06840>>35255000
JOBSESSTYPE:=JITJSTYPE;                                        <<06840>>35260000
JITEOF:=NEWJITEOF;    << Clear old EOF flags >>                <<06840>>35265000
EXCHANGEDB(0);                                                 <<06840>>35270000
<<SET RETURN VALUE FOR SUBSYSFINISH>>                          <<U.RAO>>35275000
CISUBSYSFINISH := NOT GETJCW.(0:1);                            <<U.RAO>>35280000
<<FLUSH TO EOD AS NECESSARY>>                                  <<U.RAO>>35285000
IF (JOBSESSTYPE = 2) <<JOB>> AND (JIT'EOF <>0 )                <<07053>>35290000
   AND (CIS'UDCNESTLEVEL = 0) << NOT IN UDC >> THEN            << I.A >>35295000
   BEGIN   <<FLUSH REQUIRED - READ TO :>>                      <<U.RAO>>35300000
   DO LEN := FREAD(1,CIS'WCOMIMAGE,-CIS'BCOMBUFLEN)            <<04920>>35305000
      UNTIL <> OR CIS'BCOMIMAGE = ":";                         << I.A >>35310000
   <<CCE => FOUND SOMETHING, CCL/CCG => FREAD ERROR OR EOF>>   <<U.RAO>>35315000
   <<MPE USED TO LOOK FOR : IF $STDIN OR :EOD IF $STDINX, >>   <<U.RAO>>35320000
   <<BUT THE COMPLEXITY AND THE IMCOMPATIBILITY WITH THE  >>   <<U.RAO>>35325000
   <<SERIES I FORCED US TO LOOK FOR JUST A : IN COLUMN 1. >>   <<U.RAO>>35330000
   IF = AND LEN>1 THEN   <<SUCCESS>>                           <<U.RAO>>35335000
      CIS'PENDINGCOMLEN := LEN;  << FLAG COM ALREADY READ >>   << I.A >>35340000
   END;                                                        <<U.RAO>>35345000
<< RESET THE TERMINAL TO THE DESIRED STATE >>                  <<00851>>35350000
PXGLOBAL;                                                      <<06567>>35355000
IF PXG'INTERACTIVE THEN RESET'TERMINALMODE;                    <<06567>>35360000
<<IN ANY CASE, SEND MESSAGE ABOUT PROCESS TERMINATION>>        <<U.RAO>>35365000
IF (MESSAGETYPE <> 0) AND RESULT  <<PGM SUCCESSFUL>> THEN      <<U.RAO>>35370000
   GENMSG(CIGENERALMSGSET, ENDOFPROG + MESSAGETYPE -1);        <<U.RAO>>35375000
<<FINALLY, IF APPROPRIATE, RETURN ABNORMAL TERM MESSAGE>>      <<U.RAO>>35380000
IF NOT RESULT THEN   <<FATAL ERROR SOMEWHERE>>                 <<U.RAO>>35385000
   BEGIN                                                       <<U.RAO>>35390000
   PARMNUM := 0;                                               <<U.RAO>>35395000
   IF GETJCW = %140000 THEN  <<:ABORT>>                        <<U.RAO>>35400000
      CIERR(ERRNUM := PGMABORT)                                <<U.RAO>>35405000
   ELSE   <<REGULAR ERROR>>                                    <<U.RAO>>35410000
      CIERR(ERRNUM := ERRABTERM);                              <<04785>>35415000
   END;                                                        <<U.RAO>>35420000
END;   <<CISUBSYSFINISH>>                                      <<U.RAO>>35425000
PROCEDURE RESET'TERMINALMODE;                                  <<00851>>35430000
OPTION UNCALLABLE;                                             <<00851>>35435000
BEGIN                                                          <<00851>>35440000
   COMMENT:                                                    <<00851>>35445000
      THIS PROCEDURE RESETS THE TERMINAL TO THE STATE          <<00851>>35450000
      DESIRED BY THE CI.  IN PARTICULAR IT:                    <<00851>>35455000
         1) DISABLES BREAK IF IN A NOBREAK UDC ELSE            <<00851>>35460000
            ENABLES BREAK                                      <<00851>>35465000
         2) CANCELLS ANY PREVIOUSLY ESTABLISHED TIME-          <<00851>>35470000
            OUTS FOR FREADS.;                                  <<00851>>35475000
   LOGICAL                                                     <<00851>>35480000
      PARM;  << FCONTROL PARARMETER >>                         <<00851>>35485000
                                                               <<00851>>35490000
   IF CIS'UDCNOBREAKOPT                                        << I.A >>35495000
      THEN FCONTROL( 1, DISABLEBREAK, PARM )                   << I.A >>35500000
   ELSE FCONTROL(1,ENABLEBREAK,PARM);                          <<00851>>35505000
                                                               <<00851>>35510000
   << RESET TIMED READ >>                                      <<00851>>35515000
   PARM := 0;                                                  <<00851>>35520000
   FCONTROL(1,TIMEOUT,PARM);                                   <<00851>>35525000
                                                               <<00851>>35530000
END; << PROCEDURE RESET'TERMINALMODE >>                        <<00851>>35535000
                                                               <<00851>>35540000
                                                               <<00851>>35545000
PROCEDURE CXPREPRUN EXECUTORHEAD;                              <<U.RAO>>35550000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>35555000
BEGIN                                                          <<U.RAO>>35560000
  COMMENT                                                      <<U.RAO>>35565000
    HANDLES :PREP, :RUN, :PREPRUN.                             <<U.RAO>>35570000
                                                               <<U.RAO>>35575000
ALGORITHM: CRASH THROUGH IN OBVIOUS FASHION.  PRIMARILY DRIVEN <<U.RAO>>35580000
   BY "NEXT DELIMITER" AND SECONDARILY DRIVEN BY THE KEYWORDS; <<U.RAO>>35585000
                                                               <<U.RAO>>35590000
ENTRY CXPREP, CXRUN;                                           <<U.RAO>>35595000
                                                               <<U.RAO>>35600000
BYTE ARRAY PKEYLIST(*)=PB:=                                    <<U.RAO>>35605000
   5, 3, "LIB",                                                <<U.RAO>>35610000
   9, 7, "MAXDATA",                                            <<U.RAO>>35615000
   6, 4, "PARM",                                               <<U.RAO>>35620000
   6, 4, "PMAP",                                               <<U.RAO>>35625000
   7, 5, "DEBUG",                                              <<U.RAO>>35630000
   7, 5, "STACK",                                              <<U.RAO>>35635000
   4, 2, "RL",                                                 <<U.RAO>>35640000
   6, 4, "LMAP",                                               <<U.RAO>>35645000
   4, 2, "DL",                                                 <<U.RAO>>35650000
   8, 6, "ZERODB",                                             <<U.RAO>>35655000
   8, 6, "NOPRIV",                                             <<U.RAO>>35660000
   6, 4, "NOCB",                                               <<U.RAO>>35665000
   5, 3, "CAP",                                                <<U.RAO>>35670000
   7, 5, "PATCH",                                              <<00629>>35675000
   7, 5, "STDIN",                                              <<01200>>35680000
   9, 7, "STDLIST",                                            <<01200>>35685000
   6, 4, "INFO",                                               <<01200>>35690000
   7, 5, "NOSYM",                                              <<04103>>35695000
   7, 5, "FPMAP",                                              <<04103>>35700000
   9, 7, "NOFPMAP",                                            <<04103>>35705000
  10, 8, "CHECKSUM",                                           <<04103>>35710000
   0;                                                          <<U.RAO>>35715000
EQUATE PKEYLISTL = 144;                                        <<04103>>35720000
BYTE ARRAY KEYLIST(0:PKEYLISTL-1);                             <<U.RAO>>35725000
BYTE ARRAY PCAPLIST(0:24)=PB:=                                 <<U.RAO>>35730000
   4, 2, "PH",                                                 <<U.RAO>>35735000
   4, 2, "DS",                                                 <<U.RAO>>35740000
   4, 2, "MR",                                                 <<U.RAO>>35745000
   4, 2, "PM",                                                 <<U.RAO>>35750000
   4, 2, "IA",                                                 <<U.RAO>>35755000
   4, 2, "BA",                                                 <<U.RAO>>35760000
   0;                                                          <<U.RAO>>35765000
EQUATE PCAPLISTL = 25;                                         <<U.RAO>>35770000
BYTE ARRAY CAPLIST(0:PCAPLISTL-1);                             <<U.RAO>>35775000
                                                               <<U.RAO>>35780000
<<OPERATIONAL LOCAL VARIABLES>>                                <<U.RAO>>35785000
INTEGER PREPRUNFLAG;                                           <<U.RAO>>35790000
DEFINE PREPCOM = (PREPRUNFLAG>0)#,                             <<U.RAO>>35795000
       RUNCOM  = (PREPRUNFLAG<0)#,                             <<U.RAO>>35800000
       PREPRUNCOM = (PREPRUNFLAG=0)#;                          <<U.RAO>>35805000
EQUATE COMMA=0, EQUALSIGN=1, SEMICOLON=2, CR=3;  <<DELIMITERS>><<U.RAO>>35810000
                                                               <<01426>>35815000
<< MAX LENGTH FOR A STRING COMES AFTER A 'RUN X;INFO="' >>     <<01426>>35820000
EQUATE MAXSTRINGLEN = CIS'BCOMBUFLEN - 12;                     << I.A >>35825000
<< NOTE THAT THE CURRENT TRUE MAXIMUM ON STRING LENGTH IS   >> <<01709>>35830000
<< 253 CHARACTERS DUE TO THE LIMITATION OF MYCOMMAND.       >> <<01709>>35835000
                                                               <<01426>>35840000
INTEGER NUMPARMS;                                              <<U.RAO>>35845000
DOUBLE ARRAY PARMS(0:MAXSTRINGLEN+3-1);                        <<01426>>35850000
INTEGER ARRAY IPARMS(*)=PARMS;                                 <<U.RAO>>35855000
INTEGER DELIMITER;                                             <<U.RAO>>35860000
DOUBLE TEMPPARM,DUSERCAP;                                      <<04172>>35865000
LOGICAL USERCAP = DUSERCAP + 1;                                <<04172>>35870000
BYTE POINTER PPNTR=TEMPPARM;                                   <<U.RAO>>35875000
BYTE POINTER TEMPPARMPTR = TEMPPARM;                           <<02324>>35880000
LOGICAL DUMMY;                                                 <<02324>>35885000
BYTE POINTER ERRPTR;                                           <<02324>>35890000
LOGICAL LERRPTR' = ERRPTR;                                     <<02324>>35895000
LOGICAL PARMWORD2=TEMPPARM+1;                                  <<U.RAO>>35900000
LONG                                                           <<04172>>35905000
   IA := [16/"IA",48/0]L,                                      <<04172>>35910000
   BA := [16/"BA",48/0]L,                                      <<04172>>35915000
   IB := [16/"IA",16/",B",16/"A ",16/0]L;                      <<04172>>35920000
BYTE X1=PARMWORD2;  <<JUST A DUMMY FOR THE FOLLOWING DEFINE>>  <<U.RAO>>35925000
DEFINE PARMLEN = INTEGER(X1)#;                                 <<U.RAO>>35930000
INTEGER MAXPARAM;                                              <<U.RAO>>35935000
INTEGER ERR;                                                   <<U.RAO>>35940000
INTEGER NAMELEN;          << LENGTH OF FILE NAME >>            <<01200>>35945000
BYTE POINTER SPTR;        << TARGET STRING >>                  <<01200>>35950000
BYTE ARRAY STRING(0:MAXSTRINGLEN-1); << SOURCE STRING >>       <<01426>>35955000
BYTE ARRAY SAVEDCOMIMAGE(0:CIS'BCOMBUFLEN-1);                  << I.A >>35960000
INTEGER T'IX,             << OFFSET IN TARGET STR >>           <<01200>>35965000
        S'IX;             << OFFSET IN SOURCE STR >>           <<01200>>35970000
LOGICAL STOP := FALSE;    << FLAG TO STOP SCANNING >>          <<01200>>35975000
                          << IF 'CR' OR 'QUOTECHAR' >>         <<01200>>35980000
                          << IS ENCOUNTERED. >>                <<01200>>35985000
BYTE QUOTECHAR;<< CHOSEN STRING DELIMITER, CAN BE >>           << I.A >>35990000
               << SINGLE OR DOUBLE QUOTE.         >>           <<01200>>35995000
                                                               <<U.RAO>>36000000
EQUATE C'QUOTE = %47,                                          <<01200>>36005000
       C'DQUOTE = %42,                                         <<01200>>36010000
       C'COMMA =  %54,                                         <<01200>>36015000
       C'EQUAL =  %75,                                         <<01200>>36020000
       C'SEMICOLON = %73,                                      <<01200>>36025000
       C'CR = %15;                                             <<01200>>36030000
<<PARSED PARAMETER HOLDERS.  THE ACTUAL VALUES ARE    >>       <<U.RAO>>36035000
<<ENTERED IN THE SECTION WHERE THE KEYWORDS ARE PARSED>>       <<U.RAO>>36040000
BYTE ARRAY PROGNAME(0:35);  <<PROGRAM FILE NAME>>              <<U.RAO>>36045000
LOGICAL BLANK := "  ";                                         <<U.RAO>>36050000
BYTE ARRAY ENTRYNAME(0:35);    <<ENTRY POINT NAME>>            <<U.RAO>>36055000
BYTE POINTER RL := @BLANK;                                     <<U.RAO>>36060000
BYTE ARRAY TFILENAME(0:8);  <<HOLDS TEMP FILE NAMES>>          <<U.RAO>>36065000
BYTE ARRAY FULLFILENAME(*) = KEYLIST;                          <<U.RAO>>36070000
LOGICAL PARM := 0;                                             <<U.RAO>>36075000
INTEGER STACKSIZE := -1;                                       <<U.RAO>>36080000
INTEGER DLSIZE := -1;                                          <<U.RAO>>36085000
LOGICAL FLAGS := 1;                                            <<U.RAO>>36090000
LOGICAL FLAGS'EXT1 := 0;     << EXTENSION #1 TO FLAGS - FOR >> <<01200>>36095000
                             << NOTING DUPLICATE KEYWORDS   >> <<01200>>36100000
BYTE ARRAY STDIN(0:39);            << STDIN STRING >>          <<01200>>36105000
BYTE ARRAY STDLIST(0:70);          << STDLIST STRING >>        <<01200>>36110000
INTEGER MAXDATA := -1;                                         <<U.RAO>>36115000
INTEGER PATCHSIZE := -1;                                       <<00629>>36120000
BYTE LIB := "S";                                               <<U.RAO>>36125000
INTEGER ERROR;          << ERROR RETURN FROM CREATEPROCESS >>  <<01200>>36130000
INTEGER PIN := 0;       << PIN RETURNED FROM CREATEPROCESS >>  <<01200>>36135000
LOGICAL CAPWORD := 0;                                          <<U.RAO>>36140000
LOGICAL PFLAGS := 0;                                           <<U.RAO>>36145000
INTEGER ARRAY OPTNNUMS(0:12);   << OPTIONS FOR CREATEPROCESS >><<01200>>36150000
LOGICAL ARRAY OPTNS(0:12);                                     <<01200>>36155000
LOGICAL OPTIONS := 0;          << OPTIONS FOR PROCESS CREATE >><<01200>>36160000
                                                               <<U.RAO>>36165000
DEFINE                                                         <<01200>>36170000
  STACK'OPTION    = OPTIONS.(15:1)#,                           <<01200>>36175000
  DL'OPTION       = OPTIONS.(14:1)#,                           <<01200>>36180000
  MAXDATA'OPTION  = OPTIONS.(13:1)#,                           <<01200>>36185000
  STDIN'OPTION    = OPTIONS.(12:1)#,                           <<01200>>36190000
  STDLIST'OPTION  = OPTIONS.(11:1)#,                           <<01200>>36195000
  STRING'OPTION   = OPTIONS.(10:1)#;                           <<01200>>36200000
                                                               <<01200>>36205000
DEFINE                                                         <<U.RAO>>36210000
  CHECKRUNCOM=IF RUNCOM THEN ERRNUM:=CONTXTPRPNOTRUN#,         <<U.RAO>>36215000
  CHECKPREPCOM=IF PREPCOM THEN ERRNUM:=CONTXTRUNNOTPRP#,       <<U.RAO>>36220000
  CHECKEQSIGN=IF DELIMITER<>EQUALSIGN THEN                     <<U.RAO>>36225000
     BEGIN                                                     <<U.RAO>>36230000
     @PPNTR := @PPNTR+PARMLEN;                                 <<U.RAO>>36235000
     ERRNUM := REQEQUALSIGN;                                   <<U.RAO>>36240000
     END#,                                                     <<U.RAO>>36245000
  CHECKSEGERR=                                                 <<U.RAO>>36250000
     IF <> AND (ERR<>1) <<WARNING PRINTED>> THEN               <<U.RAO>>36255000
         BEGIN                                                 <<U.RAO>>36260000
         SEGMENTER(PIN,8,DELIMITER); <<EXIT>>                  <<U.RAO>>36265000
         ERRNUM := SEGMENTERERROR;                             <<U.RAO>>36270000
         PARMNUM := ERR;                                       <<U.RAO>>36275000
         CIERR(ERRNUM,,%10000,ERR);                            <<U.RAO>>36280000
         RETURN;                                               <<U.RAO>>36285000
         END #,                                                <<01200>>36290000
   CHECKNEW=                                                   <<01200>>36295000
      IF PARMLEN <> 3 OR PPNTR <> "NEW" THEN                   <<01200>>36300000
       ERRNUM := INVALIDSTDLIST#,                              <<01709>>36305000
                                                               <<01200>>36310000
   DELIM'CHAR=                                                 <<01709>>36315000
       IF DELIMITER = COMMA THEN C'COMMA                       <<01709>>36320000
       ELSE IF DELIMITER = EQUALSIGN THEN C'EQUAL              <<01709>>36325000
       ELSE IF DELIMITER = SEMICOLON THEN  C'SEMICOLON         <<01709>>36330000
       ELSE C'CR#;                                             <<01709>>36335000
EQUATE                                                         <<01200>>36340000
  FATHERWAIT      = 1,           << FOR CALLING AWAKE >>       <<01200>>36345000
  SONWAIT         = 2;           << FOR CALLING AWAKE >>       <<01200>>36350000
                                                               <<U.RAO>>36355000
EQUATE                                                         <<01452>>36360000
  UNKNOWN'PROG    =  6;   << CREATEPROC. CAN'T FIND PROGRAM >> <<01452>>36365000
                                                               <<01200>>36370000
INTEGER SUBROUTINE NEXT;                                       <<U.RAO>>36375000
BEGIN  <<GET NEXT PARAMETER>>                                  <<U.RAO>>36380000
TEMPPARM := PARMS(PARMNUM);                                    <<U.RAO>>36385000
NEXT := PARMWORD2.(13:3);  <<RETURN DELIMITER>>                <<U.RAO>>36390000
PARMNUM := PARMNUM+1;                                          <<U.RAO>>36395000
END;  <<SUBROUTINE NEXT>>                                      <<U.RAO>>36400000
                                                               <<01200>>36405000
LOGICAL SUBROUTINE DELIM(CHAR);                                <<01200>>36410000
COMMENT                                                        <<01200>>36415000
   THE FOLLOWING SUBROUTINE DETERMINES IF CHAR IS              <<01200>>36420000
   A DELIMITER. ;                                              <<01200>>36425000
BYTE CHAR;                                                     <<01200>>36430000
BEGIN                                                          <<01200>>36435000
   DELIM := FALSE;                                             <<01200>>36440000
   IF CHAR = C'COMMA OR                                        <<01200>>36445000
      CHAR = C'EQUAL OR                                        <<01200>>36450000
      CHAR = C'SEMICOLON THEN                                  <<01200>>36455000
      DELIM := TRUE;                                           <<01200>>36460000
END;                                                           <<01200>>36465000
                                                               <<U.RAO>>36470000
<<*** MAIN BODY OF PROCEDURE ***>>                             <<U.RAO>>36475000
                                                               <<U.RAO>>36480000
PREPRUNFLAG := 0;                                              <<U.RAO>>36485000
MAXPARAM := 29;                                                <<U.RAO>>36490000
GO TO START;                                                   <<U.RAO>>36495000
                                                               <<U.RAO>>36500000
CXPREP:                                                        <<U.RAO>>36505000
PREPRUNFLAG := 1;                                              <<U.RAO>>36510000
MAXPARAM := 21;                                                <<U.RAO>>36515000
GO TO START;                                                   <<U.RAO>>36520000
                                                               <<U.RAO>>36525000
CXRUN:                                                         <<U.RAO>>36530000
PREPRUNFLAG := -1;                                             <<U.RAO>>36535000
<< MAKE MAXPARAM LARGE SO STRING OF DELIMITERS (I.E. ; , CR) >><<01426>>36540000
<< WILL BE ACCEPTED BY MYCOMMAND.                            >><<01426>>36545000
MAXPARAM := MAXSTRINGLEN + 3;                                  <<01426>>36550000
                                                               <<U.RAO>>36555000
START:                                                         <<U.RAO>>36560000
MOVE SAVEDCOMIMAGE := CIS'BCOMIMAGE, (CIS'BCOMBUFLEN);         << I.A >>36565000
MYCOMMAND(PARMSP,,MAXPARAM,NUMPARMS,PARMS);                    <<U.RAO>>36570000
IF CARRY THEN                                                  <<01709>>36575000
   BEGIN  << AN ERROR FROM MYCOMMAND >>                        <<01709>>36580000
   << SOME PARAMETER EXCEEDS 255 CHARACTERS >>                 <<01709>>36585000
   ERRNUM := PARAMTOOBIG;                                      <<01709>>36590000
   CIERR(ERRNUM);                                              <<01709>>36595000
   RETURN;                                                     <<01709>>36600000
   END;                                                        <<01709>>36605000
DELIMITER := NEXT;                                             <<U.RAO>>36610000
IF NUMPARMS=0 THEN  <<MISSING FIRST FILE NAME>>                <<U.RAO>>36615000
   BEGIN                                                       <<U.RAO>>36620000
   ERRNUM := IF RUNCOM THEN ERRNOPROGF                         <<U.RAO>>36625000
      ELSE IF PREPRUNCOM THEN ERRNOPORUF                       <<U.RAO>>36630000
      ELSE ERRNOUSLF;                                          <<U.RAO>>36635000
   CIERR(ERRNUM,PARMSP(1));                                    <<U.RAO>>36640000
   RETURN;                                                     <<U.RAO>>36645000
   END;                                                        <<U.RAO>>36650000
                                                               <<U.RAO>>36655000
<<CHECK FIRST FILE NAME>>                                      <<U.RAO>>36660000
ERRNUM := CHECKFILENAME'(TEMPPARM&LSR(8),DUMMY,DUMMY,LERRPTR');<<02324>>36665000
IF < THEN    <<CCL RETURNED , ERROR IN NAME >>                 <<02324>>36670000
    BEGIN                                                      <<02324>>36675000
    CIERR(ERRNUM,ERRPTR);   <<ERRPTR POINTING AT ERROR LOC. >> <<02324>>36680000
    RETURN;                                                    <<02324>>36685000
    END                                                        <<02324>>36690000
ELSE IF > AND ERRNUM <> 0 AND ERRNUM <> 3 THEN                 <<02324>>36695000
    BEGIN                                                      <<02324>>36700000
    CIERR(ERRNUM := INVALIDSYSDEFFL,TEMPPARMPTR);              <<02324>>36705000
    RETURN;                                                    <<02324>>36710000
    END                                                        <<02324>>36715000
ELSE                                                           <<02324>>36720000
    IF ERRNUM = 3 THEN <<  $OLDPASS IS ALLOWED  >>             <<02324>>36725000
        ERRNUM := 0;                                           <<02324>>36730000
MOVE PROGNAME := PPNTR,(PARMLEN);                              <<U.RAO>>36735000
PROGNAME(PARMLEN) := " ";                                      <<U.RAO>>36740000
                                                               <<U.RAO>>36745000
<<NEXT HANDLE SECOND FILE NAME, IF ANY>>                       <<U.RAO>>36750000
ENTRYNAME := " ";                                              <<U.RAO>>36755000
IF DELIMITER = COMMA THEN  <<ENTRY OR PROGFILE>>               <<U.RAO>>36760000
   BEGIN                                                       <<U.RAO>>36765000
   DELIMITER := NEXT;                                          <<U.RAO>>36770000
   IF PREPCOM THEN  <<CHECK PROGFILE NAME>>                    <<U.RAO>>36775000
      IF CIBADFILENAME(ERRNUM,TEMPPARM) THEN  <<BAD NAME!>>    <<U.RAO>>36780000
         BEGIN                                                 <<U.RAO>>36785000
         PARMNUM := 2;                                         <<U.RAO>>36790000
         RETURN;                                               <<U.RAO>>36795000
         END                                                   <<U.RAO>>36800000
      ELSE                                                     <<U.RAO>>36805000
   ELSE IF PARMLEN>15 THEN  <<ENTRY NAME TOO LONG>>            <<U.RAO>>36810000
      BEGIN                                                    <<U.RAO>>36815000
      CIERR(ERRNUM := ERRENTRYTOOBIG,PPNTR);                   <<U.RAO>>36820000
      PARMNUM := 2;                                            <<U.RAO>>36825000
      RETURN                                                   <<U.RAO>>36830000
      END;                                                     <<U.RAO>>36835000
   MOVE ENTRYNAME := PPNTR,(PARMLEN);                          <<U.RAO>>36840000
   ENTRYNAME(PARMLEN) := " ";                                  <<U.RAO>>36845000
   END                                                         <<U.RAO>>36850000
ELSE IF PREPCOM THEN  <<MISSING REQUIRED PROG FILE>>           <<U.RAO>>36855000
   BEGIN                                                       <<U.RAO>>36860000
   ERRNUM := ERRNOPREPTARGET;                                  <<U.RAO>>36865000
   PARMNUM := 2;                                               <<U.RAO>>36870000
   CIERR(ERRNUM,PPNTR(PARMLEN));                               <<U.RAO>>36875000
   RETURN                                                      <<U.RAO>>36880000
   END;                                                        <<U.RAO>>36885000
                                                               <<U.RAO>>36890000
<<NEXT WE DO A CASE ON THE DELIMITER FOLLOWING THE FILE>>      <<U.RAO>>36895000
<<NAMES.  CARRIAGE RETURN FALLS THROUGH>>                      <<U.RAO>>36900000
CASE DELIMITER OF                                              <<U.RAO>>36905000
   BEGIN                                                       <<U.RAO>>36910000
      BEGIN  <<COMMA, QUITE UNEXPECTED>>                       <<U.RAO>>36915000
         ERRNUM := CMAXPCTSEMIORCR;                            <<U.RAO>>36920000
         CIERR(ERRNUM,PPNTR(PARMLEN));                         <<U.RAO>>36925000
         RETURN;                                               <<U.RAO>>36930000
      END;                                                     <<U.RAO>>36935000
      BEGIN  <<EQUAL SIGN, SIMILARLY UNEXPECTED>>              <<U.RAO>>36940000
         ERRNUM := EQXPCTSEMIORCR;                             <<U.RAO>>36945000
         CIERR(ERRNUM,PPNTR(PARMLEN));                         <<U.RAO>>36950000
         RETURN;                                               <<U.RAO>>36955000
      END;                                                     <<U.RAO>>36960000
      BEGIN  <<SEMICOLON - KEYWORD(S) FOLLOW>>                 <<U.RAO>>36965000
      MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                    <<U.RAO>>36970000
      TOS := FLAGS;                                            <<U.RAO>>36975000
      DO    <<PARSE KEYWORD LIST>>                             <<U.RAO>>36980000
         BEGIN                                                 <<U.RAO>>36985000
         DELIMITER := NEXT;                                    <<U.RAO>>36990000
         IF PARMLEN=0 THEN                                     <<U.RAO>>36995000
                CIERR(-EXTRNDELIMIGNRD,PPNTR(-1))              <<04919>>37000000
            ELSE                                               <<U.RAO>>37005000
               BEGIN   <<KEYWORD PROCESSING>>                  <<U.RAO>>37010000
               CASE SEARCH(PPNTR,PARMLEN,KEYLIST) OF           <<U.RAO>>37015000
                  BEGIN                                        <<U.RAO>>37020000
                                                               <<U.RAO>>37025000
                     <<THE TOMB OF THE UNKNOWN KEYWORD>>       <<U.RAO>>37030000
                  ERRNUM := (IF PREPCOM THEN UNKNOWNKEYPREP    <<U.RAO>>37035000
                     ELSE IF RUNCOM THEN UNKNOWNKEYRUN         <<U.RAO>>37040000
                     ELSE UNKNOWNKEYPRPRN);                    <<U.RAO>>37045000
                                                               <<U.RAO>>37050000
                     <<LIB = SL>>                              <<U.RAO>>37055000
                  CHECKPREPCOM                                 <<U.RAO>>37060000
                  ELSE CHECKEQSIGN                             <<U.RAO>>37065000
                  ELSE                                         <<U.RAO>>37070000
                     BEGIN  <<CHECK THE VALUE>>                <<U.RAO>>37075000
                     DELIMITER := NEXT;                        <<U.RAO>>37080000
                     IF (PARMLEN=1) AND ((PPNTR="G")           <<U.RAO>>37085000
                        OR (PPNTR="P") OR (PPNTR="S")) THEN    <<U.RAO>>37090000
                        BEGIN  <<VALID LIB>>                   <<U.RAO>>37095000
                        LIB := PPNTR;                          <<U.RAO>>37100000
                        ASSEMBLE(TSBC 4);                      <<U.RAO>>37105000
                        END                                    <<U.RAO>>37110000
                     ELSE                                      <<U.RAO>>37115000
                        ERRNUM := INVALIDLIB;                  <<U.RAO>>37120000
                     END;                                      <<U.RAO>>37125000
                                                               <<U.RAO>>37130000
                     <<MAXDATA = SEGSIZE>>                     <<U.RAO>>37135000
                  CHECKEQSIGN                                  <<U.RAO>>37140000
                  ELSE                                         <<U.RAO>>37145000
                     BEGIN                                     <<U.RAO>>37150000
                     DELIMITER := NEXT;                        <<U.RAO>>37155000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>37160000
                        BEGIN                                  <<U.RAO>>37165000
                        MAXDATA := BINARY(PPNTR,PARMLEN);      <<U.RAO>>37170000
                        IF <> THEN                             <<U.RAO>>37175000
                           ERRNUM := INVALIDMAXDATA            <<U.RAO>>37180000
                        ELSE                                   <<U.RAO>>37185000
                           BEGIN                               <<U.RAO>>37190000
                           MAXDATA'OPTION := 1;                <<01200>>37195000
                           ASSEMBLE(TSBC 0);                   <<U.RAO>>37200000
                           END;                                <<U.RAO>>37205000
                        END                                    <<U.RAO>>37210000
                     ELSE                                      <<U.RAO>>37215000
                        ERRNUM := INVALIDMAXDATA;              <<U.RAO>>37220000
                     END;                                      <<U.RAO>>37225000
                                                               <<U.RAO>>37230000
                     <<PARM = PARM>>                           <<U.RAO>>37235000
                  CHECKPREPCOM                                 <<U.RAO>>37240000
                  ELSE CHECKEQSIGN                             <<U.RAO>>37245000
                  ELSE                                         <<U.RAO>>37250000
                     BEGIN                                     <<U.RAO>>37255000
                     DELIMITER := NEXT;                        <<U.RAO>>37260000
                     IF PARMLEN>0 THEN                         <<U.RAO>>37265000
                        BEGIN                                  <<U.RAO>>37270000
                        PARM := BINARY(PPNTR,PARMLEN);         <<U.RAO>>37275000
                        IF <> THEN                             <<U.RAO>>37280000
                           ERRNUM := INVALIDPARM               <<U.RAO>>37285000
                        ELSE                                   <<U.RAO>>37290000
                           ASSEMBLE(TSBC 1);                   <<U.RAO>>37295000
                        END                                    <<U.RAO>>37300000
                     ELSE                                      <<U.RAO>>37305000
                        ERRNUM := INVALIDPARM;                 <<U.RAO>>37310000
                     END;                                      <<U.RAO>>37315000
                                                               <<U.RAO>>37320000
                     <<PMAP>>                                  <<U.RAO>>37325000
                  CHECKRUNCOM ELSE ASSEMBLE(TSBC 6);           <<U.RAO>>37330000
                                                               <<U.RAO>>37335000
                     <<DEBUG>>                                 <<U.RAO>>37340000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 13);         <<U.RAO>>37345000
                                                               <<U.RAO>>37350000
                     <<STACK = STACKSIZE>>                     <<U.RAO>>37355000
                  CHECKEQSIGN                                  <<U.RAO>>37360000
                  ELSE                                         <<U.RAO>>37365000
                     BEGIN                                     <<U.RAO>>37370000
                     DELIMITER := NEXT;                        <<U.RAO>>37375000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>37380000
                        BEGIN                                  <<U.RAO>>37385000
                        STACKSIZE := BINARY(PPNTR,PARMLEN);    <<U.RAO>>37390000
                        IF <> OR (STACKSIZE<511) THEN          <<U.RAO>>37395000
                           ERRNUM := INVALIDSTAKSIZE           <<U.RAO>>37400000
                        ELSE                                   <<U.RAO>>37405000
                           BEGIN                               <<U.RAO>>37410000
                           STACK'OPTION := 1;                  <<01200>>37415000
                           ASSEMBLE(TSBC 2);                   <<U.RAO>>37420000
                           END                                 <<U.RAO>>37425000
                        END                                    <<U.RAO>>37430000
                     ELSE                                      <<U.RAO>>37435000
                        ERRNUM := INVALIDSTAKSIZE;             <<U.RAO>>37440000
                  END;                                         <<U.RAO>>37445000
                                                               <<U.RAO>>37450000
                     <<RL = FILENAME>>                         <<U.RAO>>37455000
                  CHECKRUNCOM                                  <<U.RAO>>37460000
                  ELSE CHECKEQSIGN                             <<U.RAO>>37465000
                  ELSE                                         <<U.RAO>>37470000
                     BEGIN                                     <<U.RAO>>37475000
                     DELIMITER := NEXT;                        <<U.RAO>>37480000
                     TOS := CHECKFILENAME'(TEMPPARM&LSR(8),    <<U.RAO>>37485000
                        MAXPARAM,MAXPARAM,ERR);                <<U.RAO>>37490000
                     IF >= THEN                                <<U.RAO>>37495000
                        BEGIN                                  <<U.RAO>>37500000
                        DEL;                                   <<U.RAO>>37505000
                        @RL := @PPNTR;                         <<U.RAO>>37510000
                        ASSEMBLE(TSBC 8)                       <<U.RAO>>37515000
                        END                                    <<U.RAO>>37520000
                     ELSE  <<CORRECT CARET PTR FOR CIERR>>     <<U.RAO>>37525000
                        BEGIN                                  <<U.RAO>>37530000
                        @PPNTR := ERR;                         <<U.RAO>>37535000
                        ERRNUM := TOS;                         <<U.RAO>>37540000
                        END;                                   <<U.RAO>>37545000
                     END;                                      <<U.RAO>>37550000
                                                               <<U.RAO>>37555000
                     <<LMAP>>                                  <<U.RAO>>37560000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 14);         <<U.RAO>>37565000
                                                               <<U.RAO>>37570000
                     <<DL = DLSIZE>>                           <<U.RAO>>37575000
                  CHECKEQSIGN                                  <<U.RAO>>37580000
                  ELSE                                         <<U.RAO>>37585000
                     BEGIN                                     <<U.RAO>>37590000
                     DELIMITER := NEXT;                        <<U.RAO>>37595000
                     IF PARMLEN > 0 THEN                       <<U.RAO>>37600000
                        BEGIN                                  <<U.RAO>>37605000
                        DLSIZE := BINARY(PPNTR,PARMLEN);       <<U.RAO>>37610000
                        IF <> THEN                             <<U.RAO>>37615000
                           ERRNUM := INVALIDDLSIZE             <<U.RAO>>37620000
                        ELSE                                   <<U.RAO>>37625000
                           BEGIN                               <<U.RAO>>37630000
                           DL'OPTION := 1;                     <<01200>>37635000
                           ASSEMBLE(TSBC 3);                   <<U.RAO>>37640000
                           END                                 <<U.RAO>>37645000
                        END                                    <<U.RAO>>37650000
                     ELSE                                      <<U.RAO>>37655000
                        ERRNUM := INVALIDDLSIZE;               <<U.RAO>>37660000
                     END;                                      <<U.RAO>>37665000
                                                               <<U.RAO>>37670000
                     <<ZERODB>>                                <<U.RAO>>37675000
                  CHECKRUNCOM ELSE ASSEMBLE(TSBC 11);          <<U.RAO>>37680000
                                                               <<U.RAO>>37685000
                     <<NOPRIV>>                                <<U.RAO>>37690000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 12);         <<U.RAO>>37695000
                                                               <<U.RAO>>37700000
                     <<NOCB>>                                  <<U.RAO>>37705000
                  CHECKPREPCOM ELSE ASSEMBLE(TSBC 9);          <<U.RAO>>37710000
                                                               <<U.RAO>>37715000
                     <<CAP>>                                   <<U.RAO>>37720000
                  CHECKRUNCOM                                  <<U.RAO>>37725000
                  ELSE CHECKEQSIGN                             <<U.RAO>>37730000
                  ELSE                                         <<U.RAO>>37735000
                     BEGIN                                     <<U.RAO>>37740000
                     MOVE CAPLIST := PCAPLIST,(PCAPLISTL);     <<U.RAO>>37745000
                     TOS := 0;  <<FUTURE CAPABILITIES WORD>>   <<U.RAO>>37750000
                     DO BEGIN                                  <<U.RAO>>37755000
                        DELIMITER := NEXT;                     <<U.RAO>>37760000
                        IF PARMLEN = 0 THEN                    <<U.RAO>>37765000
                           ERRNUM := MISSINGCAP                <<U.RAO>>37770000
                        ELSE                                   <<U.RAO>>37775000
                           CASE SEARCH(PPNTR,PARMLEN,CAPLIST)OF<<U.RAO>>37780000
                              BEGIN                            <<U.RAO>>37785000
                              BEGIN ERRNUM := UNKNOWNCAP;      <<U.RAO>>37790000
                                 @PPNTR:=@PPNTR-1;END;         <<U.RAO>>37795000
                              ASSEMBLE(TSBC 15);  <<PH>>       <<U.RAO>>37800000
                              ASSEMBLE(TSBC 14);  <<DS>>       <<U.RAO>>37805000
                              ASSEMBLE(TSBC 12);  <<MR>>       <<U.RAO>>37810000
                              ASSEMBLE(TSBC 9);   <<PM>>       <<U.RAO>>37815000
                              ASSEMBLE(TSBC 8);   <<IA>>       <<U.RAO>>37820000
                              ASSEMBLE(TSBC 7);   <<BA>>       <<U.RAO>>37825000
                              END;                             <<U.RAO>>37830000
                        END                                    <<U.RAO>>37835000
                           UNTIL (DELIMITER <> COMMA) OR       <<U.RAO>>37840000
                              (ERRNUM <> 0);                   <<U.RAO>>37845000
                     CAPWORD := TOS;                           <<U.RAO>>37850000
                     IF (CAPWORD.(7:2)=0) AND (ERRNUM=0) THEN <<*alt*>> 37855000
                        BEGIN                                  <<04172>>37860000
                        WHO(,DUSERCAP);                        <<04172>>37865000
                        CAPWORD.(7:2) := USERCAP.(7:2);        <<04172>>37870000
                        CASE USERCAP.(7:2) OF                  <<04172>>37875000
                           BEGIN                               <<04172>>37880000
                           ;                                   <<04172>>37885000
                         << Note that assignments to >>        <<04919>>37890000
                         << ERRNUM are not necessary >>        <<04919>>37895000
                         << since :PREP and :PREPRUN >>        <<04919>>37900000
                         << are not executed progam- >>        <<04919>>37905000
                         << matically  ONLY WARNINGS >>        <<04919>>37910000
                         CIERR(-IMPIABA,,0,@IA&LSL(1));        <<04919>>37915000
                         CIERR(-IMPIABA,,0,@BA&LSL(1));        <<04919>>37920000
                         CIERR(-IMPIABA,,0,@IB&LSL(1));        <<04919>>37925000
                           END;                                <<04172>>37930000
                        END;                                   <<04172>>37935000
                     ASSEMBLE(TSBC 7);                         <<U.RAO>>37940000
                     END;                                      <<U.RAO>>37945000
                                                               <<00629>>37950000
                     <<PATCH = PATCHSIZE>>                     <<00629>>37955000
                  CHECKRUNCOM                                  <<00629>>37960000
                  ELSE CHECKEQSIGN                             <<00629>>37965000
                  ELSE                                         <<00629>>37970000
                     BEGIN                                     <<00629>>37975000
                     DELIMITER := NEXT;                        <<00629>>37980000
                     IF PARMLEN > 0 THEN                       <<00629>>37985000
                        BEGIN                                  <<00629>>37990000
                        PATCHSIZE := BINARY(PPNTR,PARMLEN);    <<00629>>37995000
                        IF <> THEN                             <<00629>>38000000
                           ERRNUM := INVALIDPATCH              <<00629>>38005000
                        ELSE                                   <<00629>>38010000
                           BEGIN                               <<00629>>38015000
                           IF NOT(-1<= PATCHSIZE <=16380) THEN <<00629>>38020000
                              ERRNUM := INVALIDPATCH;          <<00629>>38025000
                           ASSEMBLE(TSBC 5);                   <<00629>>38030000
                           END;                                <<00629>>38035000
                        END                                    <<00629>>38040000
                     ELSE                                      <<00629>>38045000
                        ERRNUM := INVALIDPATCH;                <<00629>>38050000
                     END;                                      <<00629>>38055000
                                                               <<00629>>38060000
                     << STDIN = FILE >>                        <<01200>>38065000
                  CHECKPREPCOM                                 <<01200>>38070000
                  ELSE CHECKEQSIGN                             <<01200>>38075000
                  ELSE                                         <<01200>>38080000
                     BEGIN                                     <<01200>>38085000
                     STDIN'OPTION := 0;                        <<01200>>38090000
                     DELIMITER := NEXT;                        <<01200>>38095000
                     IF PARMLEN > 0 THEN                       <<01200>>38100000
                        BEGIN  << STDIN REALLY SPECIFIED >>    <<01200>>38105000
                        STDIN'OPTION := 1;                     <<01200>>38110000
                        TOS := CHECKFILENAME'(TEMPPARM&LSR(8), <<01200>>38115000
                                              MAXPARAM,        <<01200>>38120000
                                              MAXPARAM,        <<01200>>38125000
                                              ERR);            <<01200>>38130000
                        IF = THEN                              <<01200>>38135000
                           BEGIN  << SIMPLE FILE NAME >>       <<01200>>38140000
                           DEL;   << RETURN VALUE >>           <<01200>>38145000
                           MOVE STDIN := PPNTR,(PARMLEN),2;    <<01200>>38150000
                           MOVE * := ",OLD";                   <<01200>>38155000
                           STDIN(PARMLEN+4) := C'CR;           <<01200>>38160000
                           END                                 <<01200>>38165000
                        ELSE IF > THEN                         <<01200>>38170000
                           BEGIN  << SPECIAL FILE >>           <<01200>>38175000
                           IF S0 = 0 OR S0 = 6 THEN            <<01200>>38180000
                              BEGIN  << BACKREF OR $NULL >>    <<01200>>38185000
                              DEL;   << RETURN VALUE >>        <<01200>>38190000
                              MOVE STDIN := PPNTR,(PARMLEN);   <<01200>>38195000
                              STDIN(PARMLEN) := C'CR;          <<01200>>38200000
                              END                              <<01200>>38205000
                           ELSE                                <<01200>>38210000
                              BEGIN  << NOT BACKREF/$NULL >>   <<01200>>38215000
                              DEL;   << RETURN VALUE >>        <<01200>>38220000
                              ERRNUM := INVALIDSTDIN;          <<01200>>38225000
                              END;                             <<01200>>38230000
                           END                                 <<01200>>38235000
                        ELSE                                   <<01200>>38240000
                           BEGIN  << BAD FILE NAME >>          <<01200>>38245000
                           @PPNTR := ERR;                      <<01200>>38250000
                           ERRNUM := TOS;                      <<01200>>38255000
                           END;                                <<01200>>38260000
                        END;                                   <<01200>>38265000
                     TOS := FLAGS'EXT1;                        <<01200>>38270000
                     ASSEMBLE (TSBC 15);                       <<01200>>38275000
                     FLAGS'EXT1 := TOS;                        <<01200>>38280000
                     END << STDIN = FILENAME >>;               <<01200>>38285000
                                                               <<01200>>38290000
                     << STDLIST = FILE >>                      <<01200>>38295000
                  CHECKPREPCOM                                 <<01200>>38300000
                  ELSE CHECKEQSIGN                             <<01200>>38305000
                  ELSE                                         <<01200>>38310000
                     BEGIN                                     <<01200>>38315000
                     STDLIST'OPTION := 0;                      <<01200>>38320000
                     DELIMITER := NEXT;                        <<01200>>38325000
                     IF PARMLEN > 0 THEN                       <<01200>>38330000
                        BEGIN  << STDLIST REALLY SPECIFIED >>  <<01200>>38335000
                        STDLIST'OPTION := 1;                   <<01200>>38340000
                        TOS := CHECKFILENAME'(TEMPPARM&LSR(8), <<01200>>38345000
                                              MAXPARAM,        <<01200>>38350000
                                              MAXPARAM,        <<01200>>38355000
                                              ERR);            <<01200>>38360000
                        IF < THEN                              <<01200>>38365000
                           BEGIN  << BAD FILE NAME >>          <<01200>>38370000
                           @PPNTR := ERR;                      <<01200>>38375000
                           ERRNUM := TOS;                      <<01200>>38380000
                           END                                 <<01200>>38385000
                        ELSE IF > THEN                         <<01200>>38390000
                           BEGIN  << SPECIAL FILE >>           <<01200>>38395000
                           IF S0 = 0 OR S0 = 6 THEN            <<01200>>38400000
                              BEGIN  << BACKREF OR $NULL >>    <<01200>>38405000
                              DEL;   << RETURN VALUE >>        <<01200>>38410000
                              MOVE STDLIST := PPNTR,(PARMLEN); <<01200>>38415000
                              STDLIST(PARMLEN) := C'CR;        <<01200>>38420000
                              END                              <<01200>>38425000
                           ELSE                                <<01200>>38430000
                              BEGIN  << NOT BACKREF/$NULL >>   <<01200>>38435000
                              DEL;   << RETURN VALUE >>        <<01200>>38440000
                              ERRNUM := INVALIDSTDLIST;        <<01200>>38445000
                              END;                             <<01200>>38450000
                           END                                 <<01200>>38455000
                        ELSE                                   <<01200>>38460000
                           BEGIN  << SIMPLE FILE NAME >>       <<01200>>38465000
                           DEL;   << RETURN VALUE >>           <<01200>>38470000
                           MOVE STDLIST := PPNTR,(PARMLEN),2;  <<01200>>38475000
                           IF DELIMITER <> COMMA THEN          <<01200>>38480000
                              BEGIN  << MUST BE OLD FILE >>    <<01200>>38485000
                              MOVE * := ",OLD";                <<01200>>38490000
                              STDLIST(PARMLEN+4) := C'CR;      <<01200>>38495000
                              END                              <<01200>>38500000
                           ELSE                                <<01200>>38505000
                              BEGIN  << POSSIBLY NEW FILE >>   <<01200>>38510000
                              NAMELEN := PARMLEN;              <<01200>>38515000
                              DELIMITER := NEXT;               <<01200>>38520000
                              CHECKNEW                         <<01200>>38525000
                              ELSE                             <<01200>>38530000
                                 BEGIN  << A NEW FILE >>       <<01200>>38535000
                                 MOVE * := (",NEW;REC=-132",   <<01200>>38540000
                                            ",,F,ASCII;",      <<01200>>38545000
                                            "ACC=OUT;TEMP");   <<01200>>38550000
                                 STDLIST(NAMELEN+35) := C'CR;  <<01200>>38555000
                                 END;                          <<01200>>38560000
                              END;                             <<01200>>38565000
                           END << VALID FILE NAME >>;          <<01200>>38570000
                        END << $STDLIST SPECIFIED >>;          <<01200>>38575000
                     TOS := FLAGS'EXT1;                        <<01200>>38580000
                     ASSEMBLE (TSBC 14);                       <<01200>>38585000
                     FLAGS'EXT1 := TOS;                        <<01200>>38590000
                     END << STDLIST = FILE >>;                 <<01200>>38595000
                                                               <<01200>>38600000
                     << INFO = STRING >>                       <<01200>>38605000
                  CHECKPREPCOM                                 <<01200>>38610000
                  ELSE CHECKEQSIGN                             <<01200>>38615000
                  ELSE                                         <<01200>>38620000
                     BEGIN                                     <<01200>>38625000
                     DELIMITER := NEXT;                        <<01200>>38630000
                     IF PPNTR<>C'QUOTE AND PPNTR<>C'DQUOTE     <<01200>>38635000
                        THEN ERRNUM := EXPCTQUOTE              <<01200>>38640000
                     ELSE                                      <<01200>>38645000
                        BEGIN                                  <<01200>>38650000
                        STRING'OPTION := 1;                    <<01200>>38655000
                        QUOTECHAR := PPNTR;                    <<01200>>38660000
                        X := @PPNTR - @CIS'BCOMIMAGE + 1;      << I.A >>38665000
                        @SPTR := @SAVEDCOMIMAGE(X);            <<01426>>38670000
                        T'IX := S'IX := -1;                    <<01200>>38675000
                        DO                                     <<01200>>38680000
                           BEGIN                               <<01200>>38685000
                           WHILE SPTR(S'IX:=S'IX+1)<>QUOTECHAR <<01200>>38690000
                               AND INTEGER(SPTR(S'IX))<>C'CR DO<<01200>>38695000
                              BEGIN                            <<01200>>38700000
                              IF DELIM(SPTR(S'IX)) THEN        <<01200>>38705000
                                 DELIMITER := NEXT;            <<01200>>38710000
                              STRING(T'IX:=T'IX+1):=SPTR(S'IX);<<01200>>38715000
                              END;                             <<01200>>38720000
                           IF SPTR(S'IX) = C'CR THEN           <<01200>>38725000
                              BEGIN                            <<01200>>38730000
                              << FORCE PTR TO END OF STRING >> <<01200>>38735000
                              @PPNTR := @PPNTR(PARMLEN);       <<01200>>38740000
                              ERRNUM := EXPCTCLOSEQUOTE;       <<01200>>38745000
                              STOP := TRUE;                    <<01200>>38750000
                              END                              <<01200>>38755000
                           ELSE IF SPTR(S'IX:=S'IX+1)=QUOTECHAR<<01709>>38760000
                              THEN STRING(T'IX:=T'IX+1):=      <<01709>>38765000
                                      QUOTECHAR                <<01709>>38770000
                           ELSE                                <<01709>>38775000
                              BEGIN  << SHOULD BE END OF STR >><<01709>>38780000
                              STOP := TRUE;                    <<01709>>38785000
                              << MAKE SURE THERE'S NOTHING  >> <<01709>>38790000
                              << BETWEEN QUOTE & DELIMITER  >> <<01709>>38795000
                              TOS := "  ";                     <<01709>>38800000
                              TOS.(0:8) := DELIM'CHAR;         <<01709>>38805000
                              SCAN SPTR(S'IX) WHILE *;         <<01709>>38810000
                              IF NOCARRY THEN                  <<01709>>38815000
                                 BEGIN  <<SOMETHING UNEXPCTD>> <<01709>>38820000
                                 ERRNUM := XPCTSEMIORCR;       <<01709>>38825000
                                 @PPNTR := @PPNTR(S'IX+1);     <<01709>>38830000
                                 END;                          <<01709>>38835000
                              END;                             <<01709>>38840000
                           END                                 <<01200>>38845000
                              UNTIL STOP;                      <<01200>>38850000
                        T'IX := T'IX + 1;                      <<01200>>38855000
                        IF T'IX > 253 AND ERRNUM = 0 THEN      <<01709>>38860000
                           ERRNUM := STRINGTOOBIG;             <<01709>>38865000
                        END;                                   <<01200>>38870000
                     TOS := FLAGS'EXT1;                        <<01200>>38875000
                     ASSEMBLE (TSBC 13);                       <<01200>>38880000
                     FLAGS'EXT1 := TOS;                        <<01200>>38885000
                     END << INFO = STRING >>;                  <<01200>>38890000
                     <<NOSYM>>                                 <<04103>>38895000
                  CHECKRUNCOM                                  <<04103>>38900000
                  ELSE                                         <<04103>>38905000
                     BEGIN                                     <<04103>>38910000
                     TOS := FLAGS'EXT1;                        <<04103>>38915000
                     ASSEMBLE (TSBC 12);                       <<04103>>38920000
                     FLAGS'EXT1 := TOS;                        <<04103>>38925000
                     END;                                      <<04103>>38930000
                                                               <<04103>>38935000
   <<**********   FPMAP   ******************>>                 <<04103>>38940000
                  CHECKRUNCOM                                  <<04103>>38945000
                  ELSE                                         <<04103>>38950000
                     BEGIN                                     <<04103>>38955000
                     TOS := FLAGS'EXT1;                        <<04103>>38960000
                     ASSEMBLE (TSBC 11);                       <<04103>>38965000
                     FLAGS'EXT1 := TOS;                        <<04103>>38970000
                     END;                                      <<04103>>38975000
    <<*********   NOFPMAP  *****************>>                 <<04103>>38980000
                  CHECKRUNCOM                                  <<04103>>38985000
                  ELSE                                         <<04103>>38990000
                     BEGIN                                     <<04103>>38995000
                     TOS := FLAGS'EXT1;                        <<04103>>39000000
                     ASSEMBLE (TSBC 10);                       <<04103>>39005000
                     FLAGS'EXT1 := TOS;                        <<04103>>39010000
                     END;                                      <<04103>>39015000
     <<**********  CHECKSUM   **************>>                 <<04103>>39020000
                  CHECKRUNCOM                                  <<04103>>39025000
                  ELSE                                         <<04103>>39030000
                     BEGIN                                     <<04103>>39035000
                     TOS := FLAGS'EXT1;                        <<04103>>39040000
                     ASSEMBLE (TSBC 9 );                       <<04103>>39045000
                     FLAGS'EXT1 := TOS;                        <<04103>>39050000
                     END;    <<CHECKSUM>>                      <<04103>>39055000
                  END;  <<OF CASE ON KEYWORDS>>                <<U.RAO>>39060000
               IF <> AND (ERRNUM=0) THEN                       <<U.RAO>>39065000
                  BEGIN                                        <<U.RAO>>39070000
                  TOS:=-WARNDUPLKEY;                           <<U.RAO>>39075000
                  TOS:=PARMS(PARMNUM-2);                       <<U.RAO>>39080000
                  IF TOS.(14:2)<>EQUALSIGN THEN                <<U.RAO>>39085000
                     BEGIN                                     <<U.RAO>>39090000
                     DEL;                                      <<U.RAO>>39095000
                     TOS := @PPNTR;                            <<U.RAO>>39100000
                     END;                                      <<U.RAO>>39105000
                  CIERR(*,*);                                  <<U.RAO>>39110000
                  END;                                         <<U.RAO>>39115000
               IF ERRNUM <> 0 THEN                             <<U.RAO>>39120000
                  BEGIN                                        <<U.RAO>>39125000
                  CIERR(ERRNUM,PPNTR);                         <<U.RAO>>39130000
                  RETURN                                       <<U.RAO>>39135000
                  END;                                         <<U.RAO>>39140000
               END                                             <<U.RAO>>39145000
            END                                                <<U.RAO>>39150000
               UNTIL DELIMITER <> SEMICOLON;                   <<U.RAO>>39155000
                                                               <<U.RAO>>39160000
         <<NOW CLEANUP AFTER KEYWORD PROCESSING>>              <<U.RAO>>39165000
         FLAGS := TOS;                                         <<U.RAO>>39170000
         IF DELIMITER <> CR THEN                               <<U.RAO>>39175000
            BEGIN                                              <<U.RAO>>39180000
            IF DELIMITER = COMMA THEN                          <<U.RAO>>39185000
               ERRNUM := CMAXPCTSEMIORCR                       <<U.RAO>>39190000
            ELSE                                               <<U.RAO>>39195000
               ERRNUM := EQXPCTSEMIORCR;                       <<U.RAO>>39200000
            CIERR(ERRNUM,PPNTR(PARMLEN));                      <<01426>>39205000
            RETURN                                             <<U.RAO>>39210000
            END;                                               <<U.RAO>>39215000
         END;  <<KEYWORD PROCESSING>>                          <<U.RAO>>39220000
      END;  <<CASE ON DELIMITERS>>                             <<U.RAO>>39225000
                                                               <<U.RAO>>39230000
                                                               <<U.RAO>>39235000
<<THE COMMAND HAS NOW BEEN ENTIRELY PARSED.  IT SIMPLY >>      <<U.RAO>>39240000
<<REMAINS TO EXECUTE IT IF POSSIBLE>>                          <<U.RAO>>39245000
                                                               <<00830>>39250000
IF PREPRUNCOM THEN  <<ESTABLISH PASSED FILE AS PROG FILE>>     <<U.RAO>>39255000
   MOVE TFILENAME := "$NEWPASS "                               <<U.RAO>>39260000
ELSE IF PREPCOM THEN                                           <<U.RAO>>39265000
   @TFILENAME := @ENTRYNAME;                                   <<U.RAO>>39270000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>39275000
IF NOT RUNCOM THEN  <<DO PREP STAGE>>                          <<U.RAO>>39280000
   BEGIN                                                       <<U.RAO>>39285000
   IF FLAGS'EXT1.(10:2) = 3 THEN <<FPMAP/NOFPMAP BOTH >>       <<04103>>39290000
   BEGIN                         <<HAVE BEEN SPECIFIED >>      <<04103>>39295000
      ERRNUM := BOTHFPMAPNOFPMAP;                              <<04103>>39300000
      CIERR(ERRNUM,PPNTR(PARMLEN));                            <<04103>>39305000
      RETURN;                                                  <<04103>>39310000
   END;                                                        <<04103>>39315000
   PFLAGS := FLAGS.(6:1); <<PMAP>>                             <<U.RAO>>39320000
   PFLAGS.(14:1) := FLAGS.(11:1);  <<ZERODB>>                  <<U.RAO>>39325000
   PFLAGS.(9:1) := FLAGS'EXT1.(12:1); <<NOSYM>>                <<04103>>39330000
   PFLAGS.(8:1) := FLAGS'EXT1.(11:1);  << FPMAP >>             <<04103>>39335000
   PFLAGS.(7:1) := FLAGS'EXT1.(10:1);  << NOFPMAP >>           <<04103>>39340000
   PFLAGS.(6:1) := FLAGS'EXT1.(9:1);   <<CHECKSUM >>           <<04103>>39345000
   ERR := 0;  <<REINITIALIZE>>                                 <<U.RAO>>39350000
   SEGMENTER(PIN,22,ERR,,,,,,,,,PROGNAME); <<CREATE SEGMENTER>><<00629>>39355000
   CHECKSEGERR;                                                <<U.RAO>>39360000
   SEGMENTER(PIN,14,ERR,STACKSIZE,DLSIZE,PFLAGS,MAXDATA,       <<00629>>39365000
      CAPWORD,PATCHSIZE,,,TFILENAME,RL);                       <<00629>>39370000
   CHECKSEGERR;                                                <<U.RAO>>39375000
   SEGMENTER(PIN,8,ERR);  <<EXIT>>                             <<U.RAO>>39380000
   IF PREPCOM THEN   <<JUST A PREPARE, EXIT>>                  <<U.RAO>>39385000
      BEGIN                                                    <<U.RAO>>39390000
      CISUBSYSFINISH(2, ERRNUM, PARMNUM);                      <<U.RAO>>39395000
      RETURN                                                   <<U.RAO>>39400000
      END;                                                     <<U.RAO>>39405000
                                                               <<U.RAO>>39410000
   <<NOW CLEAN UP AFTER SEGMENTER>>                            <<U.RAO>>39415000
   IF NOT CISUBSYSFINISH(2, ERRNUM, PARMNUM) THEN              <<U.RAO>>39420000
      RETURN;                                                  <<U.RAO>>39425000
   MOVE TFILENAME := "$OLD";                                   <<U.RAO>>39430000
   @PROGNAME := @TFILENAME;                                    <<U.RAO>>39435000
   END;  <<OF PREPARE PHASE>>                                  <<U.RAO>>39440000
                                                               <<U.RAO>>39445000
<<NOW DO RUN PHASE>>                                           <<U.RAO>>39450000
FLAGS := FLAGS LAND %117;  <<ELIMINATE PREP FLAGS>>            <<U.RAO>>39455000
IF LIB="P" THEN FLAGS.(11:1):=1                                <<U.RAO>>39460000
ELSE IF LIB="G" THEN FLAGS.(10:1):=1;                          <<U.RAO>>39465000
TOS := TOS+0;  <<CLEAR CARRY>>                                 <<U.RAO>>39470000
<< SET UP TO CREATE THE NEW PROCESS TO RUN THE PROGRAM >>      <<01200>>39475000
OPTNNUMS(0) := 1;   OPTNS(0) := @ENTRYNAME;                    <<01200>>39480000
OPTNNUMS(1) := 2;   OPTNS(1) := PARM;                          <<01200>>39485000
OPTNNUMS(2) := 3;   OPTNS(2) := FLAGS;                         <<01200>>39490000
X := 3;                                                        <<01200>>39495000
IF STACK'OPTION THEN                                           <<01200>>39500000
   BEGIN  << STACKSIZE WAS SPECIFIED >>                        <<01200>>39505000
   OPTNNUMS(X) := 4;   OPTNS(X) := STACKSIZE;                  <<01200>>39510000
   X := X + 1;                                                 <<01200>>39515000
   END;                                                        <<01200>>39520000
IF DL'OPTION THEN                                              <<01200>>39525000
   BEGIN  << DLSIZE WAS SPECIFIED >>                           <<01200>>39530000
   OPTNNUMS(X) := 5;   OPTNS(X) := DLSIZE;                     <<01200>>39535000
   X := X + 1;                                                 <<01200>>39540000
   END;                                                        <<01200>>39545000
IF MAXDATA'OPTION THEN                                         <<01200>>39550000
   BEGIN  << MAXDATA WAS SPECIFIED >>                          <<01200>>39555000
   OPTNNUMS(X) := 6;   OPTNS(X) := MAXDATA;                    <<01200>>39560000
   X := X + 1;                                                 <<01200>>39565000
   END;                                                        <<01200>>39570000
IF STDIN'OPTION THEN                                           <<01200>>39575000
   BEGIN  << STDIN WAS SPECIFIED >>                            <<01200>>39580000
   OPTNNUMS(X) := 8;   OPTNS(X) := @STDIN;                     <<01200>>39585000
   X := X + 1;                                                 <<01200>>39590000
   END;                                                        <<01200>>39595000
IF STDLIST'OPTION THEN                                         <<01200>>39600000
   BEGIN  << STDLIST WAS SPECIFIED >>                          <<01200>>39605000
   OPTNNUMS(X) := 9;   OPTNS(X) := @STDLIST;                   <<01200>>39610000
   X := X + 1;                                                 <<01200>>39615000
   END;                                                        <<01200>>39620000
IF STRING'OPTION THEN                                          <<01200>>39625000
   BEGIN  << A STRING TO PASS WAS SPECIFIED >>                 <<01200>>39630000
   OPTNNUMS(X) := 11;   OPTNS(X) := @STRING;                   <<01200>>39635000
   X := X + 1;                                                 <<01200>>39640000
   OPTNNUMS(X) := 12;   OPTNS(X) := T'IX;                      <<01200>>39645000
   X := X + 1;                                                 <<01200>>39650000
   END;                                                        <<01200>>39655000
OPTNNUMS(X) := 0;     << END OF OPTION LIST >>                 <<01200>>39660000
                                                               <<01200>>39665000
CREATEPROCESS (ERROR, PIN, PROGNAME, OPTNNUMS, OPTNS);         <<01200>>39670000
                                                               <<01452>>39675000
IF < THEN                                                      <<01452>>39680000
   BEGIN  << PROCESS CREATION FAILED - DETERMINE WHY >>        <<01452>>39685000
   IF ERROR = UNKNOWN'PROG THEN                                <<01452>>39690000
      BEGIN  << NON-EXISTENT PROGRAM FILE >>                   <<01452>>39695000
      QUALIFYFILENAME (PROGNAME, FULLFILENAME);                <<01452>>39700000
      ERRNUM := NOSUCHPROGFILE;                                <<01452>>39705000
      PARMNUM := 1;                                            <<01452>>39710000
      TOS := ERRNUM;                                           <<01452>>39715000
      TOS := IPARMS;                                           <<01452>>39720000
      CIERR (*, *, 0, @FULLFILENAME);                          <<01452>>39725000
      END                                                      <<01452>>39730000
   ELSE                                                        <<01452>>39735000
      IF NOT CREATEPROC'ERR( ERROR, ERRNUM )  THEN             <<01452>>39740000
         CIERR( ERRNUM := PRPRNNOLOAD );                       <<01452>>39745000
   END                                                         <<01452>>39750000
ELSE                                                           <<01452>>39755000
   BEGIN  << PROCESS CREATION SUCCEEDED >>                     <<01452>>39760000
                                                               <<01452>>39765000
   << CHECK FOR CREATEPROCESS WARNING. >>                      <<01452>>39770000
   IF > THEN CREATEPROC'ERR( -ERROR, ERRNUM );                 <<01452>>39775000
                                                               <<01452>>39780000
   NEXTLINE;                                                   <<01452>>39785000
   AWAKE (PIN * PCBSIZE, FATHERWAIT, SONWAIT);                 <<01452>>39790000
                                                               <<01452>>39795000
   CISUBSYSFINISH (1, ERRNUM, PARMNUM);                        <<01452>>39800000
   END;                                                        <<01452>>39805000
END;                                                           <<U.RAO>>39810000
$CONTROL SEGMENT = CISUBS                                      <<U.RAO>>39815000
      PROCEDURE CXSEGMENTER EXECUTORHEAD;                               39820000
      OPTION PRIVILEGED, UNCALLABLE;                                    39825000
      BEGIN                                                             39830000
      COMMENT                                                           39835000
      CXSEGMENTER IS THE EXECUTOR FOR THE SEGMENTER &EDITOR COMMANDS    39840000
      ;                                                                 39845000
      ENTRY CXEDITOR;                                                   39850000
      ENTRY CXVINIT;                                           <<RH.PV>>39855000
      BYTE ARRAY PROG(0:14),LISTFILE(0:7);                     <<U.RAO>>39860000
      LOGICAL PIN;                                             <<U.RAO>>39865000
      INTEGER NUMPARMS,FLAG:=0;                                <<U.RAO>>39870000
      DOUBLE DDL:=[8/";",8/",",8/%15,8/0]D;                    <<U.RAO>>39875000
      BYTE ARRAY DL(*)=DDL;                                    <<U.RAO>>39880000
      DOUBLE PARMS;                                            <<U.RAO>>39885000
      BYTE POINTER PPNTR=PARMS;                                <<U.RAO>>39890000
      BYTE SL=PARMS+1;                                         <<U.RAO>>39895000
      INTEGER PARMWORD2=PARMS+1;                               <<U.RAO>>39900000
      LOGICAL SEGFLAG := FALSE;                                <<U.RAO>>39905000
                                                               <<U.RAO>>39910000
      MOVE LISTFILE:="SEGLIST ";                               <<U.RAO>>39915000
      MOVE PROG:="SEGDVR.PUB.SYS ";                            <<U.RAO>>39920000
      SEGFLAG := TRUE;                                         <<U.RAO>>39925000
      GO TO PROCESS;                                           <<U.RAO>>39930000
CXVINIT:   <<PVINIT EXECUTOR>>                                 <<RH.PV>>39935000
      MOVE LISTFILE := "VINLIST ";                             <<RH.PV>>39940000
      MOVE PROG := "PVINIT.PUB.SYS ";                          <<RH.PV>>39945000
      GO TO PROCESS;                                           <<RH.PV>>39950000
CXEDITOR:                                                      <<U.RAO>>39955000
      MOVE LISTFILE:="EDTLIST ";                               <<U.RAO>>39960000
      MOVE PROG:="EDITOR.PUB.SYS ";                            <<U.RAO>>39965000
PROCESS:                                                       <<U.RAO>>39970000
      MYCOMMAND(PARMSP,DL,1,NUMPARMS,PARMS);<<CHECK COMMAND>>  <<U.RAO>>39975000
      IF <> THEN  <<BEGIN -- TOO MANY PARAMETERS>>             <<U.RAO>>39980000
         BEGIN                                                 <<U.RAO>>39985000
         ERRNUM := ERR2MPLISTONLY;  <<ONLY LIST FILE ALLOWED>> <<U.RAO>>39990000
         PARMNUM := 2;                                         <<U.RAO>>39995000
         TOS := ERRNUM;                                        <<U.RAO>>40000000
         TOS := @PPNTR(SL);  <<POINT TO DELIMITER>>            <<U.RAO>>40005000
         TOS := DL(PARMWORD2.(14:2));  <<GET DELIMITER>>       <<U.RAO>>40010000
         SCAN * UNTIL *,1;                                     <<U.RAO>>40015000
         TOS := TOS+1;                                         <<U.RAO>>40020000
         CIERR(*,*);                                           <<U.RAO>>40025000
         RETURN;                                               <<U.RAO>>40030000
         END;                                                  <<U.RAO>>40035000
      IF NUMPARMS <> 0 THEN                                    <<U.RAO>>40040000
         BEGIN<<PARAMETERS INPUTTED>>                          <<U.RAO>>40045000
         FLAG:=2;<<SET LISTFILE INDICATOR>>                    <<U.RAO>>40050000
         ERRNUM := CYIMPLCTFILE'(LISTFILE,PPNTR,SL);   <<ENTER <<U.RAO>>40055000
         IF <> THEN BEGIN PARMNUM:=1;RETURN END; <<FATAL ERROR<<U.RAO>> 40060000
         END;                                                  <<U.RAO>>40065000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>40070000
      TOS := TOS + 0;<<CLEAR CARRY>>                           <<U.RAO>>40075000
      CREATE(PROG,,PIN,FLAG,1); <<CREATE PROCESS>>             <<U.RAO>>40080000
      IF CARRY THEN                                            <<U.RAO>>40085000
         BEGIN                                                 <<U.RAO>>40090000
         DELIMPFILE(FLAG,LISTFILE); <<DELETE THE FILE>>        <<U.RAO>>40095000
         PROG(6) := 0;                                         <<U.RAO>>40100000
         IF CREATEERROR THEN                                   <<U.RAO>>40105000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@PROG)          <<U.RAO>>40110000
         ELSE                                                  <<U.RAO>>40115000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@PROG);           <<U.RAO>>40120000
         RETURN;                                               <<U.RAO>>40125000
         END;                                                  <<U.RAO>>40130000
      IF < THEN                                                <<U.RAO>>40135000
         BEGIN                                                 <<U.RAO>>40140000
         DELIMPFILE(FLAG,LISTFILE);  <<DELETE FILE>>           <<U.RAO>>40145000
         PROG(6) := 0;                                         <<U.RAO>>40150000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@PROG);               <<U.RAO>>40155000
         RETURN                                                <<U.RAO>>40160000
         END;                                                  <<U.RAO>>40165000
      AWAKE(PIN*PCBSIZE,1,2); <<START PROCESS >>               <<U.RAO>>40170000
      DELIMPFILE(FLAG,LISTFILE); <<DELETE THE FILE>>           <<U.RAO>>40175000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>40180000
      END ; <<CXSEGMENTER>>                                             40185000
                                                               <<01453>>40190000
PROCEDURE CXFCOPY EXECUTORHEAD;                                <<01453>>40195000
   OPTION PRIVILEGED, UNCALLABLE;                              <<01453>>40200000
                                                               <<01453>>40205000
<< This procedure creates the FCOPY "subsystem" and passes >>  <<01453>>40210000
<< any "INFO" specified with the FCOPY command with the    >>  <<01453>>40215000
<< INFO parameter in the CREATEPROCESS call.               >>  <<01453>>40220000
                                                               <<01453>>40225000
BEGIN                                                          <<01453>>40230000
                                                               <<01453>>40235000
   ARRAY NAME'(0:6);        << Holds name of process.      >>  <<01453>>40240000
   BYTE ARRAY NAME(*) = NAME';                                 <<01453>>40245000
   BYTE POINTER TEMPBP;                                        <<01453>>40250000
   INTEGER PIN,                                                <<01453>>40255000
           LEN,                                                <<01453>>40260000
           ERROR;                                              <<01453>>40265000
   ARRAY ITEMCODES(0:10);                                      <<01453>>40270000
   ARRAY ITEMS(0:10);                                          <<01453>>40275000
   DEFINE UNKNOWN'PROG'FILE = ( ERROR = 6 )#;                  <<01453>>40280000
                                                               <<01453>>40285000
   SCAN PARMSP WHILE %6440, 1;                                 <<01453>>40290000
   IF CARRY THEN   << Found nothing but blanks for parms.  >>  <<01453>>40295000
   BEGIN                                                       <<01453>>40300000
      LEN := 0;                                                <<01453>>40305000
      @TEMPBP := @PARMSP;                                      <<01453>>40310000
      DEL;                                                     <<01453>>40315000
   END                                                         <<01453>>40320000
   ELSE                                                        <<01453>>40325000
   BEGIN                                                       <<01453>>40330000
      @TEMPBP := TOS;                                          <<01453>>40335000
      SCAN TEMPBP UNTIL %15, 1;                                <<01453>>40340000
      LEN := TOS - @TEMPBP;                                    <<01453>>40345000
   END;                                                        <<01453>>40350000
   MOVE NAME := "FCOPY.PUB.SYS ";                              <<01453>>40355000
                                                               <<01453>>40360000
   MOVE ITEMCODES := (  3,   << FLAGS                      >>  <<01453>>40365000
                       11,   << INFO STRING ADDRESS.       >>  <<01453>>40370000
                       12,   << INFO STRING LENGTH.        >>  <<01453>>40375000
                        0  );                                  <<01453>>40380000
                                                               <<01453>>40385000
   ITEMS    := 1;                                              <<01453>>40390000
   ITEMS(1) := @TEMPBP;                                        <<01453>>40395000
   ITEMS(2) := LEN;                                            <<01453>>40400000
   ITEMS(3) := 0;                                              <<01453>>40405000
                                                               <<01453>>40410000
   SETJCW( GETJCW LAND %37777 );                               <<01453>>40415000
   CREATEPROCESS( ERROR, PIN, NAME, ITEMCODES, ITEMS );        <<01453>>40420000
   IF < THEN                                                   <<01453>>40425000
   BEGIN                                                       <<01453>>40430000
      NAME(5) := 0;                                            <<01453>>40435000
      IF UNKNOWN'PROG'FILE THEN                                <<01453>>40440000
         CIERR( ERRNUM := SUBSNOTFOUND, , 0, @NAME )           <<01453>>40445000
      ELSE                                                     <<01453>>40450000
      BEGIN                                                    <<01453>>40455000
         CREATEPROC'ERR( ERROR,ERRNUM );                       <<01453>>40460000
         CIERR( ERRNUM := SUBSNOTCREATE, , 0, @NAME );         <<01453>>40465000
      END;                                                     <<01453>>40470000
   END                                                         <<01453>>40475000
   ELSE                                                        <<01453>>40480000
   BEGIN                                                       <<01453>>40485000
      IF > THEN CREATEPROC'ERR( -ERROR, ERRNUM );              <<01453>>40490000
      AWAKE( PIN * PCBSIZE, 1, 2 );                            <<01453>>40495000
      CISUBSYSFINISH( 3, ERRNUM, PARMNUM );                    <<01453>>40500000
   END;                                                        <<01453>>40505000
                                                               <<01453>>40510000
                                                               <<01453>>40515000
END;  << CXFCOPY >>                                            <<01453>>40520000
                                                               <<01453>>40525000
                                                               <<01453>>40530000
PROCEDURE CXSPL EXECUTORHEAD;                                           40535000
   OPTION PRIVILEGED, UNCALLABLE;                                       40540000
BEGIN ENTRY CXSPLPREP, CXSPLGO;                                         40545000
      ENTRY CXFORTRAN, CXFORTPREP, CXFORTGO;                            40550000
      ENTRY CXCOBOL, CXCOBOLPREP, CXCOBOLGO;                            40555000
      ENTRY CXBASICOMP,CXBASICPREP,CXBASICGO;                           40560000
      ENTRY CXRPG,CXRPGPREP,CXRPGGO;                                    40565000
      ENTRY CXPASCAL,CXPASCALPREP,CXPASCALGO;                  <<02844>>40570000
      ENTRY CXCOBOLII, CXCOBOLIIPREP, CXCOBOLIIGO;             <<06130>>40575000
      INTEGER WHICHFLG,X,NEXTDELIM,ERROR,                      <<02844>>40580000
              PARMLEN,STRINGLEN := 0;                          <<02844>>40585000
      EQUATE MAXSTRINGLEN = CIS'BCOMBUFLEN - 12,               << I.A >>40590000
             PKEYLISTL = 13,                                   <<06130>>40595000
             EQUALS = 1,                                       <<02844>>40600000
             CR = 3;                                           <<02844>>40605000
      DEFINE DELIMTYPE = (13:3)#,                              <<02844>>40610000
             UNKNOWN'PROG'FILE = (ERROR = 6)#;                 <<02844>>40615000
      LOGICAL PROGFLAG := FALSE;                                        40620000
      BYTE ARRAY SPLNAME(0:2) = PB := "SPL";                            40625000
      BYTE ARRAY FTNNAME(0:2) = PB := "FTN";                            40630000
      BYTE ARRAY COBNAME(0:2) = PB := "COB";                            40635000
      BYTE ARRAY BSCNAME(0:2) = PB := "BSC";                            40640000
      BYTE ARRAY RPGNAME(0:2) = PB := "RPG";                            40645000
      BYTE ARRAY PASCNAME(0:2) = PB := "PAS";                  <<02844>>40650000
      BYTE ARRAY TEXT(0:4) = PB := "TEXT ";                             40655000
      BYTE ARRAY LIST(0:4) = PB := "LIST ";                             40660000
      BYTE ARRAY USL(0:3) = PB := "USL ";                               40665000
      BYTE ARRAY PROG(0:35);                                  <<A01.01>>40670000
      BYTE ARRAY MAST(0:4) = PB := "MAST ";                             40675000
      BYTE ARRAY NEW(0:3)  = PB := "NEW ";                              40680000
      BYTE ARRAY SYSFILENAME(0:16);                                     40685000
      BYTE ARRAY BUILDNAME(0:8);                               <<02844>>40690000
      INTEGER NUMPARMS,MAXPARMS := 6;                          <<02844>>40695000
      INTEGER ARRAY OPTNUMS(0:12);                             <<02844>>40700000
      LOGICAL ARRAY OPTNS(0:12);                               <<02844>>40705000
      DOUBLE ARRAY PARMS(0:MAXSTRINGLEN);                      <<02844>>40710000
      LBPARMDECS;                                                       40715000
      LOGICAL COMCR := %26015;                                          40720000
      BYTE POINTER FNAME,SPTR,PARMPTR;                         <<02844>>40725000
      LOGICAL T2,T3;                                           <<U.RAO>>40730000
      LOGICAL PARM := 0;                                                40735000
      LOGICAL PIN,STOP,SCAN'STOP'TEST := %6400,INFO := FALSE;  <<02844>>40740000
      LOGICAL WKSPFOUND := FALSE; << Flag for WKSP found >>    <<06130>>40745000
      INTEGER PCNT := 0;                                                40750000
      SWITCH USLPROGLIST := US,PR,LT;                                   40755000
      BYTE ARRAY STRING(0:MAXSTRINGLEN - 1);                   << I.A >>40760000
      BYTE ARRAY SAVEDCOMIMAGE(0:CIS'BCOMBUFLEN - 1);          << I.A >>40765000
      BYTE ARRAY PKEYLIST(0:PKEYLISTL - 1) = PB :=             <<02844>>40770000
         6,4,"INFO",                                           <<02844>>40775000
         6,4,"WKSP",                                           <<06130>>40780000
         0;                                                    <<02844>>40785000
      BYTE ARRAY KEYLIST(0:PKEYLISTL - 1);                     <<02844>>40790000
DEFINE CHECKSEGERR =                                           <<U.RAO>>40795000
   IF <> AND (T2<>1) THEN   <<WARNING WAS PRINTED>>            <<U.RAO>>40800000
      BEGIN                                                    <<U.RAO>>40805000
      SEGMENTER(PIN,8,T3);  <<EXIT SEGMENTER>>                 <<U.RAO>>40810000
      PARMNUM := T2;                                           <<U.RAO>>40815000
      DELIMPFILE(PARM,BUILDNAME);                              <<U.RAO>>40820000
      CIERR(ERRNUM := SEGMENTERERROR);                         <<U.RAO>>40825000
      RETURN;                                                  <<U.RAO>>40830000
      END#;                                                    <<U.RAO>>40835000
                                                               <<U.RAO>>40840000
<< ======================================================== >> <<06130>>40845000
<< =====                                              ===== >> <<06130>>40850000
<< =====        Subroutine BLDIMPFILE                 ===== >> <<06130>>40855000
<< =====                                              ===== >> <<06130>>40860000
<< ======================================================== >> <<06130>>40865000
                                                               <<06130>>40870000
SUBROUTINE BLDIMPFILE;                                         <<U.RAO>>40875000
BEGIN                                                          <<U.RAO>>40880000
ERRNUM := CYIMPLCTFILE'(BUILDNAME,FNAME,T3);                   <<U.RAO>>40885000
IF <> THEN  <<ERROR OCCURRED>>                                 <<U.RAO>>40890000
   BEGIN                                                       <<U.RAO>>40895000
   DELIMPFILE(PARM,BUILDNAME);                                 <<U.RAO>>40900000
   PARMNUM := PCNT+1;                                          <<U.RAO>>40905000
   ASSEMBLE(EXIT 3);                                           <<U.RAO>>40910000
   END;                                                        <<U.RAO>>40915000
END;                                                           <<U.RAO>>40920000
                                                               <<06130>>40925000
<< ======================================================== >> <<06130>>40930000
<< =====                                              ===== >> <<06130>>40935000
<< =====           Subroutine GETNEXT                 ===== >> <<06130>>40940000
<< =====                                              ===== >> <<06130>>40945000
<< ======================================================== >> <<06130>>40950000
                                                               <<06130>>40955000
SUBROUTINE GETNEXT;                                            <<02844>>40960000
<< Sets PARMPTR to current parameter, gets parameter length >> <<02844>>40965000
<< establishes the delimiter type, and advances parameter   >> <<02844>>40970000
<< count.                                                   >> <<02844>>40975000
   BEGIN                                                       <<02844>>40980000
   TOS := PARMS(PARMNUM);                                      <<02844>>40985000
   NEXTDELIM := S0.DELIMTYPE;                                  <<02844>>40990000
   PARMLEN := TOS&LSR(8);                                      <<02844>>40995000
   @PARMPTR := LOGICAL(TOS);                                   <<02844>>41000000
   PARMNUM := PARMNUM + 1;                                     <<02844>>41005000
   END; << GETNEXT >>                                          <<02844>>41010000
                                                               <<06130>>41015000
<< ======================================================== >> <<06130>>41020000
<< =====                                              ===== >> <<06130>>41025000
<< =====        Subroutine PROCINFO                   ===== >> <<06130>>41030000
<< =====                                              ===== >> <<06130>>41035000
<< ======================================================== >> <<06130>>41040000
                                                               <<06130>>41045000
LOGICAL SUBROUTINE PROCINFO;                                   <<02844>>41050000
<< processing for the INFO parameter >>                                 41055000
   BEGIN                                                       <<02844>>41060000
   PROCINFO := FALSE;                                          <<02844>>41065000
   IF NEXTDELIM <> EQUALS THEN                                 <<02844>>41070000
      BEGIN                                                    <<02844>>41075000
      CIERR(ERRNUM := REQEQUALSIGN,PARMPTR);                   <<02844>>41080000
      RETURN;                                                  <<02844>>41085000
      END;                                                     <<02844>>41090000
   IF INFO THEN << specified more than once >>                 <<02844>>41095000
      CIERR(ERRNUM := -INFOOVERIDE,PARMPTR);                   <<02844>>41100000
   INFO := TRUE;                                               <<02844>>41105000
   STRINGLEN := 0;                                             <<02844>>41110000
   GETNEXT;                                                    <<02844>>41115000
   IF PARMPTR <> """" AND PARMPTR <> "'" THEN                  <<02844>>41120000
      BEGIN                                                    <<02844>>41125000
      CIERR(ERRNUM := EXPCTQUOTE,PARMPTR);                     <<02844>>41130000
      RETURN;                                                  <<02844>>41135000
      END;                                                     <<02844>>41140000
   SCAN'STOP'TEST.(8:8) := PARMPTR; << set up word for scan >> <<02844>>41145000
   << set up SPTR to point into the string copy, >>            <<02844>>41150000
   << because MYCOMMAND upshifts.                >>            <<02844>>41155000
   X := LOGICAL(@PARMPTR) - LOGICAL(@CIS'BCOMIMAGE) + 1;       << I.A >>41160000
   @SPTR := LOGICAL(@SAVEDCOMIMAGE(X));                        <<02844>>41165000
   STOP := FALSE;                                              <<02844>>41170000
   WHILE NOT STOP DO                                           <<02844>>41175000
      BEGIN                                                    <<02844>>41180000
      SCAN SPTR UNTIL SCAN'STOP'TEST,1;                        <<02844>>41185000
      IF CARRY THEN << missing closing quote, found CR >>      <<02844>>41190000
         BEGIN                                                 <<02844>>41195000
         X := TOS - LOGICAL(@SAVEDCOMIMAGE);                   <<02844>>41200000
         @PARMPTR := LOGICAL(@CIS'BCOMIMAGE(X));               << I.A >>41205000
         CIERR(ERRNUM := EXPCTCLOSEQUOTE,PARMPTR);             <<02844>>41210000
         STOP := TRUE;                                         <<02844>>41215000
         END                                                   <<02844>>41220000
      ELSE                                                     <<02844>>41225000
         BEGIN                                                 <<02844>>41230000
         X := LS0 - LOGICAL(@SPTR);                            <<02844>>41235000
         @SPTR := LOGICAL(TOS);                                <<02844>>41240000
         IF SPTR = SPTR(1) THEN << found double qoute >>       <<02844>>41245000
            BEGIN                                              <<02844>>41250000
            X := X + 1;                                        <<02844>>41255000
            @SPTR := LOGICAL(@SPTR) + 1;                       <<02844>>41260000
            END                                                <<02844>>41265000
         ELSE << found closing quote >>                        <<02844>>41270000
            STOP := TRUE;                                      <<02844>>41275000
         << move into STRING, note that if we had >>           <<02844>>41280000
         << a double qoute, one is moved in.      >>           <<02844>>41285000
         MOVE STRING(STRINGLEN) := SPTR(-X),(X);               <<02844>>41290000
         STRINGLEN := STRINGLEN + X;                           <<02844>>41295000
         << set SPTR to next character after    >>             <<02844>>41300000
         << quote or double quote.              >>             <<02844>>41305000
         @SPTR := LOGICAL(@SPTR) + 1;                          <<02844>>41310000
         END;                                                  <<02844>>41315000
      END; << WHILE LOOP >>                                    <<02844>>41320000
   << since string can contain delimiters and    >>            <<02844>>41325000
   << MYCOMMAND will parse them, advance PARMPTR >>            <<02844>>41330000
   << to the right place.                        >>            <<02844>>41335000
   X := STRINGLEN;                                             <<02844>>41340000
   WHILE (X := X - 1) >= 0 DO                                  <<02844>>41345000
      IF STRING(X) = ";" OR STRING(X) = "," OR                 <<02844>>41350000
         STRING(X) = "=" THEN                                  <<02844>>41355000
         GETNEXT;                                              <<02844>>41360000
   << check for extra chars. between closing qoute >>          <<02844>>41365000
   << and next delimiter which can be semi or cr.  >>          <<02844>>41370000
   IF ERRNUM <= 0 THEN                                         <<02844>>41375000
      BEGIN                                                    <<02844>>41380000
      SCAN SPTR WHILE %6440,1;                                 <<02844>>41385000
      IF CARRY THEN << FOUND CR >>                             <<02844>>41390000
         DEL                                                   <<02844>>41395000
      ELSE                                                     <<02844>>41400000
         BEGIN                                                 <<02844>>41405000
         IF BPS0 <> ";" THEN                                   <<02844>>41410000
            BEGIN                                              <<02844>>41415000
            X := TOS - LOGICAL(@SAVEDCOMIMAGE);                <<02844>>41420000
            @PARMPTR := LOGICAL(@CIS'BCOMIMAGE(X));            << I.A >>41425000
            CIERR(ERRNUM := XPCTSEMIORCR,PARMPTR);             <<02844>>41430000
            END                                                <<02844>>41435000
         ELSE                                                  <<02844>>41440000
            DEL;                                               <<02844>>41445000
         END;                                                  <<02844>>41450000
      END;                                                     <<02844>>41455000
   IF ERRNUM <= 0 THEN                                         <<02844>>41460000
      PROCINFO := TRUE;                                        <<02844>>41465000
   END; << PROCINFO >>                                         <<02844>>41470000
                                                               <<06130>>41475000
<< ======================================================== >> <<06130>>41480000
<< =====                                              ===== >> <<06130>>41485000
<< =====        Subroutine WKSP                       ===== >> <<06130>>41490000
<< =====                                              ===== >> <<06130>>41495000
<< ======================================================== >> <<06130>>41500000
                                                               <<06130>>41505000
                                                               <<06130>>41510000
LOGICAL SUBROUTINE WKSP;                                       <<06130>>41515000
                                                               <<06130>>41520000
<<  This routine parses the WKSP parameter. The syntax is:  >> <<06130>>41525000
<<           WKSP = wkspfilename                            >> <<06130>>41530000
<<                                                          >> <<06130>>41535000
<<  We build a file equation for xxxxWKSP and set bit 10 of >> <<06130>>41540000
<<  the PARM word. TRUE is returned only if successful.     >> <<06130>>41545000
<<                                                          >> <<06130>>41550000
<<  PARMPTR should be pointing to the WKSP keyword.         >> <<06130>>41555000
<<  PARMNUM references the wkspfilename paramter.           >> <<06130>>41560000
                                                               <<06130>>41565000
BEGIN                                                          <<06130>>41570000
   WKSP := FALSE; << return true only if everything is good >> <<06130>>41575000
   IF NEXTDELIM <> EQUALS                                      <<06130>>41580000
   THEN BEGIN                                                  <<06130>>41585000
      CIERR(ERRNUM := REQEQUALSIGN,  PARMPTR);                 <<06130>>41590000
      RETURN;                                                  <<06130>>41595000
   END;                                                        <<06130>>41600000
                                                               <<06130>>41605000
   IF WKSPFOUND                                                <<06130>>41610000
   THEN BEGIN  << We've been here before >>                    <<06130>>41615000
      CIERR(ERRNUM := WKSPALREADYFND, PARMPTR);                <<06130>>41620000
      RETURN;                                                  <<06130>>41625000
   END;                                                        <<06130>>41630000
                                                               <<06130>>41635000
   WKSPFOUND := TRUE;  << Yes, we are here >>                  <<06130>>41640000
                                                               <<06130>>41645000
   IF NOT CIBADFILENAME(ERRNUM, PARMS(PARMNUM))                <<06130>>41650000
   THEN BEGIN  << All's well >>                                <<06130>>41655000
      @FNAME := LPARM(PARMNUM*2); << Pointer to file name >>   <<06130>>41660000
      MOVE BUILDNAME(3) := "WKSP ";<< xxxxWKSP >>              <<06130>>41665000
      T3 := BPARM(PARMNUM*4+2); << Length of filename >>       <<06130>>41670000
      << ........................................... >>        <<06130>>41675000
      << The above three variables are parameters to >>        <<06130>>41680000
      << CYIMPLCTFILE' which BLDIMPFILE calls.       >>        <<06130>>41685000
      << ........................................... >>        <<06130>>41690000
                                                               <<06130>>41695000
      BLDIMPFILE;                                              <<06130>>41700000
                                                               <<06130>>41705000
      GETNEXT; << All done with WKSP >>                        <<06130>>41710000
      PARM := PARM LOR %40;<< Set bit 10 for the compilers >>  <<06130>>41715000
      WKSP := TRUE; << Successful return >>                    <<06130>>41720000
   END;                                                        <<06130>>41725000
                                                               <<06130>>41730000
END;  <<  WKSP  >>                                             <<06130>>41735000
                                                               <<06130>>41740000
                                                               <<06130>>41745000
<< ======================================================== >> <<06130>>41750000
<< =====                                              ===== >> <<06130>>41755000
<< =====        CXSPL main program                    ===== >> <<06130>>41760000
<< =====                                              ===== >> <<06130>>41765000
<< ======================================================== >> <<06130>>41770000
                                                               <<06130>>41775000
      TOS := 0;                                                         41780000
      GO TO PRESPL;                                                     41785000
CXSPLPREP:                                                              41790000
      TOS := 1;                                                         41795000
      GO TO PRESPL;                                                     41800000
CXSPLGO:                                                                41805000
      TOS := 2;                                                         41810000
PRESPL:                                                                 41815000
      MOVE SYSFILENAME := "SPL.PUB.SYS ";                               41820000
      MOVE BUILDNAME := SPLNAME , (3);                                  41825000
      GO TO PROCESS;                                                    41830000
CXRPG:                                                                  41835000
      TOS:=0;                                                           41840000
      GO TO PRERPG;                                                     41845000
CXRPGPREP:                                                              41850000
      TOS:=1;                                                           41855000
      GO TO PRERPG;                                                     41860000
CXRPGGO:                                                                41865000
      TOS:=2;                                                           41870000
PRERPG:                                                                 41875000
      MOVE SYSFILENAME:="RPG.PUB.SYS ";                                 41880000
      MOVE BUILDNAME:=RPGNAME,(3);                                      41885000
      GO TO PROCESS;                                                    41890000
CXFORTRAN:                                                              41895000
      TOS := 0;                                                         41900000
      GO TO PREFORT;                                                    41905000
CXFORTPREP:                                                             41910000
      TOS := 1;                                                         41915000
      GO TO PREFORT;                                                    41920000
CXFORTGO:                                                               41925000
      TOS := 2;                                                         41930000
PREFORT:                                                                41935000
      MOVE SYSFILENAME := "FORTRAN.PUB.SYS ";                           41940000
      MOVE BUILDNAME := FTNNAME , (3);                                  41945000
      GO TO PROCESS;                                                    41950000
CXBASICOMP:                                                             41955000
      TOS:=0;                                                           41960000
      GO TO PREBSC;                                                     41965000
CXBASICPREP:                                                            41970000
      TOS:=1;                                                           41975000
      GO TO PREBSC;                                                     41980000
CXBASICGO:                                                              41985000
      TOS:=2;                                                           41990000
PREBSC:                                                                 41995000
      MOVE SYSFILENAME:="BASICOMP.PUB.SYS ";                            42000000
      MOVE BUILDNAME:=BSCNAME,(3);                                      42005000
      MAXPARMS := 4;  <<BASIC COMPILER HAS NO NEW OR MASTER>>  <<U.RAO>>42010000
      GO TO PROCESS;                                                    42015000
CXCOBOL:                                                                42020000
      TOS := 0;                                                         42025000
      GO TO PRECOB;                                                     42030000
CXCOBOLPREP:                                                            42035000
      TOS := 1;                                                         42040000
      GO TO PRECOB;                                                     42045000
CXCOBOLGO:                                                              42050000
      TOS := 2;                                                         42055000
PRECOB:                                                                 42060000
      MOVE SYSFILENAME := "COBOL.PUB.SYS ";                             42065000
      MOVE BUILDNAME := COBNAME , (3);                                  42070000
      GO TO PROCESS;                                           <<02844>>42075000
CXCOBOLII:                                                     <<06130>>42080000
      TOS := 0;                                                <<06130>>42085000
      GO TO PRECOBII;                                          <<06130>>42090000
CXCOBOLIIPREP:                                                 <<06130>>42095000
      TOS := 1;                                                <<06130>>42100000
      GO TO PRECOBII;                                          <<06130>>42105000
CXCOBOLIIGO:                                                   <<06130>>42110000
      TOS := 2;                                                <<06130>>42115000
                                                               <<06130>>42120000
PRECOBII:                                                      <<06130>>42125000
      MOVE SYSFILENAME := "COBOLII.PUB.SYS ";                  <<06130>>42130000
      MOVE BUILDNAME   := COBNAME, (3);                        <<06130>>42135000
      GO TO PROCESS;                                           <<06130>>42140000
CXPASCAL:                                                      <<02844>>42145000
      TOS := 0;                                                <<02844>>42150000
      GO TO PREPASC;                                           <<02844>>42155000
CXPASCALPREP:                                                  <<02844>>42160000
      TOS := 1;                                                <<02844>>42165000
      GO TO PREPASC;                                           <<02844>>42170000
CXPASCALGO:                                                    <<02844>>42175000
      TOS := 2;                                                <<02844>>42180000
PREPASC:                                                       <<02844>>42185000
      MOVE SYSFILENAME := "PASCAL.PUB.SYS ";                   <<02844>>42190000
      MOVE BUILDNAME := PASCNAME,(3);                          <<02844>>42195000
      MAXPARMS := 4; << NO NEW, NO MASTER >>                   <<02844>>42200000
PROCESS:                                                                42205000
      WHICHFLG := TOS;                                                  42210000
      << check for parameters, semi marks start >>             <<02844>>42215000
      << keywords and positional parameters are >>             <<02844>>42220000
      << parsed separately.                     >>             <<02844>>42225000
      SCAN PARMSP UNTIL %6473,1; << cr,semicolon >>            <<02844>>42230000
      IF CARRY THEN                                            <<02844>>42235000
         DEL                                                   <<02844>>42240000
      ELSE                                                     <<02844>>42245000
         BEGIN << FOUND KEYWORD >>                             <<02844>>42250000
         BPS0 := %15;                                          <<02844>>42255000
         @SPTR := LOGICAL(TOS) + 1;                            <<02844>>42260000
         MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                 <<02844>>42265000
         << save string's original form >>                     <<02844>>42270000
         MOVE SAVEDCOMIMAGE := CIS'BCOMIMAGE,(CIS'BCOMBUFLEN); << I.A >>42275000
         MYCOMMAND(SPTR,,MAXSTRINGLEN + 1,NUMPARMS,PARMS);     <<02844>>42280000
         IF CARRY THEN << too many parameters in string >>     <<02844>>42285000
            BEGIN                                              <<02844>>42290000
            CIERR(ERRNUM := PARAMTOOBIG);                      <<02844>>42295000
            RETURN;                                            <<02844>>42300000
            END;                                               <<02844>>42305000
         IF NUMPARMS = 0 THEN                                  <<02844>>42310000
            CIERR(-EXTRNDELIMIGNRD,SPTR)                       <<02844>>42315000
         ELSE                                                  <<02844>>42320000
         DO << loop on keywords >>                             <<02844>>42325000
            BEGIN                                              <<02844>>42330000
            GETNEXT;                                           <<02844>>42335000
            IF PARMLEN = 0 THEN                                <<02844>>42340000
               CIERR(ERRNUM := -EXTRNDELIMIGNRD,PARMPTR)       <<02844>>42345000
            ELSE                                               <<02844>>42350000
               BEGIN                                           <<02844>>42355000
               TOS := SEARCH(PARMPTR,PARMLEN,KEYLIST);         <<02844>>42360000
               CASE *TOS OF                                    <<02844>>42365000
                  BEGIN                                        <<02844>>42370000
                  << 0 >> << NO SUCH KEYWORD >>                <<02844>>42375000
                  BEGIN                                        <<02844>>42380000
                  CIERR(ERRNUM := UNKNWNKWRD,PARMPTR);         <<02844>>42385000
                  RETURN;                                      <<02844>>42390000
                  END;                                         <<02844>>42395000
                  << 1 >> << INFO >>                           <<02844>>42400000
                  IF NOT PROCINFO THEN                         <<02844>>42405000
                     RETURN;                                   <<02844>>42410000
                  << 2 >>  << WKSP >>                          <<06130>>42415000
                  IF NOT WKSP  THEN                            <<06130>>42420000
                     RETURN;  << Error >>                      <<06130>>42425000
                  END; << CASE >>                              <<02844>>42430000
               END;                                            <<02844>>42435000
            END                                                <<02844>>42440000
         UNTIL NEXTDELIM = CR                                  <<02844>>42445000
         END;                                                  <<02844>>42450000
      T3 := 1;                                                          42455000
      IF WHICHFLG=2 THEN MAXPARMS := MAXPARMS-1; <<XXXGO>>     <<U.RAO>>42460000
      MYCOMMAND(PARMSP,COMCR,MAXPARMS,NUMPARMS,PARMS);                  42465000
      IF NUMPARMS = MAXPARMS THEN   <<TOO MANY PARAMETERS>>    <<U.RAO>>42470000
         BEGIN                                                 <<U.RAO>>42475000
         PARMNUM := MAXPARMS;                                  <<U.RAO>>42480000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>42485000
         TOS := PARMS(MAXPARMS-1);                             <<U.RAO>>42490000
         DEL;                                                  <<U.RAO>>42495000
         CIERR(*,*,%10000,MAXPARMS-1);                         <<U.RAO>>42500000
         RETURN;                                               <<U.RAO>>42505000
         END;                                                  <<U.RAO>>42510000
      IF NUMPARMS = 0 THEN GO TO DOIT;                                  42515000
      IF (T3 := BPARM(2)) = 0 THEN GO TO NEXT;                          42520000
      @FNAME := LPARM;                                                  42525000
      MOVE BUILDNAME(3) := TEXT , (5);                                  42530000
      BLDIMPFILE;                                              <<U.RAO>>42535000
      PARM := PARM + 1;                                                 42540000
NEXT:                                                                   42545000
      PCNT := PCNT + 1;                                                 42550000
      IF NUMPARMS = 1 THEN GO TO DOIT;                                  42555000
      IF (T3 := BPARM (6)) = 0 THEN                                     42560000
         IF WHICHFLG = 2 THEN GOTO NEXT2                                42565000
         ELSE GOTO NEXT1;                                               42570000
      @FNAME := LPARM(2);                                               42575000
      TOS := @BUILDNAME(3);                                             42580000
      GO TO USLPROGLIST(WHICHFLG);                                      42585000
US:   TOS := @USL;                                                      42590000
      PARM := PARM + 4;                                                 42595000
      TOS := 4;                                                         42600000
      GO TO PACK;                                                       42605000
PR:     <<PROGRAM FILE NAME>>                                 <<A01.01>>42610000
      IF CIBADFILENAME(ERRNUM,PARMS(1)) THEN                   <<U.RAO>>42615000
         BEGIN  <<PROGFILE NAME IS BAD>>                       <<U.RAO>>42620000
         PARMNUM := 2;                                         <<U.RAO>>42625000
         RETURN                                                <<U.RAO>>42630000
         END;                                                  <<U.RAO>>42635000
      PROG := " ";                                            <<A01.01>>42640000
      MOVE PROG(1) := PROG,(35);                              <<A01.01>>42645000
      TOS := @PROG;                                           <<A01.01>>42650000
      TOS := PARMS(1)&LSR(8);  <<STACK ADDRESS AND LENGTH>>   <<A01.01>>42655000
      MOVE * := *,(TOS);                                      <<A01.01>>42660000
      PROGFLAG := TRUE;                                                 42665000
      GOTO NEXT1;                                                       42670000
PACK:                                                                   42675000
      ASSEMBLE(MVB PB);                                                 42680000
      BLDIMPFILE;                                              <<U.RAO>>42685000
NEXT1:                                                                  42690000
      PCNT := PCNT + 1;                                                 42695000
      IF NUMPARMS = 2 THEN GO TO DOIT;                                  42700000
      IF (T3 := BPARM(10)) = 0 THEN GO TO NEXT2;                        42705000
      @FNAME := LPARM(4);                                               42710000
      TOS := @BUILDNAME(3);                                             42715000
LT:   TOS := @LIST;                                                     42720000
      TOS := 5;                                                         42725000
      ASSEMBLE(MVB PB);                                                 42730000
      BLDIMPFILE;                                              <<U.RAO>>42735000
      PARM := PARM + 2;                                                 42740000
NEXT2:                                                                  42745000
      PCNT := PCNT + 1;                                                 42750000
      IF NUMPARMS = PCNT THEN GO TO DOIT;                               42755000
      IF (T3 := BPARM(4*PCNT + 2))= 0 THEN GO TO NEXT3;                 42760000
      @FNAME := LPARM(2*PCNT);                                          42765000
      MOVE BUILDNAME(3) := MAST ,(5);                                   42770000
      BLDIMPFILE;                                              <<U.RAO>>42775000
      PARM := PARM LOR %10;                                             42780000
NEXT3:                                                                  42785000
      PCNT := PCNT + 1;                                                 42790000
      IF NUMPARMS = PCNT THEN GO TO DOIT;                               42795000
      IF (T3 := BPARM(4*PCNT+2)) = 0 THEN GO TO DOIT;          <<U.RAO>>42800000
      @FNAME := LPARM(2*PCNT);                                          42805000
      MOVE BUILDNAME(3) := NEW , (4);                                   42810000
      BLDIMPFILE;                                              <<U.RAO>>42815000
      PARM := PARM LOR %20;                                             42820000
DOIT:                                                                   42825000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>42830000
      OPTNUMS(0) := 3; OPTNS(0) := 1; << FLAGS >>              <<02844>>42835000
      OPTNUMS(1) := 2; OPTNS(1) := PARM; << PARM WORD >>       <<02844>>42840000
      X := 1;                                                  <<02844>>42845000
      IF INFO THEN                                             <<02844>>42850000
         BEGIN                                                 <<02844>>42855000
         OPTNUMS(X := X + 1) := 11;                            <<02844>>42860000
         OPTNS(X) := @STRING;                                  <<02844>>42865000
         OPTNUMS(X := X + 1) := 12;                            <<02844>>42870000
         OPTNS(X) := STRINGLEN;                                <<02844>>42875000
         END;                                                  <<02844>>42880000
      OPTNUMS(X := X + 1) := 0;                                <<02844>>42885000
      OPTNS(X) := 0;                                           <<02844>>42890000
      CREATEPROCESS(ERROR,PIN,SYSFILENAME,OPTNUMS,OPTNS);      <<02844>>42895000
      IF < THEN                                                <<02844>>42900000
      BEGIN                                                    <<U.RAO>>42905000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>42910000
         SCAN SYSFILENAME UNTIL "..",1;                        <<U.RAO>>42915000
         BPS0 := 0;                                            <<U.RAO>>42920000
         DEL;                                                  <<U.RAO>>42925000
         IF UNKNOWN'PROG'FILE THEN                             <<02844>>42930000
            CIERR(ERRNUM :=SUBSNOTFOUND,,0,@SYSFILENAME)       <<02844>>42935000
         ELSE                                                  <<02844>>42940000
            BEGIN                                              <<02844>>42945000
            CREATEPROC'ERR(ERROR,ERRNUM);                      <<02844>>42950000
            CIERR(ERRNUM := SUBSNOTCREATE,,0,@SYSFILENAME);    <<02844>>42955000
            END;                                               <<02844>>42960000
         RETURN;                                               <<U.RAO>>42965000
      END;                                                              42970000
      IF > THEN                                                <<02844>>42975000
         CREATEPROC'ERR(-ERROR,ERRNUM);                        <<02844>>42980000
      NEXTLINE;                                                         42985000
      AWAKE(PIN*PCBSIZE,1,2);                                           42990000
      IF WHICHFLG = 0 THEN                                              42995000
         BEGIN    <<JUST COMPILE>>                                      43000000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>43005000
         CISUBSYSFINISH(4, ERRNUM, PARMNUM);                   <<U.RAO>>43010000
         RETURN;                                               <<U.RAO>>43015000
         END;                                                           43020000
      IF NOT CISUBSYSFINISH(4, ERRNUM, PARMNUM) THEN           <<U.RAO>>43025000
         BEGIN    <<ERROR IN COMPILE OF MULTI-STEP>>                    43030000
         DELIMPFILE(PARM,BUILDNAME);                           <<U.RAO>>43035000
         CIERR(ERRNUM := COMPFAILEDNOPRP);                     <<U.RAO>>43040000
         RETURN;                                               <<U.RAO>>43045000
         END;                                                           43050000
      PIN := 0;                                                         43055000
      MOVE SYSFILENAME := "$OLDPASS ";                                  43060000
      SEGMENTER(PIN,22,T2,,,,,,,,,SYSFILENAME);                <<00629>>43065000
      CHECKSEGERR;                                             <<U.RAO>>43070000
      IF (WHICHFLG = 2)  OR NOT (PROGFLAG)  THEN                        43075000
         MOVE PROG := "$NEWPASS ";                                      43080000
      SEGMENTER (PIN, 14, T2, -1, -1, 0, -1, 0, -1, , , PROG); <<00629>>43085000
      CHECKSEGERR;                                             <<U.RAO>>43090000
      SEGMENTER (PIN, 8, T2);                                           43095000
      DELIMPFILE(PARM,BUILDNAME);                              <<U.RAO>>43100000
      IF WHICHFLG = 1 THEN   <<JUST COMPILE & PREP>>           <<U.RAO>>43105000
         BEGIN                                                 <<U.RAO>>43110000
         CISUBSYSFINISH(2, ERRNUM, PARMNUM);                   <<U.RAO>>43115000
         RETURN                                                <<U.RAO>>43120000
         END;                                                  <<U.RAO>>43125000
      IF NOT CISUBSYSFINISH(2, ERRNUM, PARMNUM) THEN           <<U.RAO>>43130000
         BEGIN                                                 <<U.RAO>>43135000
         CIERR(ERRNUM := PREPFAILEDNORUN);                     <<U.RAO>>43140000
         RETURN;                                               <<U.RAO>>43145000
         END;                                                  <<U.RAO>>43150000
      TOS := TOS + 0;            <<CLEAR CARRY>>                        43155000
      CREATE(SYSFILENAME,,PIN,,1);                                      43160000
      IF CARRY THEN   <<CREATE FAILED>>                        <<U.RAO>>43165000
         BEGIN                                                 <<U.RAO>>43170000
         IF CREATEERROR THEN                                   <<U.RAO>>43175000
            CIERR(ERRNUM := COMPILEDCREATE)                    <<U.RAO>>43180000
         ELSE                                                  <<U.RAO>>43185000
            CIERR(ERRNUM := COMPILEDLOAD);                     <<U.RAO>>43190000
         RETURN                                                <<U.RAO>>43195000
         END;                                                  <<U.RAO>>43200000
      IF < THEN                                                <<U.RAO>>43205000
         BEGIN                                                 <<U.RAO>>43210000
         CIERR(ERRNUM := INVALIDPROGFILE);                     <<U.RAO>>43215000
         RETURN                                                <<U.RAO>>43220000
         END;                                                  <<U.RAO>>43225000
      IF > THEN CIERR(ERRNUM := -DEFVAL);                      <<04785>>43230000
      NEXTLINE;                                                         43235000
      AWAKE(PIN*PCBSIZE,1,2);                                           43240000
      CISUBSYSFINISH(1, ERRNUM, PARMNUM);                      <<U.RAO>>43245000
END;  <<CXSPL ET AL>>                                          <<U.RAO>>43250000
PROCEDURE CXBASIC EXECUTORHEAD;                                         43255000
   OPTION PRIVILEGED, UNCALLABLE;                                       43260000
BEGIN LOGICAL X1 := %26015;                                             43265000
      INTEGER NUMPARMS;                                                 43270000
      DOUBLE ARRAY PARMS(0:3);                                 <<U.RAO>>43275000
      LBPARMDECS;                                                       43280000
      BYTE ARRAY BASINPT(0:6) = PB := "BASIN ";                         43285000
      BYTE ARRAY BLIST(0:7) = PB := "BASLIST ";                         43290000
      BYTE ARRAY BCOM (0:6) = PB := "BASCOM ";                          43295000
      BYTE ARRAY FNAME(0:7);                                            43300000
      BYTE POINTER FREF;                                                43305000
      LOGICAL T3;                                              <<U.RAO>>43310000
      LOGICAL PIN , PARM := 0;                                          43315000
      BYTE ARRAY SYSFILENAME(0:14);                                     43320000
      BYTE BLANK := " ";                                                43325000
      INTEGER PCNT := 1;                                                43330000
SUBROUTINE CLEANUP;                                                     43335000
BEGIN                                                                   43340000
      TOS := PARM;                                                      43345000
      IF < THEN                                                         43350000
      BEGIN MOVE FNAME := BCOM , (7);                                   43355000
            XREMJTENTRY(FNAME,BLANK,BLANK,3)                            43360000
      END;                                                              43365000
      ASSEMBLE(TBC 1);                                                  43370000
      IF <> THEN                                                        43375000
      BEGIN MOVE FNAME := BASINPT , (7);                                43380000
            XREMJTENTRY(FNAME,BLANK,BLANK,3)                            43385000
      END;                                                              43390000
      DELIMPFILE(*,FNAME);                                              43395000
END;                                                                    43400000
                                                               <<U.RAO>>43405000
SUBROUTINE BLDIMPFILE;                                         <<U.RAO>>43410000
BEGIN                                                          <<U.RAO>>43415000
ERRNUM := CYIMPLCTFILE'(FNAME,FREF,T3);                        <<U.RAO>>43420000
IF <> THEN  <<ERROR OCCURRED>>                                 <<U.RAO>>43425000
   BEGIN                                                       <<U.RAO>>43430000
   CLEANUP;                                                    <<U.RAO>>43435000
   PARMNUM := PCNT;                                            <<U.RAO>>43440000
   ASSEMBLE(EXIT 3);                                           <<U.RAO>>43445000
   END;                                                        <<U.RAO>>43450000
END;                                                           <<U.RAO>>43455000
                                                               <<U.RAO>>43460000
      MOVE SYSFILENAME := "BASIC.PUB.SYS ";                             43465000
      T3 := 1;                                                          43470000
      MYCOMMAND(PARMSP,X1,4,NUMPARMS,PARMS);                   <<U.RAO>>43475000
      IF NUMPARMS >= 4 THEN  <<T00 MANY PARAMETERS>>           <<U.RAO>>43480000
         BEGIN                                                 <<U.RAO>>43485000
         PARMNUM := 4;                                         <<U.RAO>>43490000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>43495000
         TOS := LPARM(6);                                      <<U.RAO>>43500000
         CIERR(*,*,%10000,3);                                  <<U.RAO>>43505000
         RETURN;                                               <<U.RAO>>43510000
         END;                                                  <<U.RAO>>43515000
      IF NUMPARMS = 0 THEN GO TO DOIT;                                  43520000
      IF (T3 := BPARM(2)) = 0 THEN GO TO TFILE;                         43525000
      MOVE FNAME := BCOM , (7);                                         43530000
      @FREF := LPARM;                                                   43535000
      BLDIMPFILE;                                              <<U.RAO>>43540000
      PARM.(0:1) := 1;   <<COMMAND FILE PRESENT>>              <<U.RAO>>43545000
TFILE:                                                                  43550000
      IF NUMPARMS = 1 THEN GO TO DOIT;                                  43555000
      PCNT := PCNT + 1;                                                 43560000
      IF (T3 := BPARM(6)) = 0 THEN GO TO LFILE;                         43565000
      MOVE FNAME := BASINPT , (7);                                      43570000
      @FREF := LPARM(2);                                                43575000
      BLDIMPFILE;                                              <<U.RAO>>43580000
      PARM.(1:1) := 1;  <<BASIC INPUT FILE PRESENT>>           <<U.RAO>>43585000
LFILE:                                                                  43590000
      IF NUMPARMS = 2 THEN GO TO DOIT;                                  43595000
      PCNT := PCNT + 1;                                                 43600000
      IF (T3 := BPARM(10)) = 0 THEN GO TO DOIT;                <<U.RAO>>43605000
      MOVE FNAME := BLIST , (8);                                        43610000
      @FREF := LPARM(4);                                                43615000
      BLDIMPFILE;                                              <<U.RAO>>43620000
      PARM := PARM + 2;                                                 43625000
DOIT:                                                                   43630000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>43635000
      TOS := TOS + 0;            <<CLEAR CARRY>>                        43640000
      CREATE(SYSFILENAME,,PIN,PARM,1);                                  43645000
      IF CARRY THEN                                                     43650000
      BEGIN CLEANUP;                                                    43655000
            IF CREATEERROR THEN                                <<U.RAO>>43660000
               CIERR(ERRNUM := BASICCREATEERR)                 <<U.RAO>>43665000
            ELSE                                               <<U.RAO>>43670000
               CIERR(ERRNUM := BASICLOADERR);                  <<U.RAO>>43675000
            RETURN;                                            <<U.RAO>>43680000
      END;                                                              43685000
      IF < THEN                                                         43690000
      BEGIN CLEANUP;                                                    43695000
         SYSFILENAME(5) := 0;                                  <<U.RAO>>43700000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@SYSFILENAME);        <<U.RAO>>43705000
         RETURN;                                               <<U.RAO>>43710000
      END;                                                              43715000
      NEXTLINE;                                                         43720000
      AWAKE(PIN*PCBSIZE,1,2);                                           43725000
                                                                        43730000
      CLEANUP;                                                          43735000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>43740000
END;  <<CXBASIC>>                                              <<U.RAO>>43745000
$CONTROL SEGMENT = CIPREPRUN                                   <<U.RAO>>43750000
PROCEDURE CXAPL EXECUTORHEAD;                                 <<A00.04>>43755000
   OPTION PRIVILEGED, UNCALLABLE;                             <<A00.04>>43760000
BEGIN                                                         <<A00.04>>43765000
BYTE ARRAY SYSFILENAME(0:11);                                 <<A00.04>>43770000
DOUBLE ARRAY PARMS(0:1) = Q;  <<FOR MYCOMMAND RESULTS>>        <<02.RO>>43775000
BYTE POINTER APLWSFNAME = PARMS;  <<NAME OF WORKSPACE>>        <<02.RO>>43780000
BYTE WSFNAMELEN = PARMS+1;                                     <<02.RO>>43785000
BYTE POINTER EXTRAPARM = PARMS+2; <<EXTRANEOUS PARM>>          <<02.RO>>43790000
INTEGER NUMPARMS;                                              <<02.RO>>43795000
LOGICAL PIN;  <<PIN OF CREATED APL PROCESS>>                   <<02.RO>>43800000
BYTE ARRAY FORMALDES(0:5);  << "APLWS ">>                      <<02.RO>>43805000
                                                               <<02.RO>>43810000
MYCOMMAND(PARMSP, , 2, NUMPARMS, PARMS);                       <<02.RO>>43815000
IF NUMPARMS >= 2 THEN  <<TOO MANY PARMS>>                      <<02.RO>>43820000
   BEGIN                                                       <<02.RO>>43825000
   PARMNUM := 2;                                               <<02.RO>>43830000
   CIERR(ERRNUM := APLXPCTJUSTWS, EXTRAPARM);                  <<02.RO>>43835000
   END                                                         <<02.RO>>43840000
ELSE   <<LEGAL NUMBER OF PARMS>>                               <<02.RO>>43845000
   BEGIN                                                       <<02.RO>>43850000
   IF NUMPARMS = 1 THEN  <<SET UP FILE EQUATE>>                <<02.RO>>43855000
      BEGIN                                                    <<02.RO>>43860000
      PARMNUM.(7:1) := 1;  <<SET FLAG FOR APL>>                <<02.RO>>43865000
      MOVE FORMALDES := "APLWS ";                              <<02.RO>>43870000
      ERRNUM := CYIMPLCTFILE'(FORMALDES, APLWSFNAME,           <<02.RO>>43875000
                    WSFNAMELEN);  <<DO EQUATE>>                <<02.RO>>43880000
      IF <> THEN PARMNUM := 1;  <<NAME PROBLEM>>               <<02.RO>>43885000
      END;  <<HANDLING OF FILE NAME, IF ANY>>                  <<02.RO>>43890000
   IF ERRNUM = 0 THEN  <<GOOD SO FAR, TRY LAUNCH>>            <<02.RO>>43895000
      BEGIN                                                    <<02.RO>>43900000
      MOVE SYSFILENAME := "APL.PUB.SYS ";                      <<02.RO>>43905000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>43910000
      CREATE(SYSFILENAME, , PIN, PARMNUM, 1);                  <<02.RO>>43915000
      IF CARRY THEN   <<CREATE FAILED>>                        <<02.RO>>43920000
         BEGIN                                                 <<02.RO>>43925000
         SYSFILENAME(3) := 0;                                  <<02.RO>>43930000
         IF CREATEERROR THEN                                   <<02.RO>>43935000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)   <<02.RO>>43940000
         ELSE   <<LOADER ERROR>>                               <<02.RO>>43945000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);    <<02.RO>>43950000
         END                                                   <<02.RO>>43955000
      ELSE IF < THEN  <<APL.PUB.SYS NOT FOUND>>                <<02.RO>>43960000
         BEGIN                                                 <<02.RO>>43965000
         SYSFILENAME(3) := 0;                                  <<02.RO>>43970000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@SYSFILENAME);        <<02.RO>>43975000
         END                                                   <<02.RO>>43980000
      ELSE   <<CREATE WENT F	INE>>                             <<02.RO>>43985000
         BEGIN                                                 <<02.RO>>43990000
         AWAKE(PIN*PCBSIZE, 1, 2);  <<FIRE UP SUBSYSTEM>>      <<02.RO>>43995000
         CISUBSYSFINISH(0, ERRNUM, PARMNUM);                   <<02.RO>>44000000
         END;                                                  <<02.RO>>44005000
      END;                                                     <<02.RO>>44010000
   END;                                                        <<02.RO>>44015000
END;   <<CXAPL>>                                               <<02.RO>>44020000
PROCEDURE APLTRANSLATEOUT(MESSAGE,LENGTH,TRANSTYPE);          <<A00.04>>44025000
  VALUE LENGTH,TRANSTYPE;                                     <<A00.04>>44030000
  INTEGER LENGTH,TRANSTYPE;                                   <<A00.04>>44035000
  BYTE ARRAY MESSAGE;                                         <<A00.04>>44040000
  <<TRANSTYPE = 2 => APL-ASCII BIT PAIRING CODES                        44045000
    TRANSTYPE = 3 => APL-ASCII TYPEWRITER PAIRING CODES                 44050000
                                                                        44055000
    LENGTH IS THE LENGTH IN BYTES OF ARRAY MESSAGE                      44060000
    MESSAGE IS A BYTE ARRAY CONTAINING THE MESSAGE TO BE TRANSLATED.    44065000
       THIS ARRAY WILL BE ENTIRELY CONVERTED.                           44070000
>>                                                            <<A00.04>>44075000
BEGIN                                                         <<A00.04>>44080000
ENTRY APLTRANSLATEIN;  <<ENTRY POINT FOR EXTERNAL TO INTERNAL><<A00.04>>44085000
EQUATE FIRSTCHAR = %41,  <<ALL PRECEEDING CHARS ARE THE SAME>><<A00.04>>44090000
       LASTCHAR = %176,                                       <<A00.04>>44095000
       NUMCHARS = LASTCHAR-FIRSTCHAR+1;  <<94 IN THIS INSTANCE<<A00.04>>44100000
BYTE ARRAY TRANSARRAY(FIRSTCHAR:LASTCHAR);  <<HOLDS TRANS CODE<<A00.04>>44105000
BYTE ARRAY BITPAIROUT(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY><<A00.04>>44110000
   %131, %41, " ",%174, " ",%120,%113,                        <<A00.04>>44115000
    %53, %52,%120, %55, ",", %75, ".", "/",                   <<A00.04>>44120000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>44125000
    "8", "9", %76, %74, %43, %45, %47,%121,                   <<A00.04>>44130000
   %101, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>44135000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>44140000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>44145000
    "x", "y", "z", %73, %77, %72,%137,%106,                   <<A00.04>>44150000
   %113, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>44155000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>44160000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>44165000
    "x", "y", "z",%135,%115, "}",%124;                        <<A00.04>>44170000
BYTE ARRAY TYPEWRITEROUT(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>      44175000
   %131, %41, " ",%176, " ",%120,%113,                        <<A00.04>>44180000
    %72, %42,%120, %55, ",",%137, ".", "/",                   <<A00.04>>44185000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>44190000
    "8", "9", %76, %74, %43, %45, %46,%121,                   <<A00.04>>44195000
   %101, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>44200000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>44205000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>44210000
    "x", "y", "z", %73, %77, %47, %51,%106,                   <<A00.04>>44215000
   %113, "a", "b", "c", "d", "e", "f", "g",                   <<A00.04>>44220000
    "h", "i", "j", "k", "l", "m", "n", "o",                   <<A00.04>>44225000
    "p", "q", "r", "s", "t", "u", "v", "w",                   <<A00.04>>44230000
    "x", "y", "z", "{",%115, "}",%124;                        <<A00.04>>44235000
BYTE ARRAY BITPAIRIN(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>          44240000
    %42, %42, "<", %44, "=", %46, ">",                        <<A00.04>>44245000
    %50, %51, ")", "(", ",", "+", ".", "/",                   <<A00.04>>44250000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>44255000
    "8", "9", "]", "[", ";", "-", ":", "\",                   <<A00.04>>44260000
    "_", "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>44265000
    "H", "I", "J", "'", "L",%174, "N", "O",                   <<A00.04>>44270000
    "*", "?", "R", "S", %176, "U", "V", "W",                  <<A00.04>>44275000
    "X", "^", "Z",%133,%134,%173,%136,%137,                   <<A00.04>>44280000
   %140, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>44285000
    "H", "I", "J", "K", "L", "M", "N", "O",                   <<A00.04>>44290000
    "P", "Q", "R", "S", "T", "U", "V", "W",                   <<A00.04>>44295000
    "X", "Y", "Z",%173, "$",%175,%176;                        <<A00.04>>44300000
BYTE ARRAY TYPEWRITERIN(0:LASTCHAR-1)=PB:=  <<TRANSLATION ARRAY>>       44305000
    %42, ")", "<", %44, "=", ">", "]",                        <<A00.04>>44310000
    %50, %51, %52, %53, ",", "+", ".", "/",                   <<A00.04>>44315000
    "0", "1", "2", "3", "4", "5", "6", "7",                   <<A00.04>>44320000
    "8", "9", "(", "[", ";", %75, ":", "\",                   <<A00.04>>44325000
   %100, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>44330000
    "H", "I", "J", "'", "L",%174, "N", "O",                   <<A00.04>>44335000
    "*", "?", "R", "S", %176, "U", "V", "W",                  <<A00.04>>44340000
    "X", "^", "Z", "_",%134,%135,%136, "-",                   <<A00.04>>44345000
   %140, "A", "B", "C", "D", "E", "F", "G",                   <<A00.04>>44350000
    "H", "I", "J", "K", "L", "M", "N", "O",                   <<A00.04>>44355000
    "P", "Q", "R", "S", "T", "U", "V", "W",                   <<A00.04>>44360000
    "X", "Y", "Z",%173,%174,%175, "$";                        <<A00.04>>44365000
IF NOT(2<=TRANSTYPE<=3) THEN RETURN;                          <<A00.04>>44370000
TRANSTYPE := TRANSTYPE-2;                                     <<A00.04>>44375000
GO TO DOIT;                                                   <<A00.04>>44380000
APLTRANSLATEIN:                                               <<A00.04>>44385000
  IF NOT(2<=TRANSTYPE<=3) THEN RETURN;                        <<A00.04>>44390000
DOIT:                                                         <<A00.04>>44395000
  CASE TRANSTYPE OF                                           <<A00.04>>44400000
    BEGIN                                                     <<A00.04>>44405000
    MOVE TRANSARRAY(FIRSTCHAR):=BITPAIROUT,(NUMCHARS);        <<A00.04>>44410000
    MOVE TRANSARRAY(FIRSTCHAR):=TYPEWRITEROUT,(NUMCHARS);     <<A00.04>>44415000
    MOVE TRANSARRAY(FIRSTCHAR):=BITPAIRIN,(NUMCHARS);         <<A00.04>>44420000
    MOVE TRANSARRAY(FIRSTCHAR):=TYPEWRITERIN,(NUMCHARS);      <<A00.04>>44425000
    END;                                                      <<A00.04>>44430000
WHILE (LENGTH:=LENGTH-1) >= 0 DO  <<WORK FROM END TO BEGINNING>>        44435000
   IF FIRSTCHAR<=INTEGER(MESSAGE(LENGTH))<=LASTCHAR THEN  <<IN RANGE>>  44440000
      MESSAGE(LENGTH):=TRANSARRAY(INTEGER(MESSAGE(LENGTH)));  <<A00.04>>44445000
END;                                                          <<A00.04>>44450000
PROCEDURE CXMRJE EXECUTORHEAD;                                <<<<MRJE>>44455000
   OPTION PRIVILEGED,UNCALLABLE;                              <<<<MRJE>>44460000
BEGIN                                                         <<<<MRJE>>44465000
BYTE ARRAY SYSFILENAME(0:13);                                  <<03058>>44470000
DOUBLE PARMS;  <<DUMMY FOR ERRORS FOUND BY MYCOMMAND>>        <<<<MRJE>>44475000
BYTE POINTER BPARM = PARMS;   <<POINTER FOR ERROR>>             <<MRJE>>44480000
INTEGER NUMPARMS;  <<LIKEWISE>>                               <<<<MRJE>>44485000
LOGICAL PIN;  <<PIN FROM CREATE OF MRJE SUBSYS>>              <<<<MRJE>>44490000
MOVE SYSFILENAME:="MRJE.PUB.SYS ";                            <<<<MRJE>>44495000
MYCOMMAND(PARMSP,,1,NUMPARMS,PARMS);  <<CHECK FOR PARMS>>     <<<<MRJE>>44500000
IF NUMPARMS > 0 THEN   <<EXTRANEOUS PARAMETER>>                 <<MRJE>>44505000
   CIERR(ERRNUM := -WARNXPARMSIGNORED, BPARM);                 <<04785>>44510000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>44515000
CREATE(SYSFILENAME,,PIN,PARMNUM,1);                           <<<<MRJE>>44520000
IF CARRY THEN   <<CREATE OF MRJE FAILED>>                       <<MRJE>>44525000
   BEGIN                                                        <<MRJE>>44530000
   SYSFILENAME(4) := 0;   <<FOR ERROR MESSAGE>>                 <<MRJE>>44535000
   IF CREATEERROR THEN                                          <<MRJE>>44540000
      CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)          <<MRJE>>44545000
   ELSE   <<LOAD FAILED>>                                       <<MRJE>>44550000
      CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);           <<MRJE>>44555000
   END                                                          <<MRJE>>44560000
ELSE IF < THEN   <<MRJE.PUB.SYS NOT FOUND>>                     <<MRJE>>44565000
   BEGIN                                                        <<MRJE>>44570000
   SYSFILENAME(4) := 0;   <<FOR ERROR MESSAGE>>                 <<MRJE>>44575000
   CIERR(ERRNUM := SUBSNOTFOUND, , 0,@SYSFILENAME);             <<MRJE>>44580000
   END                                                          <<MRJE>>44585000
ELSE   <<EVERYTHING OK, DO IT>>                                 <<MRJE>>44590000
   BEGIN                                                        <<MRJE>>44595000
   AWAKE(PIN*PCBSIZE,1,2);   <<FIRE UP SUBSYSTEM>>              <<MRJE>>44600000
   CISUBSYSFINISH(0, ERRNUM, PARMNUM);                          <<MRJE>>44605000
   END;                                                         <<MRJE>>44610000
END;   <<CXMRJE>>                                               <<MRJE>>44615000
                                                               <<06842>>44620000
$PAGE   "               NRJE COMMAND EXECUTOR   "              <<06842>>44625000
COMMENT:                                                       <<06842>>44630000
+----------------------------------------------------+         <<06842>>44635000
|                         |                          |         <<06842>>44640000
|  CXNRJE                 |   Algorithm              |         <<06842>>44645000
|                         |                          |         <<06842>>44650000
|  Parses the parameter   |   1.  Break parameter    |         <<06842>>44655000
|  list of the :nrje      |       list into tokens.  |         <<06842>>44660000
|  [<wsid>] command, and  |                          |         <<06842>>44665000
|  creates the NRJE       |   2.  Check parameter.   |         <<06842>>44670000
|  subsystem process.     |                          |         <<06842>>44675000
|                         |                          |         <<06842>>44680000
|                         |       The  NRJE command  |         <<06842>>44685000
|  Input                  |       has one optional   |         <<06842>>44690000
|                         |       parameter, q work- |         <<06842>>44695000
|                         |       station identifier.|         <<06842>>44700000
|  PARMSP                 |       A workstation id   |         <<06842>>44705000
|   pointer to parameter  |       contains one to    |         <<06842>>44710000
|   list                  |       eight characters,  |         <<06842>>44715000
|                         |       is alphanumberic,  |         <<06842>>44720000
|  Output                 |       starts with a let- |         <<06842>>44725000
|                         |       ter, and must be   |         <<06842>>44730000
|  ERRNUM                 |       configured in an   |         <<06842>>44735000
|   number of error en-   |       ORACLE data com-   |         <<06842>>44740000
|   countered  by cxnrje  |       munications config-|         <<06842>>44745000
|                         |       uration file.      |         <<06842>>44750000
|  PARMNUM                |                          |         <<06842>>44755000
|   number (position) of  |                          |         <<06842>>44760000
|   parameter which is    |                          |         <<06842>>44765000
|   in error              |                          |         <<06842>>44770000
|                         |                          |         <<06842>>44775000
|                         |   3.  Clear jcw abort    |         <<06842>>44780000
|                         |       bit.               |         <<06842>>44785000
|                         |                          |         <<06842>>44790000
|                         |   4.  Print <cr> <lf> to |         <<06842>>44795000
|                         |       output device.     |         <<06842>>44800000
|                         |                          |         <<06842>>44805000
|                         |   5.  Create NRJE subsys-|         <<06842>>44810000
|                         |       tem process.       |         <<06842>>44815000
|                         |                          |         <<06842>>44820000
+----------------------------------------------------+         <<06842>>44825000
END OF COMMENT;                                                <<06842>>44830000
                                                               <<06842>>44835000
PROCEDURE CXNRJE EXECUTORHEAD;                                 <<06842>>44840000
OPTION    PRIVILEGED, UNCALLABLE;                              <<06842>>44845000
BEGIN                                                          <<06842>>44850000
                                                               <<06842>>44855000
<<--------- LOCAL VARIABLE DECLARATIONS ------------>>         <<06842>>44860000
                                                               <<06842>>44865000
EQUATE  MAXCREATEPARMCOUNT = 4,                                <<06842>>44870000
        NRJEPROGLEN        = 14;                               <<06842>>44875000
                                                               <<06842>>44880000
EQUATE  MAXPARMS    = 1,                                       <<06842>>44885000
        MINPARMS    = 0,                                       <<06842>>44890000
        MAXPARMLEN  = 8,                                       <<06842>>44895000
        MINPARMLEN  = 1,                                       <<06842>>44900000
        DELIMCOUNT  = 1;                                       <<06842>>44905000
                                                               <<06842>>44910000
INTEGER ARRAY    ITEMNUMS(0:MAXCREATEPARMCOUNT);               <<06842>>44915000
BYTE    ARRAY    PROGNAME(0:NRJEPROGLEN - 1);                  <<06842>>44920000
LOGICAL ARRAY    ITEMS(0:MAXCREATEPARMCOUNT - 1);              <<06842>>44925000
BYTE    ARRAY    INFOSTRING(0:MAXPARMLEN);                     <<06842>>44930000
                                                               <<06842>>44935000
INTEGER ARRAY    PARMS(0:(MAXPARMS-1) * 2);                    <<06842>>44940000
BYTE    ARRAY    DELIMITERS(0:DELIMCOUNT - 1);                 <<06842>>44945000
INTEGER          NUMPARMS;                                     <<06842>>44950000
                                                               <<06842>>44955000
BYTE    ARRAY    GETCONFPROCNAME(0:14);                        <<06842>>44960000
EQUATE           SYSLIB = 0;                                   <<06842>>44965000
INTEGER          GETCONFPLABEL, LOADNUM;                       <<06842>>44970000
                                                               <<06842>>44975000
                                                               <<06842>>44980000
EQUATE MAXCONFIGFILELEN = 35;                                  <<06842>>44985000
BYTE ARRAY CONFIGFILE(0:MAXCONFIGFILELEN - 1);                 <<06842>>44990000
INTEGER STATUS;                                                <<06842>>44995000
                                                               <<06842>>45000000
BYTE POINTER PARMPTR;                                          <<06842>>45005000
                                                               <<06842>>45010000
INTEGER PIN;                                                   <<06842>>45015000
                                                               <<06842>>45020000
INTEGER INFOLEN := 8;                                          <<06842>>45025000
                                                               <<06842>>45030000
DEFINE  SPECIALCHARS = PARMS(1).(10:1)#,                       <<06842>>45035000
        MYCOMMAND'PARMPTR = PARMS(0)#,                         <<06842>>45040000
        PARMLEN      = PARMS(1).(0:8)#;                        <<06842>>45045000
                                                               <<06842>>45050000
EQUATE  CIERRENDOFSTRING   = 0,                                <<06842>>45055000
        CLEARABORTBITSMASK = %37777,                           <<06842>>45060000
        CREATEPROCNOERRS   = 0,                                <<06842>>45065000
        CREATEPROCNOPROG   = 6,                                <<06842>>45070000
        GETCONFIGNOERRS    = 0,                                <<06842>>45075000
        GETCONFIGNOWSID    = 1010,                             <<06842>>45080000
        SUBSYSENDMSG       = 3,                                <<06842>>45085000
        ENDOFPARMS         = 0;                                <<06842>>45090000
                                                               <<06842>>45095000
 EQUATE CARRIAGERETURN     = %15,                              <<06842>>45100000
        FLAGCODE           = 3,                                <<06842>>45105000
        ACTIVATECODE       = 10,                               <<06842>>45110000
        INFOPTRCODE        = 11,                               <<06842>>45115000
        INFOCOUNTCODE      = 12,                               <<06842>>45120000
        LOADERFLAGS        = %131001,<<STACKDUMP UNC>>         <<06842>>45125000
                                     <<DL TO QI BIT >>         <<06842>>45130000
                                     <<QI TO S  BIT >>         <<06842>>45135000
                                     <<ASCII DUMP   >>         <<06842>>45140000
        SONWAIT            = 2;                                <<06842>>45145000
                                                               <<06842>>45150000
                                                               <<06842>>45155000
INTRINSIC LOADPROC, UNLOADPROC;                                <<06842>>45160000
                                                               <<06842>>45165000
<<-------------------- CXNRJE ------------------->>            <<06842>>45170000
                                                               <<06842>>45175000
                                                               <<06842>>45180000
ERRNUM := 0; PARMNUM := 0;                                     <<06842>>45185000
                                                               <<06842>>45190000
<< 1. >>                                                       <<06842>>45195000
DELIMITERS := CARRIAGERETURN;                                  <<06842>>45200000
MYCOMMAND( PARMSP, DELIMITERS, MAXPARMS,                       <<06842>>45205000
           NUMPARMS, PARMS               );                    <<06842>>45210000
@PARMPTR := MYCOMMAND'PARMPTR;                                 <<06842>>45215000
                                                               <<06842>>45220000
<< 2. >>                                                       <<06842>>45225000
IF NUMPARMS = MAXPARMS THEN                                    <<06842>>45230000
BEGIN                                                          <<06842>>45235000
                                                               <<06842>>45240000
  IF ( PARMLEN > MAXPARMLEN ) THEN                             <<06842>>45245000
  BEGIN                                                        <<06842>>45250000
    PARMNUM := 1;                                              <<06842>>45255000
    CIERR( ERRNUM := WSIDTOOLONG, PARMPTR );                   <<06842>>45260000
    RETURN;                                                    <<06842>>45265000
  END;                                                         <<06842>>45270000
                                                               <<06842>>45275000
  IF LOGICAL(SPECIALCHARS) OR                                  <<06842>>45280000
     ( PARMPTR <> ALPHA  ) THEN                                <<06842>>45285000
  BEGIN                                                        <<06842>>45290000
    PARMNUM := 1;                                              <<06842>>45295000
    CIERR( ERRNUM := BADWSID, PARMPTR );                       <<06842>>45300000
    RETURN;                                                    <<06842>>45305000
  END;                                                         <<06842>>45310000
                                                               <<06842>>45315000
  MOVE INFOSTRING := PARMPTR, (PARMLEN);                       <<06842>>45320000
                                                               <<06842>>45325000
  IF PARMLEN < MAXPARMLEN THEN                                 <<06842>>45330000
  BEGIN                                                        <<06842>>45335000
    INFOSTRING(PARMLEN) := " ";                                <<06842>>45340000
    MOVE INFOSTRING( PARMLEN + 1 ) :=                          <<06842>>45345000
      INFOSTRING(PARMLEN),                                     <<06842>>45350000
      ( MAXPARMLEN - ( PARMLEN + 1 ) );                        <<06842>>45355000
  END;                                                         <<06842>>45360000
  INFOSTRING(MAXPARMLEN) := CIERRENDOFSTRING;                  <<06842>>45365000
                                                               <<06842>>45370000
  MOVE GETCONFPROCNAME := "NCONGET'CONFIG ";                   <<06842>>45375000
  LOADNUM := LOADPROC( GETCONFPROCNAME,                        <<06842>>45380000
                       SYSLIB,                                 <<06842>>45385000
                       GETCONFPLABEL    );                     <<06842>>45390000
  IF <> THEN                                                   <<06842>>45395000
  BEGIN                                                        <<06842>>45400000
    CIERR( ERRNUM := BADCONFACCESS );                          <<06842>>45405000
    RETURN;                                                    <<06842>>45410000
  END;                                                         <<06842>>45415000
                                                               <<06842>>45420000
  TOS := @INFOSTRING;                                          <<06842>>45425000
  TOS := @CONFIGFILE;                                          <<06842>>45430000
  TOS := @STATUS;                                              <<06842>>45435000
  TOS := GETCONFPLABEL;                                        <<06842>>45440000
  ASSEMBLE( PCAL 0 );                                          <<06842>>45445000
                                                               <<06842>>45450000
  IF STATUS = GETCONFIGNOWSID THEN                             <<06842>>45455000
  BEGIN                                                        <<06842>>45460000
    PARMNUM := 1;                                              <<06842>>45465000
    CIERR( ERRNUM := WSIDNOTCONF,                              <<06842>>45470000
           PARMPTR,                                            <<06842>>45475000
           0,                                                  <<06842>>45480000
           @INFOSTRING             );                          <<06842>>45485000
    RETURN;                                                    <<06842>>45490000
  END                                                          <<06842>>45495000
  ELSE IF STATUS <> GETCONFIGNOERRS THEN                       <<06842>>45500000
  BEGIN                                                        <<06842>>45505000
    CIERR( ERRNUM := BADCONFACCESS );                          <<06842>>45510000
    RETURN;                                                    <<06842>>45515000
  END;                                                         <<06842>>45520000
                                                               <<06842>>45525000
  UNLOADPROC( LOADNUM );                                       <<06842>>45530000
  IF <> THEN                                                   <<06842>>45535000
  BEGIN                                                        <<06842>>45540000
    CIERR( ERRNUM := BADCONFACCESS );                          <<06842>>45545000
    RETURN;                                                    <<06842>>45550000
  END;                                                         <<06842>>45555000
END;                                                           <<06842>>45560000
                                                               <<06842>>45565000
                                                               <<06842>>45570000
<< 3. >>                                                       <<06842>>45575000
SETJCW( GETJCW LAND CLEARABORTBITSMASK );                      <<06842>>45580000
                                                               <<06842>>45585000
                                                               <<06842>>45590000
<< 4. >>                                                       <<06842>>45595000
NEXTLINE;                                                      <<06842>>45600000
                                                               <<06842>>45605000
<< 5. >>                                                       <<06842>>45610000
ITEMNUMS := FLAGCODE;         ITEMNUMS(1) := ACTIVATECODE;     <<06842>>45615000
                                                               <<06842>>45620000
ITEMS := LOADERFLAGS;   ITEMS(1) := SONWAIT;                   <<06842>>45625000
                                                               <<06842>>45630000
IF NUMPARMS = MAXPARMS THEN                                    <<06842>>45635000
BEGIN                                                          <<06842>>45640000
  ITEMNUMS(2) := INFOCOUNTCODE;                                <<06842>>45645000
  ITEMNUMS(3) := INFOPTRCODE;                                  <<06842>>45650000
  ITEMNUMS(4) := ENDOFPARMS;                                   <<06842>>45655000
  ITEMS(2) := INFOLEN;                                         <<06842>>45660000
  ITEMS(3) := @INFOSTRING;                                     <<06842>>45665000
END                                                            <<06842>>45670000
ELSE ITEMNUMS(2) := ENDOFPARMS;                                <<06842>>45675000
                                                               <<06842>>45680000
MOVE PROGNAME := "NRJE.NRJE.SYS ";                             <<06842>>45685000
                                                               <<06842>>45690000
                                                               <<06842>>45695000
CREATEPROCESS( ERRNUM, PIN , PROGNAME, ITEMNUMS, ITEMS );      <<06842>>45700000
IF ERRNUM = CREATEPROCNOERRS THEN                              <<06842>>45705000
  CISUBSYSFINISH( SUBSYSENDMSG, ERRNUM, PARMNUM )              <<06842>>45710000
ELSE IF ERRNUM = CREATEPROCNOPROG THEN                         <<06842>>45715000
  CIERR( ERRNUM := NRJENOTFOUND )                              <<06842>>45720000
ELSE CREATEPROC'ERR( ERRNUM, ERRNUM );                         <<06842>>45725000
                                                               <<06842>>45730000
END;  << PROCEDURE CXNRJE >>                                   <<06842>>45735000
PROCEDURE CX3270 EXECUTORHEAD;                                          45740000
   OPTION PRIVILEGED,UNCALLABLE;                               <<00184>>45745000
BEGIN                                                          <<00184>>45750000
<< Fire up the IML/3000 subsystem (also known in   >>          <<01165>>45755000
<< some circles as the IBM 3270).                  >>          <<01165>>45760000
<<                                                 >>          <<01165>>45765000
<< The IML subsystem can now be invoked via four  >>           <<02845>>45770000
<< commands, IML and IMF for regular use, and     >>           <<02845>>45775000
<< IMLMGR or IMFMGR for manager. The syntax was   >>           <<02845>>45780000
<< changed to include the FORMAT and PRIORITY key->>           <<02845>>45785000
<< words. The complete syntax is as follows:      >>           <<02845>>45790000
<<                                                >>           <<02845>>45795000
<< IMF [;][E[NHANCE] = 0|1|2|3] [;][B[LANKS]]     >>           <<02845>>45800000
<<     [;][F[ORMAT] = 1|2|3|4]                    >>           <<02845>>45805000
<<     [;][P[RIORITY] =1|2|3|4|5|6|7|8|9|11|12|13]>>           <<02845>>45810000
<<                                                >>           <<02845>>45815000
<<                                                >>           <<02845>>45820000
<<  The parameters may be in either sequence or    >>          <<01165>>45825000
<<  may be omitted entirely.                       >>          <<01165>>45830000
                                                               <<01165>>45835000
LOGICAL MANAGER;                                               <<00184>>45840000
BYTE ARRAY SYSFILENAME(0:17),ENTRYNAME(0:9);                   <<00184>>45845000
LOGICAL FLAG := 0,PROG'PARM := [4/0,3/2,1/0,4/8,4/0];          <<02845>>45850000
EQUATE                                                         <<02845>>45855000
   PKEYLISTL = 56,                                             <<02845>>45860000
   MAXPARMS = 7,                                               <<02845>>45865000
   EQUALS = 1,                                                 <<02845>>45870000
   SEMICOLON = 0,                                              <<02845>>45875000
   CR = 2;                                                     <<02845>>45880000
BYTE ARRAY PKEYLIST(0:PKEYLISTL - 1) = PB :=                   <<02845>>45885000
   10,7,"ENHANCE",0,                                           <<02845>>45890000
   9,6,"FORMAT",1,                                             <<02845>>45895000
   11,8,"PRIORITY",2,                                          <<02845>>45900000
   9,6,"BLANKS",3,                                             <<02845>>45905000
   4,1,"E",0,                                                  <<02845>>45910000
   4,1,"F",1,                                                  <<02845>>45915000
   4,1,"P",2,                                                  <<02845>>45920000
   4,1,"B",3,                                                  <<02845>>45925000
   0;                                                          <<02845>>45930000
BYTE ARRAY KEYLIST(0:PKEYLISTL - 1);                           <<02845>>45935000
DOUBLE DELIM := [8/";",8/"=",8/%15,8/0]D;                      <<02845>>45940000
BYTE ARRAY DELIMS(*) = DELIM;                                  <<02845>>45945000
INTEGER PARMLEN,NEXTDELIM,NUMPARMS,RESULT;                     <<02845>>45950000
DOUBLE ARRAY PARMS(0:MAXPARMS - 1);                            <<02845>>45955000
BYTE POINTER PARMPTR,DICTPTR;                                  <<02845>>45960000
DEFINE                                                         <<02845>>45965000
   ENHANCE = (12:4)#,                                          <<02845>>45970000
   FORMAT = (4:3)#,                                            <<02845>>45975000
   PRIORITY = (8:4)#,                                          <<02845>>45980000
   BLANKS = (7:1)#,                                            <<02845>>45985000
   ENH = (0:1)#,                                               <<02845>>45990000
   FMT = (1:1)#,                                               <<02845>>45995000
   PRI = (2:1)#,                                               <<02845>>46000000
   DELIMTYPE = (13:3)#;                                        <<02845>>46005000
                                                               <<01165>>46010000
LOGICAL PIN;  <<PIN FROM CREATE OF 3270 SUBSYS>>               <<00184>>46015000
ENTRY CX3270MGR;                                               <<01165>>46020000
                                                               <<00184>>46025000
                                                               <<01165>>46030000
SUBROUTINE GETNEXT;                                            <<02845>>46035000
<< Sets PARMPTR to appropriate parameter, gets parameter >>    <<02845>>46040000
<< length and delimiter type. Called upon advancing to   >>    <<02845>>46045000
<< next parameter.                                       >>    <<02845>>46050000
BEGIN                                                          <<02845>>46055000
   TOS := PARMS(PARMNUM);                                      <<02845>>46060000
   NEXTDELIM := S0.DELIMTYPE;                                  <<02845>>46065000
   PARMLEN := TOS&LSR(8);                                      <<02845>>46070000
   @PARMPTR := TOS;                                            <<02845>>46075000
   PARMNUM := PARMNUM + 1;                                     <<02845>>46080000
END; << SUBROUTINE GETNEXT >>                                  <<02845>>46085000
                                                               <<02845>>46090000
                                                               <<02845>>46095000
LOGICAL SUBROUTINE PROCENHANCE;                                <<02845>>46100000
BEGIN                                                          <<02845>>46105000
   PROCENHANCE := FALSE;                                       <<02845>>46110000
   IF FLAG.ENH THEN                                            <<02845>>46115000
      CIERR(ERRNUM := -REDNDENH,PARMPTR);                      <<02845>>46120000
   FLAG.ENH := TRUE;                                           <<02845>>46125000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>46130000
      BEGIN                                                    <<02845>>46135000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>46140000
         RETURN;                                               <<02845>>46145000
      END;                                                     <<02845>>46150000
   GETNEXT;                                                    <<02845>>46155000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>46160000
   IF <> OR NOT (0 <= RESULT <= 3) THEN                        <<02845>>46165000
      CIERR(ERRNUM := ILLVALENH,PARMPTR)                       <<02845>>46170000
   ELSE                                                        <<02845>>46175000
      BEGIN                                                    <<02845>>46180000
         PROG'PARM.ENHANCE := RESULT;                          <<02845>>46185000
         PROCENHANCE := TRUE;                                  <<02845>>46190000
      END;                                                     <<02845>>46195000
END; << SUBROUTINE PROCENHANCE >>                              <<02845>>46200000
                                                               <<02845>>46205000
                                                               <<02845>>46210000
LOGICAL SUBROUTINE PROCFORMAT;                                 <<02845>>46215000
BEGIN                                                          <<02845>>46220000
   PROCFORMAT := FALSE;                                        <<02845>>46225000
   IF FLAG.FMT THEN                                            <<02845>>46230000
      CIERR(ERRNUM := -REDNDFMT,PARMPTR);                      <<02845>>46235000
   FLAG.FMT := TRUE;                                           <<02845>>46240000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>46245000
      BEGIN                                                    <<02845>>46250000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>46255000
         RETURN;                                               <<02845>>46260000
      END;                                                     <<02845>>46265000
   GETNEXT;                                                    <<02845>>46270000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>46275000
   IF <> OR NOT (1 <= RESULT <= 4) THEN                        <<02845>>46280000
      CIERR(ERRNUM := ILLVALFMT,PARMPTR)                       <<02845>>46285000
   ELSE                                                        <<02845>>46290000
      BEGIN                                                    <<02845>>46295000
         PROG'PARM.FORMAT := RESULT;                           <<02845>>46300000
         PROCFORMAT := TRUE;                                   <<02845>>46305000
      END;                                                     <<02845>>46310000
END; << SUBROUTINE PROCFORMAT >>                               <<02845>>46315000
                                                               <<02845>>46320000
                                                               <<02845>>46325000
LOGICAL SUBROUTINE PROCPRIORITY;                               <<02845>>46330000
BEGIN                                                          <<02845>>46335000
   PROCPRIORITY := FALSE;                                      <<02845>>46340000
   IF FLAG.PRI THEN                                            <<02845>>46345000
      CIERR(ERRNUM := -REDNDPRI,PARMPTR);                      <<02845>>46350000
   FLAG.PRI := TRUE;                                           <<02845>>46355000
   IF NEXTDELIM <> EQUALS THEN                                 <<02845>>46360000
      BEGIN                                                    <<02845>>46365000
         CIERR(ERRNUM := EXPCTEQUAL,PARMPTR(PARMLEN));         <<02845>>46370000
         RETURN;                                               <<02845>>46375000
      END;                                                     <<02845>>46380000
   GETNEXT;                                                    <<02845>>46385000
   RESULT := BINARY(PARMPTR,PARMLEN);                          <<02845>>46390000
   IF <> OR NOT (1 <= RESULT <= 13) THEN                       <<02845>>46395000
      CIERR(ERRNUM := ILLVALPRI,PARMPTR)                       <<02845>>46400000
   ELSE                                                        <<02845>>46405000
      BEGIN                                                    <<02845>>46410000
         PROG'PARM.PRIORITY := RESULT;                         <<02845>>46415000
         PROCPRIORITY := TRUE;                                 <<02845>>46420000
      END;                                                     <<02845>>46425000
END; << SUBROUTINE PROCPRIORITY >>                             <<02845>>46430000
                                                               <<02845>>46435000
                                                               <<02845>>46440000
IF (MANAGER := FALSE) THEN                                     <<02845>>46445000
CX3270MGR: MANAGER := TRUE;                                    <<02845>>46450000
MYCOMMAND(PARMSP,DELIMS,MAXPARMS,NUMPARMS,PARMS);              <<02845>>46455000
IF <> THEN                                                     <<02845>>46460000
   BEGIN                                                       <<02845>>46465000
      CIERR(ERRNUM := TOOMANYPARMS);                           <<02845>>46470000
      RETURN;                                                  <<02845>>46475000
   END;                                                        <<02845>>46480000
IF NUMPARMS <> 0 THEN << evidently found some >>               <<02845>>46485000
   BEGIN                                                       <<02845>>46490000
      MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                    <<02845>>46495000
      DO                                                       <<02845>>46500000
         BEGIN                                                 <<02845>>46505000
            GETNEXT;                                           <<02845>>46510000
            IF PARMLEN = 0 THEN << empty parameter >>          <<02845>>46515000
               CIERR(ERRNUM := -FILEEXTRANDELIM,PARMPTR)       <<02845>>46520000
            ELSE                                               <<02845>>46525000
               BEGIN << look for a keyword >>                  <<02845>>46530000
                  TOS := SEARCH(PARMPTR,PARMLEN,KEYLIST        <<02845>>46535000
                                ,DICTPTR);                     <<02845>>46540000
                  IF TOS <> 0 THEN                             <<02845>>46545000
                     CASE INTEGER(DICTPTR) OF                  <<02845>>46550000
                        BEGIN                                  <<02845>>46555000
                           << 0 >>                             <<02845>>46560000
                           IF NOT PROCENHANCE THEN             <<02845>>46565000
                              RETURN;                          <<02845>>46570000
                           << 1 >>                             <<02845>>46575000
                           IF NOT PROCFORMAT THEN              <<02845>>46580000
                              RETURN;                          <<02845>>46585000
                           << 2 >>                             <<02845>>46590000
                           IF NOT PROCPRIORITY THEN            <<02845>>46595000
                              RETURN;                          <<02845>>46600000
                           << 3 >>                             <<02845>>46605000
                           PROG'PARM.BLANKS := 1;              <<02845>>46610000
                        END                                    <<02845>>46615000
                  ELSE << unknown keyword >>                   <<02845>>46620000
                     BEGIN                                     <<02845>>46625000
                        CIERR(ERRNUM := UNKNOWNKEY,PARMPTR);   <<02845>>46630000
                        RETURN;                                <<02845>>46635000
                     END;                                      <<02845>>46640000
               END;                                            <<02845>>46645000
         END << keyword loop >>                                <<02845>>46650000
      UNTIL NEXTDELIM <> SEMICOLON;                            <<02845>>46655000
      IF NEXTDELIM <> CR THEN                                  <<02845>>46660000
         BEGIN                                                 <<02845>>46665000
            CIERR(ERRNUM := EXPECTSEMIC,PARMPTR(PARMLEN));     <<02845>>46670000
            RETURN;                                            <<02845>>46675000
         END;                                                  <<02845>>46680000
   END; << PARAMETERS EXIST >>                                 <<02845>>46685000
SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>          <<02.MM>>46690000
                                                               <<00184>>46695000
IF MANAGER                                                     <<00184>>46700000
  THEN MOVE ENTRYNAME := "TTSMGR "                             <<00184>>46705000
  ELSE MOVE ENTRYNAME := "  ";                                 <<00184>>46710000
                                                               <<00184>>46715000
MOVE SYSFILENAME := "TTSUSER.PUB.SYS ";                        <<01165>>46720000
CREATE(SYSFILENAME,ENTRYNAME,PIN,PROG'PARM,1);                 <<02845>>46725000
IF CARRY THEN   <<CREATE OF IML SUBSYSTEM FAILED>>             <<01424>>46730000
   BEGIN                                                       <<00184>>46735000
   SCAN SYSFILENAME UNTIL "..",1;                              <<00184>>46740000
   BPS0 := 0;       << DELIMIT STRING >>                       <<00184>>46745000
   DEL;                                                        <<00184>>46750000
   IF CREATEERROR THEN                                         <<00184>>46755000
      CIERR(ERRNUM := SUBSYSCREATEERR,,0,@SYSFILENAME)         <<00184>>46760000
   ELSE   <<LOAD FAILED>>                                      <<00184>>46765000
      CIERR(ERRNUM := SUBSYSLOADERR,,0,@SYSFILENAME);          <<00184>>46770000
   END                                                         <<00184>>46775000
ELSE IF < THEN   <<TTSUSER.PUB.SYS NOT FOUND>>                 <<00184>>46780000
   BEGIN                                                       <<00184>>46785000
   SCAN SYSFILENAME UNTIL "..",1;                              <<00184>>46790000
   BPS0 := 0;       << DELIMIT STRING >>                       <<00184>>46795000
   DEL;                                                        <<00184>>46800000
   CIERR(ERRNUM := SUBSNOTFOUND, , 0,@SYSFILENAME);            <<00184>>46805000
   END                                                         <<00184>>46810000
ELSE   <<EVERYTHING OK, DO IT>>                                <<00184>>46815000
   BEGIN                                                       <<00184>>46820000
   AWAKE(PIN*PCBSIZE,1,2);   <<FIRE UP SUBSYSTEM>>             <<00184>>46825000
   CISUBSYSFINISH(0, ERRNUM, PARMNUM);                         <<00184>>46830000
   END;                                                        <<00184>>46835000
END;   <<CX3270, CX3270MGR>>                                   <<00184>>46840000
PROCEDURE CX3270CONTROL EXECUTORHEAD;                          <<01165>>46845000
  OPTION PRIVILEGED,UNCALLABLE;                                <<01165>>46850000
BEGIN                                                          <<01165>>46855000
  BYTE ARRAY PROC'NAME(0:17);                                  <<01424>>46860000
  BYTE ARRAY ERRMSG(0:4);                                      <<01538>>46865000
  INTEGER MSG'LEN;                                             <<01538>>46870000
  INTEGER PROC'ID, PLABEL, X=X;                                <<01424>>46875000
  DEFINE ASMB = ASSEMBLE#;                                     <<01424>>46880000
  INTRINSIC LOADPROC,UNLOADPROC;                               <<01424>>46885000
                                                               <<01424>>46890000
  SUBROUTINE CXIMLCONTROL EXECUTORHEAD;                        <<01424>>46895000
    BEGIN                                                      <<01424>>46900000
    X := TOS;  << SAVE RETURN ADDRESS >>                       <<01424>>46905000
    TOS := PLABEL;                                             <<01424>>46910000
    ASMB( PCAL 0 );                                            <<01424>>46915000
    TOS := X;                                                  <<01424>>46920000
    RETURN 0;  << PROCEDURE DELETED PARMS >>                   <<01424>>46925000
    END;                                                       <<01424>>46930000
                                                               <<01424>>46935000
  MOVE PROC'NAME := "CXIMLCONTROL ";                           <<01424>>46940000
  PROC'ID := LOADPROC(PROC'NAME,0,PLABEL);                     <<01424>>46945000
  IF <> THEN                                                   <<01424>>46950000
    BEGIN                                                      <<01424>>46955000
    MOVE ERRMSG := "IML",2;                                    <<01538>>46960000
    MSG'LEN :=TOS - @ERRMSG;                                   <<01538>>46965000
    ERRMSG(MSG'LEN) := 0;                                      <<01538>>46970000
    CIERR(ERRNUM := SUBSNOTFOUND,,0,@ERRMSG);                  <<01538>>46975000
    RETURN;                                                    <<01424>>46980000
    END;                                                       <<01424>>46985000
                                                               <<01424>>46990000
  CXIMLCONTROL(PARMSP,ERRNUM,PARMNUM);                         <<01424>>46995000
                                                               <<01424>>47000000
  UNLOADPROC(PROC'ID);                                         <<01424>>47005000
                                                               <<01424>>47010000
END;  <<CX3270CONTROL>>                                        <<01424>>47015000
$CONTROL SEGMENT = CISUBS                                      <<U.RAO>>47020000
      PROCEDURE CXRJE EXECUTORHEAD;                                     47025000
      OPTION PRIVILEGED,UNCALLABLE;                                     47030000
      BEGIN                                                             47035000
      BYTE ARRAY PROGFILE(0:11);                                        47040000
      BYTE ARRAY BUILDNAME(0:7);                                        47045000
      INTEGER NUMPARMS,PCNT:=-1;                                        47050000
      DOUBLE ARRAY PARMS(0:4);                                 <<U.RAO>>47055000
      LBPARMDECS;                                                       47060000
      LOGICAL COMCR:=%26015,T:=1,PARM:=0,PIN;                           47065000
      BYTE POINTER FNAME;                                               47070000
      SUBROUTINE CLEANUP;                                               47075000
         BEGIN                                                          47080000
         DELIMPFILE(PARM,BUILDNAME);                                    47085000
         END;<<CLEAN UP>>                                               47090000
      MOVE PROGFILE:="RJE.PUB.SYS ";                                    47095000
      MOVE BUILDNAME:="RJE";                                            47100000
      MYCOMMAND(PARMSP,COMCR,5,NUMPARMS,PARMS);                <<U.RAO>>47105000
      IF NUMPARMS>4 THEN  <<TOO MANY PARAMETERS FOR RJE>>      <<U.RAO>>47110000
         BEGIN                                                 <<U.RAO>>47115000
         PARMNUM := 5;                                         <<U.RAO>>47120000
         TOS := ERRNUM := SUBS2MP;                             <<U.RAO>>47125000
         TOS := LPARM(8);                                      <<U.RAO>>47130000
         CIERR(*,*,%10000,4);                                  <<U.RAO>>47135000
         RETURN                                                <<U.RAO>>47140000
         END;                                                  <<U.RAO>>47145000
      WHILE(PCNT:=PCNT+1)<NUMPARMS DO                                   47150000
      IF (T:=BPARM(2+PCNT&ASL(2)))<>0 THEN                              47155000
         BEGIN                                                          47160000
         @FNAME:=LPARM(PCNT&ASL(1));                                    47165000
         CASE PCNT OF                                                   47170000
            BEGIN                                                       47175000
               BEGIN<<COMMAND>>                                         47180000
               MOVE BUILDNAME(3):="COM ";                               47185000
               PARM.(15:1):=1;                                          47190000
               END;                                                     47195000
               BEGIN<<INPUT>>                                           47200000
               MOVE BUILDNAME(3):="IN ";                                47205000
               PARM.(13:1):=1;                                          47210000
               END;                                                     47215000
               BEGIN<<LIST>>                                            47220000
               MOVE BUILDNAME(3):="LIST ";                              47225000
               PARM.(14:1):=1;                                          47230000
               END;                                                     47235000
               BEGIN<<PUNCH>>                                           47240000
               MOVE BUILDNAME(3):="PUNCH ";                             47245000
               PARM.(12:1):=1;                                          47250000
               END;                                                     47255000
           END;                                                         47260000
           ERRNUM := CYIMPLCTFILE'(BUILDNAME,FNAME,T);         <<U.RAO>>47265000
           IF <> THEN   <<ERROR IN NAME>>                      <<U.RAO>>47270000
              BEGIN                                            <<U.RAO>>47275000
              CLEANUP;                                         <<U.RAO>>47280000
              PARMNUM :=2;                                     <<U.RAO>>47285000
              RETURN                                           <<U.RAO>>47290000
              END;                                             <<U.RAO>>47295000
         END;                                                  <<U.RAO>>47300000
      SETJCW(GETJCW LAND %37777);  <<CLEAR JCW ABORT BITS>>    <<02.MM>>47305000
      TOS := TOS+0;  <<CLEAR CARRY BEFORE CREATE>>             <<U.RAO>>47310000
      CREATE(PROGFILE,,PIN,PARM,1);                                     47315000
      IF CARRY THEN                                                     47320000
         BEGIN                                                          47325000
         CLEANUP;                                                       47330000
         PROGFILE(3) := 0;  <<SET UP RJE AS PARM TO GENMSG>>   <<U.RAO>>47335000
         IF CREATEERROR THEN                                   <<U.RAO>>47340000
            CIERR(ERRNUM := SUBSYSCREATEERR,,0,@PROGFILE)      <<U.RAO>>47345000
         ELSE                                                  <<U.RAO>>47350000
            CIERR(ERRNUM := SUBSYSLOADERR,,0,@PROGFILE);       <<U.RAO>>47355000
         RETURN;                                               <<U.RAO>>47360000
         END;                                                           47365000
      IF< THEN                                                          47370000
         BEGIN                                                          47375000
         CLEANUP;                                                       47380000
         PROGFILE(3) := 0;                                     <<U.RAO>>47385000
         CIERR(ERRNUM := SUBSNOTFOUND,,0,@PROGFILE);           <<04785>>47390000
         RETURN;                                               <<U.RAO>>47395000
         END;                                                           47400000
      NEXTLINE;                                                         47405000
      AWAKE(PIN*PCBSIZE,1,2);                                           47410000
      CLEANUP;                                                          47415000
      CISUBSYSFINISH(3, ERRNUM, PARMNUM);                      <<U.RAO>>47420000
END;   <<CXRJE>>                                               <<U.RAO>>47425000
   INTEGER PROCEDURE CYIMPLCTFILE'(LHS,RHS,LENR);              <<U.RAO>>47430000
   VALUE LENR;                                                 <<U.RAO>>47435000
   INTEGER LENR;                                               <<U.RAO>>47440000
   BYTE ARRAY LHS, RHS;                                        <<U.RAO>>47445000
   OPTION PRIVILEGED, UNCALLABLE;                              <<U.RAO>>47450000
                                                               <<U.RAO>>47455000
BEGIN                                                          <<U.RAO>>47460000
<< This procedure does implicit file equates for >>            <<U.RAO>>47465000
<< the subsystem commands.  For example, it does >>            <<U.RAO>>47470000
<< an equate SPLTEXT = <user supplied file name> >>            <<U.RAO>>47475000
<< for the SPL compiler, if required.  File      >>            <<U.RAO>>47480000
<< equates should only be done if the user       >>            <<U.RAO>>47485000
<< explicitly provided a file name.  The usual   >>            <<U.RAO>>47490000
<< communication path to the compilers is through>>            <<U.RAO>>47495000
<< the PARM parameter in the CREATE intrinsic.   >>            <<U.RAO>>47500000
<< See the individual subsystem for specifics.   >>            <<U.RAO>>47505000
<< Incidentally, the reader should note that     >>            <<U.RAO>>47510000
<< this routine is responsible for parsing the   >>            <<U.RAO>>47515000
<< user supplied file name and for reporting     >>            <<U.RAO>>47520000
<< errors related to the procedure's inability   >>            <<U.RAO>>47525000
<< to add the equate to the JDT.  A companion    >>            <<U.RAO>>47530000
<< procedure, DELIMPFILE, deletes the file equate>>            <<U.RAO>>47535000
<< on termination of the compiler.               >>            <<U.RAO>>47540000
                                                               <<U.RAO>>47545000
INTEGER RESULTSPACE=CYIMPLCTFILE';                             <<U.RAO>>47550000
BYTE BLANK := " ";                                             <<U.RAO>>47555000
      LOGICAL ARRAY FENTRY(0:31);                              <<U.RAO>>47560000
BYTE ARRAY BFENTRY(*) = FENTRY;                                <<U.RAO>>47565000
BYTE POINTER BGPTR := @BLANK,                                  <<U.RAO>>47570000
             BAPTR := @BLANK,                                  <<U.RAO>>47575000
             BERRPTR;                                          <<U.RAO>>47580000
LOGICAL GPTR = BGPTR,                                          <<U.RAO>>47585000
        APTR = BAPTR,                                          <<U.RAO>>47590000
        ERRPTR = BERRPTR;                                      <<U.RAO>>47595000
LOGICAL SYSFLAG := FALSE;                                      <<U.RAO>>47600000
INTEGER                                                        <<04980>>47605000
   DISPOS'INDX,                                                <<04980>>47610000
   FOPTION'INDX,                                               <<04980>>47615000
   FILLERLEN,                                                  <<04980>>47620000
   FENTRYLEN;       << LENGTH OF FEQ WORK ENTRY FROM THE >>    <<04980>>47625000
                    << PMASK WORD TO/INCLUDING "LENGTH   >>    <<04980>>47630000
                    << FORMS=" WORD                      >>    <<04980>>47635000
EQUATE                                                         <<04980>>47640000
   FILLER     = 0,                                             <<04980>>47645000
   JDTWORKLEN = 15; << work length-len of actual name >>       <<06566>>47650000
                                                               <<U.RAO>>47655000
CC := CCE;                                                     <<U.RAO>>47660000
<<FIRST TASK IS TO CHECK VALIDITY OF FILE NAME>>               <<U.RAO>>47665000
TOS := 0;                                                      <<U.RAO>>47670000
TOS := @RHS;                                                   <<U.RAO>>47675000
TOS := LENR;                                                   <<U.RAO>>47680000
TOS := CHECKFILENAME'(*,GPTR,APTR,ERRPTR);                     <<U.RAO>>47685000
IF < THEN  <<ERROR IN PARSING NAME>>                           <<U.RAO>>47690000
   BEGIN                                                       <<U.RAO>>47695000
   CYIMPLCTFILE' := S0;                                        <<U.RAO>>47700000
   CC := CCG;                                                  <<U.RAO>>47705000
   CIERR(*,BERRPTR);                                           <<U.RAO>>47710000
   RETURN                                                      <<U.RAO>>47715000
   END                                                         <<U.RAO>>47720000
ELSE IF > THEN                                                 <<U.RAO>>47725000
   IF S0=0 THEN  <<BACK REFERENCED FILE NAME>>                 <<U.RAO>>47730000
      BEGIN                                                    <<U.RAO>>47735000
      DEL;                                                     <<U.RAO>>47740000
      FENTRY := 1;  <<NAME PRESENT BIT IN PMASK>>              <<U.RAO>>47745000
      FENTRY(1) := %1000;  <<SET POINTER BIT>>                 <<U.RAO>>47750000
      FENTRY(2) := (LENR-1)&LSL(8);  <<NAME LENGTH>>           <<U.RAO>>47755000
      MOVE BFENTRY(6) := RHS(1),(LENR-1);                      <<U.RAO>>47760000
      TOS := XADDJTENTRY(LHS,BLANK,BLANK,-3,(14+LENR&LSR(1)),  <<U.RAO>>47765000
                 FENTRY,RHS(1),BGPTR,BAPTR);                   <<U.RAO>>47770000
      CASE TOS OF                                              <<U.RAO>>47775000
         BEGIN                                                 <<U.RAO>>47780000
         ;  <<OK RETURN>>                                      <<U.RAO>>47785000
         BEGIN                                                 <<U.RAO>>47790000
            CC := CCL;                                         <<U.RAO>>47795000
            CIERR(RESULTSPACE := FEQTABFULL);                  <<U.RAO>>47800000
         END;                                                  <<U.RAO>>47805000
         ;  <<DUPLICATE NAME - CAN'T HAPPEN>>                  <<U.RAO>>47810000
         BEGIN   <<ACTUAL DESIGNATOR NOT FOUND>>               <<U.RAO>>47815000
            CC := CCL;                                         <<U.RAO>>47820000
            QUALIFYFILENAME(RHS(1),BFENTRY);                   <<U.RAO>>47825000
            CIERR(RESULTSPACE := FILEBREFMISADES,,0,@BFENTRY); <<U.RAO>>47830000
         END;                                                  <<U.RAO>>47835000
         BEGIN  <<TOO MANY BACK REFERENCES TO THIS ADESIGNATOR><<U.RAO>>47840000
            CC := CCL;                                         <<U.RAO>>47845000
            QUALIFYFILENAME(RHS(1),BFENTRY);                   <<U.RAO>>47850000
            CIERR(RESULTSPACE := TOOMANYFEQBREF,,0,@BFENTRY);  <<U.RAO>>47855000
         END;                                                  <<U.RAO>>47860000
         BEGIN  << CIRCULAR FILE EQUATION >>                   <<00834>>47865000
            CC := CCL;                                         <<00834>>47870000
            CIERR(RESULTSPACE := CIRCULARFEQ);                 <<00834>>47875000
         END;                                                  <<00834>>47880000
         END;  <<OF CASE>>                                     <<U.RAO>>47885000
      END                                                      <<U.RAO>>47890000
   ELSE                                                        <<U.RAO>>47895000
      BEGIN  <<SYSTEM DEFINED FILE>>                           <<U.RAO>>47900000
      SYSFLAG := TRUE;                                         <<U.RAO>>47905000
      FENTRY := %20;  <<DEFAULT DESIGNATOR BIT>>               <<U.RAO>>47910000
      FENTRY(1) := 0;  <<PMASK WORD 2>>                        <<U.RAO>>47915000
      FENTRY(2) := 0;  <<NAME LENGTH>>                         <<U.RAO>>47920000
      FENTRY(3) := TOS&LSL(3);  <<FOPTIONS WORD>>              <<U.RAO>>47925000
      FENTRY(4) := FILLER; << AOPTIONS WORD >>                 <<04980>>47930000
      MOVE FENTRY(5) := FENTRY(4),(9);     << ZERO OUT ENT.>>  <<04980>>47935000
      TOS := ADDJTENTRY(LHS,BLANK,BLANK,-3,14,FENTRY);         <<04980>>47940000
      IF TOS <> 0 THEN   <<ERROR RETURN FROM DIRECTORY>>       <<U.RAO>>47945000
         BEGIN                                                 <<U.RAO>>47950000
         CC := CCL;                                            <<U.RAO>>47955000
         CIERR(RESULTSPACE := FEQTABFULL);                     <<U.RAO>>47960000
         END;                                                  <<U.RAO>>47965000
      END                                                      <<U.RAO>>47970000
ELSE   <<REGULAR FILE NAME>>                                   <<U.RAO>>47975000
<<********************************************************>>   <<04980>>47980000
<< Regular file name;  Need to add the file equation to   >>   <<04980>>47985000
<< the JDT in the JFEQ table.  When adding a file equation>>   <<04980>>47990000
<< a full file equation must be added, meaning the        >>   <<04980>>47995000
<< FOPTION, AOPTION, # BUFFERS, DISPOSTION, etc fields    >>   <<04980>>48000000
<< be included as part of the file equation entry whether >>   <<04980>>48005000
<< they are used or not.  Because this part of the pro-   >>   <<04980>>48010000
<< cedure does not need the information from the FOPTION  >>   <<04980>>48015000
<< word to the end of the entry those words have been     >>   <<04980>>48020000
<< zeroed out, with the exception of the DISPOSITION word >>   <<04980>>48025000
<< which has a one in it to indicate a SAVE disposition.  >>   <<04980>>48030000
<<********************************************************>>   <<04980>>48035000
   BEGIN                                                       <<U.RAO>>48040000
   FOPTION'INDX := ((LENR+1)&LSR(1)) + 3;    <<INDEX FROM >>   <<04980>>48045000
                                          <<START OF   >>      <<04980>>48050000
                                          <<WORK AREA  >>      <<04980>>48055000
   DISPOS'INDX := ((LENR+1)&LSR(1)) + 5;                       <<04980>>48060000
   FENTRYLEN := ((LENR+1)&LSR(1)) + JDTWORKLEN;                <<04980>>48065000
   FENTRY := 1;  <<NAME PRESENT>>                              <<U.RAO>>48070000
   FENTRY(1) := 0;                                             <<U.RAO>>48075000
   FENTRY(2) := LENR&LSL(8); <<NAME LENGTH IN UPPER BYTE>>     <<U.RAO>>48080000
   MOVE BFENTRY(6) := RHS,(LENR);                              <<U.RAO>>48085000
   FILLERLEN := FENTRYLEN - FOPTION'INDX;                      <<04980>>48090000
   FENTRY(FOPTION'INDX) := FILLER;                             <<04980>>48095000
   MOVE FENTRY(FOPTION'INDX + 1) :=                            <<04980>>48100000
        FENTRY(FOPTION'INDX),(FILLERLEN - 1);                  <<04980>>48105000
   FENTRY(DISPOS'INDX) := 1; << PUT AS SAVE DISPOSITION>>      <<04980>>48110000
   TOS := ADDJTENTRY(LHS,BLANK,BLANK,-3,FENTRYLEN,FENTRY);     <<04980>>48115000
<< FILE EQUATION HAS BEEN ADDED TO JDT AT THIS POINT >>        <<04980>>48120000
   IF TOS <> 0 THEN   <<ERROR RETURN FROM DIRECTORY>>          <<U.RAO>>48125000
      BEGIN                                                    <<U.RAO>>48130000
      CC := CCL;                                               <<U.RAO>>48135000
      CIERR(RESULTSPACE := FEQTABFULL);                        <<U.RAO>>48140000
      END;                                                     <<U.RAO>>48145000
   END;                                                        <<U.RAO>>48150000
END;                                                           <<U.RAO>>48155000
PROCEDURE DELIMPFILE(PARM,FNAME);                                       48160000
                                                                        48165000
<< ======================================================== >> <<06130>>48170000
<<                  PROCEDURE DELIMPLFILE                   >> <<06130>>48175000
<<                                                          >> <<06130>>48180000
<<     THIS PROCEDURE DELETES THE IMPLICIT FILE EQUATIONS   >> <<06130>>48185000
<<     MADE BY VARIOUS COMPILERS AND THE SEGMENTER.  IT     >> <<06130>>48190000
<<     KNOWS WHICH EQUATIONS ARE THERE BY THE BITS SET IN   >> <<06130>>48195000
<<     THE INPUT PARM WORD.                                 >> <<06130>>48200000
<<                                                          >> <<06130>>48205000
<<      ** INPUT **                                         >> <<06130>>48210000
<<            PARM  --  THE LOGICAL WORD WHICH DESCRIBES    >> <<06130>>48215000
<<                      WHICH EQUATES HAVE BEEN MADE AS     >> <<06130>>48220000
<<                      FOLLOWS:                            >> <<06130>>48225000
<<                         BIT            FILE EQUATE       >> <<06130>>48230000
<<                          15            XXXXTEXT          >> <<06130>>48235000
<<                          14            XXXXLIST          >> <<06130>>48240000
<<                          13            XXXXUSL           >> <<06130>>48245000
<<                          12            XXXXMAST          >> <<06130>>48250000
<<                          11            XXXXNEW           >> <<06130>>48255000
<<                          10            XXXXWKSP          >> <<06130>>48260000
<<                                                          >> <<06130>>48265000
<<      ** OUTPUT **                                        >> <<06130>>48270000
<<                                                          >> <<06130>>48275000
<<            NONE                                          >> <<06130>>48280000
                                                               <<06130>>48285000
   VALUE PARM;                                                          48290000
   LOGICAL PARM;                                                        48295000
   BYTE ARRAY FNAME;                                                    48300000
   OPTION PRIVILEGED, UNCALLABLE;                                       48305000
BEGIN LOGICAL BLANK := "  ";                                            48310000
      BYTE POINTER GPNTR := @BLANK;                                     48315000
      INTEGER I := 0;                                                   48320000
      BYTE ARRAY FTYPES(0:29) = PB :=                                   48325000
         "TEXT LIST USL  MAST NEW  WKSP ";                     <<06130>>48330000
LOOP:                                                                   48335000
      IF PARM THEN                                                      48340000
      BEGIN MOVE FNAME(3) := FTYPES(5*I) , (5);                         48345000
            XREMJTENTRY(FNAME,GPNTR,GPNTR,3)                            48350000
      END;                                                              48355000
      PARM := PARM & LSR(1);                                            48360000
      I := I + 1;                                                       48365000
      IF I < 6 THEN GO TO LOOP;                                <<06130>>48370000
END   <<DELIMPFILE>>;                                                   48375000
$PAGE   "MISC. COMMAND EXECUTORS -- JOB, HELLO,BYE ETC."                48380000
$CONTROL SEGMENT=CIPREPRUN                                     <<04786>>48385000
PROCEDURE SETSTDLIST(PARMPOINT,ERRPTR,ERRORNUM,PARMNUM);       <<04786>>48390000
<<********************************************************>>   <<04786>>48395000
<<                                                        >>   <<04786>>48400000
<<  PROCEDURE NAME: SETSTDLIST                            >>   <<04786>>48405000
<<  PROGRAMMER: MARIE WESTON                              >>   <<04786>>48410000
<<  DATE: JUNE 30, 1982                                   >>   <<04786>>48415000
<<                                                        >>   <<04786>>48420000
<<  PARAMETERS                                            >>   <<04786>>48425000
<<        PARMPOINT--ON INPUT, THIS IS A POINTER TO THE   >>   <<04786>>48430000
<<                   FIRST CHARACTER OF THE INVOKING SUB- >>   <<04786>>48435000
<<                   STRING.  ON OUTPUT, THIS POINTS TO   >>   <<04786>>48440000
<<                   THE DELIMITER FOLLOWING THE INVOKING >>   <<04786>>48445000
<<                   SUBSTRING.                           >>   <<04786>>48450000
<<                                                        >>   <<04786>>48455000
<<        ERRPTR   --THIS POINTER IS UNDEFINED ON INPUT.  >>   <<04786>>48460000
<<                   IN CASE OF AN ERROR, THIS POINTS TO  >>   <<04786>>48465000
<<                   THE OFFENDING BYTE IN THE PARAMETER  >>   <<04786>>48470000
<<                   STRING ON OUTPUT.                    >>   <<04786>>48475000
<<                                                        >>   <<04786>>48480000
<<        ERRNUM   --THIS INTEGER IS UNDEFINED ON INPUT.  >>   <<04786>>48485000
<<                   IN CASE OF AN ERROR, ON OUTPUT, THIS >>   <<04786>>48490000
<<                   WILL CONTAIN THE CI ERROR NUMBER, OR,>>   <<04786>>48495000
<<                   IF THERE IS NO ERROR, IT WILL CONTAIN>>   <<04786>>48500000
<<                   A ZERO.                              >>   <<04786>>48505000
<<                                                        >>   <<04786>>48510000
<<        PARMNUM  --THIS INTEGER IS INCREMENTED BY TWO   >>   <<04786>>48515000
<<                   EVERY TIME SETSTDLIST IS CALLED TO   >>   <<04786>>48520000
<<                   INDICATE THAT TWO PARAMETERS WERE    >>   <<04786>>48525000
<<                   PROCESSED.                           >>   <<04786>>48530000
<<                                                        >>   <<04786>>48535000
<<                                                        >>   <<04786>>48540000
<<  DESCRIPTION:  THIS PROCEDURE EXECUTES THE "STDLIST"   >>   <<04786>>48545000
<<    OPTION OF THE "SET" COMMAND WHICH IS USED TO FLAG   >>   <<04786>>48550000
<<    THE STDLIST SPOOLFILE FOR DELETION OR SALVATION     >>   <<04786>>48555000
<<    DEPENDING ON THE OPTION SPECIFIED.  THE ACCOUNT     >>   <<04786>>48560000
<<    PASSWORD BIT IN THE FIRST WORD OF THE JMAT ENTRY IS >>   <<04786>>48565000
<<    USED AS THE FLAG BIT.                               >>   <<04786>>48570000
<<                                                        >>   <<04786>>48575000
<<********************************************************>>   <<04786>>48580000
                                                               <<04786>>48585000
                                                               <<04786>>48590000
  BYTE POINTER PARMPOINT;                                      <<04786>>48595000
  BYTE POINTER ERRPTR;                                         <<04786>>48600000
  INTEGER ERRORNUM,PARMNUM;                                    <<04786>>48605000
  OPTION PRIVILEGED,UNCALLABLE;                                <<*7882>>48610000
                                                               <<04786>>48615000
BEGIN                                                          <<04786>>48620000
                                                               <<04786>>48625000
  EQUATE                                                       <<04786>>48630000
    EQUALS=0,                 <<  DELIMITER NUMBER         >>  <<04786>>48635000
    SAVE=2,                                                    <<04786>>48640000
    DELETE=1,                                                  <<04786>>48645000
    REQPARMS=2;               <<  REQUIRED NUMBER OF PARMS >>  <<04786>>48650000
    INTRINSIC FFILEINFO;                                       <<04786>>48655000
                                                               <<04786>>48660000
  INTEGER                                                      <<04786>>48665000
    ENTRYNO,                  <<  DICTIONARY ENTRY NUMBER  >>  <<04786>>48670000
    TEMPERR,                  <<  ERROR DURING DB EXCHANGE >>  <<04786>>48675000
    NUMPARMS,                 <<  FOR MYCOMMAND RESULTS    >>  <<04786>>48680000
    OPTIONLEN;                <<  LENGTH OF STDLIST OPTION >>  <<04786>>48685000
                                                               <<04786>>48690000
  ARRAY QARRAY(*) = Q+0;                                       <<06567>>48695000
  INTEGER PCBGLOBLOC;                                          <<06567>>48700000
                                                               <<06567>>48705000
  LOGICAL                                                      <<04786>>48710000
    OK,                       <<  FLAG FOR SPOOLED STATUS  >>  <<04786>>48715000
    STATUS,                   <<  SPOOLED STATUS RETURNED  >>  <<04786>>48720000
    SAVESIR;                  <<  FOR RETURN FROM GETSIR   >>  <<04786>>48725000
                                                               <<04786>>48730000
  <<          SET UP OPTION DICTIONARY                     >>  <<04786>>48735000
                                                               <<04786>>48740000
  BYTE ARRAY DICT(0:1)=PB:=                                    <<04786>>48745000
    8,6,"DELETE",                                              <<04786>>48750000
    6,4,"SAVE",                                                <<04786>>48755000
    0;                                                         <<04786>>48760000
  EQUATE DICTLEN=15;                                           <<04786>>48765000
  BYTE ARRAY LOCALDICT(0:DICTLEN-1);                           <<04786>>48770000
                                                               <<04786>>48775000
  <<          SET UP MYCOMMAND PARAMETERS                  >>  <<04786>>48780000
                                                               <<04786>>48785000
  DOUBLE                                                       <<04786>>48790000
    DUMMY1,                                                    <<04786>>48795000
    DUMMY2,                                                    <<04786>>48800000
    DUMMY3;                                                    <<04786>>48805000
  DOUBLE ARRAY NEWPARMS(*)=DUMMY1;                             <<04786>>48810000
  LOGICAL DELIMWORD=DUMMY1+1;                                  <<04786>>48815000
  LOGICAL OPTWORD=DUMMY2+1;                                    <<04786>>48820000
  DEFINE                                                       <<04786>>48825000
    DELIM=DELIMWORD.(11:5)#,                                   <<04786>>48830000
    PARMLEN=OPTWORD.(0:8)#;                                    <<04786>>48835000
  BYTE POINTER OPTIONPTR=DUMMY2;                               <<04786>>48840000
  DOUBLE DDL:=[8/"=",8/";",16/%6400]D;                         <<04786>>48845000
  BYTE ARRAY DL(*)=DDL;                                        <<04786>>48850000
                                                               <<06571>>48855000
<< ........................................................ >> <<06571>>48860000
<<     Declarations for referencing the JMAT                >> <<06571>>48865000
<<   JMATARR -- A DB+0 array used to reference the JMAT     >> <<06571>>48870000
<<              after an exchange DB                        >> <<06571>>48875000
<<   JMATINX -- An index into the JMATARR to the correct    >> <<06571>>48880000
<<              entry.                                      >> <<06571>>48885000
<< ........................................................ >> <<06571>>48890000
                                                               <<06571>>48895000
   INTEGER ARRAY JMATARR(*) = DB+0;                            <<06571>>48900000
   INTEGER       JMATINX;                                      <<06571>>48905000
                                                               <<06571>>48910000
                                                               <<04786>>48915000
<<                 SET STDLIST MAINLINE                    >>  <<04786>>48920000
                                                               <<04786>>48925000
OK:=FALSE;                                                     <<04786>>48930000
MOVE LOCALDICT:=DICT,(DICTLEN);                                <<04786>>48935000
MYCOMMAND(PARMPOINT,DL,REQPARMS,NUMPARMS,NEWPARMS);            <<04786>>48940000
OPTIONLEN:=PARMLEN;                                            <<04786>>48945000
ENTRYNO:=SEARCH(OPTIONPTR,OPTIONLEN,LOCALDICT);                <<04786>>48950000
                                                               <<04786>>48955000
<<           DO SYNTAX CHECKING ON PARM STRING             >>  <<04786>>48960000
                                                               <<04786>>48965000
IF DELIM<>EQUALS THEN                                          <<04786>>48970000
  BEGIN                                                        <<04786>>48975000
    @ERRPTR:=@PARMPOINT+7;                                     <<04786>>48980000
    ERRORNUM:=NO'EQUALS;                                       <<04786>>48985000
  END                                                          <<04786>>48990000
ELSE IF ENTRYNO=0 THEN                                         <<04786>>48995000
  BEGIN                                                        <<04786>>49000000
    @ERRPTR:=@OPTIONPTR;                                       <<04786>>49005000
    ERRORNUM:=BAD'OPTION;                                      <<04786>>49010000
  END                                                          <<04786>>49015000
ELSE                                                           <<04786>>49020000
                                                               <<04786>>49025000
<<    NOW CHECK IF PROCESS IS A JOB WITH A SPOOLED STDLIST  >> <<04786>>49030000
                                                               <<04786>>49035000
  BEGIN                                                        <<04786>>49040000
    TEMPERR:=0;                                                <<04786>>49045000
    FFILEINFO(2,38,STATUS);                                    <<04786>>49050000
    IF STATUS <> 0 THEN                                        <<04786>>49055000
       OK:=TRUE;                                               <<04786>>49060000
                                                               <<04786>>49065000
<<    GET JMAT INDEX AND LOCK THE JMAT                     >>  <<04786>>49070000
                                                               <<04786>>49075000
    PXGLOBAL;                                                  <<06567>>49080000
    JMATINX  := PXG'JMATINX * JMATENTRYSIZE;                   <<06571>>49085000
    SAVESIR := GETSIR(JMATSIR);                                <<04786>>49090000
    EXCHANGEDB(JMATDST);                                       <<04786>>49095000
    IF OK THEN                                                 <<04786>>49100000
                                                               <<04786>>49105000
<<   NOW CHECK IF THE OPTION IS ALREADY IN EFFECT. IF IT   >>  <<04786>>49110000
<<   ISN'T THEN CHANGE THE FLAG BY COMPLEMENTING THE BIT.   >> <<04786>>49115000
                                                               <<04786>>49120000
      IF (JMATSAVESTDLIST=0 LAND ENTRYNO=SAVE)                 <<06571>>49125000
                      LOR                                      <<04786>>49130000
         (JMATSAVESTDLIST=1 LAND ENTRYNO=DELETE)  THEN         <<06571>>49135000
         TEMPERR:=-ALREADY                                     <<04786>>49140000
      ELSE                                                     <<04786>>49145000
         JMATSAVESTDLIST := JMATSAVESTDLIST + 1                <<06571>>49150000
    ELSE                                                       <<04786>>49155000
      TEMPERR:=NOT'SPOOLED;                                    <<04786>>49160000
                                                               <<04786>>49165000
<<  RESTORE THE OLD DB AND RELEASE THE JMATSIR        >>       <<04786>>49170000
                                                               <<04786>>49175000
    EXCHANGEDB(0);                                             <<04786>>49180000
    RELSIR(JMATSIR,SAVESIR);                                   <<04786>>49185000
    ERRORNUM:=TEMPERR;                                         <<04786>>49190000
    @ERRPTR:=@PARMPOINT;                                       <<04786>>49195000
  END;                                                         <<04786>>49200000
                                                               <<04786>>49205000
<<     MOVE PARMPOINT TO COMMAND DELIMITER                   >><<04786>>49210000
                                                               <<04786>>49215000
  @PARMPOINT:=@OPTIONPTR+OPTIONLEN;                            <<04786>>49220000
  SCAN PARMPOINT WHILE "  ",1;                                 <<04786>>49225000
  @PARMPOINT:=TOS;                                             <<04786>>49230000
                                                               <<04786>>49235000
<<     INCREMENT BY NUMBER OF PARAMETERS PROCESSED    >>       <<04786>>49240000
                                                               <<04786>>49245000
  PARMNUM:=PARMNUM+2;                                          <<04786>>49250000
END;                                                           <<04786>>49255000
                                                               <<04786>>49260000
$CONTROL SEGMENT=CIPREPRUN                                     <<04786>>49265000
PROCEDURE CXSET EXECUTORHEAD;                                  <<04786>>49270000
OPTION PRIVILEGED,UNCALLABLE;                                  <<*7882>>49275000
<<*********************************************************>>  <<04786>>49280000
<<                                                         >>  <<04786>>49285000
<<  PROCEDURE NAME: CXSET                                  >>  <<04786>>49290000
<<  PROGRAMMER: MARIE WESTON                               >>  <<04786>>49295000
<<  DATE: JUNE 30, 1982                                    >>  <<04786>>49300000
<<                                                         >>  <<04786>>49305000
<<  DESCRIPTION:  THIS PROCEDURE PARSES THE "SET" COMMAND  >>  <<04786>>49310000
<<    PARAMETER THEN CALLS THE PROCEDURE NEEDED TO EXECUTE >>  <<04786>>49315000
<<    THAT COMMAND.  TO ADD A NEW OPTION TO THE COMMAND,   >>  <<04786>>49320000
<<    YOU MUST:                                            >>  <<04786>>49325000
<<       (1)  PUT THE OPTION NAME INTO THE DICTIONARY      >>  <<04786>>49330000
<<       (2)  INCREASE THE VALUE OF "DICTLEN" ACCORDINGLY  >>  <<04786>>49335000
<<       (3)  PUT THE PROCEDURE CALL INTO THE CASE STMT    >>  <<04786>>49340000
<<                                                         >>  <<04786>>49345000
<<*********************************************************>>  <<04786>>49350000
                                                               <<04786>>49355000
  BEGIN                                                        <<04786>>49360000
                                                               <<04786>>49365000
  BYTE ARRAY DICT(0:1)=PB:=                                    <<04786>>49370000
    9,7,"STDLIST",                                             <<04786>>49375000
    0;                                                         <<04786>>49380000
  EQUATE DICTLEN=10;                                           <<04786>>49385000
  BYTE ARRAY LOCALDICT(0:DICTLEN-1);                           <<04786>>49390000
  BYTE POINTER                                                 <<04786>>49395000
    PARMPOINT,                    << POINTS TO CURRENT PARM  >><<04786>>49400000
    ERRPTR;                                                    <<04786>>49405000
                                                               <<04786>>49410000
  INTEGER                                                      <<04786>>49415000
    ENTRYNO,                      << DICTIONARY ENTRY NUMBER >><<04786>>49420000
    ERRORNUM,                                                  <<04786>>49425000
    PARMLEN;                      << PARAMETER LENGTH        >><<04786>>49430000
                                                               <<04786>>49435000
  LOGICAL                                                      <<04786>>49440000
    STILLPARSE;                   << CONTINUE PARSING FLAG   >><<04786>>49445000
                                                               <<04786>>49450000
  EQUATE                                                       <<04786>>49455000
    CR=%15,                       << CARRIAGE RETURN         >><<04786>>49460000
    SEMICOL=";";                                               <<04786>>49465000
                                                               <<04786>>49470000
                                                               <<04786>>49475000
                                                               <<04786>>49480000
MOVE LOCALDICT:=DICT,(DICTLEN);                                <<04786>>49485000
@PARMPOINT:=@PARMSP(0);                                        <<04786>>49490000
ERRORNUM:=0;                                                   <<04786>>49495000
STILLPARSE:=TRUE;                                              <<04786>>49500000
                                                               <<04786>>49505000
WHILE STILLPARSE DO                                            <<04786>>49510000
  BEGIN                                                        <<04786>>49515000
    PARMNUM:=PARMNUM+1;                                        <<04786>>49520000
    SCAN PARMPOINT WHILE "  ",1;                               <<04786>>49525000
    @PARMPOINT := TOS;                                         <<04786>>49530000
    IF PARMPOINT<>ALPHA THEN                                   <<04786>>49535000
      BEGIN                                                    <<04786>>49540000
        @ERRPTR:=@PARMPOINT;                                   <<04786>>49545000
        ERRORNUM:=NONALPHA;                                    <<04786>>49550000
      END                                                      <<04786>>49555000
    ELSE                                                       <<04786>>49560000
      BEGIN                                                    <<04786>>49565000
        MOVE PARMPOINT:=PARMPOINT WHILE ANS,1;                 <<04786>>49570000
        PARMLEN:=TOS-@PARMPOINT;                               <<04786>>49575000
        ENTRYNO:=SEARCH(PARMPOINT,PARMLEN,LOCALDICT);          <<04786>>49580000
        CASE ENTRYNO OF                                        <<04786>>49585000
         BEGIN                                                 <<04786>>49590000
                                                               <<04786>>49595000
           BEGIN                     <<  OPTION NOT FOUND  >>  <<04786>>49600000
             @ERRPTR:=@PARMPOINT;                              <<04786>>49605000
             ERRORNUM:=INVALID'PARM;                           <<04786>>49610000
           END;                                                <<04786>>49615000
                                                               <<04786>>49620000
           SETSTDLIST(PARMPOINT,ERRPTR,ERRORNUM,PARMNUM);      <<04786>>49625000
                                                               <<04786>>49630000
         END;                                                  <<04786>>49635000
                                                               <<04786>>49640000
<<    IF COMMAND DELIMITER IS A SEMICOLON--CONTINUE PARSING,>> <<04786>>49645000
<<    A CR: THEN STOP PARSING;  ANYTHING ELSE IS AN ERROR   >> <<04786>>49650000
                                                               <<04786>>49655000
        IF (PARMPOINT=SEMICOL) AND (ERRORNUM=0)  THEN          <<04786>>49660000
           @PARMPOINT:=@PARMPOINT+1                            <<04786>>49665000
        ELSE                                                   <<04786>>49670000
          IF (PARMPOINT<>CR) AND (ERRORNUM=0)  THEN            <<04786>>49675000
            BEGIN                                              <<04786>>49680000
              @ERRPTR:=@PARMPOINT;                             <<04786>>49685000
              ERRORNUM:=-UNEXP'DELIM;                          <<04786>>49690000
            END                                                <<04786>>49695000
          ELSE                                                 <<04786>>49700000
            STILLPARSE:=FALSE;                                 <<04786>>49705000
      END;                                                     <<04786>>49710000
                                                               <<04786>>49715000
<<      TAKE CARE OF ANY ERRORS                      >>        <<04786>>49720000
                                                               <<04786>>49725000
      IF ERRORNUM<>0 THEN                                      <<04786>>49730000
        BEGIN                                                  <<04786>>49735000
          ERRNUM:=ERRORNUM;                                    <<04786>>49740000
          CIERR(ERRNUM,ERRPTR);                                <<04786>>49745000
          IF ERRNUM>0 THEN                                     <<04786>>49750000
             RETURN;                                           <<04786>>49755000
        END;                                                   <<04786>>49760000
                                                               <<04786>>49765000
  END;                                                         <<04786>>49770000
END;                                                           <<04786>>49775000
$CONTROL SEGMENT=CIPREPRUN                                     <<U.RAO>>49780000
      PROCEDURE CXSETMSG EXECUTORHEAD;                                  49785000
      OPTION PRIVILEGED,UNCALLABLE;                                     49790000
      BEGIN                                                             49795000
DOUBLE ARRAY PARMS(0:1)=Q;                                     <<U.RAO>>49800000
ARRAY QARRAY(*)=Q+0;                                           <<06567>>49805000
INTEGER PCBGLOBLOC;                                            <<06567>>49810000
BYTE POINTER BPARM = PARMS;  <<POINTER TO ARGUMENT>>           <<U.RAO>>49815000
BYTE BPARMLEN = PARMS+1;     <<ARGUMENT LENGTH>>               <<U.RAO>>49820000
BYTE POINTER EXTRAPARM = PARMS+2;                              <<U.RAO>>49825000
DOUBLE DDL := [8/",",8/";",16/%6400]D;                         <<U.RAO>>49830000
BYTE ARRAY DL(*)=DDL;                                          <<U.RAO>>49835000
INTEGER NUMPARMS;                                              <<U.RAO>>49840000
                                                               <<06571>>49845000
<< ........................................................ >> <<06571>>49850000
<<     Declarations for referencing the JMAT                >> <<06571>>49855000
<<   JMATARR -- A DB+0 array used to reference the JMAT     >> <<06571>>49860000
<<              after an exchange DB                        >> <<06571>>49865000
<<   JMATINX -- An index into the JMATARR to the correct    >> <<06571>>49870000
<<              entry.                                      >> <<06571>>49875000
<< ........................................................ >> <<06571>>49880000
                                                               <<06571>>49885000
   INTEGER ARRAY JMATARR(*) = DB+0;                            <<06571>>49890000
   INTEGER       JMATINX;                                      <<06571>>49895000
                                                               <<06571>>49900000
MYCOMMAND(PARMSP,DL,2,NUMPARMS,PARMS);                         <<U.RAO>>49905000
IF NUMPARMS = 0 THEN   <<NOT ENOUGH PARMS>>                    <<U.RAO>>49910000
   BEGIN                                                       <<U.RAO>>49915000
   CIERR(ERRNUM := SETMSGPARMPROB, PARMSP(1));                 <<U.RAO>>49920000
   PARMNUM := 1;                                               <<U.RAO>>49925000
   END                                                         <<U.RAO>>49930000
ELSE IF NUMPARMS > 1 THEN  <<TOO MANY PARMS>>                  <<U.RAO>>49935000
   BEGIN                                                       <<U.RAO>>49940000
   CIERR(ERRNUM := SETMSGEXTRAPARM, EXTRAPARM);                <<U.RAO>>49945000
   PARMNUM := 2;                                               <<U.RAO>>49950000
   END                                                         <<U.RAO>>49955000
ELSE IF (BPARMLEN=2) AND (BPARM="ON")                          <<U.RAO>>49960000
     OR (BPARMLEN=3) AND (BPARM="OFF") THEN                    <<U.RAO>>49965000
   BEGIN  <<HAVE LEGAL ARGUMENT>>                              <<U.RAO>>49970000
   PXGLOBAL;                                                   <<06567>>49975000
   JMATINX := PXG'JMATINX * JMATENTRYSIZE;                     <<06571>>49980000
   EXCHANGEDB(JMATDST);                                        <<U.RAO>>49985000
                                                               <<06571>>49990000
   <<  The following statement ends up setting the QUIET bit >><<06571>>49995000
   <<  if BPARMLEN = 3.  If BPARMLEN = 2 it clears the bit   >><<06571>>50000000
                                                               <<06571>>50005000
   JMATQUIETMODE := BPARMLEN;  << a cute trick >>              <<06571>>50010000
   EXCHANGEDB(0);                                              <<U.RAO>>50015000
   END                                                         <<U.RAO>>50020000
ELSE  <<UNKNOWN ARGUMENT>>                                     <<U.RAO>>50025000
   BEGIN                                                       <<U.RAO>>50030000
   PARMNUM := 1;                                               <<U.RAO>>50035000
   CIERR(ERRNUM := SETMSGPARMPROB, BPARM);                     <<U.RAO>>50040000
   END;                                                        <<U.RAO>>50045000
END;  <<CXSETMSG>>                                             <<U.RAO>>50050000
      PROCEDURE SETDUMP(FLAGS);                                         50055000
      VALUE FLAGS;                                                      50060000
      LOGICAL FLAGS;                                                    50065000
      BEGIN                                                             50070000
      ARRAY QARRAY(*)=Q+0;                                     <<06567>>50075000
      INTEGER PCBGLOBLOC;                                      <<06567>>50080000
      ERRORON;                                                          50085000
      PXGLOBAL;                                                <<06567>>50090000
      FLAGS.(10:1):=1;<<ARM>>                                           50095000
      TOS := IF PXG'STKDUMPFLAGS <> 0 THEN 0 ELSE 2;           <<06567>>50100000
      PXG'STKDUMPFLAGS := FLAGS;                               <<06567>>50105000
      STATUS.(6:2):=TOS;<<SET CONDITION CODE>>                          50110000
      ERROREXIT(1,0,0);                                                 50115000
      END;<<SET DUMP>>                                                  50120000
      PROCEDURE RESETDUMP;                                              50125000
      OPTION PRIVILEGED;                                                50130000
      BEGIN                                                             50135000
      ARRAY QARRAY(*)=Q+0;                                     <<06567>>50140000
      INTEGER PCBGLOBLOC;                                      <<06567>>50145000
      ERRORON;                                                          50150000
      PXGLOBAL;                                                <<06567>>50155000
      TOS := IF PXG'STKDUMPFLAGS=0 THEN 0 ELSE 2;              <<06567>>50160000
      PXG'STKDUMPFLAGS := 0;                                   <<06567>>50165000
      STATUS.(6:2):=TOS;                                                50170000
      ERROREXIT(0,0,0);                                                 50175000
      END;<<RESET DUMP>>                                                50180000
PROCEDURE CXSETDUMP EXECUTORHEAD;                              <<U.RAO>>50185000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>50190000
BEGIN                                                          <<U.RAO>>50195000
INTEGER PCNT:=0,  <<PARM COUNT>>                               <<U.RAO>>50200000
        NUMPARMS,                                              <<U.RAO>>50205000
        NEXTDELIM,  <<DELIMITER FOUND AFTER CURRENT TOKEN>>    <<U.RAO>>50210000
        PLEN;   <<LENGTH OF CURRENT PARM>>                     <<U.RAO>>50215000
LOGICAL FLAGS := %20;  <<TEMPLATE FOR DUMP FLAGS>>             <<U.RAO>>50220000
DOUBLE ARRAY PARMS(0:4) = Q;                                   <<U.RAO>>50225000
BYTE POINTER BADPARM = PARMS+8;                                <<U.RAO>>50230000
BYTE POINTER PPNTR;  <<POINTER TO PRESENT TOKEN>>              <<U.RAO>>50235000
DOUBLE DDL := [8/",",8/";",16/%6400]D;                         <<U.RAO>>50240000
BYTE ARRAY DL(*)=DDL;                                          <<U.RAO>>50245000
EQUATE DLEN = 20;  <<LENGTH OF DUMPTYPE ARRAY>>                <<U.RAO>>50250000
BYTE ARRAY DUMPTYPESL(0:DLEN-1) = PB :=                        <<U.RAO>>50255000
   4,2,"ST",                                                   <<U.RAO>>50260000
   4,2,"DB",                                                   <<U.RAO>>50265000
   4,2,"QS",                                                   <<U.RAO>>50270000
   7,5,"ASCII",                                                <<U.RAO>>50275000
   0;                                                          <<U.RAO>>50280000
BYTE ARRAY DUMPTYPES(0:DLEN-1);                                <<U.RAO>>50285000
                                                               <<U.RAO>>50290000
SUBROUTINE GETNEXTPARM;                                        <<U.RAO>>50295000
BEGIN                                                          <<U.RAO>>50300000
TOS := PARMS(PCNT);                                            <<U.RAO>>50305000
NEXTDELIM := S0.(14:2);                                        <<U.RAO>>50310000
PLEN := TOS&LSR(8);                                            <<U.RAO>>50315000
@PPNTR := TOS;                                                 <<U.RAO>>50320000
END;                                                           <<U.RAO>>50325000
                                                               <<U.RAO>>50330000
SUBROUTINE SYNERR;  <<SYNTAX ERROR>>                           <<U.RAO>>50335000
BEGIN                                                          <<U.RAO>>50340000
PARMNUM := PCNT+1;                                             <<U.RAO>>50345000
PPNTR(PLEN) := 0;                                              <<U.RAO>>50350000
CIERR(ERRNUM := SETDUMPUNKNOWN,PPNTR,0,@PPNTR);                <<U.RAO>>50355000
ASSEMBLE(EXIT 3);  <<RETURN>>                                  <<U.RAO>>50360000
END;                                                           <<U.RAO>>50365000
                                                               <<U.RAO>>50370000
MYCOMMAND(PARMSP,DL,5,NUMPARMS,PARMS);                         <<U.RAO>>50375000
PARMNUM := 5;  <<MAX NUMBER OF PARMS>>                         <<U.RAO>>50380000
IF NUMPARMS > 4 THEN                                           <<U.RAO>>50385000
   CIERR(ERRNUM := SETDUMP2MP,BADPARM)                         <<U.RAO>>50390000
ELSE  <<LEGAL NUMBER OF PARMS>>                                <<U.RAO>>50395000
   BEGIN                                                       <<U.RAO>>50400000
   IF NUMPARMS > 0 THEN                                        <<U.RAO>>50405000
      BEGIN  <<PARSE PARMS>>                                   <<U.RAO>>50410000
      MOVE DUMPTYPES := DUMPTYPESL, (DLEN);  <<INIT SEARCH ARRA<<U.RAO>>50415000
      DO   <<LOOP THROUGH PARMS, IDENTIFYING DUMP TYPES>>      <<U.RAO>>50420000
         BEGIN                                                 <<U.RAO>>50425000
         GETNEXTPARM;                                          <<U.RAO>>50430000
         IF PLEN <> 0 THEN  <<PARM IS PRESENT>>                <<U.RAO>>50435000
            CASE SEARCH(PPNTR, PLEN, DUMPTYPES) OF             <<U.RAO>>50440000
               BEGIN                                           <<U.RAO>>50445000
               SYNERR;  <<NON-EXISTANT TYPE>>                  <<U.RAO>>50450000
               FLAGS.(14:1) := 1;  <<ST>>                      <<U.RAO>>50455000
               FLAGS.(15:1) := 1;  <<DB>>                      <<U.RAO>>50460000
               FLAGS.(13:1) := 1;  <<QS>>                      <<U.RAO>>50465000
               BEGIN                                           <<S8764>>50470000
                  FLAGS.(11:1) := 0;  <<ASCII>>                <<S8764>>50475000
                  FLAGS.(12:1) := 1;  <<ASCII BIT>>            <<S8764>>50480000
               END;                                            <<S8764>>50485000
               END;                                            <<U.RAO>>50490000
         PCNT := PCNT+1;                                       <<U.RAO>>50495000
         END                                                   <<U.RAO>>50500000
      UNTIL NEXTDELIM=2;  <<UNTIL FIND CR DELIMITER>>          <<U.RAO>>50505000
      END;                                                     <<U.RAO>>50510000
   SETDUMP(FLAGS);                                             <<U.RAO>>50515000
   END;                                                        <<U.RAO>>50520000
END;  <<CXSETDUMP>>                                            <<U.RAO>>50525000
PROCEDURE CXRESETDUMP EXECUTORHEAD;                            <<U.RAO>>50530000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>50535000
BEGIN                                                          <<U.RAO>>50540000
MYCOMMAND(PARMSP,,0);                                          <<U.RAO>>50545000
IF <> THEN CIERR(ERRNUM := -WARNXPARMSIGNORED,PARMSP);         <<04785>>50550000
RESETDUMP;                                                     <<U.RAO>>50555000
END;                                                           <<U.RAO>>50560000
$CONTROL LIST                                                           50565000
$PAGE "MOVEJDT"                                                << 8499>>50570000
                                                               << 8499>>50575000
                                                               << 8499>>50580000
$CONTROL SEGMENT=CILISTF                                       << 8499>>50585000
                                                               << 8499>>50590000
LOGICAL PROCEDURE MOVEJDT( A );                                << 8765>>50595000
LOGICAL ARRAY A;                                               << 8765>>50600000
OPTION UNCALLABLE;                                             << 8499>>50605000
COMMENT:                                                       << 8499>>50610000
        THIS PROCEDURE FILLS A DB RELATIVE ARRAY A             << 8499>>50615000
        WITH THE CONTENTS OF THE JOB DIRECTORY TABLE.          << 8499>>50620000
        The JDT DST number is pulled from the stack ;          << 8765>>50625000
BEGIN                                                          << 8499>>50630000
LOGICAL ARRAY QARRAY( * ) = Q + 0;                             << 8765>>50635000
LOGICAL PCBGLOBLOC := 0;                                       << 8765>>50640000
LOGICAL JDT'DST;                                               << 8499>>50645000
LOGICAL SIZE;                                                  << 8765>>50650000
                                                               << 8499>>50655000
MOVEJDT := TRUE;  << ASSUME SUCCESS >>                         << 8499>>50660000
                                                               << 8499>>50665000
<< get the JDT DST number from the PXGLOBAL area >>            << 8499>>50670000
                                                               << 8499>>50675000
<< WE MUST RETRIEVE THE JDT DST NUMBER AND MOVE THE DST >>     << 8499>>50680000
PXGLOBAL;                                                      << 8765>>50685000
JDT'DST := PXG'JDTDST;                                         << 8765>>50690000
<< Get the actual JDT length from the DST table >>             << 8765>>50695000
<< Size of data segment size is divided by 4    >>             << 8765>>50700000
<< Need to multiply SIZE by 4.  Entries of DST  >>             << 8765>>50705000
<< are 4 words long.                            >>             << 8765>>50710000
SIZE := DST( JDT'DST * DST'ENTRY'SIZE ).DST'DSEG'SIZE;         << 8765>>50715000
TOS := @A;                                                     << 8499>>50720000
TOS := JDT'DST;                                                << 8499>>50725000
TOS := 0;                                                      << 8499>>50730000
TOS := SIZE * 4;                                               << 8765>>50735000
ASSEMBLE( MFDS 4 );                                            << 8499>>50740000
END;                                                           << 8499>>50745000
$PAGE "PARSELISTEQ"                                            << 8499>>50750000
                                                               << 8499>>50755000
                                                               << 8499>>50760000
<<******************************************************>>     << 8499>>50765000
<<                                                      >>     << 8499>>50770000
<<  PROCEDURE PARSELISTEQ                               >>     << 8499>>50775000
<<                                                      >>     << 8499>>50780000
<<  PURPOSE:  TO PARSE ANY PARAMETERS THAT ARE ENTERED  >>     << 8499>>50785000
<<            WITH THE LISTEQ COMMNAD.  ALL SYNTAX      >>     << 8499>>50790000
<<            ERRORS WILL BE FLAGGED IN THIS PROCEDURE. >>     << 8499>>50795000
<<            AT THIS TIME, THE MAXIMUM NUMBER OF       >>     << 8499>>50800000
<<            PARAMETERS IS 2.  THE SYNTAX OF THE       >>     << 8499>>50805000
<<            COMMAND IS :LISTEQ [listfile]             >>     << 8499>>50810000
<<                                                      >>     << 8499>>50815000
<<******************************************************>>     << 8499>>50820000
LOGICAL PROCEDURE PARSELISTEQ( PARMPOINT, LISTLEN, LISTFILE ); << 8499>>50825000
BYTE POINTER PARMPOINT;                                        << 8499>>50830000
INTEGER LISTLEN;                                               << 8499>>50835000
BYTE POINTER LISTFILE;                                         << 8499>>50840000
OPTION UNCALLABLE;                                             << 8499>>50845000
                                                               << 8499>>50850000
<<*************************************************************<< 8499>>50855000
<<                                                             << 8499>>50860000
<< PARMPOINT - BYTE POINTER TO THE START OF THE PARAMETER STRIN<< 8499>>50865000
<< LISTLEN   - THE LENGTH OF THE BYTE STRING DEPICTING THE LIST<< 8499>>50870000
<<             FILE PARAMETER.  IF ZERO, THE LIST FILE DID NOT << 8499>>50875000
<<             EXIST IN THE PARAMTER LIST.                     << 8499>>50880000
<< LISTFILE  - BYTE POINTER TO THE LISTFILE.                   << 8499>>50885000
<<                                                             << 8499>>50890000
<<*************************************************************<< 8499>>50895000
                                                               << 8499>>50900000
<<   NOW SET UP ALL THE MYCOMMAND PARAMETERS AND THOSE     >>  << 8499>>50905000
<<   NEEDED TO PARSE THE COMMAND                           >>  << 8499>>50910000
                                                               << 8499>>50915000
BEGIN                                                          << 8499>>50920000
DOUBLE ARRAY DPARMS(0:1)=Q;  << Make room for 2 parms.  One for<< 8499>>50925000
                             << listfile and one for error     << 8499>>50930000
INTEGER ARRAY PARMS(*)=DPARMS;                                 << 8499>>50935000
LOGICAL PARSEOK = PARSELISTEQ;                                 << 8499>>50940000
<<                                                           >><< 8499>>50945000
<< THE BREAK DOWN OF PARMS IS AS FOLLOWS:                    >><< 8499>>50950000
<<     PARMS(0) - BYTE POINTER FOR PARAMETER 1.              >><< 8499>>50955000
<<     PARMS(1) - PARAMETER 1 INFORMATION                    >><< 8499>>50960000
<<     PARMS(2) - BYTE POINTER FOR PARAMETER 2.              >><< 8499>>50965000
<<     PARMS(3) - PARAMETER 2 INFORMATION.                   >><< 8499>>50970000
<<                                                           >><< 8499>>50975000
                                                               << 8499>>50980000
DEFINE                                                         << 8499>>50985000
  PARM1'LEN            = PARMS(1).(0:8)#,                      << 8499>>50990000
  PARM2'LEN            = PARMS(3).(0:8)#,                      << 8499>>50995000
  DELIM'FOR'PARM1      = PARMS(1).(11:5)#,                     << 8499>>51000000
  DELIM'FOR'PARM2      = PARMS(3).(11:5)#;                     << 8499>>51005000
                                                               << 8499>>51010000
BYTE POINTER PARM1, PARM2, IPTR;                               << 8499>>51015000
INTEGER ICHECK;  << USED IN SUBROUTINE CHECKIT >>              << 8499>>51020000
                                                               << 8499>>51025000
BYTE POINTER ERRPTR;                                           << 8499>>51030000
                                                               << 8499>>51035000
DOUBLE RDL := [16/%6400,16/%6400]D;                            << 8499>>51040000
BYTE ARRAY RL(*) = RDL;                                        << 8499>>51045000
                                                               << 8499>>51050000
DOUBLE DDL := [8/".",8/",",16/%6400]D;                         << 8499>>51055000
BYTE ARRAY DL(*) = DDL;                                        << 8499>>51060000
                                                               << 8499>>51065000
EQUATE DOT                = 0,                                 << 8499>>51070000
       COMMA              = 1,                                 << 8499>>51075000
       CR                 = 2,                                 << 8499>>51080000
       MAXPARMS           = 1, << The [listfile]          >>   << 8499>>51085000
       MAX'NAME'LEN       = 8,                                 << 8499>>51090000
       GOOD               = 0,                                 << 8499>>51095000
       FILE'NAME'TWO'LONG = 1,                                 << 8499>>51100000
       FIRST'CHAR'BAD     = 2,                                 << 8499>>51105000
       FUNNY'CHAR         = 3,                                 << 8499>>51110000
       IMB'BLK            = 4,                                 << 8499>>51115000
       ZERO'LEN           = 5;                                 << 8499>>51120000
                                                               << 8499>>51125000
                                                               << 8499>>51130000
                                                               << 8499>>51135000
INTEGER NUMPARMS, CHECKF, ERRORNUM;                            << 8499>>51140000
BYTE WILD    := "@",                                           << 8499>>51145000
     STAR    := "*",                                           << 8499>>51150000
     NUM     := "#",                                           << 8499>>51155000
     SINGLE  := "?",                                           << 8499>>51160000
     CAR'RET := %15,                                           << 8499>>51165000
     SPACE   := " ";                                           << 8499>>51170000
$PAGE                                                          << 8499>>51175000
                                                               << 8499>>51180000
<<************************************************************><< 8499>>51185000
<<                                                            ><< 8499>>51190000
<< SUBROUTINE GOOD'FILE                                       ><< 8499>>51195000
<<                                                            ><< 8499>>51200000
<< PURPOSE:  CALLS EXTERNAL PROCEDURE CIBADFILENAME TO        ><< 8499>>51205000
<<           DETERMINE IF THE LIST FILE REPRESENTED BY PARM2  ><< 8499>>51210000
<<           IS IN A LEGAL MPE FILE SYSTEM FORM.  IF NOT,     ><< 8499>>51215000
<<           GOOD'FILE RETURNS FALSE.                         ><< 8499>>51220000
<<                                                            ><< 8499>>51225000
<<************************************************************><< 8499>>51230000
                                                               << 8499>>51235000
LOGICAL SUBROUTINE GOOD'FILE( D'FILE );                        << 8499>>51240000
                                                               << 8499>>51245000
<<***********************************************************>><< 8499>>51250000
<<                                                           >><< 8499>>51255000
<< D'FILE - A DOUBLE ARRAY ELEMENT (AS RETURNED FROM         >><< 8499>>51260000
<<          MYCOMMAND) USED BY CIBADFILENAME.                >><< 8499>>51265000
<<                                                           >><< 8499>>51270000
<<***********************************************************>><< 8499>>51275000
DOUBLE ARRAY D'FILE;                                           << 8499>>51280000
                                                               << 8499>>51285000
BEGIN                                                          << 8499>>51290000
GOOD'FILE := TRUE;                                             << 8499>>51295000
IF CIBADFILENAME( ERRORNUM, D'FILE )                           << 8499>>51300000
   THEN GOOD'FILE := FALSE;                                    << 8499>>51305000
END;    << GOOD'FILE >>                                        << 8499>>51310000
                                                               << 8499>>51315000
$PAGE                                                          << 8499>>51320000
<<                   M A I N   B O D Y                  >>     << 8499>>51325000
                                                               << 8499>>51330000
PARSELISTEQ := TRUE;          << Assume success >>             << 8499>>51335000
                                                               << 8499>>51340000
LISTLEN := 0;                                                  << 8499>>51345000
PARMS(0) := 0;                                                 << 8499>>51350000
MOVE PARMS(1) := PARMS(0),(3);                                 << 8499>>51355000
                                                               << 8499>>51360000
<< Attempt to get the [listfile] and then check for any other ><< 8499>>51365000
<< parameters.  If other parameters are found, flag them.     ><< 8499>>51370000
MYCOMMAND( PARMPOINT, RL, MAXPARMS, NUMPARMS, DPARMS);         << 8499>>51375000
                                                               << 8499>>51380000
@PARM1:=PARMS(0);                                              << 8499>>51385000
@PARM2:=PARMS(2);                                              << 8499>>51390000
                                                               << 8499>>51395000
                                                               << 8499>>51400000
IF NUMPARMS > 0                                                << 8499>>51405000
   THEN IF GOOD'FILE( DPARMS(0) )                              << 8499>>51410000
           THEN BEGIN                                          << 8499>>51415000
                LISTLEN := PARM1'LEN;                          << 8499>>51420000
                @LISTFILE := @PARM1;                           << 8499>>51425000
                END                                            << 8499>>51430000
           ELSE PARSELISTEQ := FALSE;                          << 8499>>51435000
                                                               << 8499>>51440000
                                                               << 8499>>51445000
END;   << Procedure PARSELISTEQ >>                             << 8499>>51450000
                                                               << 8499>>51455000
                                                               << 8499>>51460000
$PAGE "LISTEQ"                                                 << 8499>>51465000
$CONTROL SEGMENT=CILISTF                                       << 8499>>51470000
PROCEDURE CXLISTEQ EXECUTORHEAD;                               << 8499>>51475000
OPTION PRIVILEGED,UNCALLABLE;                                  << 8499>>51480000
BEGIN                                                          << 8499>>51485000
                                                               << 8499>>51490000
<<***********************************************************>><< 8499>>51495000
<<                                                           >><< 8499>>51500000
<< CXLISTEQ: COMMAND EXECUTOR FOR THE LISTEQ COMMAND.        >><< 8499>>51505000
<<                                                           >><< 8499>>51510000
<< THE SYNTAX IS :LISTEQ [Listfile]                          >><< 8499>>51515000
<<                                                           >><< 8499>>51520000
<< Where:                                                    >><< 8499>>51525000
<<       Listfile is any file or back-referenced file to     >><< 8499>>51530000
<<          the output will be deposited.  Default is        >><< 8499>>51535000
<<          $STDLIST.                                        >><< 8499>>51540000
<<                                                           >><< 8499>>51545000
<<***********************************************************>><< 8499>>51550000
                                                               << 8499>>51555000
                                                               << 8499>>51560000
DEFINE                                                         << 8499>>51565000
   TURNOFFTRAPS = PUSH( STATUS );                              << 8499>>51570000
                  TOS.(2:1) := 0;                              << 8499>>51575000
                  SET( STATUS )#;                              << 8499>>51580000
                                                               << 8499>>51585000
EQUATE JDT'LEN     = JDT'MAX'LEN,                              << 8499>>51590000
       FORMS'TYPE  = 0,                                        << 8499>>51595000
       TAPE'LABEL  = 1;                                        << 8499>>51600000
                                                               << 8499>>51605000
BYTE SPACE  := " ";                                            << 8499>>51610000
                                                               << 8499>>51615000
LOGICAL ARRAY JDTARR( 0:JDT'LEN - 1 );                         << 8499>>51620000
                                                               << 8499>>51625000
<< LOGICAL POINTERS FOR MOVING THROUGH FEQ ENTRIES >>          << 8499>>51630000
LOGICAL POINTER                                                << 8499>>51635000
                TEMP'FEQ,    << TEMPORARY POINTER >>           << 8499>>51640000
                SAVE'FEQ'ENTRY, << SAVES FEQ'ENTRY/FEQ >>      << 8499>>51645000
                FEQ'HEAD, << POINTS TO START OF FEQ TABLE >>   << 8499>>51650000
                FEQ'ENTRY,<< POINTS TO TOP OF FEQ ENTRY   >>   << 8499>>51655000
                FEQ'TAIL; << POINTS TO END OF FEQ TABLE >>     << 8499>>51660000
                                                               << 8499>>51665000
INTEGER FEQ'WORDS,       << NUMBER OF WORDS/FEQ ENTRY    >>    << 8499>>51670000
        FEQ'FNAME'SIZE,  << NUMBER WORDS/FORMAL DESIG    >>    << 8499>>51675000
        FEQ'ANAME'SIZE,  << NUMBER BYTES/ACTUAL FNAME    >>    << 8499>>51680000
        FEQ'DNAME'SIZE;  << NUMBER BYTES/DEV #/CLASSNAME >>    << 8499>>51685000
                                                               << 8499>>51690000
INTEGER OB'INDEX;  << INDEX INTO OUT'BUFF FOR NEXT STRING  >>  << 8499>>51695000
                                                               << 8499>>51700000
LOGICAL ARRAY OUT'BUFF'L(0:127); << TO PRINT FINAL FEQ   >>    << 8499>>51705000
BYTE    ARRAY OUT'BUFF(*) = OUT'BUFF'L; << HOLDS BUDDING FEQ >><< 8499>>51710000
                                                               << 8499>>51715000
LOGICAL COMPLETE := TRUE,                                      << 8499>>51720000
        FOPTIONS := 0,                                         << 8499>>51725000
        AOPTIONS := 0,                                         << 8499>>51730000
        JIR      := 0,                                         << 8499>>51735000
        PMASK1   := 0,                                         << 8499>>51740000
        PMASK2   := 0;                                         << 8499>>51745000
                                                               << 8499>>51750000
BYTE    ARRAY REALNAMEA(0:35);                                 << 8499>>51755000
BYTE POINTER REALNAME := @REALNAMEA;                           << 8499>>51760000
                                                               << 8499>>51765000
LOGICAL ARRAY FILE'NAME'L(0:35);                               << 8499>>51770000
BYTE    ARRAY FILE'NAME(*) = FILE'NAME'L;                      << 8499>>51775000
                                                               << 8499>>51780000
BYTE POINTER PARMPOINT,                                        << 8499>>51785000
             DEVNAME,                                          << 8499>>51790000
             KEYWORDS,                                         << 8499>>51795000
             FORM,                                             << 8499>>51800000
             L'F'NAME,                                         << 8499>>51805000
             LABEL'F,                                          << 8499>>51810000
             B2,                                               << 8499>>51815000
             EOF,                                              << 8499>>51820000
             FILENAME;     << PTR TO VARIOUS NAMES IN FEQ >>   << 8499>>51825000
                                                               << 8499>>51830000
INTEGER FILE'NUM,                                              << 8499>>51835000
        ERROR'PARM,                                            << 8499>>51840000
        I,                                                     << 8499>>51845000
        DEVPART,                                               << 8499>>51850000
        KEYPART,                                               << 8499>>51855000
        WHICH,                                                 << 8499>>51860000
        LABEL'LENGTH,                                          << 8499>>51865000
        L'F'LEN;                                               << 8499>>51870000
                                                               << 8499>>51875000
DOUBLE POINTER FILE'SIZE;                                      << 8499>>51880000
                                                               << 8499>>51885000
BYTE ARRAY TEMP(0:80);                                         << 8499>>51890000
<<                                                           >><< 8499>>51895000
<< The following equates are used primarily as indexes into  >><< 8499>>51900000
<< a formatting CASE statement that is used to print the     >><< 8499>>51905000
<< appropriate keywords, etc.                                >><< 8499>>51910000
<<                                                           >><< 8499>>51915000
                                                               << 8499>>51920000
EQUATE                                                         << 8499>>51925000
     CR           = %15,                                       << 8499>>51930000
     FILE'        = 2,                                         << 8499>>51935000
     SEMI'COLON   = 3,                                         << 8499>>51940000
     COMMA        = 4,                                         << 8499>>51945000
     EQUALS       = 5,                                         << 8499>>51950000
     STDLIST      = 6,                                         << 8499>>51955000
     NEWPASS      = 7,                                         << 8499>>51960000
     OLDPASS      = 8,                                         << 8499>>51965000
     STDIN        = 9,                                         << 8499>>51970000
     STDINX       = 10,                                        << 8499>>51975000
     NULL         = 11,                                        << 8499>>51980000
     FIXED        = 12,                                        << 8499>>51985000
     VARIABLE'    = 13,                                        << 8499>>51990000
     UNDEFINED    = 14,                                        << 8499>>51995000
     NEW          = 15,                                        << 8499>>52000000
     OLD          = 16,                                        << 8499>>52005000
     OLDTEMP      = 17,                                        << 8499>>52010000
     DEV          = 18,                                        << 8499>>52015000
     DISC         = 19,                                        << 8499>>52020000
     NOBUF        = 20,                                        << 8499>>52025000
     CCTL         = 21,                                        << 8499>>52030000
     MR           = 22,                                        << 8499>>52035000
     EXC          = 23,                                        << 8499>>52040000
     SEMI         = 24,                                        << 8499>>52045000
     SHR          = 25,                                        << 8499>>52050000
     ACC          = 26,                                        << 8499>>52055000
     BUF          = 27,                                        << 8499>>52060000
     DEL'         = 28,                                        << 8499>>52065000
     SAVE         = 29,                                        << 8499>>52070000
     TEMP'        = 30,                                        << 8499>>52075000
     CODE         = 31,                                        << 8499>>52080000
     BINARY'      = 32,                                        << 8499>>52085000
     ASCII'       = 33,                                        << 8499>>52090000
     REC          = 34,                                        << 8499>>52095000
     STAR         = 35,                                        << 8499>>52100000
     IN           = 36,                                        << 8499>>52105000
     OUT          = 37,                                        << 8499>>52110000
     OUTKEEP      = 38,                                        << 8499>>52115000
     APPEND       = 39,                                        << 8499>>52120000
     INOUT        = 40,                                        << 8499>>52125000
     UPDATE       = 41,                                        << 8499>>52130000
     FAIL'ON'JDT  = 42,                                        << 8499>>52135000
     NOLABEL      = 43,                                        << 8499>>52140000
     LABEL'       = 44,                                        << 8499>>52145000
     KSAM'        = 45,                                        << 8499>>52150000
     FORMS        = 46,                                        << 8499>>52155000
     LOCK         = 47,                                        << 8499>>52160000
     NOLOCK       = 48,                                        << 8499>>52165000
     NOCCTL       = 49,                                        << 8499>>52170000
     NOMR         = 50,                                        << 8499>>52175000
     MULTI        = 51,                                        << 8499>>52180000
     NOMULTI      = 52,                                        << 8499>>52185000
     WAIT         = 53,                                        << 8499>>52190000
     NOWAIT       = 54,                                        << 8499>>52195000
     GMULTI       = 55,                                        << 8499>>52200000
     STD          = 56,                                        << 8499>>52205000
     RIO          = 57,                                        << 8499>>52210000
     MSG          = 58,                                        << 8499>>52215000
     CIR          = 59,                                        << 8499>>52220000
     COPY         = 60,                                        << 8499>>52225000
     NOCOPY       = 61,                                        << 8499>>52230000
     VTERM        = 62,                                        << 8499>>52235000
     DUMMY1       = 999;                                       << 8499>>52240000
$PAGE                                                          << 8499>>52245000
                                                               << 8499>>52250000
                                                               << 8499>>52255000
INTRINSIC FOPEN,FWRITE,ASCII,DASCII;                           << 8499>>52260000
                                                               << 8499>>52265000
<<*************************************************************<< 8499>>52270000
<<                                                             << 8499>>52275000
<< SUBROUTINE LOAD'STRING                                      << 8499>>52280000
<<                                                             << 8499>>52285000
<< PURPOSE - TO LOAD A STRING CONSTANT INTO A BYTE ARRAY       << 8499>>52290000
<<           OUT'BUFF( OB'INDEX ) AND INCREMENT OB'INDEX BY    << 8499>>52295000
<<           THE LENGTH OF THE STRING                          << 8499>>52300000
<<                                                             << 8499>>52305000
<<*************************************************************<< 8499>>52310000
                                                               << 8499>>52315000
SUBROUTINE LOAD'STRING( INDEX );                               << 8499>>52320000
 VALUE INDEX;                                                  << 8499>>52325000
 INTEGER INDEX;                                                << 8499>>52330000
                                                               << 8499>>52335000
<<*************************************************************<< 8499>>52340000
<<                                                             << 8499>>52345000
<< INDEX - AN INTEGER THAT IS AN INDEX TO A CASE STATEMENT     << 8499>>52350000
<<         THAT REPRESENTS THE STRING TO BE PLACED IN OUT'BUFF << 8499>>52355000
<<                                                             << 8499>>52360000
<<*************************************************************<< 8499>>52365000
BEGIN                                                          << 8499>>52370000
                                                               << 8499>>52375000
CASE INDEX OF                                                  << 8499>>52380000
     BEGIN                                                     << 8499>>52385000
     << 0 >>                                                   << 8499>>52390000
     ;                                                         << 8499>>52395000
                                                               << 8499>>52400000
     << 1 >>                                                   << 8499>>52405000
     ;                                                         << 8499>>52410000
                                                               << 8499>>52415000
     << 2 >>                                                   << 8499>>52420000
     BEGIN                                                     << 8499>>52425000
     MOVE OUT'BUFF( OB'INDEX ) := " FILE ";                    << 8499>>52430000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>52435000
     END;                                                      << 8499>>52440000
                                                               << 8499>>52445000
     << 3 >>                                                   << 8499>>52450000
     BEGIN                                                     << 8499>>52455000
     MOVE OUT'BUFF( OB'INDEX ) := ";";                         << 8499>>52460000
     OB'INDEX := OB'INDEX + 1;                                 << 8499>>52465000
     END;                                                      << 8499>>52470000
                                                               << 8499>>52475000
     << 4 >>                                                   << 8499>>52480000
     BEGIN                                                     << 8499>>52485000
     MOVE OUT'BUFF( OB'INDEX ) := ",";                         << 8499>>52490000
     OB'INDEX := OB'INDEX + 1;                                 << 8499>>52495000
     END;                                                      << 8499>>52500000
                                                               << 8499>>52505000
     << 5 >>                                                   << 8499>>52510000
     BEGIN                                                     << 8499>>52515000
     MOVE OUT'BUFF( OB'INDEX ) := "=";                         << 8499>>52520000
     OB'INDEX := OB'INDEX +  1;                                << 8499>>52525000
     END;                                                      << 8499>>52530000
                                                               << 8499>>52535000
     << 6 >>                                                   << 8499>>52540000
     BEGIN                                                     << 8499>>52545000
     MOVE OUT'BUFF( OB'INDEX ) := "=$STDLIST";                 << 8499>>52550000
     OB'INDEX := OB'INDEX +  10;                               << 8499>>52555000
     END;                                                      << 8499>>52560000
                                                               << 8499>>52565000
     << 7 >>                                                   << 8499>>52570000
     BEGIN                                                     << 8499>>52575000
     MOVE OUT'BUFF( OB'INDEX ) := "=$NEWPASS";                 << 8499>>52580000
     OB'INDEX := OB'INDEX +  9;                                << 8499>>52585000
     END;                                                      << 8499>>52590000
                                                               << 8499>>52595000
     << 8 >>                                                   << 8499>>52600000
     BEGIN                                                     << 8499>>52605000
     MOVE OUT'BUFF( OB'INDEX ) := "=$OLDPASS";                 << 8499>>52610000
     OB'INDEX := OB'INDEX +  9;                                << 8499>>52615000
     END;                                                      << 8499>>52620000
                                                               << 8499>>52625000
     << 9 >>                                                   << 8499>>52630000
     BEGIN                                                     << 8499>>52635000
     MOVE OUT'BUFF( OB'INDEX ) := "=$STDIN";                   << 8499>>52640000
     OB'INDEX := OB'INDEX + 7;                                 << 8499>>52645000
     END;                                                      << 8499>>52650000
                                                               << 8499>>52655000
     << 10 >>                                                  << 8499>>52660000
     BEGIN                                                     << 8499>>52665000
     MOVE OUT'BUFF( OB'INDEX ) := "=$STDINX";                  << 8499>>52670000
     OB'INDEX := OB'INDEX + 8;                                 << 8499>>52675000
     END;                                                      << 8499>>52680000
                                                               << 8499>>52685000
     << 11 >>                                                  << 8499>>52690000
     BEGIN                                                     << 8499>>52695000
     MOVE OUT'BUFF( OB'INDEX ) := "=$NULL";                    << 8499>>52700000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>52705000
     END;                                                      << 8499>>52710000
                                                               << 8499>>52715000
     << 12 >>                                                  << 8499>>52720000
     BEGIN                                                     << 8499>>52725000
     MOVE OUT'BUFF( OB'INDEX ) := "F";                         << 8499>>52730000
     OB'INDEX := OB'INDEX + 1;                                 << 8499>>52735000
     END;                                                      << 8499>>52740000
                                                               << 8499>>52745000
     << 13 >>                                                  << 8499>>52750000
     BEGIN                                                     << 8499>>52755000
     MOVE OUT'BUFF( OB'INDEX ) := "V";                         << 8499>>52760000
     OB'INDEX := OB'INDEX + 1;                                 << 8499>>52765000
     END;                                                      << 8499>>52770000
                                                               << 8499>>52775000
     << 14 >>                                                  << 8499>>52780000
     BEGIN                                                     << 8499>>52785000
     MOVE OUT'BUFF( OB'INDEX ) := "U";                         << 8499>>52790000
     OB'INDEX := OB'INDEX + 1;                                 << 8499>>52795000
     END;                                                      << 8499>>52800000
                                                               << 8499>>52805000
     << 15 >>                                                  << 8499>>52810000
     BEGIN                                                     << 8499>>52815000
     MOVE OUT'BUFF( OB'INDEX ) := ",NEW";                      << 8499>>52820000
     OB'INDEX := OB'INDEX + 4;                                 << 8499>>52825000
     END;                                                      << 8499>>52830000
                                                               << 8499>>52835000
     << 16 >>                                                  << 8499>>52840000
     BEGIN                                                     << 8499>>52845000
     MOVE OUT'BUFF( OB'INDEX ) := ",OLD";                      << 8499>>52850000
     OB'INDEX := OB'INDEX +  4;                                << 8499>>52855000
     END;                                                      << 8499>>52860000
                                                               << 8499>>52865000
     << 17 >>                                                  << 8499>>52870000
     BEGIN                                                     << 8499>>52875000
     MOVE OUT'BUFF( OB'INDEX ) := ",OLDTEMP";                  << 8499>>52880000
     OB'INDEX := OB'INDEX + 8;                                 << 8499>>52885000
     END;                                                      << 8499>>52890000
                                                               << 8499>>52895000
     << 18 >>                                                  << 8499>>52900000
     BEGIN                                                     << 8499>>52905000
     MOVE OUT'BUFF( OB'INDEX ) := ";DEV=";                     << 8499>>52910000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>52915000
     END;                                                      << 8499>>52920000
                                                               << 8499>>52925000
     << 19 >>                                                  << 8499>>52930000
     BEGIN                                                     << 8499>>52935000
     MOVE OUT'BUFF( OB'INDEX ) := ";DISC=";                    << 8499>>52940000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>52945000
     END;                                                      << 8499>>52950000
                                                               << 8499>>52955000
     << 20 >>                                                  << 8499>>52960000
     BEGIN                                                     << 8499>>52965000
     MOVE OUT'BUFF( OB'INDEX ) := ";NOBUF";                    << 8499>>52970000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>52975000
     END;                                                      << 8499>>52980000
                                                               << 8499>>52985000
     << 21 >>                                                  << 8499>>52990000
     BEGIN                                                     << 8499>>52995000
     MOVE OUT'BUFF( OB'INDEX ) := ";CCTL";                     << 8499>>53000000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53005000
     END;                                                      << 8499>>53010000
                                                               << 8499>>53015000
     << 22 >>                                                  << 8499>>53020000
     BEGIN                                                     << 8499>>53025000
     MOVE OUT'BUFF( OB'INDEX ) := ";MR";                       << 8499>>53030000
     OB'INDEX := OB'INDEX + 3;                                 << 8499>>53035000
     END;                                                      << 8499>>53040000
                                                               << 8499>>53045000
     << 23 >>                                                  << 8499>>53050000
     BEGIN                                                     << 8499>>53055000
     MOVE OUT'BUFF( OB'INDEX ) := ";EXC";                      << 8499>>53060000
     OB'INDEX := OB'INDEX + 4;                                 << 8499>>53065000
     END;                                                      << 8499>>53070000
                                                               << 8499>>53075000
     << 24 >>                                                  << 8499>>53080000
     BEGIN                                                     << 8499>>53085000
     MOVE OUT'BUFF( OB'INDEX ) := ";SEMI";                     << 8499>>53090000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53095000
     END;                                                      << 8499>>53100000
                                                               << 8499>>53105000
     << 25 >>                                                  << 8499>>53110000
     BEGIN                                                     << 8499>>53115000
     MOVE OUT'BUFF( OB'INDEX ) := ";SHR";                      << 8499>>53120000
     OB'INDEX := OB'INDEX + 4;                                 << 8499>>53125000
     END;                                                      << 8499>>53130000
                                                               << 8499>>53135000
     << 26 >>                                                  << 8499>>53140000
     BEGIN                                                     << 8499>>53145000
     MOVE OUT'BUFF( OB'INDEX ) := ";ACC=";                     << 8499>>53150000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53155000
     END;                                                      << 8499>>53160000
                                                               << 8499>>53165000
     << 27 >>                                                  << 8499>>53170000
     BEGIN                                                     << 8499>>53175000
     MOVE OUT'BUFF( OB'INDEX ) := ";BUF=";                     << 8499>>53180000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53185000
     END;                                                      << 8499>>53190000
                                                               << 8499>>53195000
     << 28 >>                                                  << 8499>>53200000
     BEGIN                                                     << 8499>>53205000
     MOVE OUT'BUFF( OB'INDEX ) := ";DEL";                      << 8499>>53210000
     OB'INDEX := OB'INDEX + 4;                                 << 8499>>53215000
     END;                                                      << 8499>>53220000
                                                               << 8499>>53225000
     << 29 >>                                                  << 8499>>53230000
     BEGIN                                                     << 8499>>53235000
     MOVE OUT'BUFF( OB'INDEX ) := ";SAVE";                     << 8499>>53240000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53245000
     END;                                                      << 8499>>53250000
                                                               << 8499>>53255000
     << 30 >>                                                  << 8499>>53260000
     BEGIN                                                     << 8499>>53265000
     MOVE OUT'BUFF( OB'INDEX ) := ";TEMP";                     << 8499>>53270000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53275000
     END;                                                      << 8499>>53280000
                                                               << 8499>>53285000
     << 31 >>                                                  << 8499>>53290000
     BEGIN                                                     << 8499>>53295000
     MOVE OUT'BUFF( OB'INDEX ) := ";CODE=";                    << 8499>>53300000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>53305000
     END;                                                      << 8499>>53310000
                                                               << 8499>>53315000
     << 32 >>                                                  << 8499>>53320000
     BEGIN                                                     << 8499>>53325000
     MOVE OUT'BUFF( OB'INDEX ) := ",BINARY";                   << 8499>>53330000
     OB'INDEX := OB'INDEX + 7;                                 << 8499>>53335000
     END;                                                      << 8499>>53340000
                                                               << 8499>>53345000
     << 33 >>                                                  << 8499>>53350000
     BEGIN                                                     << 8499>>53355000
     MOVE OUT'BUFF( OB'INDEX ) := ",ASCII";                    << 8499>>53360000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>53365000
     END;                                                      << 8499>>53370000
                                                               << 8499>>53375000
     << 34 >>                                                  << 8499>>53380000
     BEGIN                                                     << 8499>>53385000
     MOVE OUT'BUFF( OB'INDEX ) := ";REC=";                     << 8499>>53390000
     OB'INDEX := OB'INDEX +  5;                                << 8499>>53395000
     END;                                                      << 8499>>53400000
                                                               << 8499>>53405000
     << 35 >>                                                  << 8499>>53410000
     BEGIN                                                     << 8499>>53415000
     MOVE OUT'BUFF( OB'INDEX ) := "*";                         << 8499>>53420000
     OB'INDEX := OB'INDEX + 1;                                 << 8499>>53425000
     END;                                                      << 8499>>53430000
                                                               << 8499>>53435000
     << 36 >>                                                  << 8499>>53440000
     BEGIN                                                     << 8499>>53445000
     MOVE OUT'BUFF( OB'INDEX ) := "IN";                        << 8499>>53450000
     OB'INDEX := OB'INDEX + 2;                                 << 8499>>53455000
     END;                                                      << 8499>>53460000
                                                               << 8499>>53465000
     << 37 >>                                                  << 8499>>53470000
     BEGIN                                                     << 8499>>53475000
     MOVE OUT'BUFF( OB'INDEX ) := "OUT";                       << 8499>>53480000
     OB'INDEX := OB'INDEX + 3;                                 << 8499>>53485000
     END;                                                      << 8499>>53490000
                                                               << 8499>>53495000
     << 38 >>                                                  << 8499>>53500000
     BEGIN                                                     << 8499>>53505000
     MOVE OUT'BUFF( OB'INDEX ) := "OUTKEEP";                   << 8499>>53510000
     OB'INDEX := OB'INDEX + 7;                                 << 8499>>53515000
     END;                                                      << 8499>>53520000
                                                               << 8499>>53525000
     << 39 >>                                                  << 8499>>53530000
     BEGIN                                                     << 8499>>53535000
     MOVE OUT'BUFF( OB'INDEX ) := "APPEND";                    << 8499>>53540000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>53545000
     END;                                                      << 8499>>53550000
                                                               << 8499>>53555000
     << 40 >>                                                  << 8499>>53560000
     BEGIN                                                     << 8499>>53565000
     MOVE OUT'BUFF( OB'INDEX ) := "INOUT";                     << 8499>>53570000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53575000
     END;                                                      << 8499>>53580000
                                                               << 8499>>53585000
     << 41 >>                                                  << 8499>>53590000
     BEGIN                                                     << 8499>>53595000
     MOVE OUT'BUFF( OB'INDEX ) := "UPDATE";                    << 8499>>53600000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>53605000
     END;                                                      << 8499>>53610000
                                                               << 8499>>53615000
     << 42 >>                                                  << 8499>>53620000
     BEGIN                                                     << 8499>>53625000
     MOVE OUT'BUFF( OB'INDEX ) := "FAILURE TO GET JDT";        << 8499>>53630000
     OB'INDEX := OB'INDEX + 18;                                << 8499>>53635000
     END;                                                      << 8499>>53640000
                                                               << 8499>>53645000
     << 43 >>                                                  << 8499>>53650000
     BEGIN                                                     << 8499>>53655000
     MOVE OUT'BUFF( OB'INDEX ) := ";NOLABEL";                  << 8499>>53660000
     OB'INDEX := OB'INDEX + 9;                                 << 8499>>53665000
     END;                                                      << 8499>>53670000
                                                               << 8499>>53675000
     << 44 >>                                                  << 8499>>53680000
     BEGIN                                                     << 8499>>53685000
     MOVE OUT'BUFF( OB'INDEX ) := ";LABEL";                    << 8499>>53690000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>53695000
     END;                                                      << 8499>>53700000
                                                               << 8499>>53705000
     << 45 >>                                                  << 8499>>53710000
     BEGIN                                                     << 8499>>53715000
     MOVE OUT'BUFF( OB'INDEX ) := ";KSAM";                     << 8499>>53720000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53725000
     END;                                                      << 8499>>53730000
                                                               << 8499>>53735000
     << 46 >>                                                  << 8499>>53740000
     BEGIN                                                     << 8499>>53745000
     MOVE OUT'BUFF( OB'INDEX ) := ";FORMS";                    << 8499>>53750000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>53755000
     END;                                                      << 8499>>53760000
                                                               << 8499>>53765000
     << 47 >>                                                  << 8499>>53770000
     BEGIN                                                     << 8499>>53775000
     MOVE OUT'BUFF( OB'INDEX ) := ";LOCK";                     << 8499>>53780000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53785000
     END;                                                      << 8499>>53790000
                                                               << 8499>>53795000
     << 48 >>                                                  << 8499>>53800000
     BEGIN                                                     << 8499>>53805000
     MOVE OUT'BUFF( OB'INDEX ) := ";NOLOCK";                   << 8499>>53810000
     OB'INDEX := OB'INDEX + 7;                                 << 8499>>53815000
     END;                                                      << 8499>>53820000
                                                               << 8499>>53825000
     << 49 >>                                                  << 8499>>53830000
     BEGIN                                                     << 8499>>53835000
     MOVE OUT'BUFF( OB'INDEX ) := ";NOCCTL";                   << 8499>>53840000
     OB'INDEX := OB'INDEX + 7;                                 << 8499>>53845000
     END;                                                      << 8499>>53850000
                                                               << 8499>>53855000
     << 50 >>                                                  << 8499>>53860000
     BEGIN                                                     << 8499>>53865000
     MOVE OUT'BUFF( OB'INDEX ) := ";NOMR";                     << 8499>>53870000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53875000
     END;                                                      << 8499>>53880000
                                                               << 8499>>53885000
     << 51 >>                                                  << 8499>>53890000
     BEGIN                                                     << 8499>>53895000
     MOVE OUT'BUFF( OB'INDEX ) := ";MULTI";                    << 8499>>53900000
     OB'INDEX := OB'INDEX + 6;                                 << 8499>>53905000
     END;                                                      << 8499>>53910000
                                                               << 8499>>53915000
     << 52 >>                                                  << 8499>>53920000
     BEGIN                                                     << 8499>>53925000
     MOVE OUT'BUFF( OB'INDEX ) := ";NOMULTI";                  << 8499>>53930000
     OB'INDEX := OB'INDEX + 8;                                 << 8499>>53935000
     END;                                                      << 8499>>53940000
                                                               << 8499>>53945000
     << 53 >>                                                  << 8499>>53950000
     BEGIN                                                     << 8499>>53955000
     MOVE OUT'BUFF( OB'INDEX ) := ";WAIT";                     << 8499>>53960000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>53965000
     END;                                                      << 8499>>53970000
                                                               << 8499>>53975000
     << 54 >>                                                  << 8499>>53980000
     BEGIN                                                     << 8499>>53985000
     MOVE OUT'BUFF( OB'INDEX ) := ";NOWAIT";                   << 8499>>53990000
     OB'INDEX := OB'INDEX + 7;                                 << 8499>>53995000
     END;                                                      << 8499>>54000000
                                                               << 8499>>54005000
     << 55 >>                                                  << 8499>>54010000
     BEGIN                                                     << 8499>>54015000
     MOVE OUT'BUFF( OB'INDEX ) := ";GMULTI";                   << 8499>>54020000
     OB'INDEX := OB'INDEX + 7;                                 << 8499>>54025000
     END;                                                      << 8499>>54030000
                                                               << 8499>>54035000
     << 56 >>                                                  << 8499>>54040000
     BEGIN                                                     << 8499>>54045000
     MOVE OUT'BUFF( OB'INDEX ) := ";STD";                      << 8499>>54050000
     OB'INDEX := OB'INDEX + 4;                                 << 8499>>54055000
     END;                                                      << 8499>>54060000
                                                               << 8499>>54065000
     << 57 >>                                                  << 8499>>54070000
     BEGIN                                                     << 8499>>54075000
     MOVE OUT'BUFF( OB'INDEX ) := ";RIO";                      << 8499>>54080000
     OB'INDEX := OB'INDEX + 4;                                 << 8499>>54085000
     END;                                                      << 8499>>54090000
                                                               << 8499>>54095000
     << 58 >>                                                  << 8499>>54100000
     BEGIN                                                     << 8499>>54105000
     MOVE OUT'BUFF( OB'INDEX ) := ";MSG";                      << 8499>>54110000
     OB'INDEX := OB'INDEX + 4;                                 << 8499>>54115000
     END;                                                      << 8499>>54120000
                                                               << 8499>>54125000
     << 59 >>                                                  << 8499>>54130000
     BEGIN                                                     << 8499>>54135000
     MOVE OUT'BUFF( OB'INDEX ) := ";CIR";                      << 8499>>54140000
     OB'INDEX := OB'INDEX + 4;                                 << 8499>>54145000
     END;                                                      << 8499>>54150000
                                                               << 8499>>54155000
     << 60 >>                                                  << 8499>>54160000
     BEGIN                                                     << 8499>>54165000
     MOVE OUT'BUFF( OB'INDEX ) := ";COPY";                     << 8499>>54170000
     OB'INDEX := OB'INDEX + 5;                                 << 8499>>54175000
     END;                                                      << 8499>>54180000
                                                               << 8499>>54185000
     << 61 >>                                                  << 8499>>54190000
     BEGIN                                                     << 8499>>54195000
     MOVE OUT'BUFF( OB'INDEX ) := ";NOCOPY";                   << 8499>>54200000
     OB'INDEX := OB'INDEX + 7;                                 << 8499>>54205000
     END;                                                      << 8499>>54210000
                                                               << 8499>>54215000
                                                               << 8499>>54220000
                                                               << 8499>>54225000
     END; << CASE STATEMENT >>                                 << 8499>>54230000
                                                               << 8499>>54235000
END;   << LOAD'STRING >>                                       << 8499>>54240000
$PAGE                                                          << 8499>>54245000
<<**********************************************************>> << 8499>>54250000
<<                                                          >> << 8499>>54255000
<< SUBROUTINE PUTNUM                                        >> << 8499>>54260000
<<                                                          >> << 8499>>54265000
<< PURPOSE - TO PLACE A VALUE INTO OUTPUT BUFFER OUT'BUFF   >> << 8499>>54270000
<<                                                          >> << 8499>>54275000
<<**********************************************************>> << 8499>>54280000
                                                               << 8499>>54285000
SUBROUTINE PUTNUM( VAL );                                      << 8499>>54290000
VALUE VAL;                                                     << 8499>>54295000
INTEGER VAL;                                                   << 8499>>54300000
<<***********************************************************>><< 8499>>54305000
<<                                                           >><< 8499>>54310000
<< VAL - AN INTEGER TO BY "ASCII"ED INTO A BASE 10 CHAR STR  >><< 8499>>54315000
<<                                                           >><< 8499>>54320000
<<***********************************************************>><< 8499>>54325000
BEGIN                                                          << 8499>>54330000
TOS:=ASCII( VAL, 10, OUT'BUFF( OB'INDEX ) );                   << 8499>>54335000
OB'INDEX := OB'INDEX + TOS;                                    << 8499>>54340000
END;                                                           << 8499>>54345000
$PAGE                                                          << 8499>>54350000
<<***********************************************************>><< 8499>>54355000
<<                                                           >><< 8499>>54360000
<< SUBROUTINE PUTDNUM                                        >><< 8499>>54365000
<<                                                           >><< 8499>>54370000
<< PURPOSE - TO CONVERT A VALUE TO A DOUBLE BASE 10 AND PLACE>><< 8499>>54375000
<<           IT IN OUT'BUFF.                                 >><< 8499>>54380000
<<                                                           >><< 8499>>54385000
<<***********************************************************>><< 8499>>54390000
                                                               << 8499>>54395000
SUBROUTINE PUTDNUM( VAL );                                     << 8499>>54400000
VALUE VAL;                                                     << 8499>>54405000
DOUBLE VAL;                                                    << 8499>>54410000
<<************************************************************><< 8499>>54415000
<<                                                            ><< 8499>>54420000
<< VAL - A DOUBLE BY VALUE TO BE "ASCII"ED INTO OUT'BUFF      ><< 8499>>54425000
<<                                                            ><< 8499>>54430000
<<************************************************************><< 8499>>54435000
                                                               << 8499>>54440000
BEGIN                                                          << 8499>>54445000
TOS:=DASCII( VAL , 10, OUT'BUFF( OB'INDEX ) );                 << 8499>>54450000
OB'INDEX := OB'INDEX + TOS;                                    << 8499>>54455000
END;                                                           << 8499>>54460000
$PAGE                                                          << 8499>>54465000
<<***********************************************************>><< 8499>>54470000
<<                                                           >><< 8499>>54475000
<< SUBROUTINE OBTAIN'FORMAL'DESIG                            >><< 8499>>54480000
<<                                                           >><< 8499>>54485000
<< PURPOSE:  TO LOAD THE NAME OF THE FORMAL DESIGNATOR INTO  >><< 8499>>54490000
<<           THE BYTE STRING OUT'BUFF.                       >><< 8499>>54495000
<<                                                           >><< 8499>>54500000
<<***********************************************************>><< 8499>>54505000
                                                               << 8499>>54510000
LOGICAL SUBROUTINE OBTAIN'FORMAL'DESIG;                        << 8499>>54515000
                                                               << 8499>>54520000
BEGIN                                                          << 8499>>54525000
OBTAIN'FORMAL'DESIG := TRUE;  << ASSUME SUCCESS >>             << 8499>>54530000
                                                               << 8499>>54535000
<< OK, here's the deal.  When the FEQ formal designator >>     << 8499>>54540000
<< ss placed in the JDT, it is crunched.  The encoding  >>     << 8499>>54545000
<< is as follows:  The high-order bit of the first      >>     << 8499>>54550000
<< byte of each qualifier is turned on and the         >>      << 8499>>54555000
<< last part of the formal designator name is           >>     << 8499>>54560000
<< terminated by a blank.                               >>     << 8499>>54565000
<<                                                      >>     << 8499>>54570000
<< For example, if the formal designator is             >>     << 8499>>54575000
<< FILE.GROUP.ACCT, the high-order bit in the first     >>     << 8499>>54580000
<< byte of each qualifier (FILE, GROUP, and ACCT would  >>     << 8499>>54585000
<< be turned on.  So for "FILE", instead of %043111 =   >>     << 8499>>54590000
<< "FI", the first word is %143111.  And "ACCT" is      >>     << 8499>>54595000
<< terminated by a blank.                               >>     << 8499>>54600000
<<                                                      >>     << 8499>>54605000
<< NOTE:  THIS WILL RAISE HELL WHEN WE DECIDE TO SUPPORT>>     << 8499>>54610000
<< 8-BIT NAMES!!!!!!    NATIVE LANGUAGE - WATCH OUT!!!  >>     << 8499>>54615000
                                                               << 8499>>54620000
<< GET THE FORMAL FILE NAME SIZE IN BYTES >>                   << 8499>>54625000
                                                               << 8499>>54630000
FEQ'FNAME'SIZE := FEQ'ENTRY.(8:8);  << # WORDS >>              << 8499>>54635000
FEQ'FNAME'SIZE := FEQ'FNAME'SIZE * 2; << # BYTES >>            << 8499>>54640000
@FILENAME := (@FEQ'ENTRY + 1) * 2;  << BYTE PTR TO FNAME >>    << 8499>>54645000
I := 0;                                                        << 8499>>54650000
WHILE ( I < FEQ'FNAME'SIZE ) DO                                << 8499>>54655000
   BEGIN                                                       << 8499>>54660000
   IF FILENAME( I ) >= %200  << THE HIGH ORDER BIT ON? >>      << 8499>>54665000
      THEN BEGIN                                               << 8499>>54670000
           << YES. START DESIG. NAME >>                        << 8499>>54675000
           << CLEAR HIGH ORDER BIT   >>                        << 8499>>54680000
           FILENAME( I ) := FILENAME( I ) - %200;              << 8499>>54685000
                                                               << 8499>>54690000
           << IF I=0 THEN WE HAVE THE START OF A FILE NAME >>  << 8499>>54695000
           << AND WE DON'T NEED A "." DENOTING A GROUP OR  >>  << 8499>>54700000
           << ACCOUNT                                      >>  << 8499>>54705000
                                                               << 8499>>54710000
           IF I <> 0                                           << 8499>>54715000
              THEN BEGIN                                       << 8499>>54720000
                   << NEED A SEPARATOR >>                      << 8499>>54725000
                   OUT'BUFF( OB'INDEX ) := ".";                << 8499>>54730000
                   OB'INDEX := OB'INDEX + 1;                   << 8499>>54735000
                   END;                                        << 8499>>54740000
           END;                                                << 8499>>54745000
                                                               << 8499>>54750000
   << Move character into OUT'BUFF, and increment >>           << 8499>>54755000
   << the counters                                >>           << 8499>>54760000
   IF FILENAME( I ) <> " "                                     << 8499>>54765000
      THEN BEGIN                                               << 8499>>54770000
           OUT'BUFF( OB'INDEX ) := FILENAME( I );              << 8499>>54775000
           OB'INDEX := OB'INDEX + 1;                           << 8499>>54780000
           END;                                                << 8499>>54785000
   << ELSE THE END OF THE FORMAL FILE DESIGNATOR IF IT IS ODD ><< 8499>>54790000
   << IF FORMAL NAME IS ODD IN LENGTH, A BLANK IS APPENDED.   ><< 8499>>54795000
   << AND WE DO NOT WANT THE BLANK.                           ><< 8499>>54800000
   I := I + 1;                                                 << 8499>>54805000
   END;  << WHILE STMT >>                                      << 8499>>54810000
                                                               << 8499>>54815000
                                                               << 8499>>54820000
<< MOVE FEQ'ENTRY TO NEXT MAJOR PART OF FEQ ENTRY >>           << 8499>>54825000
<< MUST CONVERT FEQ'FNAME'SIZE BACK TO WORDS      >>           << 8499>>54830000
                                                               << 8499>>54835000
FEQ'FNAME'SIZE := FEQ'FNAME'SIZE/2;                            << 8499>>54840000
                                                               << 8499>>54845000
IF FEQ'FNAME'SIZE = 1                                          << 8499>>54850000
   THEN @FEQ'ENTRY := @FEQ'ENTRY + 2                           << 8499>>54855000
   ELSE @FEQ'ENTRY := ( @FEQ'ENTRY + (FEQ'FNAME'SIZE) ) + 1;   << 8499>>54860000
                                                               << 8499>>54865000
END; << OBTAIN'FORMAL'DESIG >>                                 << 8499>>54870000
$PAGE                                                          << 8499>>54875000
<<***********************************************************>><< 8499>>54880000
<<                                                           >><< 8499>>54885000
<< SUBROUTINE OBTAIN'PMASKS                                  >><< 8499>>54890000
<<                                                           >><< 8499>>54895000
<< PURPOSE - TO OBTAIN THE TWO PARAMTER MASKS FROM THE JDT   >><< 8499>>54900000
<<           THAT DESCRIBE THE FEQ.  ONE PAIR/FEQ.  LOADED   >><< 8499>>54905000
<<           INTO PARM1 AND PARM2.                           >><< 8499>>54910000
<<                                                           >><< 8499>>54915000
<<***********************************************************>><< 8499>>54920000
                                                               << 8499>>54925000
SUBROUTINE OBTAIN'PMASKS;                                      << 8499>>54930000
BEGIN                                                          << 8499>>54935000
PMASK1 := FEQ'ENTRY;                                           << 8499>>54940000
@FEQ'ENTRY := @FEQ'ENTRY + 1;                                  << 8499>>54945000
PMASK2 := FEQ'ENTRY;                                           << 8499>>54950000
@FEQ'ENTRY := @FEQ'ENTRY + 1;                                  << 8499>>54955000
                                                               << 8499>>54960000
END;   << Subroutine OBTAIN'PMASKS >>                          << 8499>>54965000
$PAGE                                                          << 8499>>54970000
<<***********************************************************>><< 8499>>54975000
<<                                                           >><< 8499>>54980000
<< SUBROUTINE OBTAIN'F'A'OPTIONS                             >><< 8499>>54985000
<<                                                           >><< 8499>>54990000
<< PURPOSE - TO OBTAIN THE FOPTIONS AND AOPTIONS MASKS FROM  >><< 8499>>54995000
<<           THE JDT.  ONE PAIR/FEQ.  DESCRIBE THE FOPTONS   >><< 8499>>55000000
<<           AND THE AOPTIONS OF THE FEQ.                    >><< 8499>>55005000
<<                                                           >><< 8499>>55010000
<<***********************************************************>><< 8499>>55015000
                                                               << 8499>>55020000
SUBROUTINE OBTAIN'F'A'OPTIONS;                                 << 8499>>55025000
BEGIN                                                          << 8499>>55030000
                                                               << 8499>>55035000
<< FEQ'DNAME'SIZE RETREIVED IN OBTAIN'ACTUAL'FNAME >>          << 8499>>55040000
<< FEQ'ENTRY IS STILL POINTING TO THE WORD CONTAINING LENGTHS>><< 8499>>55045000
<< OF ACTUAL AND DEVICE STRINGS.                             >><< 8499>>55050000
                                                               << 8499>>55055000
@TEMP'FEQ := @FEQ'ENTRY;                                       << 8499>>55060000
@TEMP'FEQ := @TEMP'FEQ +                                       << 8499>>55065000
             ((FEQ'ANAME'SIZE + FEQ'DNAME'SIZE + 1)/2) + 1;    << 8499>>55070000
                                                               << 8499>>55075000
<< TEMP'FEQ NOW POINTING TO FOPTIONS WORD >>                   << 8499>>55080000
FOPTIONS := TEMP'FEQ;                                          << 8499>>55085000
AOPTIONS := TEMP'FEQ( 1 );                                     << 8499>>55090000
END;   << Subroutine OBTAIN'F'A'OPTIONS >>                     << 8499>>55095000
$PAGE                                                          << 8499>>55100000
<<***********************************************************>><< 8499>>55105000
<<                                                           >><< 8499>>55110000
<< SUBROUTINE OBTAIN'ACTUAL'FNAME                            >><< 8499>>55115000
<<                                                           >><< 8499>>55120000
<< PURPOSE:  TO LOAD THE ACTUAL FILE NAME INTO THE OUTPUT    >><< 8499>>55125000
<<           BUFFER OUT'BUFF IF AN ACTUAL FILE NAME EXISTS.  >><< 8499>>55130000
<<           IF THE ACTUAL FILE NAME DOES NOT EXIST, THEN    >><< 8499>>55135000
<<           OBTAIN'ACTUAL'FNAME RETURNS FALSE. ELSE IF AN   >><< 8499>>55140000
<<           ACTUAL FILE NAME DOES EXIST, THEN RETURN TRUE   >><< 8499>>55145000
<<           ONLY IF A BACKREFERENCE IS HERE, ELSE RETURN    >><< 8499>>55150000
<<           FALSE.                                          >><< 8499>>55155000
<<                                                           >><< 8499>>55160000
<<***********************************************************>><< 8499>>55165000
                                                               << 8499>>55170000
LOGICAL SUBROUTINE OBTAIN'ACTUAL'FNAME;                        << 8499>>55175000
BEGIN                                                          << 8499>>55180000
<< @FEQ'ENTRY IS POINTING TO A WORD THAT CONTAINS THE LENGTH >><< 8499>>55185000
<< IN BYTES OF A POSSIBLE ACTUAL FILE NAME DESIGNATOR IN THE >><< 8499>>55190000
<< FIRST EIGHT BITS AND THE THE LENGTH OF A DEVICE CLASS     >><< 8499>>55195000
<< NAME/NUMBER IN THE SECOND HALF OF THE WORD.  WE WANT TO   >><< 8499>>55200000
<< GET BOTH OF THESE VALUES AND MOVE THE ACTUAL NAME TO THE  >><< 8499>>55205000
<< OUTPUT BUFFER (OUT'BUFF) IF POSSIBLE.                     >><< 8499>>55210000
                                                               << 8499>>55215000
<< When we exit, FEQ'ENTRY needs to still be at the word     >><< 8499>>55220000
<< that contains the lengths.                                >><< 8499>>55225000
                                                               << 8499>>55230000
OBTAIN'ACTUAL'FNAME := FALSE; << ASSUME ACTUAL FNAME W/O "*" >><< 8499>>55235000
                              << OR NOT ACTUAL NAME AT ALL   >><< 8499>>55240000
<< FEQ'ANAME'SIZE is the number of characters, not including >><< 8499>>55245000
<< any packed blanks.                                        >><< 8499>>55250000
FEQ'ANAME'SIZE := FEQ'ENTRY.(0:8); << LENGTH IN BYTES >>       << 8499>>55255000
FEQ'DNAME'SIZE := FEQ'ENTRY.(8:8);  << LENGTH IN BYTES >>      << 8499>>55260000
IF FEQ'ANAME'SIZE <> 0                                         << 8499>>55265000
   THEN BEGIN                                                  << 8499>>55270000
        << MOVE THE ACTUAL FILE NAME TO THE BUFFER >>          << 8499>>55275000
                                                               << 8499>>55280000
        LOAD'STRING( EQUALS );  << "=" >>                      << 8499>>55285000
        IF FEQ'BACK'FILE'REF = 1                               << 8499>>55290000
           THEN BEGIN                                          << 8499>>55295000
                                                               << 8499>>55300000
                << ACTUAL FILE IS BACK REFERENCED >>           << 8499>>55305000
                LOAD'STRING( STAR ); << "*" >>                 << 8499>>55310000
                OBTAIN'ACTUAL'FNAME := TRUE;                   << 8499>>55315000
                END;                                           << 8499>>55320000
        @FILENAME := ( @FEQ'ENTRY + 1 ) * 2;                   << 8499>>55325000
        MOVE OUT'BUFF( OB'INDEX ) := FILENAME,(FEQ'ANAME'SIZE);<< 8499>>55330000
        OB'INDEX := OB'INDEX + FEQ'ANAME'SIZE;                 << 8499>>55335000
        END;                                                   << 8499>>55340000
                                                               << 8499>>55345000
<< @FEQ'ENTRY pointing to word conataining the lengths >>      << 8499>>55350000
                                                               << 8499>>55355000
END;   << Subroutine OBTAIN'ACTUAL'FNAME >>                    << 8499>>55360000
$PAGE                                                          << 8499>>55365000
<<***********************************************************>><< 8499>>55370000
<<                                                           >><< 8499>>55375000
<< SUBROUTINE OBTAIN'DEV'INFO                                >><< 8499>>55380000
<<                                                           >><< 8499>>55385000
<< PURPOSE:  TO FILL OUT'BUFF WITH ALL RELEVANT INFORMATION  >><< 8499>>55390000
<<           ON THE DEVICE NUMBER OR DEVICE CLASS NAME       >><< 8499>>55395000
<<                                                           >><< 8499>>55400000
<<***********************************************************>><< 8499>>55405000
                                                               << 8499>>55410000
SUBROUTINE OBTAIN'DEV'INFO;                                    << 8499>>55415000
BEGIN                                                          << 8499>>55420000
                                                               << 8499>>55425000
<< @FEQ'ENTRY IS POINTING TO THE DEVICE INFORMATION IN JDT   >><< 8499>>55430000
<< FEQ'DNAME'SIZE WAS CALCULATED INSIDE OBTAIN'ACTUAL FNAME  >><< 8499>>55435000
<< FEQ'DNAME'SIZE IS IN BYTES.                               >><< 8499>>55440000
                                                               << 8499>>55445000
<< FILL AN ARRAY FULL OF CR's >>                               << 8499>>55450000
TEMP(0) := CR;                                                 << 8499>>55455000
MOVE TEMP(1) := TEMP(0),(80);                                  << 8499>>55460000
                                                               << 8499>>55465000
<< NOW MOVE THE DEVICE INFORMATION PART INTO THE ARRAY FULL >> << 8499>>55470000
<< OF CARRIAGE RETURNS.                                     >> << 8499>>55475000
                                                               << 8499>>55480000
<< If FEQ'ANAME'SIZE <> 0, then @FILENAME is still pointing >> << 8499>>55485000
<< to the beginnig of the actual filename string.  We will  >> << 8499>>55490000
<< use @FILENAME to get to the start of the device string if>> << 8499>>55495000
<< that is the case.  Else, calculate the start of the      >> << 8499>>55500000
<< device string from FEQ'ENTRY (which is pointing to the   >> << 8499>>55505000
<< word containing the lengths of the actual filename and   >> << 8499>>55510000
<< device string).                                          >> << 8499>>55515000
                                                               << 8499>>55520000
IF FEQ'ANAME'SIZE <> 0                                         << 8499>>55525000
   THEN @DEVNAME := @FILENAME( FEQ'ANAME'SIZE )                << 8499>>55530000
   ELSE @DEVNAME := (@FEQ'ENTRY + 1) * 2;                      << 8499>>55535000
                                                               << 8499>>55540000
MOVE TEMP := DEVNAME,( FEQ'DNAME'SIZE );                       << 8499>>55545000
                                                               << 8499>>55550000
<< NOW SEPARATE THE DEVICE PART AND ITS KEYWORD (PARAMETER) >> << 8499>>55555000
<< PART.                                                    >> << 8499>>55560000
                                                               << 8499>>55565000
SCAN TEMP UNTIL %6473, 1; << LOOK FOR CR, SEMICOLON >>         << 8499>>55570000
DEVPART := TOS - @TEMP;                                        << 8499>>55575000
KEYPART := FEQ'DNAME'SIZE - DEVPART - 1;  << LENGTH KYWDS   >> << 8499>>55580000
                                                               << 8499>>55585000
<< MOVE IN THE DEVICE INFORMATION >>                           << 8499>>55590000
MOVE OUT'BUFF( OB'INDEX ) := DEVNAME,(DEVPART);                << 8499>>55595000
OB'INDEX := OB'INDEX + DEVPART;                                << 8499>>55600000
<< POSTION @FEQ'ENTRY TO THE WORD AFTER THE AOPTIONS WORD >>   << 8499>>55605000
                                                               << 8499>>55610000
<< Now increment @FEQ'ENTRY one past the AOPTIONs word >>      << 8499>>55615000
                                                               << 8499>>55620000
@FEQ'ENTRY := @FEQ'ENTRY +                                     << 8499>>55625000
              ((FEQ'ANAME'SIZE + FEQ'DNAME'SIZE + 1)/2) + 3;   << 8499>>55630000
                                                               << 8499>>55635000
<< NOW SEE IF ANY KEYWORDS EXIST FOR THIS DEVICE, IF SO PUT >> << 8499>>55640000
<< THEM INTO OUT'BUFF (OUTPRI AND NUMCOPIES)                >> << 8499>>55645000
                                                               << 8499>>55650000
IF (( FEQ'NUM'COPIES = 1 ) LOR ( FEQ'OUT'PRI = 1 ))            << 8499>>55655000
   THEN BEGIN                                                  << 8499>>55660000
        << NUMCOPIES OR OUTPUT PRIORITY KWDS >>                << 8499>>55665000
        LOAD'STRING( COMMA );                                  << 8499>>55670000
                                                               << 8499>>55675000
        << PICK UP THE NUMCOPIES/OUTPRI >>                     << 8499>>55680000
        I := INTEGER( FEQ'ENTRY( 6 ) );                        << 8499>>55685000
        IF FEQ'OUT'PRI = 1                                     << 8499>>55690000
           THEN PUTNUM( I.(0:4) );                             << 8499>>55695000
        IF FEQ'NUM'COPIES = 1                                  << 8499>>55700000
           THEN BEGIN                                          << 8499>>55705000
                LOAD'STRING( COMMA );                          << 8499>>55710000
                PUTNUM( I.(4:7) );                             << 8499>>55715000
                END;                                           << 8499>>55720000
        END;                                                   << 8499>>55725000
                                                               << 8499>>55730000
<< GET THE KEY WORDS SUPPIED IN JDT >>                         << 8499>>55735000
IF KEYPART > 0                                                 << 8499>>55740000
   THEN BEGIN                                                  << 8499>>55745000
        IF ((DEVPART = 0) LAND (NOT (FEQ'NUM'COPIES) LOR       << 8499>>55750000
                                    (FEQ'OUT'PRI)))            << 8499>>55755000
           THEN OB'INDEX := OB'INDEX - 5;                      << 8499>>55760000
        @KEYWORDS := @DEVNAME + DEVPART; << START OF KYWDS >>  << 8499>>55765000
        MOVE OUT'BUFF( OB'INDEX ) := KEYWORDS,(KEYPART);       << 8499>>55770000
        OB'INDEX := OB'INDEX + KEYPART;                        << 8499>>55775000
        END;                                                   << 8499>>55780000
                                                               << 8499>>55785000
                                                               << 8499>>55790000
END;   << Subroutine OBTAIN'DEV'INFO >>                        << 8499>>55795000
$PAGE                                                          << 8499>>55800000
<<************************************************************><< 8499>>55805000
<<                                                            ><< 8499>>55810000
<< SUBROUTINE OBTAIN'FORMS'LABEL'KSAM                         ><< 8499>>55815000
<<                                                            ><< 8499>>55820000
<< PURPOSE:  TO LOAD INTO OUT'BUFF INFORMATION REGARDING ANY  ><< 8499>>55825000
<<           FORMS FILE, TAPE LABEL, OR KSAM INFORMATION      ><< 8499>>55830000
<<                                                            ><< 8499>>55835000
<<************************************************************><< 8499>>55840000
                                                               << 8499>>55845000
SUBROUTINE OBTAIN'FORMS'LABEL'KSAM( TYPE );                    << 8499>>55850000
VALUE TYPE;                                                    << 8499>>55855000
INTEGER TYPE;                                                  << 8499>>55860000
                                                               << 8499>>55865000
<<************************************************************><< 8499>>55870000
<<                                                            ><< 8499>>55875000
<< TYPE - IF 0 THEN LOAD OUT'BUFF WITH TAPE LABEL INFORMATION ><< 8499>>55880000
<<      - IF 1 THEN LOAD OUT'BUFF WITH FORMS FILE INFORMATION ><< 8499>>55885000
<<                                                            ><< 8499>>55890000
<<************************************************************><< 8499>>55895000
                                                               << 8499>>55900000
BEGIN                                                          << 8499>>55905000
                                                               << 8499>>55910000
<< IT IS ASSUMED THAT @FEQ'ENTRY IS POINTING AT THE REF COUNT ><< 8499>>55915000
<< AND #USER LABELS WORD IN THE FEQ                           ><< 8499>>55920000
                                                               << 8499>>55925000
LABEL'LENGTH := FEQ'ENTRY( 2 );                                << 8499>>55930000
IF LABEL'LENGTH <> 0                                           << 8499>>55935000
   THEN BEGIN                                                  << 8499>>55940000
        CASE TYPE OF                                           << 8499>>55945000
             BEGIN                                             << 8499>>55950000
                                                               << 8499>>55955000
             << 0 >> << FORMS >>                               << 8499>>55960000
             BEGIN                                             << 8499>>55965000
             @FORM :=  @FEQ'ENTRY( 3 ) * 2;                    << 8499>>55970000
             SCAN FORM UNTIL "..",1;                           << 8499>>55975000
             @EOF := TOS;                                      << 8499>>55980000
             IF @EOF > @FORM                                   << 8499>>55985000
                THEN BEGIN                                     << 8499>>55990000
                     LOAD'STRING( EQUALS );                    << 8499>>55995000
                     I := @EOF - @FORM + 1;                    << 8499>>56000000
                     MOVE OUT'BUFF( OB'INDEX ) := FORM,(I);    << 8499>>56005000
                     OB'INDEX := OB'INDEX + I;                 << 8499>>56010000
                     END;                                      << 8499>>56015000
             END;  << FORMS >>                                 << 8499>>56020000
                                                               << 8499>>56025000
             << 1 >> << LABEL >>                               << 8499>>56030000
             BEGIN                                             << 8499>>56035000
             @LABEL'F := @FEQ'ENTRY( 3 ) * 2;                  << 8499>>56040000
             SCAN LABEL'F UNTIL "..",1;                        << 8499>>56045000
             @EOF := TOS;                                      << 8499>>56050000
             IF LABEL'LENGTH > (@EOF - @LABEL'F + 1 )          << 8499>>56055000
                THEN BEGIN                                     << 8499>>56060000
                     LOAD'STRING( EQUALS );                    << 8499>>56065000
                     I := LABEL'LENGTH -(@EOF-@LABEL'F) - 2;   << 8499>>56070000
                     MOVE OUT'BUFF( OB'INDEX ) := EOF(1),(I);  << 8499>>56075000
                     OB'INDEX := OB'INDEX + I;                 << 8499>>56080000
                     END;                                      << 8499>>56085000
             END;   << LABEL >>                                << 8499>>56090000
                                                               << 8499>>56095000
             END;   << CASE STMT >>                            << 8499>>56100000
                                                               << 8499>>56105000
        END;  << BEGIN  - LABEL'LENGTH <> 0 >>                 << 8499>>56110000
                                                               << 8499>>56115000
END;  << OBTAIN'FORMS'LABEL'KSAM >>                            << 8499>>56120000
$PAGE                                                          << 8499>>56125000
<<*************************************************************<< 8499>>56130000
<<                                                             << 8499>>56135000
<< SUBROUTINE FORMAT'WITH'PMASKS                               << 8499>>56140000
<<                                                             << 8499>>56145000
<< PURPOSE:  TO FORMAT THE FEQ INTO THE OUTPUT BUFFER OUT'BUFF << 8499>>56150000
<<           ACCORDING TO THE VARIOUS BIT MAPS IN PMASK1 AND   << 8499>>56155000
<<           PMASK2.                                           << 8499>>56160000
<<                                                             << 8499>>56165000
<<*************************************************************<< 8499>>56170000
                                                               << 8499>>56175000
SUBROUTINE FORMAT'WITH'PMASKS;                                 << 8499>>56180000
BEGIN                                                          << 8499>>56185000
                                                               << 8499>>56190000
<< UPON ENTRANCE TO THIS SUBROUTINE, @FEQ'ENTRY IS POINTING >> << 8499>>56195000
<< TO EITHER THE START OF THE DEVICE CLASS/DEVICE NUMBER    >> << 8499>>56200000
<< ENTRIES OR AT THE WORD IMMEDIATELY FOLLOWING THE WORD    >> << 8499>>56205000
<< CONTAINING THE AOPTIONS.                                 >> << 8499>>56210000
                                                               << 8499>>56215000
<< FORMAL DESIGNATOR KEYWORDS >>                               << 8499>>56220000
IF FEQ'DEFAULT'DESIG = 1                                       << 8499>>56225000
   THEN CASE FOPT'DEFAULT'DESIG OF                             << 8499>>56230000
             BEGIN                                             << 8499>>56235000
             << 0 >> << FILE NAME >>                           << 8499>>56240000
             ;                                                 << 8499>>56245000
                                                               << 8499>>56250000
             << 1 >> << $STDLIST  >>                           << 8499>>56255000
             LOAD'STRING( STDLIST );                           << 8499>>56260000
                                                               << 8499>>56265000
             << 2 >> << $NEWPASS  >>                           << 8499>>56270000
             LOAD'STRING( NEWPASS );                           << 8499>>56275000
                                                               << 8499>>56280000
             << 3 >> << $OLDPASS  >>                           << 8499>>56285000
             LOAD'STRING( OLDPASS );                           << 8499>>56290000
                                                               << 8499>>56295000
             << 4 >> << $STDIN    >>                           << 8499>>56300000
             LOAD'STRING( STDIN   );                           << 8499>>56305000
                                                               << 8499>>56310000
             << 5 >> << $STDINX   >>                           << 8499>>56315000
             LOAD'STRING( STDINX  );                           << 8499>>56320000
                                                               << 8499>>56325000
             << 6 >> << $NULL     >>                           << 8499>>56330000
             LOAD'STRING(  NULL   );                           << 8499>>56335000
                                                               << 8499>>56340000
             END;  << CASE STATEMENT >>                        << 8499>>56345000
                                                               << 8499>>56350000
                                                               << 8499>>56355000
<< NEW/OLD/OLDTEMP/ KEYWORDS >>                                << 8499>>56360000
IF FEQ'DOMAIN = 1                                              << 8499>>56365000
   THEN CASE FOPT'DOMAIN OF                                    << 8499>>56370000
             BEGIN                                             << 8499>>56375000
                                                               << 8499>>56380000
             << 0 >> << NEW >>                                 << 8499>>56385000
             LOAD'STRING( NEW );                               << 8499>>56390000
                                                               << 8499>>56395000
             << 1 >> << OLD >>                                 << 8499>>56400000
             LOAD'STRING( OLD );                               << 8499>>56405000
                                                               << 8499>>56410000
             << 2 >> << OLDTEMP >>                             << 8499>>56415000
             LOAD'STRING( OLDTEMP );                           << 8499>>56420000
                                                               << 8499>>56425000
             END; << CASE STMT >>                              << 8499>>56430000
                                                               << 8499>>56435000
<< FEQ'DEVICE is set if ;DEV=, ;ENV=, or ;OUTQ= >>             << 8499>>56440000
IF ((FEQ'DEVICE = 1) LOR (FEQ'NUM'COPIES=1)LOR(FEQ'OUT'PRI=1)  << 8499>>56445000
                     LOR (FEQ'VTERM = 1   ))                   << 8499>>56450000
   THEN BEGIN                                                  << 8499>>56455000
        LOAD'STRING( DEV );                                    << 8499>>56460000
        OBTAIN'DEV'INFO;    << LOAD THE DEVICE NAME >>         << 8499>>56465000
                            << AND ANY PARAMETERS   >>         << 8499>>56470000
        END << Getting device information >>                   << 8499>>56475000
   ELSE BEGIN                                                  << 8499>>56480000
                                                               << 8499>>56485000
        << Need to properly increment FEQ'ENTRY >>             << 8499>>56490000
                                                               << 8499>>56495000
        @FEQ'ENTRY := @FEQ'ENTRY +                             << 8499>>56500000
                      ((FEQ'ANAME'SIZE+FEQ'DNAME'SIZE+1)/2)+3; << 8499>>56505000
        END;  << ELSE BEGIN >>                                 << 8499>>56510000
                                                               << 8499>>56515000
<< @FEQ'ENTRY IS NOW POINTING TO THE NUMBUFFER/INIT ALLOCAT >> << 8499>>56520000
<< WORD IN FEQ.  THIS IS THE WORD IMMEDIATELY AFTER THE     >> << 8499>>56525000
<< AOPTIONS WORD                                            >> << 8499>>56530000
                                                               << 8499>>56535000
<< REC KEYWORD >>                                              << 8499>>56540000
IF ((FEQ'BLOCK'FACTOR=1) LOR                                   << 8499>>56545000
    (FEQ'REC'SIZE = 1  ) LOR                                   << 8499>>56550000
    (FEQ'REC'FMT  = 1  ) LOR                                   << 8499>>56555000
    (FEQ'ASCII    = 1  ) )                                     << 8499>>56560000
   THEN BEGIN                                                  << 8499>>56565000
        << REC = >>                                            << 8499>>56570000
        LOAD'STRING( REC );                                    << 8499>>56575000
        IF FEQ'REC'SIZE = 1                                    << 8499>>56580000
           THEN PUTNUM( FEQ'ENTRY( 1 ) ); << RECORD SIZE >>    << 8499>>56585000
                                                               << 8499>>56590000
        IF (( FEQ'BLOCK'FACTOR = 1 ) LOR                       << 8499>>56595000
            ( FEQ'REC'FMT      = 1 ) LOR                       << 8499>>56600000
            ( FEQ'ASCII        = 1 ) )                         << 8499>>56605000
           THEN BEGIN                                          << 8499>>56610000
                LOAD'STRING( COMMA );                          << 8499>>56615000
                IF FEQ'BLOCK'FACTOR = 1                        << 8499>>56620000
                   THEN PUTNUM( FEQ'ENTRY( 2 ).(8:8) );        << 8499>>56625000
                                                               << 8499>>56630000
                IF (( FEQ'REC'FMT = 1 ) LOR                    << 8499>>56635000
                    ( FEQ'ASCII   = 1 ) )                      << 8499>>56640000
                   THEN BEGIN                                  << 8499>>56645000
                        LOAD'STRING( COMMA );                  << 8499>>56650000
                        IF FEQ'REC'FMT = 1                     << 8499>>56655000
                           THEN CASE FOPT'RECORD'FMT OF        << 8499>>56660000
                                     BEGIN                     << 8499>>56665000
                                                               << 8499>>56670000
                                     << 0 >> << F >>           << 8499>>56675000
                                     LOAD'STRING( FIXED );     << 8499>>56680000
                                                               << 8499>>56685000
                                     << 1 >> << V >>           << 8499>>56690000
                                     LOAD'STRING( VARIABLE' ); << 8499>>56695000
                                                               << 8499>>56700000
                                     << 2 >> << U >>           << 8499>>56705000
                                     LOAD'STRING( UNDEFINED ); << 8499>>56710000
                                                               << 8499>>56715000
                                     END;<< CASE STMT >>       << 8499>>56720000
                                                               << 8499>>56725000
                        IF FEQ'ASCII = 1                       << 8499>>56730000
                           THEN BEGIN                          << 8499>>56735000
                                CASE FOPT'ASCII'BINARY OF      << 8499>>56740000
                                     BEGIN                     << 8499>>56745000
                                                               << 8499>>56750000
                                     << 0 >> << BINARY >>      << 8499>>56755000
                                     LOAD'STRING( BINARY' );   << 8499>>56760000
                                                               << 8499>>56765000
                                     << 1 >> << ASCII >>       << 8499>>56770000
                                     LOAD'STRING( ASCII' );    << 8499>>56775000
                                                               << 8499>>56780000
                                     END; << CASE STMT >>      << 8499>>56785000
                                                               << 8499>>56790000
                                END; << FEQ'ASCII = 1 >>       << 8499>>56795000
                                                               << 8499>>56800000
                        END; << FEQ'REC'FMT  OR FEQ'ASCII >>   << 8499>>56805000
                                                               << 8499>>56810000
                END;  << FEQ'BLOCK'FACTOR OR FEQ'REC'FMT >>    << 8499>>56815000
                      << OR FEQ'ASCII                    >>    << 8499>>56820000
                                                               << 8499>>56825000
        END; << FEQ'BLOCK'FACTOR OR FEQ'REC'SIZE OR >>         << 8499>>56830000
             << FEQ'REC'FMT OR FEQ'ASCII            >>         << 8499>>56835000
                                                               << 8499>>56840000
                                                               << 8499>>56845000
<< DISC KEYWORD >>                                             << 8499>>56850000
IF (( FEQ'INIT'ALLOC  = 1 ) LOR                                << 8499>>56855000
    ( FEQ'NUM'EXTENTS = 1 ) LOR                                << 8499>>56860000
    ( FEQ'FILE'SIZE   = 1 ) )                                  << 8499>>56865000
    THEN BEGIN                                                 << 8499>>56870000
         LOAD'STRING( DISC );  << ;DISC= >>                    << 8499>>56875000
         @FILE'SIZE := @FEQ'ENTRY+ 3;    << DOUBLE FILE SIZE >><< 8499>>56880000
         IF FEQ'FILE'SIZE = 1                                  << 8499>>56885000
            THEN PUTDNUM( FILE'SIZE ); << LOAD FILE SIZE >>    << 8499>>56890000
         IF (( FEQ'NUM'EXTENTS = 1 ) LOR                       << 8499>>56895000
             ( FEQ'INIT'ALLOC  = 1 ) )                         << 8499>>56900000
            THEN BEGIN                                         << 8499>>56905000
                 LOAD'STRING( COMMA );                         << 8499>>56910000
                 IF FEQ'NUM'EXTENTS = 1                        << 8499>>56915000
                    THEN PUTNUM( FEQ'ENTRY( 2 ).(0:5) + 1 );   << 8499>>56920000
                                                               << 8499>>56925000
                 IF FEQ'INIT'ALLOC = 1                         << 8499>>56930000
                    THEN BEGIN                                 << 8499>>56935000
                         LOAD'STRING( COMMA );                 << 8499>>56940000
                         PUTNUM( FEQ'ENTRY( 0 ).(8:5) + 1 );   << 8499>>56945000
                         END; << FEQ'INIT'ALLLOC >>            << 8499>>56950000
                                                               << 8499>>56955000
                 END;  << FEQ'NUM'EXTENTS OR FEQ'INIT'ALLOC >> << 8499>>56960000
                                                               << 8499>>56965000
         END; << FEQ'FILE'SIZE OR FEQ'NUM'EXTENTS >>           << 8499>>56970000
              << FEQ'INIT'ALLOC                   >>           << 8499>>56975000
                                                               << 8499>>56980000
IF (( FEQ'BUF'INHIBIT = 1 ) LAND ( AOPT'NOBUFF = 1 ))          << 8499>>56985000
   THEN LOAD'STRING( NOBUF );                                  << 8499>>56990000
                                                               << 8499>>56995000
<< CCTL/NOCCTL KEYWORDS >>                                     << 8499>>57000000
IF FEQ'CCTL = 1                                                << 8499>>57005000
   THEN IF FOPT'CCTL = 1                                       << 8499>>57010000
           THEN LOAD'STRING( CCTL )                            << 8499>>57015000
           ELSE LOAD'STRING( NOCCTL );                         << 8499>>57020000
                                                               << 8499>>57025000
IF FEQ'MULTI'REC = 1                                           << 8499>>57030000
   THEN IF AOPT'MULTI'RECORD = 1                               << 8499>>57035000
           THEN LOAD'STRING( MR )                              << 8499>>57040000
           ELSE LOAD'STRING( NOMR );                           << 8499>>57045000
                                                               << 8499>>57050000
                                                               << 8499>>57055000
<< EXC/EAR/SHR KEYWORDS >>                                     << 8499>>57060000
IF FEQ'EXCLUSIVE = 1                                           << 8499>>57065000
   THEN CASE AOPT'EXCLUSIVE'AC OF                              << 8499>>57070000
             BEGIN                                             << 8499>>57075000
                                                               << 8499>>57080000
             << 0 >> << DEFAULT >>                             << 8499>>57085000
             ;                                                 << 8499>>57090000
             << 1 >> << EXCLUSIVE >>                           << 8499>>57095000
             LOAD'STRING( EXC );                               << 8499>>57100000
                                                               << 8499>>57105000
             << 2 >> << SEMI >>                                << 8499>>57110000
             LOAD'STRING( SEMI );                              << 8499>>57115000
                                                               << 8499>>57120000
             << 3 >> << SHARED >>                              << 8499>>57125000
             LOAD'STRING( SHR  );                              << 8499>>57130000
                                                               << 8499>>57135000
             END; << CASE STMT >>                              << 8499>>57140000
                                                               << 8499>>57145000
<< ACC KEYWORD >>                                              << 8499>>57150000
IF FEQ'ACCESS'TYPE = 1                                         << 8499>>57155000
   THEN BEGIN                                                  << 8499>>57160000
        LOAD'STRING( ACC );                                    << 8499>>57165000
        CASE AOPT'ACCESS'TYPE OF                               << 8499>>57170000
             BEGIN                                             << 8499>>57175000
                                                               << 8499>>57180000
             << 0 >> << IN - READ ONLY >>                      << 8499>>57185000
             LOAD'STRING( IN );                                << 8499>>57190000
                                                               << 8499>>57195000
             << 1 >> << OUT - WRITE ONLY >>                    << 8499>>57200000
             LOAD'STRING( OUT );                               << 8499>>57205000
                                                               << 8499>>57210000
             << 2 >> << OUTKEEP - WRITE ONLY(SAVE) >>          << 8499>>57215000
             LOAD'STRING( OUTKEEP );                           << 8499>>57220000
                                                               << 8499>>57225000
             << 3 >> << APPEND - APPEND ONLY >>                << 8499>>57230000
             LOAD'STRING( APPEND );                            << 8499>>57235000
                                                               << 8499>>57240000
             << 4 >> << INOUT - READ/WRITE >>                  << 8499>>57245000
             LOAD'STRING( INOUT );                             << 8499>>57250000
                                                               << 8499>>57255000
             << 5 >> << UPDATE >>                              << 8499>>57260000
             LOAD'STRING( UPDATE );                            << 8499>>57265000
                                                               << 8499>>57270000
             << 6 >> << EXECUTE - NOT USED >>                  << 8499>>57275000
                                                               << 8499>>57280000
             END; << CASE STMT >>                              << 8499>>57285000
                                                               << 8499>>57290000
        END;  << FEQ'ACCESS'TYPE = 1 >>                        << 8499>>57295000
                                                               << 8499>>57300000
<< BUF KEYWORD >>                                              << 8499>>57305000
IF FEQ'NUM'BUFFS = 1                                           << 8499>>57310000
   THEN BEGIN                                                  << 8499>>57315000
        LOAD'STRING( BUF ); << ;BUFF= >>                       << 8499>>57320000
        PUTNUM( FEQ'ENTRY( 0 ).(0:8) );                        << 8499>>57325000
        END;                                                   << 8499>>57330000
                                                               << 8499>>57335000
<< DEL/SAVE/TEMP KEYWORDS >>                                   << 8499>>57340000
IF FEQ'DISP = 1                                                << 8499>>57345000
   THEN IF FEQ'ENTRY( 0 ).(13:1) = 1                           << 8499>>57350000
           THEN LOAD'STRING( DEL' )                            << 8499>>57355000
           ELSE IF FEQ'ENTRY( 0 ).(14:1) = 1                   << 8499>>57360000
                   THEN LOAD'STRING( TEMP' )                   << 8499>>57365000
                   ELSE IF FEQ'ENTRY( 0 ).(15:1) = 1           << 8499>>57370000
                           THEN LOAD'STRING( SAVE );           << 8499>>57375000
                                                               << 8499>>57380000
<< COPY/NOCOPY KEYWORDS >>                                     << 8499>>57385000
IF FEQ'COPY = 1                                                << 8499>>57390000
   THEN CASE AOPT'COPY OF                                      << 8499>>57395000
             BEGIN                                             << 8499>>57400000
                                                               << 8499>>57405000
             << 0 >> << NOCOPY - NATIVE MODE >>                << 8499>>57410000
             LOAD'STRING( NOCOPY );                            << 8499>>57415000
                                                               << 8499>>57420000
             << 1 >> << COPY - SEQ FILE ACCESS >>              << 8499>>57425000
             LOAD'STRING( COPY );                              << 8499>>57430000
                                                               << 8499>>57435000
             END;  << CASE STMT >>                             << 8499>>57440000
                                                               << 8499>>57445000
<< CODE KEYWORD >>                                             << 8499>>57450000
IF FEQ'FILE'CODE = 1                                           << 8499>>57455000
   THEN BEGIN                                                  << 8499>>57460000
        LOAD'STRING( CODE );  << ;CODE= >>                     << 8499>>57465000
        PUTNUM( FEQ'ENTRY( 5 ) ); << FILE CODE >>              << 8499>>57470000
        END;                                                   << 8499>>57475000
                                                               << 8499>>57480000
<< MULTI/NOMULTI/GMULTI KEYWORDS >>                            << 8499>>57485000
IF FEQ'MULTI'ACCESS = 1                                        << 8499>>57490000
   THEN CASE AOPT'MULTI'ACCESS OF                              << 8499>>57495000
             BEGIN                                             << 8499>>57500000
                                                               << 8499>>57505000
             << 0 >> << NOMULTI - NON-MULTIPLE ACCESS >>       << 8499>>57510000
             LOAD'STRING( NOMULTI );                           << 8499>>57515000
                                                               << 8499>>57520000
             << 1 >> << MULTI - INTRA-JOB MULTIPLE ACCESS >>   << 8499>>57525000
             LOAD'STRING( MULTI );                             << 8499>>57530000
                                                               << 8499>>57535000
             << 2 >> << GMULTI - INTER-JOB MULTIPLE ACCESS >>  << 8499>>57540000
             LOAD'STRING( GMULTI );                            << 8499>>57545000
                                                               << 8499>>57550000
             END; << CASE STMT >>                              << 8499>>57555000
                                                               << 8499>>57560000
<< WAIT/NOWAIT KEYWORDS >>                                     << 8499>>57565000
IF FEQ'WAIT = 1                                                << 8499>>57570000
   THEN IF AOPT'NOWAIT = 1                                     << 8499>>57575000
           THEN LOAD'STRING( NOWAIT )                          << 8499>>57580000
           ELSE LOAD'STRING( WAIT   );                         << 8499>>57585000
                                                               << 8499>>57590000
<< INCREMENT @FEQ'ENTRY TO THE START OF THE REF COUNT AND >>   << 8499>>57595000
<< NUMBER OF USER LABELS WORD                             >>   << 8499>>57600000
                                                               << 8499>>57605000
@FEQ'ENTRY := @FEQ'ENTRY + 7;                                  << 8499>>57610000
                                                               << 8499>>57615000
<< NOLABEL/LABEL = KEYWORD >>                                  << 8499>>57620000
IF (( FEQ'LABELED'TAPE = 1 ) LAND                              << 8499>>57625000
    ( FOPT'TAPE'LABEL'F = 0) )                                 << 8499>>57630000
    THEN LOAD'STRING( NOLABEL )                                << 8499>>57635000
    ELSE IF FEQ'LABELED'TAPE = 1                               << 8499>>57640000
             THEN BEGIN                                        << 8499>>57645000
                  LOAD'STRING( LABEL' );                       << 8499>>57650000
                  OBTAIN'FORMS'LABEL'KSAM( TAPE'LABEL );       << 8499>>57655000
                 END;                                          << 8499>>57660000
                                                               << 8499>>57665000
IF FEQ'FILE'TYPE = 1                                           << 8499>>57670000
   THEN CASE FOPT'FILE'TYPE OF                                 << 8499>>57675000
             BEGIN                                             << 8499>>57680000
                                                               << 8499>>57685000
             << 0 >> << STD FILE >>                            << 8499>>57690000
             LOAD'STRING( STD );                               << 8499>>57695000
                                                               << 8499>>57700000
             << 1 >> << KSAM >>                                << 8499>>57705000
             LOAD'STRING( KSAM' );                             << 8499>>57710000
                                                               << 8499>>57715000
             << 2 >> << RIO >>                                 << 8499>>57720000
             LOAD'STRING( RIO );                               << 8499>>57725000
                                                               << 8499>>57730000
             << 3 >> << UNDEFINED - NOT USED >>                << 8499>>57735000
             ;                                                 << 8499>>57740000
                                                               << 8499>>57745000
             << 4 >> << CIR >>                                 << 8499>>57750000
             LOAD'STRING( CIR );                               << 8499>>57755000
                                                               << 8499>>57760000
             << 5 >> << UNDEFINED - NOT USED >>                << 8499>>57765000
             ;                                                 << 8499>>57770000
                                                               << 8499>>57775000
             << 6 >> << MSG >>                                 << 8499>>57780000
             LOAD'STRING( MSG );                               << 8499>>57785000
                                                               << 8499>>57790000
             END; << CASE STMT >>                              << 8499>>57795000
                                                               << 8499>>57800000
<< FORM KEYWORD >>                                             << 8499>>57805000
IF FEQ'FORMS = 1                                               << 8499>>57810000
   THEN BEGIN                                                  << 8499>>57815000
        LOAD'STRING( FORMS );                                  << 8499>>57820000
        OBTAIN'FORMS'LABEL'KSAM( FORMS'TYPE );                 << 8499>>57825000
        END;                                                   << 8499>>57830000
                                                               << 8499>>57835000
<< LOCK/NOLOCK KEYWORD >>                                      << 8499>>57840000
IF FEQ'DYNAMIC'LOCK = 1                                        << 8499>>57845000
   THEN IF AOPT'LOCKING = 1                                    << 8499>>57850000
           THEN LOAD'STRING( LOCK )                            << 8499>>57855000
           ELSE LOAD'STRING( NOLOCK );                         << 8499>>57860000
                                                               << 8499>>57865000
END;  << FORMAT'WITH'PMASKS >>                                 << 8499>>57870000
                                                               << 8499>>57875000
                                                               << 8499>>57880000
$PAGE                                                          << 8499>>57885000
<<***********************************************************>><< 8499>>57890000
<<                                                           >><< 8499>>57895000
<< SUBROUTINE PRINT'LINE                                     >><< 8499>>57900000
<<                                                           >><< 8499>>57905000
<< PURPOSE - TO PRINT THE OUTPUT BUFFER OF OUT'BUFF TO THE   >><< 8499>>57910000
<<           LISTFILE, IF APPLICABLE, OR TO STDLIST.         >><< 8499>>57915000
<<                                                           >><< 8499>>57920000
<<***********************************************************>><< 8499>>57925000
                                                               << 8499>>57930000
SUBROUTINE PRINT'LINE;                                         << 8499>>57935000
BEGIN                                                          << 8499>>57940000
FWRITE( FILE'NUM, OUT'BUFF'L, -OB'INDEX, 0 );                  << 8499>>57945000
IF <>                                                          << 8499>>57950000
   THEN CIERR( ERRNUM := 555 );                                << 8499>>57955000
                                                               << 8499>>57960000
END;  << PRINT'LINE >>                                         << 8499>>57965000
$PAGE                                                          << 8499>>57970000
<<**********************************************************>> << 8499>>57975000
<<                                                          >> << 8499>>57980000
<< SUBROUTINE LIST'FILE'ERROR                               >> << 8499>>57985000
<<                                                          >> << 8499>>57990000
<< PURPOSE:  PRINTS THE LISTFILE ERRORS                     >> << 8499>>57995000
<<                                                          >> << 8499>>58000000
<<**********************************************************>> << 8499>>58005000
                                                               << 8499>>58010000
SUBROUTINE LIST'FILE'ERROR;                                    << 8499>>58015000
BEGIN                                                          << 8499>>58020000
FERROR'( FILE'NUM, ERROR'PARM );                               << 8499>>58025000
ERRNUM := LISTFFSERR;                                          << 8499>>58030000
TOS := LISTFFSERR;                                             << 8499>>58035000
TOS := @L'F'NAME;                                              << 8499>>58040000
CIERR( *, *, %10000, ERROR'PARM );                             << 8499>>58045000
FCLOSE( FILE'NUM, 0, 0 );                                      << 8499>>58050000
END;                                                           << 8499>>58055000
$PAGE                                                          << 8499>>58060000
                                                               << 8499>>58065000
<<***********************************************************>><< 8499>>58070000
<<                                                           >><< 8499>>58075000
<< SUBROUTINE CLOSE'LISTFILE                                 >><< 8499>>58080000
<<                                                           >><< 8499>>58085000
<< PURPOSE:  TO CLOSE THE LISTFILE FOPENED BEFORE THE FEQ    >><< 8499>>58090000
<<           FORMATTING.                                     >><< 8499>>58095000
<<                                                           >><< 8499>>58100000
<<***********************************************************>><< 8499>>58105000
                                                               << 8499>>58110000
SUBROUTINE CLOSE'LISTFILE;                                     << 8499>>58115000
                                                               << 8499>>58120000
BEGIN                                                          << 8499>>58125000
<< IF COMPLETE = FALSE PURGE THE FILE, ELSE SAVE IT >>         << 8499>>58130000
<< FILE'NUM <> 2 IF OUTPUT NOT TO $STDLIST          >>         << 8499>>58135000
IF FILE'NUM <> 2                                               << 8499>>58140000
   THEN BEGIN                                                  << 8499>>58145000
        FCLOSE( FILE'NUM, 2, 0 );                              << 8499>>58150000
        IF <>                                                  << 8499>>58155000
           THEN LIST'FILE'ERROR;                               << 8499>>58160000
        END;                                                   << 8499>>58165000
END;                                                           << 8499>>58170000
$PAGE                                                          << 8499>>58175000
<<*********************************************************>>  << 8499>>58180000
<<                                                         >>  << 8499>>58185000
<< SUBROUTINE HANDLE'LIST'FILE                                 << 8499>>58190000
<<                                                         >>  << 8499>>58195000
<< PURPOSE - TO FOPEN THE LIST FILE, IF ANY.  IF THE FOPEN >>  << 8499>>58200000
<<           SUCCEEDS, THE RETURN TRUE. IF THE FOPEN FAILS >>  << 8499>>58205000
<<           RETURN FALSE.  IF NO LIST FILE WAS SPECIFIED  >>  << 8499>>58210000
<<           IN THE PARAMTER LIST, RETURN TRUE             >>  << 8499>>58215000
<<                                                         >>  << 8499>>58220000
<<*********************************************************>>  << 8499>>58225000
                                                               << 8499>>58230000
LOGICAL SUBROUTINE HANDLE'LIST'FILE;                           << 8499>>58235000
                                                               << 8499>>58240000
BEGIN                                                          << 8499>>58245000
FILE'NUM := 2;  << DEFAULT TO $STDLIST W/NO FOPEN >>           << 8499>>58250000
HANDLE'LIST'FILE := TRUE;                                      << 8499>>58255000
IF L'F'LEN <> 0                                                << 8499>>58260000
   THEN BEGIN                                                  << 8499>>58265000
                                                               << 8499>>58270000
        << FOPEN THE LISTFILE >>                               << 8499>>58275000
        MOVE L'F'NAME( L'F'LEN + 1 ) := 0;                     << 8499>>58280000
                                                               << 8499>>58285000
        << Foptions = New ASCII,    FEQ, CCTL >>               << 8499>>58290000
        << Aoptions = Write only, Exclusive   >>               << 8499>>58295000
                                                               << 8499>>58300000
        FILE'NUM := FOPEN( L'F'NAME, %2504, %101 );            << 8499>>58305000
        IF <>                                                  << 8499>>58310000
           THEN BEGIN                                          << 8499>>58315000
                LIST'FILE'ERROR;                               << 8499>>58320000
                FCLOSE( FILE'NUM, 0, 0 );                      << 8499>>58325000
                HANDLE'LIST'FILE := FALSE;                     << 8499>>58330000
                END;                                           << 8499>>58335000
        END;                                                   << 8499>>58340000
END;  << HANDLE'LIST'FILE >>                                   << 8499>>58345000
$PAGE                                                          << 8499>>58350000
<<************************************************************><< 8499>>58355000
<<                                                            ><< 8499>>58360000
<< SUBROUTINE FORMAT'FEQ                                      ><< 8499>>58365000
<<                                                            ><< 8499>>58370000
<< PURPOSE - THE DRIVE THE FORMATTING OF THE FEQ'S            ><< 8499>>58375000
<<                                                            ><< 8499>>58380000
<<************************************************************><< 8499>>58385000
                                                               << 8499>>58390000
SUBROUTINE FORMAT'FEQ;                                         << 8499>>58395000
BEGIN                                                          << 8499>>58400000
<< SET THE HEAD AND TAIL POINTERS TO FEQ TABLE >>              << 8499>>58405000
<< THESE POINTERS ARE JDTARR RELATIVE          >>              << 8499>>58410000
OB'INDEX := 0;  << INDEX TO OUT'BUFF >>                        << 8499>>58415000
@FEQ'HEAD := JDTJTFEQPTR;                                      << 8499>>58420000
@FEQ'TAIL := JDTJTLEQPTR;                                      << 8499>>58425000
IF @FEQ'HEAD = @FEQ'TAIL                                       << 8499>>58430000
   THEN BEGIN                                                  << 8499>>58435000
        COMPLETE := FALSE;                                     << 8499>>58440000
        CIERR( ERRNUM := LEQ'NO'FEQS );        << NO FEQS HERE << 8499>>58445000
        END                                                    << 8499>>58450000
   ELSE BEGIN                                                  << 8499>>58455000
        << FEQ'ENTRY IS NOW POINTING AT THE FIRST FEQ ENTRY >> << 8499>>58460000
        << ONCE START OF Q RELATIVE ARRAY JDTARR IS ADDED   >> << 8499>>58465000
        @FEQ'ENTRY := @FEQ'HEAD + @JDTARR;                     << 8499>>58470000
        @FEQ'TAIL := @FEQ'TAIL + @JDTARR;                      << 8499>>58475000
                                                               << 8499>>58480000
        << NOW LOOP ON @FEQ'ENTRY UNTIL @FEQ'ENTRY EQUALS >>   << 8499>>58485000
        << @FEQ'TAIL, AT WHICH POINT THE FEQs SHOULD HAVE >>   << 8499>>58490000
        << ALL BEEN FORMATTED AND PRINTED.                >>   << 8499>>58495000
                                                               << 8499>>58500000
        OUT'BUFF( 0 ) := SPACE;                                << 8499>>58505000
        MOVE OUT'BUFF( 1 ) := OUT'BUFF( 0 ),(255);             << 8499>>58510000
                                                               << 8499>>58515000
        OB'INDEX := 2;                                         << 8499>>58520000
        << Post a blank line >>                                << 8499>>58525000
        PRINT'LINE;                                            << 8499>>58530000
        GENMSG( 2, LEQ'FEQS );                                 << 8499>>58535000
                                                               << 8499>>58540000
        COMPLETE := FALSE;                                     << 8499>>58545000
        WHILE ( @FEQ'ENTRY < @FEQ'TAIL ) DO                    << 8499>>58550000
          BEGIN                                                << 8499>>58555000
          OB'INDEX := 0;                                       << 8499>>58560000
          @SAVE'FEQ'ENTRY := @FEQ'ENTRY;                       << 8499>>58565000
          OUT'BUFF(0) := SPACE;                                << 8499>>58570000
          MOVE OUT'BUFF(1) := OUT'BUFF(0),(255);               << 8499>>58575000
          FEQ'WORDS := FEQ'ENTRY.(0:8);  << # WORDS/FEQ ENTRY ><< 8499>>58580000
          LOAD'STRING( FILE' );  << ":FILE " >>                << 8499>>58585000
                                                               << 8499>>58590000
          << GET FORMAL FILE DESIGNATOR NAME >>                << 8499>>58595000
          OBTAIN'FORMAL'DESIG;                                 << 8499>>58600000
          COMPLETE := TRUE;  << PRINTED SOMETHING >>           << 8499>>58605000
                                                               << 8499>>58610000
          << GET PARAMTER MASKS - PMASK1 AND PMASK2 >>         << 8499>>58615000
          OBTAIN'PMASKS;                                       << 8499>>58620000
                                                               << 8499>>58625000
          << GET THE ACTUAL FILE NAME IF APPLICABLE >>         << 8499>>58630000
          IF OBTAIN'ACTUAL'FNAME                               << 8499>>58635000
             THEN BEGIN                                        << 8499>>58640000
                  << THAT'S IT - PRINT IT >>                   << 8499>>58645000
                  << BACK REFERENCED ACTUAL FILE >>            << 8499>>58650000
                  PRINT'LINE;                                  << 8499>>58655000
                  END                                          << 8499>>58660000
             ELSE BEGIN                                        << 8499>>58665000
                  << CONTINUE ON >>                            << 8499>>58670000
                                                               << 8499>>58675000
                  << OBTAIN THE FOPTIONS AND AOPTIONS >>       << 8499>>58680000
                  OBTAIN'F'A'OPTIONS;                          << 8499>>58685000
                                                               << 8499>>58690000
                  << CONTINUE FORMATTING THE FEQ >>            << 8499>>58695000
                  FORMAT'WITH'PMASKS;                          << 8499>>58700000
                                                               << 8499>>58705000
                  << NOW PRINT THE RESULTS >>                  << 8499>>58710000
                  PRINT'LINE;                                  << 8499>>58715000
                  END;                                         << 8499>>58720000
                                                               << 8499>>58725000
          << INCREMENT @FEQ'ENTRY >>                           << 8499>>58730000
          @FEQ'ENTRY := @SAVE'FEQ'ENTRY +                      << 8499>>58735000
                        FEQ'WORDS;                             << 8499>>58740000
          END;   << WHILE BEGIN >>                             << 8499>>58745000
                                                               << 8499>>58750000
        << Post a line after the list of FEQ's >>              << 8499>>58755000
        OUT'BUFF( 0 ) := SPACE;                                << 8499>>58760000
        MOVE OUT'BUFF( 1 ) := OUT'BUFF,( 10 );                 << 8499>>58765000
        OB'INDEX := 2;                                         << 8499>>58770000
        PRINT'LINE;                                            << 8499>>58775000
        END;  << ELSE BEGIN FORMATTING FEQS >>                 << 8499>>58780000
END;                                                           << 8499>>58785000
$PAGE                                                          << 8499>>58790000
<<****************** MAIN *************************************<< 8499>>58795000
                                                               << 8499>>58800000
                                                               << 8499>>58805000
                                                               << 8499>>58810000
TURNOFFTRAPS;                                                  << 8499>>58815000
@PARMPOINT:=@PARMSP(0);                                        << 8499>>58820000
<<*************************************************************<< 8499>>58825000
<< PARMPOINT - IS THE BYTE POINTER TO THE COMMAND'S PARAMETER  << 8499>>58830000
<<             LIST  (IT WAS ASSIGNED TO BY PARMSP)            << 8499>>58835000
<< REALNAME  - BYTE ARRAY TO CONTAIN THE FILE EQUATION FORMAL  >>       58840000
<<             DESIGNATOR.  WILL RETURN "@" IF NONE SUPPLIED   >>       58845000
<< L'F'LEN   - INTEGER FOR LIST FILE NAME LENGTH               << 8499>>58850000
<< L'F'NAME  - BYTE POINTER FOR THE LIST FILE IF SUPPLIED      << 8499>>58855000
<<*************************************************************<< 8499>>58860000
<<                                                             << 8499>>58865000
<< THE PROCEDURE PARSELISTEQ WILL PARSE THE PARAMETER LIST AND << 8499>>58870000
<< RETURN THE FORMAL FILE EQUATION NAME IF SUPPLIED AND THE    >>       58875000
<< NAME OF THE LIST FILE NAME IF SUPPLIED.  WILL OUTPUT ANY    << 8499>>58880000
<< ERRORS THAT ARE FOUND                                       << 8499>>58885000
<<                                                             << 8499>>58890000
<< NOTE THAT WE OBTAIN THE JIR THROUGH OUT THE FORMATING.  TO  << 8499>>58895000
<< DO THIS WILL ONLY HOLD UP THE CIMAIN'S PROCESS TREE FOR A   << 8499>>58900000
<< MINIMAL PERIOD OF TIME.  WE GET THIS EVEN THOUGH WE GET A   << 8499>>58905000
<< COPY OF THE JDT AND DO NOT SCAN THE JDT IN PLACE.  IT IS    << 8499>>58910000
<< GOTTEN TO COINCIDE WITH SET AND RESET.                      << 8499>>58915000
                                                               << 8499>>58920000
IF NOT PARSELISTEQ( PARMPOINT, L'F'LEN, L'F'NAME )             << 8499>>58925000
   THEN                                                        << 8499>>58930000
        << Screwed up.  Errors caught in PARSELISTEQ >>        << 8499>>58935000
        RETURN                                                 << 8499>>58940000
   ELSE BEGIN                                                  << 8499>>58945000
                                                               << 8499>>58950000
        IF HANDLE'LIST'FILE  << Open $STDLIST >>               << 8499>>58955000
           THEN BEGIN                                          << 8499>>58960000
                JIR := LOCKJIR;                                << 8499>>58965000
                IF MOVEJDT( JDTARR )          << Get JDT >>    << 8765>>58970000
                   THEN BEGIN                                  << 8499>>58975000
                        UNLOCKJIR( JIR );                      << 8499>>58980000
                        FORMAT'FEQ;  << DRIVE FORMATTING OF FEQ<< 8499>>58985000
                        CLOSE'LISTFILE; << CLOSE LISTFILE >>   << 8499>>58990000
                        END                                    << 8499>>58995000
                   ELSE UNLOCKJIR( JIR );                      << 8499>>59000000
                                                               << 8499>>59005000
                END << HANDLE'LIST'FILE >>                     << 8499>>59010000
           ELSE                                                << 8499>>59015000
        END; << ELSE BEGIN >>                                  << 8499>>59020000
                                                               << 8499>>59025000
RETURN;                                                        << 8499>>59030000
END;                                                           << 8499>>59035000
$PAGE    "LISTFTEMP COMMAND EXECUTOR"                          << 8500>>59040000
$CONTROL SEGMENT=CIFILEM                                       << 8500>>59045000
PROCEDURE CXLISTFTEMP EXECUTORHEAD;                            << 8500>>59050000
OPTION PRIVILEGED, UNCALLABLE;                                 << 8500>>59055000
BEGIN                                                          << 8500>>59060000
$INCLUDE INCLFLAB                                              << 8500>>59065000
$INCLUDE INCLCAP                                               << 8500>>59070000
                                                               << 8500>>59075000
$PAGE    "LISTFTEMP COMMAND EXECUTOR"                          << 8500>>59080000
EQUATE JDT'LEN        = JDT'MAX'LEN;                           << 8500>>59085000
DEFINE PAGEEJECT      = FWRITE(FNUM,DATEBUF,0,%61) #,          << 8500>>59090000
       LOG            = LOGICAL#,                              << 8500>>59095000
       FILE'OPEN      = FLABDBL( 16 ) <> 0D#;                  << 8500>>59100000
EQUATE F'STDLIST      = 1,                                     << 8500>>59105000
       NEW'FILE       = 0,                                     << 8500>>59110000
       TEMP'DOMAIN    = 2,                                     << 8500>>59115000
       CURRENT'DOMAIN = 0;                                     << 8500>>59120000
DEFINE MVTABX = PVINFO.(4:4)#;                                 << 8921>>59125000
                                                               << 8921>>59130000
DOUBLE DL := COMMASEMICR;                                      << 8500>>59135000
INTEGER NUMPARMS;                                              << 8500>>59140000
DOUBLE ARRAY PARMS(0:3) = Q;                                   << 8500>>59145000
                                                               << 8500>>59150000
INTEGER ARRAY RECIPPARMS(0:SYSL'PARMLEN-1);                    << 8500>>59155000
INTEGER ARRAY PPRESULT(*) = RECIPPARMS(SYSL'PPRINX);           << 8500>>59160000
BYTE ARRAY BPRESULT(*) = PPRESULT;                             << 8500>>59165000
                                                               << 8500>>59170000
BYTE ARRAY FILENAME(0:23);                                     << 8500>>59175000
                                                               << 8502>>59180000
BYTE ARRAY T'F(0:25);                                          << 8502>>59185000
                                                               << 8500>>59190000
BYTE ARRAY FOR'FILE'NAME(0:25);                                << 8500>>59195000
                                                               << 8500>>59200000
BYTE ARRAY FMT'USER(0:25);                                     << 8500>>59205000
                                                               << 8500>>59210000
LOGICAL ARRAY JDTARR( 0:JDT'LEN - 1 );                         << 8500>>59215000
LOGICAL ARRAY JITARR( 0:JIT'ENTRY'SIZE - 1 );                  << 8500>>59220000
                                                               << 8500>>59225000
INTEGER ARRAY FLAB(0:127);                                     << 8500>>59230000
BYTE ARRAY FLAB'B(*) = FLAB;                                   << 8500>>59235000
DOUBLE ARRAY FLABDBL(*) = FLAB;                                << 8500>>59240000
                                                               << 8500>>59245000
DOUBLE  ARRAY DEXTENT'MAP(0:31);                               << 8500>>59250000
LOGICAL ARRAY EXTENT'MAP(*) = DEXTENT'MAP;                     << 8500>>59255000
                                                               << 8500>>59260000
DOUBLE ARRAY EXTENTS(*) = FLEXTMAP;                            << 8500>>59265000
                                                               << 8500>>59270000
BYTE ARRAY USER(0:7),                                          << 8500>>59275000
           ACCOUNT(0:7),                                       << 8500>>59280000
           LGGROUP(0:7);                                       << 8500>>59285000
                                                               << 8500>>59290000
LOGICAL ARRAY B'LINE(0:1);                                     << 8500>>59295000
                                                               << 8500>>59300000
LOGICAL ARRAY FIRST'LINE(0:7);                                 << 8500>>59305000
BYTE ARRAY FIRST'LINE'B(*) = FIRST'LINE;                       << 8500>>59310000
                                                               << 8500>>59315000
BYTE ARRAY HEADING(0:45);                                      << 8500>>59320000
LOGICAL ARRAY HEADING'L(*) = HEADING;                          << 8500>>59325000
                                                               << 8500>>59330000
BYTE POINTER LEAFNAME  = PARMS;                                << 8500>>59335000
INTEGER LEAFNAMECHAR   = PARMS+1;                              << 8500>>59340000
BYTE LEAFNAMELEN       = PARMS+1;                              << 8500>>59345000
BYTE POINTER LISTLEVEL = PARMS+2;                              << 8500>>59350000
BYTE LISTLEVELLEN      = PARMS+3;                              << 8500>>59355000
BYTE POINTER LISTFILE  = PARMS+2;  <<TRICKY BIT>>              << 8500>>59360000
INTEGER LISTFILECHAR   = PARMS+3;                              << 8500>>59365000
BYTE POINTER EXTRAPARM = PARMS+6;                              << 8500>>59370000
BYTE EXTRAPARMLEN      = PARMS+7;                              << 8500>>59375000
                                                               << 8500>>59380000
INTEGER ARRAY OUT'BUFF( 0:37 );                                << 8500>>59385000
INTEGER ARRAY ASCII'PART(*) = OUT'BUFF( 28 );                  << 8500>>59390000
                                                               << 8500>>59395000
BYTE ARRAY OUT'BUFF'B(*)   = OUT'BUFF;                         << 8500>>59400000
BYTE ARRAY ASCII'PART'B(*) = ASCII'PART;                       << 8500>>59405000
                                                               << 8500>>59410000
BYTE ARRAY PRIV'MNEMONIC(0:4),                                 << 8500>>59415000
           KSAM(0:4);                                          << 8500>>59420000
                                                               << 8500>>59425000
LOGICAL POINTER TFEQ'ENTRY,                                    << 8500>>59430000
                SAVE'TFEQ'ENTRY,                               << 8500>>59435000
                TFEQ'HEAD,                                     << 8500>>59440000
                TFEQ'TAIL;                                     << 8500>>59445000
                                                               << 8500>>59450000
EQUATE COMMA = 0,                                              << 8500>>59455000
       SEMI  = 1,                                              << 8500>>59460000
        PV = 1,                                                << 8921>>59465000
       CR    = 2;                                              << 8500>>59470000
                                                               << 8500>>59475000
BYTE POINTER DELIM;                                            << 8500>>59480000
                                                               << 8500>>59485000
BYTE ARRAY T'ACCOUNT(0:7);     << Account in JDT entry >>      << 8500>>59490000
BYTE ARRAY D'ACCOUNT(0:7);     << Account desired      >>      << 8500>>59495000
BYTE ARRAY W'ACCOUNT(0:7);    << Holds logon account >>        << 8502>>59500000
                                                               << 8500>>59505000
BYTE ARRAY T'GROUP(0:7);       << Group in JDT entry   >>      << 8500>>59510000
BYTE ARRAY D'GROUP(0:7);       << Group desired        >>      << 8500>>59515000
BYTE ARRAY W'GROUP(0:7);      << Holds logon group   >>        << 8502>>59520000
                                                               << 8500>>59525000
BYTE ARRAY T'FILENAME(0:7);    << Filename IN JDT entry>>      << 8500>>59530000
BYTE ARRAY D'FILENAME(0:7);    << Filename desired     >>      << 8500>>59535000
                                                               << 8921>>59540000
LOGICAL ARRAY T'ACCOUNT'L(*)   = T'ACCOUNT;                    << 8921>>59545000
LOGICAL ARRAY T'GROUP'L(*)     = T'GROUP;                      << 8921>>59550000
LOGICAL ARRAY T'FILENAME'L(*)  = T'FILENAME;                   << 8921>>59555000
                                                               << 8921>>59560000
                                                               << 8500>>59565000
INTEGER SOPEN'FOPTIONS  := %2504,                              << 8500>>59570000
        NUM'EXTENTS'USED:= 0,                                  << 8500>>59575000
        OB'INDEX        := 0,                                  << 8500>>59580000
        FCLOSE'OPTIONS  := 2,   << Temporary domain >>         << 8500>>59585000
        FOPTIONS        := 0,                                  << 8500>>59590000
        T'FILENUMBER    := 0,                                  << 8500>>59595000
        L               := 0,                                  << 8500>>59600000
        VOLUME'INDEX    := 0,                                  << 8500>>59605000
        RSIZE           := 0,                                  << 8500>>59610000
        COUNT           := 0,                                  << 8500>>59615000
        LEN             := 0,                                  << 8500>>59620000
        LIST'LEVEL      := 0,                                  << 8500>>59625000
        TFEQ'ENTRY'SIZE := 0,                                  << 8500>>59630000
        TFEQ'FNAME'SIZE := 0,                                  << 8500>>59635000
        I               := 0,                                  << 8500>>59640000
        J               := 0,                                  << 8500>>59645000
        M               := 0,                                  << 8500>>59650000
        FL'MNEMONIC'LEN := 0,                                  << 8500>>59655000
        LDEV            := 0,                                  << 8921>>59660000
        STAR            := [8/"*", 8/" "],                     << 8921>>59665000
        MOUNT'REQ       := 2,                                  << 8921>>59670000
        SUCCESS'MOUNT   := FALSE,                              << 8921>>59675000
        TWO             := 2,                                  << 8921>>59680000
        DEV             := 0,  <<DEVICE TYPE OF LIST FILE>>    << 8500>>59685000
        PCBGLOBLOC      := 0,  << For indexing user's stack >> << 8500>>59690000
        FNUM            := 2;  <<DEFAULT TO $STDLIST>>         << 8500>>59695000
                                                               << 8500>>59700000
LOGICAL STDLIST     := TRUE,                                   << 8500>>59705000
        MAX'EXTS    := 0,                                      << 8500>>59710000
        TFEQ'WORDS  := 0,                                      << 8500>>59715000
        JIT'DST     := 0,                                      << 8500>>59720000
        JIR         := 0,                                      << 8500>>59725000
        REPROCESS   := FALSE,                                  << 8502>>59730000
        CHECK'NEEDED:= TRUE,                                   << 8502>>59735000
        REC'SIZE    := 0,                                      << 8500>>59740000
        ALREADY'PRT := FALSE,                                  << 8500>>59745000
        INTERACTIVE := TRUE;                                   << 8500>>59750000
                                                               << 8500>>59755000
DOUBLE SECTOR;  << Sector address of file label >>             << 8500>>59760000
                                                               << 8921>>59765000
DOUBLE DIREC'ERROR;                                            << 8921>>59770000
DOUBLE DIREC'INDEX;                                            << 8921>>59775000
                                                               << 8921>>59780000
INTEGER PVINFO;                                                << 8921>>59785000
                                                               << 8921>>59790000
LOGICAL ARRAY GROUP'ENTRY'ARRAY( 0 : GSIZE - 1 );              << 8921>>59795000
                                                               << 8921>>59800000
LOGICAL ARRAY FILE'INFO( 0:3 );                                << 8921>>59805000
                                                               << 8921>>59810000
                                                               << 8500>>59815000
                                                               << 8500>>59820000
LOGICAL SECTOR0 = SECTOR,                                      << 8500>>59825000
        SECTOR1 = SECTOR + 1;                                  << 8500>>59830000
                                                               << 8500>>59835000
                                                               << 8500>>59840000
ARRAY DATEBUF(0:13);  <<USED FOR TIME STAMP OF OUTPUT>>        << 8500>>59845000
ARRAY QARRAY(*)=Q+0;                                           << 8500>>59850000
                                                               << 8500>>59855000
POINTER UCAPPTR;                                               << 8500>>59860000
                                                               << 8500>>59865000
LOGICAL ARRAY HEAD1(0:19);                                     << 8500>>59870000
                                                               << 8500>>59875000
LOGICAL ARRAY HEAD2(0:25);                                     << 8500>>59880000
                                                               << 8500>>59885000
LOGICAL ARRAY HEAD22(0:8);                                     << 8500>>59890000
                                                               << 8500>>59895000
LOGICAL ARRAY HEAD3(0:16);                                     << 8500>>59900000
                                                               << 8500>>59905000
LOGICAL ARRAY HEAD32(0:8);                                     << 8500>>59910000
                                                               << 8500>>59915000
BYTE ARRAY B'HEAD1(*)  = HEAD1;                                << 8500>>59920000
BYTE ARRAY B'HEAD2(*)  = HEAD2;                                << 8500>>59925000
BYTE ARRAY B'HEAD22(*) = HEAD22;                               << 8500>>59930000
BYTE ARRAY B'HEAD3(*)  = HEAD3;                                << 8500>>59935000
BYTE ARRAY B'HEAD32(*) = HEAD32;                               << 8500>>59940000
                                                               << 8500>>59945000
$PAGE                                                          << 8500>>59950000
<<*************************************************************<< 8500>>59955000
<<                                                             << 8500>>59960000
<< Subroutine INIT'BUFF                                        << 8500>>59965000
<<                                                             << 8500>>59970000
<< Purpose:  To initialize OUT'BUFF to 80 blanks.              << 8500>>59975000
<<                                                             << 8500>>59980000
<<*************************************************************<< 8500>>59985000
                                                               << 8500>>59990000
SUBROUTINE INIT'BUFF;                                          << 8500>>59995000
BEGIN                                                          << 8500>>60000000
OB'INDEX := 0;                                                 << 8500>>60005000
I := 0;                                                        << 8500>>60010000
WHILE( I < 76 ) DO                                             << 8500>>60015000
     BEGIN                                                     << 8500>>60020000
     OUT'BUFF'B( I ) := " ";                                   << 8500>>60025000
     I := I + 1                                                << 8500>>60030000
     END;                                                      << 8500>>60035000
END;                                                           << 8500>>60040000
$PAGE                                                          << 8500>>60045000
<<************************************************************><< 8500>>60050000
<<                                                            ><< 8500>>60055000
<< Subroutine FORMAT'USER                                     ><< 8500>>60060000
<<                                                            ><< 8500>>60065000
<< Purpose:  To format USER.ACCOUNT,GROUP                     ><< 8500>>60070000
<<           into HEADING.                                    ><< 8500>>60075000
<<                                                            ><< 8500>>60080000
<<************************************************************><< 8500>>60085000
SUBROUTINE FORMAT'USER;                                        << 8500>>60090000
BEGIN                                                          << 8500>>60095000
INIT'BUFF;                                                     << 8500>>60100000
WHO( , , ,USER, LGGROUP, ACCOUNT );                                     60105000
MOVE HEADING :=                                                << 8500>>60110000
         "TEMPORARY FILES FOR                           ";     << 8500>>60115000
L := 0;                                                        << 8500>>60120000
MOVE FMT'USER( 0 ) := USER,(8);                                << 8500>>60125000
FMT'USER( L + 8 ) := ".";                                      << 8500>>60130000
L := L + 9;                                                    << 8500>>60135000
MOVE FMT'USER( L ) := ACCOUNT,(8);                             << 8500>>60140000
FMT'USER( L + 8 ) := ",";                                      << 8500>>60145000
L := L + 9;                                                    << 8500>>60150000
MOVE FMT'USER( L ) := LGGROUP,(8);                             << 8500>>60155000
                                                               << 8500>>60160000
<< REMOVE THE BLANKS AND STUFF >>                              << 8500>>60165000
L := 0;                                                        << 8500>>60170000
I := 20;                                                       << 8500>>60175000
WHILE L <= 25 DO                                               << 8500>>60180000
   BEGIN                                                       << 8500>>60185000
   IF FMT'USER( L ) <> " "                                     << 8500>>60190000
      THEN BEGIN                                               << 8500>>60195000
           MOVE HEADING( I ) := FMT'USER( L ),( 1 );           << 8500>>60200000
           I := I + 1;                                         << 8500>>60205000
           END;                                                << 8500>>60210000
   L := L + 1;                                                 << 8500>>60215000
   END;                                                        << 8500>>60220000
                                                               << 8500>>60225000
END;  << Subroutine FORMAT'USER >>                             << 8500>>60230000
$PAGE                                                          << 8500>>60235000
<<************************************************************><< 8500>>60240000
<<                                                            ><< 8500>>60245000
<< Subroutine FORMAT'FILE'NAME                                ><< 8500>>60250000
<<                                                            ><< 8500>>60255000
<< Purpose:  To format F = FILE.GROUP.ACCOUNT                 ><< 8500>>60260000
<<           into title for LISTFTEMP ,-1                     ><< 8500>>60265000
<<           using FOR'FILE'NAME and TFEQ'FNAME'SIZE from the ><< 8500>>60270000
<<           subroutine GET'TFNAME.                           ><< 8500>>60275000
<<                                                            ><< 8500>>60280000
<<************************************************************><< 8500>>60285000
SUBROUTINE FORMAT'FILE'NAME;                                   << 8500>>60290000
BEGIN                                                          << 8500>>60295000
INIT'BUFF;     << Post another blank line >>                   << 8500>>60300000
FWRITE( FNUM, OUT'BUFF, 38, 0 );                               << 8500>>60305000
                                                               << 8500>>60310000
MOVE OUT'BUFF'B( 0 ) := "F  =  ";                              << 8500>>60315000
MOVE OUT'BUFF'B( 6 ) := FOR'FILE'NAME,( 26 );                  << 8500>>60320000
MOVE OUT'BUFF'B( 7 + 26 + 3 ) :=                               << 8500>>60325000
               "(TEMPORARY FILE )";                            << 8500>>60330000
                                                               << 8500>>60335000
FWRITE( FNUM, OUT'BUFF, 38, 0 );                               << 8500>>60340000
END;  << Subroutine FORMAT'FILE'NAME >>                        << 8500>>60345000
$PAGE                                                          << 8500>>60350000
<<**********************************************************>> << 8500>>60355000
<<                                                          >> << 8500>>60360000
<< Subroutine CHECK'USER'CAPS                               >> << 8500>>60365000
<<                                                             << 8500>>60370000
<< Purpose:  To determine if the user is either an account  >> << 8500>>60375000
<<           or system manager.  If not CHECK'USER'CAPS     >> << 8500>>60380000
<<           returns false, else it returns true.           >> << 8500>>60385000
<<                                                          >> << 8500>>60390000
<<**********************************************************>> << 8500>>60395000
                                                               << 8500>>60400000
LOGICAL SUBROUTINE CHECK'USER'CAPS;                            << 8500>>60405000
BEGIN                                                          << 8500>>60410000
PXGLOBAL;                                                      << 8500>>60415000
@UCAPPTR := @PXG'USERATTRIBUTES;                               << 8500>>60420000
IF UCAPSM = 1 LOR UCAPAM = 1                                   << 8921>>60425000
   THEN CHECK'USER'CAPS := TRUE                                << 8500>>60430000
   ELSE CHECK'USER'CAPS := FALSE;                              << 8500>>60435000
END;                                                           << 8500>>60440000
$PAGE                                                          << 8500>>60445000
<<***********************************************************>><< 8500>>60450000
<<                                                           >><< 8500>>60455000
<< Subroutine LIST'LEVEL'OK                                  >><< 8500>>60460000
<<                                                           >><< 8500>>60465000
<< Purpose: To retrieve the list level integer, or if none   >><< 8500>>60470000
<<          is supplied, set one.  The list level will be    >><< 8500>>60475000
<<          placed in the global LIST'LEVEL.  If any errors  >><< 8500>>60480000
<<          occur, LIST'LEVEL'OK will return FALSE, else it  >><< 8500>>60485000
<<          will return TRUE.                                >><< 8500>>60490000
<<                                                           >><< 8500>>60495000
<<***********************************************************>><< 8500>>60500000
                                                               << 8500>>60505000
LOGICAL SUBROUTINE LIST'LEVEL'OK;                              << 8500>>60510000
BEGIN                                                          << 8500>>60515000
                                                               << 8500>>60520000
<< Check for the LISTLEVEL, if any was supplied   >>           << 8500>>60525000
<< Legal values are -1, 0, 1, or 2.  If any other >>           << 8500>>60530000
<< was supplied, a default of 2 is used as long   >>           << 8500>>60535000
<< as what was supplied is not less than -1, else >>           << 8500>>60540000
<< a -1 is used as long as the user has SM caps   >>           << 8500>>60545000
<< or AM caps.  If no LISTLEVEL was supplied, the >>           << 8500>>60550000
<< default will be 0.                             >>           << 8500>>60555000
                                                               << 8500>>60560000
LIST'LEVEL'OK := TRUE;  << Assume success >>                   << 8500>>60565000
IF LEAFNAMECHAR.(11:5) = COMMA       <<LISTLEVEL PRESENT>>     << 8500>>60570000
   THEN BEGIN                                                  << 8500>>60575000
        LIST'LEVEL :=BINARY( LISTLEVEL, INTEGER(LISTLEVELLEN));<< 8500>>60580000
        IF <> OR NOT(-1 <= LIST'LEVEL <= 2)                    << 8500>>60585000
          THEN BEGIN   << Bad conversion or bad number >>      << 8500>>60590000
               CIERR( ERRNUM := -LISTFTEMPBADLEVEL,            << 8500>>60595000
                                LISTLEVEL );                   << 8500>>60600000
               IF LIST'LEVEL < -1         <<Give LISTF ,-1 >>  << 8500>>60605000
                  THEN LIST'LEVEL := -1                        << 8500>>60610000
                  ELSE LIST'LEVEL := 2;  << Give LISTF ,2 >>   << 8500>>60615000
                                                               << 8500>>60620000
               END;                                            << 8500>>60625000
                                                               << 8500>>60630000
        IF LIST'LEVEL < 0    << Check caps. if LIST'LEVEL = -1 << 8500>>60635000
           THEN IF CHECK'USER'CAPS <> TRUE                     << 8500>>60640000
                   THEN BEGIN                                  << 8500>>60645000
                        CIERR( ERRNUM := LISTFTEMPSMORAM );    << 8500>>60650000
                        LIST'LEVEL'OK := FALSE;                << 8500>>60655000
                        END;                                   << 8500>>60660000
        PARMS := PARMS(1);     << Move up since LIST'FILE   >> << 8500>>60665000
        PARMS(1) := PARMS(2);  << is there if no LISTLEVEL  >> << 8500>>60670000
        END                                                    << 8500>>60675000
   ELSE LIST'LEVEL := 0;  << List level default >>             << 8500>>60680000
                                                               << 8500>>60685000
END;  << Subroutine LIST'LEVEL'OK >>                           << 8500>>60690000
$PAGE                                                          << 8500>>60695000
<<************************************************************><< 8500>>60700000
<<                                                            ><< 8500>>60705000
<< Subroutine LIST'FILE'OK                                    ><< 8500>>60710000
<<                                                            ><< 8500>>60715000
<< Purpose:  To retieve any LISTFILE from the command image   ><< 8500>>60720000
<<           and to FOPEN the file and return the file number ><< 8500>>60725000
<<           through the global variable FNUM.  If any errors ><< 8500>>60730000
<<           occur, LIST'FILE'OK will return FALSE, else it   ><< 8500>>60735000
<<           return TRUE.                                     ><< 8500>>60740000
<<                                                            ><< 8500>>60745000
<<************************************************************><< 8500>>60750000
                                                               << 8500>>60755000
LOGICAL SUBROUTINE LIST'FILE'OK;                               << 8500>>60760000
BEGIN                                                          << 8500>>60765000
                                                               << 8500>>60770000
LIST'FILE'OK := TRUE;  << Assume success >>                    << 8500>>60775000
IF LEAFNAMECHAR.(11:5) = SEMI  << LISTFILE probably supplied >><< 8500>>60780000
   THEN IF CIBADFILENAME( ERRNUM,PARMS(1) )                    << 8500>>60785000
           THEN LIST'FILE'OK := FALSE                          << 8500>>60790000
           ELSE STDLIST := FALSE   <<USER SPECIFIED A FILE >>  << 8500>>60795000
   ELSE IF LEAFNAMECHAR.(11:5) = COMMA       <<ERROR>>         << 8500>>60800000
           THEN BEGIN                                          << 8500>>60805000
                CIERR( ERRNUM := LISTFTEMPEXPECTFILE,          << 8500>>60810000
                                 LISTFILE );                   << 8500>>60815000
                LIST'FILE'OK := FALSE;                         << 8500>>60820000
                END;                                           << 8500>>60825000
                                                               << 8500>>60830000
<< Now check for extraneous parmeters >>                       << 8500>>60835000
IF (LISTFILECHAR.(11:5) <> CR) AND (EXTRAPARMLEN<>0)           << 8500>>60840000
   THEN BEGIN                                                  << 8500>>60845000
        CIERR( ERRNUM := LISTFTEMP2MP,EXTRAPARM );             << 8500>>60850000
        LIST'FILE'OK := FALSE;                                 << 8500>>60855000
        END                                                    << 8500>>60860000
                                                               << 8500>>60865000
   ELSE IF NOT STDLIST <<OPEN USER DEFINED FILE>>              << 8500>>60870000
           THEN BEGIN                                          << 8500>>60875000
                FNUM := FOPEN(LISTFILE, SOPEN'FOPTIONS, %101); << 8500>>60880000
                IF <>                                          << 8500>>60885000
                   THEN BEGIN                                  << 8500>>60890000
                        FERROR'(FNUM, PARMNUM);                << 8500>>60895000
                        CIERR(ERRNUM := LISTFFSERR,LISTFILE,   << 8500>>60900000
                                        %10000,PARMNUM);       << 8500>>60905000
                        LIST'FILE'OK := FALSE;                 << 8500>>60910000
                        END;                                   << 8500>>60915000
                END;                                           << 8500>>60920000
                                                               << 8500>>60925000
END;  << Subroutine LIST'FILE'OK >>                            << 8500>>60930000
$PAGE                                                          << 8502>>60935000
<<***********************************************************>><< 8502>>60940000
<<                                                           >><< 8502>>60945000
<< Subroutine MOD'FOR'FILE'NAME                              >><< 8502>>60950000
<<                                                           >><< 8502>>60955000
<< Purpose:   To add "$OLDPASS" to FOR'FILE'NAME since we    >><< 8502>>60960000
<<            will have to reprocess the original formal file>><< 8502>>60965000
<<            name later.  We are actually updating the file >><< 8502>>60970000
<<            name and shifting the group and account around >><< 8502>>60975000
<<                                                           >><< 8502>>60980000
<<***********************************************************>><< 8502>>60985000
SUBROUTINE MOD'FOR'FILE'NAME;                                  << 8502>>60990000
BEGIN                                                          << 8502>>60995000
                                                               << 8502>>61000000
MOVE T'F := "                          ";                      << 8502>>61005000
                                                               << 8502>>61010000
MOVE T'F := "$OLDPASS";                                        << 8502>>61015000
I := 0;                                                        << 8502>>61020000
M := 8;                                                        << 8502>>61025000
                                                               << 8502>>61030000
<< Find the start of the group name (including delimiter) >>   << 8502>>61035000
WHILE ( FOR'FILE'NAME( I ) <> "." ) DO                         << 8502>>61040000
   I := I + 1;                                                 << 8502>>61045000
                                                               << 8502>>61050000
<< Move the group and account to T'F >>                        << 8502>>61055000
WHILE I < 26 DO                                                << 8502>>61060000
   BEGIN                                                       << 8502>>61065000
   T'F( M ) := FOR'FILE'NAME( I );                             << 8502>>61070000
   I := I + 1;                                                 << 8502>>61075000
   M := M + 1;                                                 << 8502>>61080000
   END;                                                        << 8502>>61085000
                                                               << 8502>>61090000
<< Now move T'F to FOR'FILE'NAME >>                            << 8502>>61095000
                                                               << 8502>>61100000
MOVE FOR'FILE'NAME := "                          ";            << 8502>>61105000
MOVE FOR'FILE'NAME := T'F,(26);                                << 8502>>61110000
                                                               << 8502>>61115000
END;       << Subroutine MOD'FOR'FILE'NAME >>                  << 8502>>61120000
$PAGE                                                          << 8500>>61125000
<<**********************************************************>> << 8502>>61130000
<<                                                          >> << 8502>>61135000
<< Subroutine HANDLE'OLDPASS                                >> << 8502>>61140000
<<                                                          >> << 8502>>61145000
<< Purpose:  1.  To obtain the user's JIT DST number.       >> << 8502>>61150000
<<           2.  To use the JIT DST number to get the       >> << 8502>>61155000
<<               PASSED FILE pointer - the sector           >> << 8502>>61160000
<<               information needed to get the information  >> << 8502>>61165000
<<               to display.                                >> << 8502>>61170000
<<           3.  Return TRUE if SECTOR address <> 0D, else  >> << 8502>>61175000
<<               return FALSE.                              >> << 8502>>61180000
<<                                                          >> << 8502>>61185000
<<**********************************************************>> << 8502>>61190000
                                                               << 8502>>61195000
LOGICAL SUBROUTINE HANDLE'OLDPASS;                             << 8502>>61200000
                                                               << 8502>>61205000
BEGIN                                                          << 8502>>61210000
                                                               << 8502>>61215000
          << Get the JIT DST NUMBER and the JIT >>             << 8502>>61220000
          PXGLOBAL;                                            << 8502>>61225000
          JIT'DST := PXG'JITDST;                               << 8502>>61230000
                                                               << 8502>>61235000
          TOS := @JITARR;                                      << 8502>>61240000
          TOS := JIT'DST;                                      << 8502>>61245000
          TOS := 0;                                            << 8502>>61250000
          TOS := JIT'ENTRY'SIZE;                               << 8502>>61255000
          ASSEMBLE( MFDS 4 );                                  << 8502>>61260000
                                                               << 8502>>61265000
          << Get the sector information >>                     << 8502>>61270000
          VOLUME'INDEX := JITPASSFILEVTABX;                    << 8502>>61275000
          SECTOR0 := JITPASSFILEPTR1;                          << 8502>>61280000
          SECTOR1 := JITPASSFILEPTR2;                          << 8502>>61285000
                                                               << 8502>>61290000
          IF SECTOR <> 0D                                      << 8502>>61295000
             THEN BEGIN                                        << 8502>>61300000
                  << $OLDPASS is active - display info. >>     << 8502>>61305000
                  MOVE T'FILENAME := "$OLDPASS";               << 8502>>61310000
                  HANDLE'OLDPASS := TRUE;                      << 8502>>61315000
                  MOD'FOR'FILE'NAME;  << move in $OLDPASS >>   << 8502>>61320000
                                                               << 8502>>61325000
                  END   << Have a current $OLDPASS >>          << 8502>>61330000
                                                               << 8502>>61335000
             ELSE HANDLE'OLDPASS := FALSE;  << No $OLDPASS >>  << 8502>>61340000
                                                               << 8502>>61345000
END;  << Subroutine HANDLE'OLDPASS >>                          << 8502>>61350000
$page                                                          << 8502>>61355000
<<***********************************************************>><< 8500>>61360000
<<                                                           >><< 8500>>61365000
<< Subroutine GET'TFNAME                                     >><< 8500>>61370000
<<                                                           >><< 8500>>61375000
<< Purpose:  To determine if there is a match between the    >><< 8500>>61380000
<<           file name in the TFEQ'ENTRY and the desired     >><< 8500>>61385000
<<           name in PPRESULT.                               >><< 8500>>61390000
<<           The volume index and the sector address is      >><< 8500>>61395000
<<           placed in VOL'INDEX, and SECTOR'ADDR, while the >><< 8500>>61400000
<<           file's name is put into T'ACCOUNT, T'GROUP and  >><< 8500>>61405000
<<           T'FILENAME;  only if there is a match.  If a    >><< 8500>>61410000
<<           match is realized, GET'FNAME returns TRUE, else >><< 8500>>61415000
<<           it returns FALSE.                               >><< 8500>>61420000
<<                                                           >><< 8500>>61425000
<<***********************************************************>><< 8500>>61430000
                                                               << 8500>>61435000
LOGICAL SUBROUTINE GET'TFNAME;                                 << 8500>>61440000
BEGIN                                                          << 8500>>61445000
                                                               << 8500>>61450000
GET'TFNAME := TRUE;  << Assume success >>                      << 8500>>61455000
TFEQ'FNAME'SIZE := TFEQ'ENTRY.(8:8);  << Name size in words >> << 8500>>61460000
                                                               << 8500>>61465000
<< Get FILENAME byte array to start of filename.  Each     >>  << 8500>>61470000
<< is fully qualified with high order bit in each byte of  >>  << 8500>>61475000
<< representing the character of each qualifier.  Place the>>  << 8500>>61480000
<< the three qualifiers into each of the three T'xxxx vars.>>  << 8500>>61485000
MOVE                                                           << 8500>>61490000
FOR'FILE'NAME := "                          ";                 << 8500>>61495000
                                                               << 8500>>61500000
TFEQ'FNAME'SIZE := TFEQ'FNAME'SIZE * 2; << # BYTES LONG >>     << 8500>>61505000
@FILENAME := (@TFEQ'ENTRY + 1) * 2;  << BYTE PTR TO F NAME >>  << 8500>>61510000
MOVE T'FILENAME := "        ";                                 << 8500>>61515000
MOVE T'GROUP    := "        ";                                 << 8500>>61520000
MOVE T'ACCOUNT  := "        ";                                 << 8500>>61525000
L := 0;                                                        << 8500>>61530000
I := 0;                                                        << 8500>>61535000
J := -1;  << Keeps track of which qualifier is being decoded >><< 8500>>61540000
WHILE I < TFEQ'FNAME'SIZE DO                                   << 8500>>61545000
  BEGIN                                                        << 8500>>61550000
  IF FILENAME( I ) >= %200                                     << 8500>>61555000
     THEN BEGIN                                                << 8500>>61560000
          M := 0;  << Index into file name qualifiers >>       << 8500>>61565000
          J := J + 1;                                          << 8500>>61570000
          IF I <> 0                                            << 8500>>61575000
             THEN BEGIN                                        << 8500>>61580000
                  FOR'FILE'NAME( L ) := ".";                   << 8500>>61585000
                  L := L + 1;                                  << 8500>>61590000
                  END;                                         << 8500>>61595000
          END;                                                 << 8500>>61600000
                                                               << 8500>>61605000
  CASE J OF                                                    << 8500>>61610000
       BEGIN                                                   << 8500>>61615000
       << 0 >> << FILE NAME >>                                 << 8500>>61620000
       IF FILENAME( I ) >= %200                                << 8502>>61625000
          THEN T'FILENAME( M ) := FILENAME( I ) - %200         << 8502>>61630000
          ELSE T'FILENAME( M ) := FILENAME( I );               << 8502>>61635000
                                                               << 8500>>61640000
       << 1 >> << GROUP NAME >>                                << 8500>>61645000
       IF FILENAME( I ) >= %200                                << 8502>>61650000
          THEN T'GROUP( M ) := FILENAME( I ) - %200            << 8502>>61655000
          ELSE T'GROUP( M ) := FILENAME( I );                  << 8502>>61660000
                                                               << 8500>>61665000
       << 2 >> << ACCOUNT NAME >>                              << 8500>>61670000
       IF FILENAME( I ) <> " "                                 << 8502>>61675000
          THEN IF FILENAME( I ) >= %200                        << 8502>>61680000
                  THEN T'ACCOUNT( M ) := FILENAME( I ) - %200  << 8502>>61685000
                  ELSE T'ACCOUNT( M ) := FILENAME( I );        << 8502>>61690000
                                                               << 8500>>61695000
       END; << CASE STMT >>                                    << 8500>>61700000
                                                               << 8500>>61705000
  IF FILENAME( I ) >= %200                                     << 8502>>61710000
     THEN FOR'FILE'NAME( L ) := FILENAME( I ) - %200           << 8502>>61715000
     ELSE FOR'FILE'NAME( L ) := FILENAME( I );                 << 8502>>61720000
  L := L + 1;                                                  << 8502>>61725000
                                                               << 8500>>61730000
  M := M + 1;                                                  << 8500>>61735000
  I := I + 1;                                                  << 8500>>61740000
  END;    << WHILE LOOP  >>                                    << 8500>>61745000
                                                               << 8502>>61750000
<< Before we check the entry from the JDT against what >>      << 8502>>61755000
<< the user desires, we need to see if this is the 1st >>      << 8502>>61760000
<< occurance of the logon group and logon account.  If >>      << 8502>>61765000
<< it is, then we must check for the existence of the  >>      << 8502>>61770000
<< temporary file, $OLDPASS.  If $OLDPASS exists, then >>      << 8502>>61775000
<< we will reprocess this JDT entry after the $OLDPASS >>      << 8502>>61780000
<< is displayed.  Sorry...                             >>      << 8502>>61785000
                                                               << 8502>>61790000
IF CHECK'NEEDED = TRUE                                         << 8502>>61795000
   THEN IF ( ( BPRESULT( 38 ) = "@       "        ) LAND       << 8502>>61800000
             ( W'GROUP        = T'GROUP,(8)       ) LAND       << 8502>>61805000
             ( W'ACCOUNT      = T'ACCOUNT,(8)     ) )          << 8502>>61810000
           THEN BEGIN                                          << 8502>>61815000
                CHECK'NEEDED := FALSE;                         << 8502>>61820000
                REPROCESS := TRUE;                             << 8502>>61825000
                GOTO OLDPASS;                                  << 8502>>61830000
                END;                                           << 8502>>61835000
                                                               << 8502>>61840000
                                                               << 8500>>61845000
<< Now all three qualifiers are out of the TFEQ'ENTRY >>       << 8500>>61850000
<< It must be determined if they match.  All three    >>       << 8500>>61855000
<< must match if we are to get the Volume Index and   >>       << 8500>>61860000
<< the sector address.                                >>       << 8500>>61865000
                                                               << 8500>>61870000
IF((DIRMATCH( BPRESULT( 38 ), T'FILENAME ) = 0 ) LAND          << 8500>>61875000
   (DIRMATCH( BPRESULT( 46 ), T'GROUP    ) = 0 ) LAND          << 8500>>61880000
   (DIRMATCH( BPRESULT( 54 ), T'ACCOUNT  ) = 0 ) )             << 8500>>61885000
  THEN BEGIN                                                   << 8500>>61890000
                                                               << 8500>>61895000
       << We have a match >>                                   << 8500>>61900000
                                                               << 8500>>61905000
       << Increment TFEQ'ENTRY to vol. and sector words >>     << 8500>>61910000
       @TFEQ'ENTRY := (@TFEQ'ENTRY + (TFEQ'FNAME'SIZE/2)) + 1; << 8500>>61915000
       VOLUME'INDEX := TFEQ'ENTRY.(0:8);                       << 8500>>61920000
       SECTOR0 := TFEQ'ENTRY.(8:8);                            << 8500>>61925000
       SECTOR1 := TFEQ'ENTRY( 1 );                             << 8500>>61930000
       END                                                     << 8500>>61935000
  ELSE GET'TFNAME := FALSE;  << NO MATCH >>                    << 8500>>61940000
                                                               << 8500>>61945000
GOTO END'GET'TFNAME;                                           << 8502>>61950000
                                                               << 8502>>61955000
OLDPASS:  GET'TFNAME := HANDLE'OLDPASS;                        << 8502>>61960000
                                                               << 8502>>61965000
END'GET'TFNAME:                                                << 8502>>61970000
                                                               << 8502>>61975000
END;  << Subroutine GET'TFNAME >>                              << 8500>>61980000
$PAGE                                                          << 8500>>61985000
<<                                                           >><< 8500>>61990000
<<***********************************************************>><< 8500>>61995000
<<                                                           >><< 8500>>62000000
<< Subroutine PRINT'DUMP'LINE                                >><< 8500>>62005000
<<                                                           >><< 8500>>62010000
<< Purpose:  To print an octal dump and the ASCII equivelent >><< 8500>>62015000
<<           and replace the unprintables by "."             >><< 8500>>62020000
<<                                                           >><< 8500>>62025000
<<***********************************************************>><< 8500>>62030000
                                                               << 8500>>62035000
SUBROUTINE PRINT'DUMP'LINE( LINE, LEN );                       << 8500>>62040000
VALUE LEN;                                                     << 8500>>62045000
INTEGER LEN;                                                   << 8500>>62050000
INTEGER ARRAY LINE;                                            << 8500>>62055000
BEGIN                                                          << 8500>>62060000
MOVE ASCII'PART(0) := LINE,(LEN);                              << 8500>>62065000
OUT'BUFF( 0 ) := "  ";                                         << 8500>>62070000
MOVE OUT'BUFF( 1 ) := OUT'BUFF,(27);                           << 8500>>62075000
MOVE ASCII'PART( LEN ) := OUT'BUFF,( 8 - LEN );                << 8500>>62080000
COUNT := 0;                                                    << 8500>>62085000
                                                               << 8500>>62090000
<< Go through the ascii part and replace unprintable >>        << 8500>>62095000
<< characters with ".".  Convert each 16 bit word to >>        << 8500>>62100000
<< octal representation and put into first part of   >>        << 8500>>62105000
<< OUT'BUFF                                          >>        << 8500>>62110000
WHILE COUNT < LEN DO                                           << 8500>>62115000
  BEGIN                                                        << 8500>>62120000
  TOS := 0;                                                    << 8500>>62125000
  TOS := ASCII'PART'B( COUNT &LSL(1) );                        << 8500>>62130000
  IF <                                                         << 8500>>62135000
     THEN ASCII'PART'B( X ) := ".";  << AN UNPRINTABLE CHAR >> << 8500>>62140000
  TOS := TOS &LSL(8);                                          << 8500>>62145000
  TOS := ASCII'PART'B( X + 1 );                                << 8500>>62150000
  IF <                                                         << 8500>>62155000
     THEN ASCII'PART'B( X ) := "."; << UNPRINTABLE CHAR >>     << 8500>>62160000
  TOS := TOS LOR TOS;                                          << 8500>>62165000
  ASCII( *, 8, OUT'BUFF'B( COUNT * 7 ));                       << 8500>>62170000
  COUNT := COUNT + 1;                                          << 8500>>62175000
  END;                                                         << 8500>>62180000
FWRITE( FNUM, OUT'BUFF, 38, 0 );                               << 8500>>62185000
                                                               << 8500>>62190000
END;  << Subroutine PRINT'DUMP'LINE >>                         << 8500>>62195000
$PAGE                                                          << 8500>>62200000
<<***********************************************************>><< 8500>>62205000
<<                                                           >><< 8500>>62210000
<< Subroutine FORMAT'LEVEL'MINUS'1                           >><< 8500>>62215000
<<                                                           >><< 8500>>62220000
<< Purpose:  To display the file label in an octal dump/ASCII>><< 8500>>62225000
<<           format.                                         >><< 8500>>62230000
<<                                                           >><< 8500>>62235000
<<***********************************************************>><< 8500>>62240000
                                                               << 8500>>62245000
SUBROUTINE FORMAT'LEVEL'MINUS'1;                               << 8500>>62250000
BEGIN                                                          << 8500>>62255000
                                                               << 8500>>62260000
<< F = FILE.GROUP.ACCOUNT line >>                              << 8500>>62265000
FORMAT'FILE'NAME;                                              << 8500>>62270000
                                                               << 8502>>62275000
ALREADY'PRT := TRUE;                                           << 8502>>62280000
                                                               << 8500>>62285000
<< Format and print the first line of the display.  This >>    << 8500>>62290000
<< includes the name of the file and the sector info     >>    << 8500>>62295000
<< of the file.                                          >>    << 8500>>62300000
                                                               << 8500>>62305000
MOVE FIRST'LINE'B( 0 ) := T'FILENAME,( 8 );                    << 8500>>62310000
FIRST'LINE( 4 ) := SECTOR0;                                    << 8500>>62315000
FIRST'LINE( 5 ) := SECTOR1;                                    << 8500>>62320000
PRINT'DUMP'LINE( FIRST'LINE, 6 );                              << 8500>>62325000
                                                               << 8500>>62330000
                                                               << 8500>>62335000
L := 128;                                                      << 8500>>62340000
WHILE L > 8 DO                                                 << 8500>>62345000
  BEGIN                                                        << 8500>>62350000
  PRINT'DUMP'LINE(FLAB( 128 - L ), 8 );                        << 8500>>62355000
  L := L - 8;                                                  << 8500>>62360000
  END;                                                         << 8500>>62365000
IF L > 0                                                       << 8500>>62370000
   THEN PRINT'DUMP'LINE( FLAB( 128 - L ), L );                 << 8500>>62375000
                                                               << 8500>>62380000
END;  << Subroutin FORMAT'LEVEL'MINUS'1 >>                     << 8500>>62385000
                                                               << 8500>>62390000
$PAGE                                                          << 8500>>62395000
<<***********************************************************>><< 8500>>62400000
<<                                                           >><< 8500>>62405000
<< Subroutine WRITE'BANNER                                   >><< 8500>>62410000
<<                                                           >><< 8500>>62415000
<< Purpose:  To move T'ACCOUNT and T'GROUP in to B'HEAD1 and >><< 8500>>62420000
<<           to print the four lines of the banner.          >><< 8500>>62425000
<<                                                           >><< 8500>>62430000
<<***********************************************************>><< 8500>>62435000
                                                               << 8500>>62440000
SUBROUTINE WRITE'BANNER;                                       << 8500>>62445000
                                                               << 8500>>62450000
BEGIN                                                          << 8500>>62455000
                                                               << 8500>>62460000
FWRITE( FNUM, B'LINE, 2, 0 );                                  << 8500>>62465000
                                                               << 8500>>62470000
MOVE B'HEAD1( 10 ) := T'ACCOUNT,(8);                           << 8500>>62475000
MOVE B'HEAD1( 30 ) := T'GROUP,( 8 );                           << 8502>>62480000
                                                               << 8500>>62485000
FWRITE( FNUM, HEAD1, 20, 0 );                                  << 8500>>62490000
FWRITE( FNUM, B'LINE, 2, 0 );                                  << 8500>>62495000
IF LIST'LEVEL = 2                                              << 8500>>62500000
   THEN BEGIN                                                  << 8500>>62505000
        << Append and write headings for level 2 >>            << 8500>>62510000
        INIT'BUFF;                                             << 8500>>62515000
        MOVE OUT'BUFF'B( 0 ) := B'HEAD2,( 51 );                << 8500>>62520000
        MOVE OUT'BUFF'B( 50 ) := B'HEAD22,( 18 );              << 8502>>62525000
        FWRITE( FNUM, OUT'BUFF, 38, 0 );                       << 8500>>62530000
        INIT'BUFF;                                             << 8500>>62535000
        MOVE OUT'BUFF'B( 18 ) := B'HEAD3,( 33 );               << 8500>>62540000
        MOVE OUT'BUFF'B( 50 ) := B'HEAD32,( 18 );              << 8502>>62545000
        FWRITE( FNUM, OUT'BUFF, 38, 0 );                       << 8500>>62550000
        END                                                    << 8500>>62555000
   ELSE BEGIN                                                  << 8500>>62560000
        << Write the heading for level 1 >>                    << 8500>>62565000
        FWRITE( FNUM, HEAD2, 26, 0 );                          << 8500>>62570000
                                                               << 8500>>62575000
        INIT'BUFF;                                             << 8500>>62580000
        MOVE OUT'BUFF'B( 18 ) := B'HEAD3,( 33 );               << 8500>>62585000
        FWRITE( FNUM, OUT'BUFF, 38, 0 );                       << 8500>>62590000
        END;                                                   << 8500>>62595000
                                                               << 8500>>62600000
END;  << Subroutine WRITE'BANNER >>                            << 8500>>62605000
$PAGE                                                          << 8500>>62610000
<<***********************************************************>><< 8500>>62615000
<<                                                           >><< 8500>>62620000
<< Subroutine FORMAT'LEVEL'0                                 >><< 8500>>62625000
<<                                                           >><< 8500>>62630000
<< Purpose:  To control the output of temporary file name in >><< 8500>>62635000
<<           LIST'LEVEL = 0 format.  Each file is printed    >><< 8500>>62640000
<<           linearly, one fully qualified file name per     >><< 8500>>62645000
<<           line.                                           >><< 8500>>62650000
<<                                                           >><< 8500>>62655000
<<***********************************************************>><< 8500>>62660000
                                                               << 8500>>62665000
SUBROUTINE FORMAT'LEVEL'0;                                     << 8500>>62670000
BEGIN                                                          << 8500>>62675000
                                                               << 8500>>62680000
<< FOR'FILE'NAME (from subroutine GET'TFNAME) for the name   >><< 8500>>62685000
<< of the file.   TFEQ'FNAME'SIZE is used for the length     >><< 8500>>62690000
                                                               << 8500>>62695000
                                                               << 8500>>62700000
INIT'BUFF;                                                     << 8500>>62705000
MOVE OUT'BUFF'B( 0 ) := FOR'FILE'NAME,( 26 );                  << 8502>>62710000
FWRITE( FNUM, OUT'BUFF, 38, 0 );                               << 8500>>62715000
END;                                                           << 8500>>62720000
$PAGE                                                          << 8500>>62725000
<<**********************************************************>> << 8500>>62730000
<<                                                          >> << 8500>>62735000
<< Subroutine FORMAT'LEVEL'1'2                              >> << 8500>>62740000
<<                                                          >> << 8500>>62745000
<< Purpose:  To print LIST'LEVEL = 1 information about a    >> << 8500>>62750000
<<           temporary file.                                >> << 8500>>62755000
<<                                                          >> << 8500>>62760000
<<**********************************************************>> << 8500>>62765000
                                                               << 8500>>62770000
SUBROUTINE FORMAT'LEVEL'1'2;                                   << 8500>>62775000
BEGIN                                                          << 8500>>62780000
                                                               << 8500>>62785000
<< If the last group or the last account printed >>            << 8500>>62790000
<< do not match the current group or account,    >>            << 8500>>62795000
<< post a new banner before printing the info.   >>            << 8500>>62800000
                                                               << 8500>>62805000
IF T'GROUP <> B'HEAD1( 30 ),( 8 ) OR                           << 8502>>62810000
   T'ACCOUNT <> B'HEAD1(10),(8)                                << 8500>>62815000
   THEN WRITE'BANNER;                                          << 8500>>62820000
INIT'BUFF;                                                     << 8500>>62825000
                                                               << 8500>>62830000
L := 0;                                                        << 8500>>62835000
MOVE OUT'BUFF'B( L ) := T'FILENAME( 0 ),( 8 );                 << 8500>>62840000
L := L + 8;                                                    << 8500>>62845000
                                                               << 8500>>62850000
<< If file is opened, then post an "*" >>                      << 8500>>62855000
IF FILE'OPEN                                                   << 8500>>62860000
   THEN MOVE OUT'BUFF'B( L ) := "*";                           << 8500>>62865000
L := L + 2;                                                    << 8502>>62870000
                                                               << 8500>>62875000
<< Get the file code and the mnemonic if possible.  If the >>  << 8500>>62880000
<< file code is negative, move "PRIV" into the buffer.  If >>  << 8500>>62885000
<< the file code is > 0 see if the code is HP reserved, if >>  << 8500>>62890000
<< so the mnemonic will be placed in the buffer.  If the   >>  << 8500>>62895000
<< file code = 0, it still may be a KSAM file so check and >>  << 8500>>62900000
<< move "KSAM" into the buffer, else leave it blank for 0. >>  << 8500>>62905000
                                                               << 8500>>62910000
IF FLFILECODE < 0                                              << 8500>>62915000
   THEN MOVE OUT'BUFF'B( L ) := PRIV'MNEMONIC,( 5 )            << 8500>>62920000
   ELSE IF FLFILECODE > 0                                      << 8500>>62925000
           THEN BEGIN                                          << 8500>>62930000
                GET'FILEMNEMONIC( FLFILECODE,                  << 8500>>62935000
                                  OUT'BUFF'B( L ),             << 8500>>62940000
                                  FL'MNEMONIC'LEN );           << 8500>>62945000
                IF <>                                          << 8500>>62950000
                   THEN ASCII(FLFILECODE,-10,OUT'BUFF'B(L+3)); << 8500>>62955000
                END                                            << 8500>>62960000
           ELSE IF FLKSAM                                      << 8500>>62965000
                   THEN MOVE OUT'BUFF'B( L ) := KSAM,( 5 );    << 8500>>62970000
                                                               << 8500>>62975000
L := L + 11;                                                   << 8500>>62980000
                                                               << 8500>>62985000
<< Post the record size and the type >>                        << 8500>>62990000
                                                               << 8500>>62995000
<< The record size is stored negative>>                        << 8500>>63000000
<< and in bytes.                     >>                        << 8500>>63005000
IF FLASCII = 0                                                 << 8500>>63010000
   THEN BEGIN                                                  << 8500>>63015000
        << A Binary file >>                                    << 8500>>63020000
       TOS := -FLRECSIZE;                                      << 8500>>63025000
       << Convert to words >>                                  << 8500>>63030000
       TOS := TOS & ASR(1);                                    << 8500>>63035000
       RSIZE := TOS;                                           << 8500>>63040000
       MOVE OUT'BUFF'B( L ) := "W";                            << 8500>>63045000
       END                                                     << 8500>>63050000
  ELSE BEGIN                                                   << 8500>>63055000
       RSIZE := -FLRECSIZE;                                    << 8500>>63060000
       MOVE OUT'BUFF'B( L ) := "B";                            << 8500>>63065000
       END;                                                    << 8500>>63070000
                                                               << 8500>>63075000
IF FLFORMAT = 1     << A VARIABLE RECORD LENGTH >>             << 8500>>63080000
      AND           <<            AND           >>             << 8500>>63085000
   NOT FLMSGFILE    << NOT A MESSAGE FILE THEN  >>             << 8500>>63090000
   THEN BEGIN                                                  << 8500>>63095000
        RSIZE := RSIZE - 2;                                    << 8500>>63100000
        IF FLASCII = 1                                         << 8500>>63105000
           THEN RSIZE := RSIZE - 2;                            << 8500>>63110000
        END;                                                   << 8500>>63115000
                                                               << 8500>>63120000
ASCII( RSIZE, -10, OUT'BUFF'B( L - 1) );                       << 8500>>63125000
                                                               << 8500>>63130000
L := L + 3;                                                    << 8500>>63135000
                                                               << 8500>>63140000
<< Post the format of the records >>                           << 8500>>63145000
CASE FLFORMAT OF                                               << 8500>>63150000
                                                               << 8500>>63155000
     BEGIN                                                     << 8500>>63160000
                                                               << 8500>>63165000
     << 0 >> << Fixed >>                                       << 8500>>63170000
     MOVE OUT'BUFF'B( L ) := "F";                              << 8500>>63175000
                                                               << 8500>>63180000
     << 1 >> << Variable >>                                    << 8500>>63185000
     MOVE OUT'BUFF'B( L ) := "V";                              << 8500>>63190000
                                                               << 8500>>63195000
     << 2 >> << Undefined >>                                   << 8500>>63200000
     MOVE OUT'BUFF'B( L ) := "U";                              << 8500>>63205000
                                                               << 8500>>63210000
     END;                                                      << 8500>>63215000
                                                               << 8500>>63220000
L := L + 1;                                                    << 8500>>63225000
                                                               << 8500>>63230000
<< Post the Binary or the Ascii >>                             << 8500>>63235000
CASE FLASCII OF                                                << 8500>>63240000
                                                               << 8500>>63245000
     BEGIN                                                     << 8500>>63250000
                                                               << 8500>>63255000
     << 0 >> << Binary >>                                      << 8500>>63260000
     MOVE OUT'BUFF'B( L ) := "B";                              << 8500>>63265000
                                                               << 8500>>63270000
     << 1 >> << ASCII >>                                       << 8500>>63275000
     MOVE OUT'BUFF'B( L ) := "A";                              << 8500>>63280000
                                                               << 8500>>63285000
     END;                                                      << 8500>>63290000
                                                               << 8500>>63295000
L := L + 1;                                                    << 8500>>63300000
                                                               << 8500>>63305000
<< Post information on CCTL >>                                 << 8500>>63310000
IF FLCONTROL = 1                                               << 8500>>63315000
   THEN BEGIN                                                  << 8500>>63320000
        MOVE OUT'BUFF'B( L ) := "C";                           << 8500>>63325000
        L := L + 1;                                            << 8500>>63330000
        END;                                                   << 8500>>63335000
                                                               << 8500>>63340000
<< Post the file type >>                                       << 8500>>63345000
CASE FLFILETYPE OF                                             << 8500>>63350000
                                                               << 8500>>63355000
     BEGIN                                                     << 8500>>63360000
                                                               << 8500>>63365000
     << 0 >> << Standard          >>                           << 8500>>63370000
     ;                                                         << 8500>>63375000
                                                               << 8500>>63380000
     << 1 >> << Reserved for KSAM >>                           << 8500>>63385000
     ;                                                         << 8500>>63390000
                                                               << 8500>>63395000
     << 2 >> <<   RIO             >>                           << 8500>>63400000
     MOVE OUT'BUFF'B( L ) := "R";                              << 8500>>63405000
                                                               << 8500>>63410000
     << 3 >> << Not Assigned      >>                           << 8500>>63415000
     ;                                                         << 8500>>63420000
                                                               << 8500>>63425000
     << 4 >> << Circular File     >>                           << 8500>>63430000
     MOVE OUT'BUFF'B( L ) := "O";                              << 8500>>63435000
                                                               << 8500>>63440000
     << 5 >> << Not Assigned      >>                           << 8500>>63445000
     ;                                                         << 8500>>63450000
                                                               << 8500>>63455000
     << 6 >> << Message File      >>                           << 8500>>63460000
     MOVE OUT'BUFF'B( L ) := "M";                              << 8500>>63465000
                                                               << 8500>>63470000
     END;                                                      << 8500>>63475000
                                                               << 8500>>63480000
IF FLCONTROL = 1                                               << 8500>>63485000
   THEN L := L + 10                                            << 8500>>63490000
   ELSE L := L + 11;                                           << 8500>>63495000
                                                               << 8500>>63500000
<< Print the EOF of the file >>                                << 8500>>63505000
I := DASCII( FLEOF, 10, FIRST'LINE'B );                        << 8500>>63510000
MOVE OUT'BUFF'B( L - I + 1 ) := FIRST'LINE'B( 0 ),( I );       << 8500>>63515000
                                                               << 8500>>63520000
L := L + 11;                                                   << 8500>>63525000
                                                               << 8500>>63530000
<< Print the limit of the file >>                              << 8500>>63535000
I := DASCII( FLFLIM, 10, FIRST'LINE'B );                       << 8500>>63540000
MOVE OUT'BUFF'B( L - I + 1 ) := FIRST'LINE'B( 0 ),( I );       << 8500>>63545000
                                                               << 8500>>63550000
L := L + 2;                                                    << 8500>>63555000
                                                               << 8500>>63560000
IF LIST'LEVEL = 2                                              << 8500>>63565000
   THEN BEGIN                                                  << 8500>>63570000
                                                               << 8500>>63575000
        L := L + 2;                                            << 8500>>63580000
                                                               << 8500>>63585000
        << Need records/block, number of sectors, number of >> << 8500>>63590000
        << extents, and number of extents allocated.        >> << 8500>>63595000
                                                               << 8500>>63600000
        << Compute records/block >>                            << 8500>>63605000
        TOS := DOUBLE( FLBLKSIZE );                            << 8500>>63610000
        TOS := FLRECSIZE;                                      << 8500>>63615000
        IF =                                                   << 8500>>63620000
           THEN TOS := TOS + 128                               << 8500>>63625000
           ELSE IF <                                           << 8500>>63630000
                   THEN TOS := (-TOS + 1) & LSR(1);            << 8500>>63635000
        IF FLMSGFILE                                           << 8500>>63640000
           THEN TOS := TOS + 3;  << Add msg file header >>     << 8500>>63645000
        ASSEMBLE( LDIV, DEL );                                 << 8500>>63650000
        REC'SIZE := TOS;                                       << 8500>>63655000
        ASCII( REC'SIZE, -10, OUT'BUFF'B( L ) );               << 8500>>63660000
                                                               << 8500>>63665000
        L := L + 12;                                           << 8500>>63670000
                                                               << 8500>>63675000
        << Compute the number of extents  >>                   << 8500>>63680000
        << That are being used.           >>                   << 8500>>63685000
        << FLNUMEXTS are max. # extents - 1 >>                 << 8502>>63690000
        MAX'EXTS := FLNUMEXTS;                                 << 8500>>63695000
        EXTENT'MAP( 0 ) := 0;                                  << 8500>>63700000
        MOVE EXTENT'MAP( 1 ) := EXTENT'MAP(0),(63);            << 8502>>63705000
        MOVE EXTENT'MAP( 0 ) := FLEXTMAP,( (MAX'EXTS+1) * 2 ); << 8502>>63710000
        M := 0;                                                << 8500>>63715000
        << Find the number of extents being used >>            << 8500>>63720000
        NUM'EXTENTS'USED := 0;                                 << 8500>>63725000
        WHILE ( M <= INTEGER( MAX'EXTS )) DO                   << 8500>>63730000
           BEGIN                                               << 8500>>63735000
           IF DEXTENT'MAP( M ) <> 0D                           << 8500>>63740000
              THEN NUM'EXTENTS'USED := NUM'EXTENTS'USED + 1;   << 8500>>63745000
           M := M + 1;                                         << 8500>>63750000
           END;                                                << 8500>>63755000
                                                               << 8500>>63760000
                                                               << 8500>>63765000
        << Post number of extents used >>                      << 8500>>63770000
        ASCII( NUM'EXTENTS'USED, -10, OUT'BUFF'B( L ) );       << 8500>>63775000
                                                               << 8500>>63780000
                                                               << 8500>>63785000
        L := L + 3;                                            << 8500>>63790000
                                                               << 8500>>63795000
        << Post the number of max. extents >>                  << 8500>>63800000
        ASCII( MAX'EXTS + 1, -10, OUT'BUFF'B( L ) );           << 8500>>63805000
                                                               << 8500>>63810000
        << Compute the sector information >>                   << 8500>>63815000
        IF DEXTENT'MAP( MAX'EXTS ) = 0D                        << 8500>>63820000
           THEN TOS := LOGICAL( NUM'EXTENTS'USED )             << 8500>>63825000
                       **LOGICAL( FLEXTSIZE )                  << 8500>>63830000
           ELSE TOS := ( LOGICAL( NUM'EXTENTS'USED ) -1 )      << 8500>>63835000
                       **LOGICAL( FLEXTSIZE ) +                << 8500>>63840000
                       DOUBLE(LOGICAL(FLLASTEXTSIZE));         << 8500>>63845000
                                                               << 8500>>63850000
        << Post the sector information >>                      << 8500>>63855000
        M := DASCII( *, 10, FIRST'LINE'B );                    << 8765>>63860000
        MOVE OUT'BUFF'B( L - 6 - M + 1 ) := FIRST'LINE'B( 0 ), << 8500>>63865000
                                            ( M );             << 8500>>63870000
                                                               << 8500>>63875000
                                                               << 8500>>63880000
        L := L + 2;                                            << 8500>>63885000
       END;  << If LIST'LEVEL = 2 >>                           << 8500>>63890000
                                                               << 8500>>63895000
                                                               << 8500>>63900000
MOVE OUT'BUFF'B( L ) := "(TEMP)";                              << 8500>>63905000
                                                               << 8500>>63910000
FWRITE( FNUM, OUT'BUFF, 38 , 0 );                              << 8500>>63915000
                                                               << 8500>>63920000
END; << Subroutine FORMAT'LEVEL'1'2 >>                         << 8500>>63925000
$PAGE                                                          << 8921>>63930000
<< *********************************************************** << 8921>>63935000
<<                                                             << 8921>>63940000
<< Subroutine GET'FILE'LABEL                                   << 8921>>63945000
<<                                                             << 8921>>63950000
<< Purpose: To return the file label of the temporary file     << 8921>>63955000
<<          from the directory.  Check to see if file was      << 8921>>63960000
<<          created under a user on a private volume.  May     << 8921>>63965000
<<          need to mount a volume.                            << 8921>>63970000
<<                                                             << 8921>>63975000
<< *********************************************************** << 8921>>63980000
                                                               << 8921>>63985000
LOGICAL SUBROUTINE GET'FILE'LABEL;                             << 8921>>63990000
BEGIN                                                          << 8921>>63995000
GET'FILE'LABEL := 1;  << MUST EQUAL 0 IF WE GET LABEL >>       << 8921>>64000000
SUCCESS'MOUNT := TRUE;                                         << 8921>>64005000
PVINFO := 0;                                                   << 8921>>64010000
FILE'INFO( 0 ) := -1;                                          << 8921>>64015000
MOVE FILE'INFO( 1 ) := FILE'INFO( 0 ),( 3 );                   << 8921>>64020000
                                                               << 8921>>64025000
<< Returns true if the file label is successfully retreived >> << 8921>>64030000
                                                               << 8921>>64035000
<< See if group and account is on a PV.  If so, attempt to >>  << 8921>>64040000
<< mount.  If it mounts, PVINFO.(4:4) will contain the     >>  << 8921>>64045000
<< mounted volume table index used to get the correct LDEV >>  << 8921>>64050000
DIREC'ERROR := DIRECFIND( %10, 0D, T'ACCOUNT'L, T'GROUP'L,     << 8921>>64055000
                          T'FILENAME'L, GROUP'ENTRY'ARRAY );   << 8921>>64060000
                                                               << 8921>>64065000
IF GROUP'ENTRY'ARRAY( GLINKAGE ).(PVF) = PV THEN               << 8921>>64070000
   BEGIN                                                       << 8921>>64075000
   MOUNT( STAR, T'GROUP, T'ACCOUNT, MOUNT'REQ, -1, PVINFO );   << 8921>>64080000
   IF <>                                                       << 8921>>64085000
      THEN BEGIN                                               << 8921>>64090000
           SUCCESS'MOUNT := FALSE;                             << 8921>>64095000
           CIERR( -LISTFFLABIOERR );                           << 8921>>64100000
           END;                                                << 8921>>64105000
   END;                                                        << 8921>>64110000
                                                               << 8921>>64115000
IF SUCCESS'MOUNT = TRUE                                        << 8921>>64120000
   THEN BEGIN                                                  << 8921>>64125000
        LDEV := LUN( VOLUME'INDEX, MVTABX );                   << 8921>>64130000
        TOS  := FLABIO( LDEV, SECTOR, 0, FLAB );               << 8921>>64135000
        IF TOS <> 0                                            << 8921>>64140000
           THEN CIERR( -LISTFFLABIOERR )                       << 8921>>64145000
           ELSE GET'FILE'LABEL := 0;                           << 8921>>64150000
        IF GROUP'ENTRY'ARRAY( GLINKAGE ).( PVF ) = PV          << 9001>>64155000
            THEN DISMOUNT( STAR, T'GROUP, T'ACCOUNT,           << 8921>>64160000
                                  TWO, PVINFO );               << 8921>>64165000
                                                               << 8921>>64170000
       END;                                                    << 8921>>64175000
END;   << Subroutine GET'FILE'LABEL >>                         << 8921>>64180000
$PAGE                                                          << 8500>>64185000
<<**********************************************************>> << 8500>>64190000
<<                                                          >> << 8500>>64195000
<< Subroutine FORMAT'FILE'INFO                              >> << 8500>>64200000
<<                                                          >> << 8500>>64205000
<< Purpose:  1.  Get the file label.                        >> << 8500>>64210000
<<           2.  Drive the formatting of the file           >> << 8500>>64215000
<<               information depending upon LIST'LEVEL.     >> << 8500>>64220000
<<           3.  Control the printing of the correct banner >> << 8500>>64225000
<<               at the correct time.                       >> << 8500>>64230000
<<                                                          >> << 8500>>64235000
<<**********************************************************>> << 8500>>64240000
                                                               << 8500>>64245000
SUBROUTINE FORMAT'FILE'INFO;                                   << 8500>>64250000
BEGIN                                                          << 8500>>64255000
                                                               << 8500>>64260000
                                                               << 8500>>64265000
<< Get the file label if LIST'LEVEL <> 0 >>                    << 8921>>64270000
IF LIST'LEVEL = 0                                              << 8921>>64275000
   THEN FORMAT'LEVEL'0                                         << 8921>>64280000
   ELSE BEGIN                                                  << 8921>>64285000
                                                               << 8921>>64290000
        TOS := GET'FILE'LABEL;                                 << 8921>>64295000
        IF TOS = 0                                             << 8921>>64300000
           THEN CASE ( LIST'LEVEL + 1  ) OF                    << 8921>>64305000
                     BEGIN                                     << 8921>>64310000
                     << 0 >> << LEVEL -1 FORMAT >>             << 8921>>64315000
                     FORMAT'LEVEL'MINUS'1;                     << 8921>>64320000
                                                               << 8921>>64325000
                     << 1 >> << LEVEL 0 FORMAT  >>             << 8921>>64330000
                     ;       << SPOKEN FOR      >>             << 8921>>64335000
                                                               << 8921>>64340000
                     << 2 >> << LEVEL 1 FORMAT  >>             << 8921>>64345000
                     FORMAT'LEVEL'1'2;                         << 8921>>64350000
                                                               << 8921>>64355000
                     << 3 >> << LEVEL 2 FORMAT  >>             << 8921>>64360000
                     FORMAT'LEVEL'1'2;                         << 8921>>64365000
                                                               << 8921>>64370000
                     END;                                      << 8921>>64375000
        END;  << LIST'LEVEL <> 0 >>                            << 8921>>64380000
                                                               << 8921>>64385000
END;   << Subroutine FORMAT'FILE'INFO >>                       << 8921>>64390000
$PAGE                                                          << 8500>>64395000
<<***********************************************************>><< 8500>>64400000
<<                                                           >><< 8500>>64405000
<< Subroutine CLOSE'LIST'FILE                                >><< 8500>>64410000
<<                                                           >><< 8500>>64415000
<< Purpose:  To close any user specified listfile            >><< 8500>>64420000
<<           as a Temporary file.                            >><< 8500>>64425000
<<                                                           >><< 8500>>64430000
<<***********************************************************>><< 8500>>64435000
                                                               << 8500>>64440000
SUBROUTINE CLOSE'LIST'FILE;                                    << 8500>>64445000
BEGIN                                                          << 8500>>64450000
<< POST A BLANK LINE >>                                        << 8500>>64455000
IF ALREADY'PRT = TRUE                                          << 8502>>64460000
   THEN FWRITE( FNUM, B'LINE, 2, 0 );                          << 8500>>64465000
                                                               << 8500>>64470000
IF NOT STDLIST                                                 << 8500>>64475000
   THEN BEGIN                                                  << 8500>>64480000
        FCLOSE( FNUM, FCLOSE'OPTIONS, 0 );                     << 8500>>64485000
        IF <>                                                  << 8500>>64490000
           THEN BEGIN                                          << 8500>>64495000
                FERROR'( FNUM, PARMNUM );                      << 8500>>64500000
                CIERR( ERRNUM := LISTFFSERR, LISTFILE,         << 8500>>64505000
                                 %10000, PARMNUM );            << 8500>>64510000
                END;                                           << 8500>>64515000
       END;                                                    << 8500>>64520000
END;  << Subroutine CLOSE'LIST'FILE >>                         << 8500>>64525000
$PAGE                                                          << 8500>>64530000
$PAGE                                                          << 8500>>64535000
<<***********************************************************>><< 8502>>64540000
<<                                                             << 8502>>64545000
<< Subroutine PRINT'DRIVER                                     << 8502>>64550000
<<                                                             << 8502>>64555000
<< Purpose:   To drive the printing of the header and the      << 8502>>64560000
<<            formatting of the information.                   << 8502>>64565000
<<                                                             << 8502>>64570000
<<***********************************************************>><< 8502>>64575000
                                                               << 8502>>64580000
SUBROUTINE PRINT'DRIVER;                                       << 8502>>64585000
                                                               << 8502>>64590000
BEGIN                                                          << 8502>>64595000
<< Post USER.ACCOUNT,LOGGROUP  >>                              << 8502>>64600000
                                                               << 8502>>64605000
IF (( LIST'LEVEL > -1     ) LAND                               << 8502>>64610000
    ( ALREADY'PRT = FALSE ) )                                  << 8502>>64615000
    THEN BEGIN                                                 << 8502>>64620000
         FWRITE( FNUM, B'LINE, 2, 0 );                         << 8502>>64625000
         FORMAT'USER;                                          << 8502>>64630000
         FWRITE( FNUM, HEADING'L, -46, 0 );                    << 8502>>64635000
         IF LIST'LEVEL = 0                                     << 8502>>64640000
             THEN FWRITE( FNUM, B'LINE, 2, 0 );                << 8502>>64645000
         ALREADY'PRT := TRUE;                                  << 8502>>64650000
         END;                                                  << 8502>>64655000
FORMAT'FILE'INFO;  << Display info >>                          << 8502>>64660000
END;  << Subroutine PRINT'DRIVER >>                            << 8502>>64665000
$PAGE                                                          << 8502>>64670000
<<***********************************************************>><< 8502>>64675000
<<                                                            ><< 8500>>64680000
<< Subroutine FORMAT'TEMP'FILES                               ><< 8500>>64685000
<<                                                            ><< 8500>>64690000
<< Purpose:  To format the temporary files in the user's      ><< 8500>>64695000
<<           desired format.                                  ><< 8500>>64700000
<<                                                            ><< 8500>>64705000
<<************************************************************><< 8500>>64710000
                                                               << 8500>>64715000
SUBROUTINE FORMAT'TEMP'FILES;                                  << 8500>>64720000
BEGIN                                                          << 8500>>64725000
                                                               << 8500>>64730000
FGETINFO( FNUM, , FOPTIONS, , , DEV );                         << 8500>>64735000
                                                               << 8500>>64740000
<< Print time stamp if we have a job or a listfile >>          << 8500>>64745000
PXGLOBAL;                                                      << 8500>>64750000
INTERACTIVE := PXG'INTERACTIVE;                                << 8500>>64755000
IF NOT INTERACTIVE AND STDLIST                                 << 8500>>64760000
             OR                                                << 8500>>64765000
   NOT INTERACTIVE AND DEV >= 8                                << 8500>>64770000
   THEN BEGIN                                                  << 8500>>64775000
        IF NOT INTERACTIVE AND FOPTIONS.(10:3) = F'STDLIST     << 8500>>64780000
           THEN PAGEEJECT;                                     << 8500>>64785000
        DATE'LINE( DATEBUF );                                  << 8500>>64790000
        FWRITE( FNUM, DATEBUF, -27, %60 );                     << 8500>>64795000
        END;                                                   << 8500>>64800000
                                                               << 8500>>64805000
<< We want to whirl through the JDT matching files with >>     << 8500>>64810000
<< PPRESULT.  We want to get the file's file label and  >>     << 8500>>64815000
<< print the appropriate information depending upon the >>     << 8500>>64820000
<< LIST'LEVEL                                           >>     << 8500>>64825000
<< (Of course this sounds easier than it is done)       >>     << 8500>>64830000
<<                                                      >>     << 8500>>64835000
<< PPRESULT was obtained through PRODUCEPARMS.  We are  >>     << 8500>>64840000
<< matching PPRESULT(19) for filename, PPRESULT(23) for >>     << 8500>>64845000
<< group name and PPRESULT(27) for account name.        >>     << 8500>>64850000
<<                                                      >>     << 8500>>64855000
                                                               << 8500>>64860000
<< Get the JDT full of information                      >>     << 8500>>64865000
MOVEJDT( JDTARR );                                             << 8765>>64870000
                                                               << 8500>>64875000
WHO( , , , ,W'GROUP, W'ACCOUNT ); << WHO ARE WE? >>            << 8502>>64880000
                                                               << 8500>>64885000
<< Initialize FOR'FILE'NAME with group and acct in case  >>    << 9001>>64890000
<< $OLDPASS is the first file                            >>    << 9001>>64895000
                                                               << 9001>>64900000
MOVE FOR'FILE'NAME( 0 ) := " ";                                << 9001>>64905000
MOVE FOR'FILE'NAME( 1 ) := FOR'FILE'NAME( 0 ),( 25 );          << 9001>>64910000
MOVE FOR'FILE'NAME( 8 ) := ".";                                << 9001>>64915000
I := 0;                                                        << 9001>>64920000
M := 9;                                                        << 9001>>64925000
WHILE (I < 8 LAND W'GROUP( I ) <> " ") DO                      << 9001>>64930000
   BEGIN                                                       << 9001>>64935000
   MOVE FOR'FILE'NAME( M ) := W'GROUP( I ),( 1 );              << 9001>>64940000
   I := I + 1;                                                 << 9001>>64945000
   M := M + 1;                                                 << 9001>>64950000
   END;                                                        << 9001>>64955000
FOR'FILE'NAME( M ) := ".";                                     << 9001>>64960000
M := M + 1;                                                    << 9001>>64965000
I := 0;                                                        << 9001>>64970000
WHILE ( I < 8 LAND W'ACCOUNT( I ) <> " ") DO                   << 9001>>64975000
   BEGIN                                                       << 9001>>64980000
   MOVE FOR'FILE'NAME( M ) := W'ACCOUNT( I ),( 1 );            << 9001>>64985000
   I := I + 1;                                                 << 9001>>64990000
   M := M + 1;                                                 << 9001>>64995000
   END;                                                        << 9001>>65000000
                                                               << 9001>>65005000
MOVE T'ACCOUNT(0) := W'ACCOUNT( 0 ),(8);                       << 9001>>65010000
MOVE T'GROUP( 0 ) := W'GROUP( 0 ),(8);                         << 9001>>65015000
                                                               << 8500>>65020000
<< Set head and tail pointers                           >>     << 8500>>65025000
@TFEQ'HEAD := JDTJTFDPTR;                                      << 8500>>65030000
@TFEQ'TAIL := JDTJTFEQPTR;                                     << 8500>>65035000
                                                               << 8502>>65040000
REPROCESS    := FALSE;                                         << 8502>>65045000
CHECK'NEEDED := TRUE;                                          << 8502>>65050000
ALREADY'PRT  := FALSE;                                         << 8502>>65055000
                                                               << 8502>>65060000
IF @TFEQ'HEAD = @TFEQ'TAIL                                     << 8500>>65065000
   THEN IF HANDLE'OLDPASS = FALSE   << No $OLDPASS >>          << 8502>>65070000
           THEN CIERR( ERRNUM := -LISTFTEMPNOTFEQS )           << 8500>>65075000
           ELSE PRINT'DRIVER  << Handles heading/formatting >> << 8502>>65080000
   ELSE BEGIN                                                  << 8500>>65085000
                                                               << 8500>>65090000
                                                               << 8500>>65095000
        << TFEQ'ENTRY POINTING AT THE FIRST TFEQ >>            << 8500>>65100000
        << START OF Q RELATIVE ARRAY JDTARR IS  >>             << 8500>>65105000
        << IS ADDED.                            >>             << 8500>>65110000
        @TFEQ'ENTRY := @TFEQ'HEAD + @JDTARR;                   << 8500>>65115000
        @TFEQ'TAIL  := @TFEQ'TAIL + @JDTARR;                   << 8500>>65120000
                                                               << 8500>>65125000
        << Loop on TFEQ'ENTRY until @TFEQ'ENTRY = >>           << 8500>>65130000
        << @TFEQ'TAIL.  Files will be formatted >>             << 8500>>65135000
                                                               << 8500>>65140000
        WHILE( @TFEQ'ENTRY < @TFEQ'TAIL ) DO                   << 8500>>65145000
          BEGIN                                                << 8500>>65150000
          @SAVE'TFEQ'ENTRY := @TFEQ'ENTRY;                     << 8500>>65155000
                                                               << 8500>>65160000
          << Entry size is in words >>                         << 8500>>65165000
          TFEQ'ENTRY'SIZE := TFEQ'ENTRY.(0:8);                 << 8500>>65170000
          INIT'BUFF;                                           << 8500>>65175000
          << If we have a temporary file that the user >>      << 8921>>65180000
          << desires, call the formatting subroutine,  >>      << 8921>>65185000
          << PRINT'DRIVER.                             >>      << 8921>>65190000
          IF GET'TFNAME = TRUE                                 << 8502>>65195000
             THEN PRINT'DRIVER;                                << 8502>>65200000
          IF REPROCESS = FALSE                                 << 8502>>65205000
          << A reprocess takes effect if $OLDPASS was  >>      << 8921>>65210000
          << processed instead of the temporary file.  >>      << 8921>>65215000
          << This will happen if the group and/or the  >>      << 8921>>65220000
          << account of the temporary file is different>>      << 8921>>65225000
          << than that of the previously processed     >>      << 8921>>65230000
          << temporary file.  $OLDPASS is always       >>      << 8921>>65235000
          << checked after a new group and/or account  >>      << 8921>>65240000
          << is detected.                              >>      << 8921>>65245000
             THEN @TFEQ'ENTRY:=@SAVE'TFEQ'ENTRY+TFEQ'ENTRY'SIZE<< 8502>>65250000
             ELSE REPROCESS := FALSE;  << Flop flag back >>    << 8502>>65255000
          END;    << While statement >>                        << 8500>>65260000
                                                               << 8500>>65265000
        IF ALREADY'PRT = FALSE                                 << 8502>>65270000
           THEN CIERR( ERRNUM := -LISTFTEMPNOTFOUND );         << 8502>>65275000
        END  << Else begin      >>                             << 8500>>65280000
                                                               << 8500>>65285000
END;                                                           << 8500>>65290000
$PAGE                                                          << 8500>>65295000
                                                               << 8500>>65300000
<<            ***********************                        >><< 8500>>65305000
<<            **                   **                        >><< 8500>>65310000
<<            ** M A I N   B O D Y **                        >><< 8500>>65315000
<<            **                   **                        >><< 8500>>65320000
<<            ***********************                        >><< 8500>>65325000
                                                               << 8500>>65330000
<< Initialize PARMS and various other arrays >>                << 8500>>65335000
MOVE B'LINE := "    ";                                         << 8500>>65340000
MOVE B'HEAD1 :=                                                << 8500>>65345000
   "ACCOUNT=              GROUP=            ";                 << 8502>>65350000
MOVE B'HEAD2 :=                                                << 8500>>65355000
   "FILENAME  CODE  ------------LOGICAL RECORD--------  ";     << 8502>>65360000
MOVE B'HEAD22 :=                                               << 8500>>65365000
   "---  ----SPACE----";                                       << 8500>>65370000
MOVE B'HEAD3 :=                                                << 8500>>65375000
   "SIZE  TYP        EOF      LIMIT   ";                       << 8502>>65380000
MOVE B'HEAD32 :=                                               << 8500>>65385000
   "R/B  SECTORS #X MX";                                       << 8500>>65390000
                                                               << 8500>>65395000
MOVE PRIV'MNEMONIC := "PRIV ";                                 << 8500>>65400000
MOVE KSAM := "KSAM ";                                          << 8500>>65405000
                                                               << 8500>>65410000
PARMS := 0D;                                                   << 8500>>65415000
TOS := @PARMS+2;   << Address of here to start initializing >> << 8500>>65420000
TOS := @PARMS+1;   << Address where the zero is coming from >> << 8500>>65425000
TOS := 6;          << Number of words to initialize         >> << 8500>>65430000
ASSEMBLE( MOVE );  << Move the zero to six words            >> << 8500>>65435000
                                                               << 8500>>65440000
<< Parse the LISTFTEMP command                              >> << 8500>>65445000
<<**********************************************************>> << 8500>>65450000
<< The syntax is as follows:                                >> << 8500>>65455000
<<                                                          >> << 8500>>65460000
<<                                 0                        >> << 8500>>65465000
<<           :LISTFTEMP [fileset][,1][;listfile]            >> << 8500>>65470000
<<                                 2                        >> << 8500>>65475000
<<                                -1                        >> << 8500>>65480000
<<                                                          >> << 8500>>65485000
<<**********************************************************>> << 8500>>65490000
<<                                                          >> << 8500>>65495000
<< WE KEEP THE JIR THROUGHOUT THE PROCESSING TO KEEP OTHER  >> << 8500>>65500000
<< MEMBERS OF THE PROCESS TREE FROM PURGING TEMPORARY FILES >> << 8500>>65505000
<<                                                          >> << 8500>>65510000
                                                               << 8500>>65515000
JIR := LOCKJIR;                                                << 8500>>65520000
MYCOMMAND(PARMSP,DL,4,NUMPARMS,PARMS);                         << 8500>>65525000
PARMNUM := 1;                                                  << 8500>>65530000
IF NOT PRODUCEPARMS( 0, PARMSP, PPRESULT, DELIM, ERRNUM)       << 8500>>65535000
   THEN BEGIN                                                  << 8502>>65540000
        UNLOCKJIR( JIR );                                      << 8502>>65545000
        RETURN;                                                << 8502>>65550000
        END;     << Begin if parsing error >>                  << 8502>>65555000
IF ( NUMPARMS > 0 ) AND  <<NOT JUST A CR>>                     << 8500>>65560000
   (@DELIM < @LEAFNAME+INTEGER(LEAFNAMELEN))                   << 8500>>65565000
   THEN BEGIN  << EXTRANEOUS STUFF IN LEAFNAME >>              << 8500>>65570000
        TOS := ERRNUM := LISTFEXTRANEOUS;                      << 8500>>65575000
        TOS := @DELIM;                                         << 8500>>65580000
        CIERR( *, * );                                         << 8500>>65585000
        UNLOCKJIR( JIR );                                      << 8502>>65590000
        RETURN;                                                << 8500>>65595000
        END;                                                   << 8500>>65600000
                                                               << 8500>>65605000
IF NUMPARMS = 0                                                << 8500>>65610000
   THEN LEAFNAMECHAR := CR;                                    << 8500>>65615000
                                                               << 8500>>65620000
IF LIST'LEVEL'OK = TRUE                   << Get LIST'LEVEL  >><< 8502>>65625000
   THEN IF LIST'FILE'OK = TRUE            << Get LIST'FILE   >><< 8502>>65630000
           THEN BEGIN                                          << 8500>>65635000
                FORMAT'TEMP'FILES;        << Print fileinfo  >><< 8502>>65640000
                CLOSE'LIST'FILE;          << Close LIST'FILE >><< 8502>>65645000
                END;                                           << 8500>>65650000
                                                               << 8500>>65655000
UNLOCKJIR( JIR );                                              << 8500>>65660000
END;  <<CXLISTFTEMP>>                                          << 8500>>65665000
$CONTROL SEGMENT=MAIN                                          << 8500>>65670000
END.                                                           << 8500>>65675000
